UNIX — универсальная среда программирования - Брайан Керниган

$ cat fib

proc fib() {

 a = 0

 b = 1

 while (b < $1) {

  print b

  с = b

  b = a+b

  a = с

 }

 print "n"

}

$ hoc6 fib -

fib(1000)

 1 1 2 3 5 8 13 21 34.55 89 144 233 377 610 987

...

Здесь также показано использование файлов: имя файла "-" задает стандартный входной поток.

Ниже приведена функция "факториал":

$ cat fac

func fac() {

 if ($1 <= 0) return 1 else return $1 * fac($1-1)

}

$ hoc6 fac -

fac(0)

 1

fac(7)

 5040

fac(10)

 3628800

...

Внутри процедуры или функции к параметрам можно обращаться с помощью $1 и т.д., как в командных файлах, но, кроме того, допустимо присваивание параметрам. Функции и процедуры рекурсивны, но в качестве локальных переменных можно использовать только параметры; остальные переменные являются глобальными, т.е. доступными во всей программе.

В языке hoc функции и процедуры различаются, что дает возможность проверки, ценной для освобождения стека. (Ведь так легко забыть выполнить возврат или записать липшее выражение и получить несбалансированный стек!)

Требуется значительное число изменений для преобразования грамматики при переходе от hoc5 к hoc6, но все они локальные. Нужны новые лексемы и нетерминальные символы, а в описание %union необходимо ввести новый элемент для хранения числа аргументов:

$cat hoc.y

...

%{

#include "hoc.h"

#define code2(c1,c2) code(c1); code(c2)

#define code3(c1,c2,c3) code(c1); code(c2); code(c3)

%}

%union {

 Symbol *sym; /* symbol table pointer */

 Inst *inst; /* machine instruction */

 int narg; /* number of arguments */

}

%token <sym> NUMBER STRING PRINT VAR BLTIN UNDEF WHILE IF ELSE

%token <sym> FUNCTION PROCEDURE RETURN FUNC PROC READ

%token <narg> ARG

%type <inst> expr stmt asgn prlist stmtlist

%type <inst> cond while if begin end

%type <sym> procname

%type <narg> arglist

%right '='

%left OR

%left AND

%left GT GE LT LE EQ NE

%left '+'

%left '*' '/'

%left UNARYMINUS NOT

%right '^'

%%

list: /* nothing */

 | list 'n'

 | list defn 'n'

 | list asgn 'n' { code2(pop, STOP); return 1; }

 | list stmt 'n' { code(STOP); return 1; }

 | list expr 'n' { code2(print, STOP); return 1; }

 | list error 'n' { yyerrok; }

 ;

asgn: VAR '=' expr { code3(varpush,(Inst)$1,assign); $$=$3; }

 | ARG '=' expr

  { defnonly("$"); code2(argassign,(Inst)$1); $$=$3;}

 ;

stmt: expr { code(pop); }

 | RETURN { defnonly("return"); code(procret); }

 | RETURN expr

  { defnonly("return"); $$=$2; code(funcret); }

 | PROCEDURE begin '(' arglist ')'

  { $$ = $2; code3(call, (Inst)$1, (Inst)$4); }

 | PRINT prlist { $$ = $2; }

 | while cond stmt end {

  ($1)[1] = (Inst)$3; /* body of loop */

  ($1)[2] = (Inst)$4;

 } /* end, if cond fails */

 | if cond stmt end { /* else-less if */

  ($1)[1] = (Inst)$3; /* thenpart */

  ($1)[3] = (Inst)$4;

 } /* end, if cond fails */

 | if cond stmt end ELSE stmt end { /* if with else */

  ($1)[1] = (Inst)$3; /* thenpart */

  ($1)[2] = (Inst)$6; /* elsepart */

  ($1)[3] = (Inst)$7;

 } /* end, if cond fails */

 | '{' stmtlist '}' { $$ = $2; }

 ;

cond: '(' expr ')' { code(STOP); $$ = $2; }

 ;

while: WHILE { $$ = code3(whilecode,STOP,STOP); }

 ;

if: IF { $$ = code(ifcode); code3(STOP, STOP, STOP); }

 ;

begin: /* nothing */ { $$ = progp; }

 ;

end: /* nothing */ { code(STOP); $$ = progp; }

 ;

stmtlist: /* nothing */ { $$ = progp; }

 | stmtlist 'n'

 | stmtlist stmt

 ;

expr: NUMBER { $$ = code2(constpush, (Inst)$1); }

 | VAR { $$ = code3(varpush, (Inst)$1, eval); }

 | ARG { defnonly("$"); $$ = code2(arg, (Inst)$1); }

 | asgn

 | FUNCTION begin '(' arglist ')'

  { $$ = $2; code3(call,(Inst)$1,(Inst)$4); }

 | READ '(' VAR ')' { $$ = code2(varread, (Inst)$3); }

 | BLTIN '(' expr ')' { $$=$3; code2(bltin, (Inst)$1->u.ptr); }

 | '(' expr ')' { $$ = $2; }

 | expr '+' expr { code(add); }

 | expr '-' expr { code(sub); }

 | expr '*' expr { code(mul); }

 | expr '/' expr { code(div); }

 | expr '^' expr { code (power); }

 | '-' expr %prec UNARYMINUS { $$=$2; code(negate); }

 | expr GT expr { code(gt); }

 | expr GE expr { code(ge); }

 | expr LT expr { code(lt); }

 | expr LE expr { code(le); }

 | expr EQ expr { code(eq); }

 | expr NE expr { code(ne); }

 | expr AND expr { code(and); }

 | expr OR expr { code(or); }

 | NOT expr { $$ = $2; code(not); }

 ;

prlist: expr { code(prexpr); }

 | STRING { $$ = code2(prstr, (Inst)$1); }

 | prlist ',' expr { code(prexpr); }

 | prlist ',' STRING { code2(prstr, (Inst)$3); }

 ;

defn: FUNC procname { $2->type=FUNCTION; indef=1; }

  '(' ')' stmt { code(procret); define($2); indef=0; }

 | PROC procname { $2->type=PROCEDURE; indef=1; }

  '(' ')' stmt { code(procret); define($2); indef=0; }

 ;

procname: VAR

 | FUNCTION

 | PROCEDURE

 ;

arglist: /* nothing */ { $$ = 0; }

 | expr { $$ = 1; }

 | arglist expr { $$ = $1 + 1; }

 ;

%%

/* end of grammar */

...

С помощью правила для аргсписок (список аргументов) подсчитывается число аргументов. На первый взгляд может показаться, что нужно каким-то образом собирать аргументы, но это не так, поскольку каждое выражение (выраж) из списка аргументов вырабатывает значение в стеке как раз там, где оно необходимо.

Правило для опред вводит новое свойство языка yacc: встроенное действие. Оказывается, можно поместить действие посредине правила, так, чтобы оно выполнялось в процессе распознавания последнего. Мы воспользовались этой возможностью, чтобы запомнить, что сейчас распознается: определение функции или процедуры. (В качестве альтернативного решения можно было бы ввести новый символ типа begin, который распознавался бы в соответствующее время.) Функция defnonly печатает предупреждающее сообщение, если вопреки синтаксису какая-либо конструкция окажется вне определения функции или процедуры. Обычно вам предоставляется выбор: обнаруживать ошибку синтаксически или семантически. Перед нами уже стояла такая задача ранее, при диагностике неопределенных переменных. Функция defnonly хорошо иллюстрирует ситуацию, когда семантическая проверка легче синтаксической.

defnonly(s) /* warn if illegal definition */

 char *s;

{

 if (!indef)

  execerror(s, "used outside definition");

}

Переменная indef определена в hoc.y и принимает значения в действиях для опред.

К лексическому анализатору добавлены средства проверки аргументов: символ $, за которым следует чисто для строки в кавычках. Последовательности в строках, начинающиеся с обратной дробной черты, например n, обрабатываются функцией backslash:

yylex() /* hoc6 */

 ...

 if (c == '$') { /* argument? */

  int n = 0;

  while (isdigit(c=getc(fin)))

   n = 10 * n + c — '0';

  ungetc(с, fin);

  if (n == 0)

   execerror("strange $...", (char*)0);

  yylval.narg = n;

  return ARG;

 }

 if (c == '"') { /* quoted string */

  char sbuf [100], *p, *emalloc();

  for (p = sbuf; (c=getc(fin)) != '"'; p++) {

   if (с == 'n' || c == EOF)

    execerror("missing quote", "");

   if (p >= sbuf + sizeof (sbuf) - 1) {

    *p = '';

    execerror("string too long", sbuf);

   }

   *p = backslash(c);

  }

  *p = 0;

  yylval.sym = (Symbol*)emalloc(strlen(sbuf)+1);

  strcpy(yylval.sym, sbuf);

  return STRING;

 }

 ...

backslash(c) /* get next char with 's interpreted */

 int c;

{

 char *index(); /* 'strchr()' in some systems */

 static char transtab[] = "bbffnnrrtt";

 if (c != '\')

  return c;

 c = getc(fin);

 if (islower(c) && index(transtab, c))

  return index(transtab, с)[1];

 return c;

}

Лексический анализатор является примером конечного автомата независимо от того, написан ли он на Си или получен с помощью порождающей программы типа lex. Наша первоначальная версия Си программы стала весьма сложной, и поэтому для всех программ, больших ее по объему, лучше использовать lex, чтобы максимально упростить внесение изменений.

Остальные изменения сосредоточены главным образом в файле code.c, хотя несколько имен функций добавляется к файлу hoc.h. Машина остается той же, но с дополнительным стеком для хранения последовательности вложенных вызовов функций и процедур (проще ввести второй стек, чем загружать больший объем информации в существующий). Начало файла code.c выглядит так: