Читаем без скачивания UNIX — универсальная среда программирования - Брайан Керниган

while (read(x)) {

 print "value is ", x, "n"

}

.ft

.DE

.NH

Functions and Procedures

.PP

Functions and procedures are distinct in @[email protected],

although they are defined by the same mechanism.

This distinction is simply for run-time error checking:

it is an error for a procedure to return a value,

and for a function @[email protected] to return one.

.PP

The definition syntax is:

.ix [hoc] function~definition

.ix [hoc] procedure~definition

.DS

.I

.ta 1i

function: func name() stmt

procedure: proc name() stmt

.R

.DE

.I name

may be the name of any variable (em built-in functions are excluded.

The definition, up to the opening brace or statement,

must be on one line, as with the

.I if

statements above.

.PP

Unlike C,

the body of a function or procedure may be any statement, not

necessarily a compound (brace-enclosed) statement.

Since semicolons have no meaning in @[email protected],

a null procedure body is formed by an empty pair of braces.

.PP

Functions and procedures may take arguments, separated by commas,

when invoked. Arguments are referred to as in the shell:

.ix [hoc] arguments

.IT $3

refers to the third (1-indexed) argument.

They are passed by value and within functions

are semantically equivalent to variables.

It is an error to refer to an argument numbered greater than the

number of arguments passed to the routine. The error checking

is done dynamically, however, so a routine may have variable numbers

of arguments if initial arguments affect the number of arguments

to be referenced (as in C's @[email protected]).

.PP

Functions and procedures may recurse, but the stack has limited depth

(about a hundred calls). The following shows a

.I

hoc

definition of Ackermann's function:

.ix Ackermann's~function

.DS

.ft CW

.ix [ack]~function

.S $ "hoc

.S "func ack() {

.S " if ($1 == 0) return $2+1

.S " if ($2 == 0) return ack($1-1, 1)

.S " return ack($1-1, ack($1, $2-1))

.S "}

.S "ack(3, 2)

 29

.S "ack(3, 3)

 61

.S "ack(3, 4)

hoc: stack too deep near line 8

&...

.ft

.DE

.bp

.NH

Examples

.PP

Stirling's~formula:

.ix Stirling's~formula

.EQ

n! ~(ap~ sqrt {2n pi} (n/e) sup n (1+ 1 over 12n )

.EN

.DS

.ft CW

.S $ hoc

.S "func stirl() {

.S " return sqrt(2*$1*PI) * ($1/E)"$1*(1 + 1/(12*$1)) .S "}

.S "stirl(10)

 3628684.7

.S stirl(20)

 2.4328818e+18

.ft R

.DE

.PP

Factorial function, @[email protected]:

.ix [fac]~function

.DS

. S "func fac() if ($1 <= 0) return 1 else return $1 * fac($1-1)

.ft R

.DE

.PP

Ratio of factorial to Stirling approximation:

.DS

.S "i = 9

.S "while ((i = i+1) <= 20) {

.S print i, " ", fac(i)/stirl(i), "en"

.S "} .ft CW

10 1.0000318

11 1.0000265

12 1.0000224

13 1.0000192

14 1.0000166

15 1.0000146

16 1.0000128

17 1.0000114

18 1.0000102

19 1.0000092

20 1.0000083

.ft

.DE

3.7.14 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)UID = (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 */

#include <stdio.h>

#include <ctype.h>

char *progname;

int lineno = 1;

#include <signal.h>

#include <setjmp.h>

jmp_buf begin;

int indef;

char *infile; /* input file name */

FILE *fin; /* input file pointer */

char **gargv; /* global argument list */

int gargc;

int c; /* global for use by warning() */

yylex() /* hoc6 */

{

 while ((c=getc(fin)) == ' ' || c == 't')

  ;

 if (c == EOF)

  return 0;

 if (c == '.' || isdigit(c)) { /* number */

  double d;

  ungetc(c, fin);

  fscanf(fin, "%lf", &d);

  yylval.sym = install("", NUMBER, d);

  return NUMBER;

 }

 if (isalpha(c)) {

  Symbol *s;

  char sbuf[100], *p = sbuf;

  do {

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

    *p = '';

    execerror("name too long", sbuf);

   }

   *p++ = c;

  } while ((c=getc(fin)) != EOF && isalnum(c));

  ungetc(c, fin);

  *p = '';

  if ((s=lookup(sbuf)) == 0)

   s = install(sbuf, UNDEF, 0.0);

  yylval.sym = s;

  return s->type == UNDEF ? VAR : s->type;

 }

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

  int n = 0;

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

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

  ungetc(c, 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);