v07i125: OCCAM - yacc specification with lexer
Brandon S. Allbery - comp.sources.misc
allbery at uunet.UU.NET
Sat Aug 12 10:11:51 AEST 1989
Posting-number: Volume 7, Issue 125
Submitted-by: pjmp at hrc63.uucp (Peter Polkinghorne)
Archive-name: occam.yacc
[Which leaves me only one question: what is OCCAM? It looks like some kind of
realtime control language (for MIDI?). ++bsa]
Here is a simple OCCAM yacc specification with lexer. OCCAM & OCCAM2 are
handled. Hope this is the right newsgroup. [It is. ++bsa] It is not perfect!
---- Cut Here and unpack ----
#!/bin/sh
# shar: Shell Archiver (v1.22)
#
# Run the following text with /bin/sh to create:
# README
# Makefile
# occam.y
# occamlex.c
# occam2.y
# occam2lex.c
# test1
# test2
# test3
# test4
#
if test -f README; then echo "File README exists"; else
echo "x - extracting README (Text)"
sed 's/^X//' << 'SHAR_EOF' > README &&
X
XThese are two Occam recognisers, defined with yacc & handcrafted lexers.
XThe Occam recogniser was developed as a lex & yacc learning exercise.
XThe one for Occam is unambiguous. The one for Occam2 is ambiguous and requires
Xwork to tidy up the syntax. This is mainly because the Occam2 definition is a
Xrather unsuited for yacc, as defined by the Occam2 Language definition by David
XMay.
X
XThe most original part of this is the lex routines which deal with Occam's
Xindentation features. These recognisers are offered because periodically
XI see people on the net asking for an Occam lex & yacc definition.
X
XTo build a compiler from this requires a LOT more work. I hope someone
Xfinds this useful, however I do not intend to maintain it. Hence I am
Xplacing this in the public domain.
X
XFiles supplied:
X
XREADME - this file!
XMakefile - simple UNIX makefile
X
Xoccam.y - Occam yacc specification
Xoccamlex.c - Occam lexer
X
Xoccam2.y - Occam2 yacc specification
Xoccam2lex.c - Occam2 lexer
X
Xtest1 )
Xtest2 )- set of Occam test files for occam.
Xtest3 )
Xtest4 )
X
XHave fun!
X
XPeter Polkinghorne ( pjmp at uk.co.gec-rl-hrc or ...!mcvax!ukc!hrc63!pjmp )
XGEC Hirst Research Centre, East Lane, Wembley, Middlesex, UK
X
SHAR_EOF
chmod 0666 README || echo "restore of README fails"
set `wc -c README`;Sum=$1
if test "$Sum" != "1197"
then echo original size 1197, current size $Sum;fi
fi
if test -f Makefile; then echo "File Makefile exists"; else
echo "x - extracting Makefile (Text)"
sed 's/^X//' << 'SHAR_EOF' > Makefile &&
X#
X# Makefile for occam recogniser - pjmp @ hrc 22/7/86
X#
X
X#
X# This work is in the public domain.
X# It was written by Peter Polkinghorne in 1986 & 1989 at
X# GEC Hirst Research Centre, Wembley, England.
X# No liability is accepted or warranty given by the Author,
X# still less my employers.
X#
X
X# sys V like flags
X#CFLAGS=-g -O
X#YFLAGS=-vdt
X
X# BSD like flags
XCFLAGS=-O
XYFLAGS=-dv
X
Xall: occam occam2
X
Xoccam: occam.o occamlex.o
X cc $(CFLAGS) occam.o occamlex.o -o occam
X
Xoccam.c: occam.y
X yacc $(YFLAGS) occam.y
X mv y.tab.h lex.h
X mv y.tab.c occam.c
X
Xoccam2: occam2.o occam2lex.o
X cc $(CFLAGS) occam2.o occam2lex.o -o occam2
X
Xoccam2.c: occam2.y
X yacc $(YFLAGS) occam2.y
X mv y.tab.h lex2.h
X mv y.tab.c occam2.c
X
Xclean:
X rm -f *.o occam2.c occam.c lex2.h lex.h y.output
X
Xshar: README Makefile occam.y occamlex.c occam2.y occam2lex.c test1 test2 test3 test4
X shar2 -v -s -x -c README Makefile occam.y occamlex.c occam2.y occam2lex.c test1 test2 test3 test4 > shar
SHAR_EOF
chmod 0666 Makefile || echo "restore of Makefile fails"
set `wc -c Makefile`;Sum=$1
if test "$Sum" != "981"
then echo original size 981, current size $Sum;fi
fi
if test -f occam.y; then echo "File occam.y exists"; else
echo "x - extracting occam.y (Text)"
sed 's/^X//' << 'SHAR_EOF' > occam.y &&
X/*
X *
X * OCCAM yacc specification
X *
X * Peter Polkinghorne - GEC Research
X *
X */
X
X/*
X * This work is in the public domain.
X * It was written by Peter Polkinghorne in 1986 & 1989 at
X * GEC Hirst Research Centre, Wembley, England.
X * No liability is accepted or warranty given by the Author,
X * still less my employers.
X */
X
X/* revision history
X 0.0 initial attempt pjmp 22/7/86
X 0.1 add in COMMA so that yylex can cope with
X comma differentiation for PROC decls pjmp 4/8/86
X 0.2 add in main - since BSD does not have -ly
X pjmp 8/3/89
X
Xend revisions */
X
X%token VAR CHAN ANY WAIT SKIP ID EOL
X%token VALUE BYTE DEF PROC NOT NUMBER BOOL
X%token NOW TABLE BOOLOP SHIFTOP COMPOP CHCON STR
X%token LOGOP SEQ ALT IF PAR WHILE FOR
X%token BEG END COMMA
X
X%start program
X
X%%
X
Xprogram : sep process
X | process
X ;
X
Xprocess : primitive sep
X | ID sep
X | ID '(' explist ')' sep
X | construct
X | declaration ':' sep process
X | error sep
X {
X yyerrok;
X }
X ;
X
Xprimitive : assignment
X | input
X | output
X | wait
X | skip
X ;
X
X
Xconstruct : SEQ sep BEG proclist END
X | SEQ replic sep BEG process END
X | SEQ sep
X | PAR sep BEG proclist END
X | PAR replic sep BEG process END
X | PAR sep
X | IF sep BEG condlist END
X | IF replic sep BEG cond END
X | IF sep
X | ALT sep BEG guardplist END
X | ALT replic sep BEG guardp END
X | ALT sep
X | WHILE expr sep BEG process END
X ;
X
Xsep : EOL
X | sep EOL
X ;
X
Xproclist : process
X | proclist process
X ;
X
Xcondlist : cond
X | condlist cond
X ;
X
Xguardplist : guardp
X | guardplist guardp
X ;
X
X
Xreplic : ID '=' '[' expr FOR expr ']'
X ;
X
Xcond : expr sep BEG process END
X | IF sep
X | IF sep BEG condlist END
X | IF replic sep BEG cond END
X ;
X
Xguardp : guard sep BEG process END
X | ALT sep
X | ALT sep BEG guardplist END
X | ALT replic sep BEG guardp END
X ;
X
Xguard : expr '&' input
X | input
X | expr '&' wait
X | wait
X | expr '&' SKIP
X | SKIP
X ;
X
Xdeclaration : VAR varlist
X | CHAN chanlist
X | DEF deflist
X | PROC ID '=' sep BEG process END
X | PROC ID formparms '=' sep BEG process END
X ;
X
Xassignment : var ':' '=' expr
X ;
X
Xinput : chan '?' inlist
X | chan '?' ANY
X ;
X
Xoutput : chan '!' outlist
X | chan '!' ANY
X ;
X
Xwait : WAIT expr
X ;
X
Xskip : SKIP
X ;
X
Xinlist : var
X | inlist ';' var
X ;
X
Xoutlist : expr
X | outlist ';' expr
X ;
X
Xexplist : expr
X | explist ',' expr
X ;
X
Xvarlist : var
X | varlist ',' var
X ;
X
Xchanlist : chan
X | chanlist ',' chan
X ;
X
Xdeflist : def
X | deflist ',' def
X ;
X
Xformparms : '(' fparmlist ')'
X ;
X
Xfparmlist : fparm
X | fparmlist COMMA fparm
X ;
X
Xvar : ID
X | ID subscript
X ;
X
Xchan : ID
X | ID '[' expr ']'
X ;
X
Xdef : ID '=' expr
X | ID '=' veccon
X ;
X
Xsubscript : '[' expr ']'
X | '[' BYTE expr ']'
X ;
X
X
Xfparm : VAR plist
X | CHAN plist
X | VALUE plist
X ;
X
Xplist : parm
X | plist ',' parm
X ;
X
Xparm : ID
X | ID '[' ']'
X ;
X
Xexpr : monop element
X | element op element
X | ellist
X ;
X
Xellist : element
X | ellist assop element
X ;
X
Xmonop : '-'
X | NOT
X ;
X
Xelement : NUMBER
X | BOOL
X | NOW
X | CHCON
X | '(' expr ')'
X | item
X ;
X
Xop : arop
X | COMPOP
X | '='
X | SHIFTOP
X ;
X
Xassop : '+'
X | '*'
X | LOGOP
X | BOOLOP
X ;
X
Xarop : '-'
X | '/'
X | '\\'
X ;
X
Xitem : ID
X | ID subscript
X | veccon subscript
X ;
X
Xveccon : str
X | TABLE '[' BYTE tlist ']'
X | TABLE '[' tlist ']'
X ;
X
X
Xstr : STR
X | str sep STR
X ;
X
Xtlist : expr
X | tlist ',' expr
X ;
X
X%%
X
X#include <stdio.h>
X
Xvoid main()
X{
X
X exit( yyparse() );
X
X}/*main*/
X
Xyyerror( str )
Xchar *str;
X/* our slightly more informative error routine */
X{
X
Xextern int yylineno;
Xextern char yytext[];
X
X fprintf( stderr, "ERROR <%s> near <%s> on line %d\n",
X str, yytext, yylineno );
X
X}/*yyerror*/
X
X/*end occam.y*/
SHAR_EOF
chmod 0666 occam.y || echo "restore of occam.y fails"
set `wc -c occam.y`;Sum=$1
if test "$Sum" != "3693"
then echo original size 3693, current size $Sum;fi
fi
if test -f occamlex.c; then echo "File occamlex.c exists"; else
echo "x - extracting occamlex.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > occamlex.c &&
X/*
X * OCCAM lexical analysis routine
X *
X * pjmp HRC 31/7/86
X *
X */
X
X/*
X * This work is in the public domain.
X * It was written by Peter Polkinghorne in 1986 & 1989 at
X * GEC Hirst Research Centre, Wembley, England.
X * No liability is accepted or warranty given by the Author,
X * still less my employers.
X */
X
X/* revision history
X
X 0.0 first release pjmp 31/7/86
X 0.1 make yylex more rational - common exit pjmp 1/8/86
X 0.2 add in comma differentiation - for proc decl pjmp 4/8/86
X
Xend revisions */
X
X#include <stdio.h>
X#include <ctype.h>
X#include "lex.h"
X
X#define MAXLINE 256
X
X#define TRUE 1
X#define FALSE 0
X
X/************************************************************************/
X/* reserved word list - ordered for binary chomp */
X
Xstatic struct reserv { char * word; int tok, len; } rlist[] = {
X "AFTER", COMPOP, 5,
X "ALT", ALT, 3,
X "AND", BOOLOP, 3,
X "ANY", ANY, 3,
X "BYTE", BYTE, 4,
X "CHAN", CHAN, 4,
X "DEF", DEF, 3,
X "FALSE", BOOL, 5,
X "FOR", FOR, 3,
X "IF", IF, 2,
X "NOT", NOT, 3,
X "NOW", NOW, 3,
X "OR", BOOLOP, 2,
X "PAR", PAR, 3,
X "PROC", PROC, 4,
X "SEQ", SEQ, 3,
X "SKIP", SKIP, 4,
X "TABLE", TABLE, 5,
X "TRUE", BOOL, 5,
X "VALUE", VALUE, 5,
X "VAR", VAR, 3,
X "WAIT", WAIT, 4,
X "WHILE", WHILE, 5,
X 0, 0, 0
X
X };
X
X/************************************************************************/
X
Xstatic char line[MAXLINE]; /* where we store the input, line as a time */
X
Xchar yytext[MAXLINE]; /* where we store text associated with token */
X
Xint yylineno=1, /* line number of input */
X yylen; /* amount of text stored */
X
Xstatic int llen, /* how much in line */
X curind, /* current indentation */
X indent=0; /* this lines indent */
X ldebug = TRUE, /* set to TRUE for debug */
X index; /* where we are in the line */
X
X/* state we are in: either start - get new input, decide what next
X ind - processing indentation
X rest - processing some occam stmt
X eof - tidy up processing
X*/
X
Xstatic enum lexstate { Start, Ind, Rest, Eof } state = Start;
X
X/************************************************************************/
X
Xyylex()
X/* this function returns the next token (defined by lex.h), a character
Xvalue or 0 for end of input. The tokens are defined by standard input
X*/
X{
X int tok = -1, /* token to return - init to impossible value */
X sind = index; /* start of input being processed */
X
X/* go round and round until token to return */
X while ( tok < 0 ) {
X
X/* decide by state */
X switch (state) {
X
X case Start: {
X/*grab some more line */
X if ( fgets( line, MAXLINE-1, stdin ) == NULL ) {
X state = Eof;
X break;
X
X } else if ( (llen=strlen(line)) >= MAXLINE-1 ) {
X fprintf( stderr,
X "line <%s> longer than %d\n",
X line, MAXLINE-1 );
X exit( 1 );
X }/*if*/
X
X index = 0;
X sind = 0;
X indent = 0;
X
X
X/* if blank line OR has just comment skip, otherwise got to appropriate state */
X
X if ( m_nulline() ) {
X /* do nowt */
X
X } else if ( line[0]==' ' && line[1]==' ' ) {
X state = Ind;
X
X } else {
X state = Rest;
X
X }/*if*/
X
X break;}/*Start*/
X
X case Ind: {
X/* work out indentation */
X if ( line[index]==' ' && line[index+1]==' ' ) {
X indent++;
X index+=2;
X sind+=2;
X } else {
X state = Rest;
X
X }/*if*/
X
X break;}/*Ind*/
X
X case Rest: {
X/* do we have some indentation to adjust for ... */
X if ( curind > indent ) {
X curind--;
X tok = END;
X break;
X
X } else if ( curind < indent ) {
X curind++;
X tok = BEG;
X break;
X
X }/*if*/
X
X/* process ch as appropriate */
X switch ( line[index] ) {
X
X/* space ignored */
X case ' ': {
X sind++;
X index++;
X break;}
X
X/* eol change state again */
X case '\n': {
X yylineno++;
X index++;
X state = Start;
X tok = EOL;
X break;}
X
X/* - a comment perhaps OR just itself */
X case '-': {
X if ( line[index+1] == '-' ) {
X index = llen+1;
X state = Start;
X tok = EOL;
X
X } else {
X tok = line[index++];
X
X }/*if*/
X break;}
X
X case '<': {
X if ( line[index+1] == '<' ) {
X index+=2;
X tok = SHIFTOP;
X
X } else {
X if ( line[index+1] == '=' ||
X line[index+1] == '>' ) {
X index++;
X }/*if*/
X index++;
X tok = COMPOP;
X }/*if*/
X break;}
X
X case '>': {
X if ( line[index+1] == '>' ) {
X index+=2;
X tok = SHIFTOP;
X
X } else if ( line[index+1] == '<' ) {
X index+=2;
X tok = LOGOP;
X
X } else {
X if ( line[index+1] == '=' ) {
X index++;
X }/*if*/
X index++;
X tok = COMPOP;
X }/*if*/
X
X break;}
X
X case '/': {
X if ( line[index+1] == '\\' ) {
X index+=2;
X tok = LOGOP;
X
X } else {
X tok = line[index++];
X
X }/*if*/
X break;}
X
X case '\\': {
X if ( line[index+1] == '/' ) {
X index+=2;
X tok = LOGOP;
X
X } else {
X tok = line[index++];
X
X }/*if*/
X break;}
X
X case '#': {
X if ( isxdigit( line[index+1] ) ) {
X/* gobble up hex digits */
X index++;
X while ( isxdigit(line[index]) ){
X index++;
X }/*while*/
X
X tok = NUMBER;
X
X } else {
X tok = line[index++];
X
X }/*if*/
X
X break;}
X
X case '\'': {
X if ( line[index+1] != '*'
X && line[index+2] == '\'' ) {
X
X index+=3;
X tok = CHCON;
X
X } else if ( line[index+1] == '*'
X && line[index+2] != '#'
X && line[index+3] == '\'' ) {
X
X index+=4;
X tok = CHCON;
X
X } else if ( line[index+1] == '*'
X && line[index+2] == '#'
X && isxdigit( line[index+3] )
X && isxdigit( line[index+4] )
X && line[index+5] == '\'' ) {
X
X index+=6;
X tok = CHCON;
X
X } else {
X tok = line[index++];
X
X }/*if*/
X
X break;}
X
X
X case '"': {
X int lindex=index+1;
X
X while ( line[lindex] != '"'
X && lindex <= llen ) {
X lindex++;
X }/*while*/
X
X if ( line[lindex] == '"' ) {
X index = lindex+1;
X tok = STR;
X
X } else {
X tok = line[index++];
X
X }/*if*/
X
X break;}
X
X/* do extra look ahead that yacc can not do for CHAN | VAR | VALUE */
X case ',': {
X int lindex=index+1;
X
X while ( line[lindex] == ' ' ) {
X lindex++;
X }/*while*/
X
X if ( strncmp(&line[lindex], "CHAN", 4)
X == 0
X || strncmp(&line[lindex], "VAR", 3)
X == 0
X || strncmp(&line[lindex], "VALUE", 5)
X == 0 ) {
X
X index++;
X tok = COMMA;
X
X } else {
X tok = line[index++];
X
X }/*if*/
X
X break;}
X
X/* oh well pass back to yacc & let it cope - if not digit or alpha */
X default: {
X if ( isdigit( line[index] ) ) {
X/* gobble up digits */
X index++;
X while ( isdigit(line[index]) ){
X index++;
X }/*while*/
X
X tok = NUMBER;
X break;
X
X } else if ( isalpha( line[index] ) ) {
X int i, wlen = 1;
X index++;
X/* gobble up associated chs */
X while ( isalpha( line[index] )
X || isdigit( line[index])
X || line[index] == '.' ){
X wlen++;
X index++;
X }/*while*/
X
X/* now check against reserved word list */
X for ( i=0;
X rlist[i].word != NULL;
X i++ ) {
X
X if ( rlist[i].len
X != wlen ) {
X continue;
X }/*if*/
X
X if ( strncmp(
X &line[index-wlen],
X rlist[i].word,
X wlen ) == 0 ) {
X
X tok = rlist[i].tok;
X break;
X }/*if*/
X }/*for*/
X
X/* not a reserved word */
X if ( tok < 0 ) {
X tok = ID;
X }/*if*/
X break;
X
X }/*if*/
X
X tok = line[index++];
X
X break;}/*default*/
X
X }/*switch*/
X
X break;}/*Rest*/
X
X case Eof: {
X/* do we have some indentation to adjust for ... */
X if ( curind > 0 ) {
X curind--;
X tok = END;
X } else {
X tok = 0;
X }/*if*/
X
X
X break;}/*Eof*/
X
X
X }/*switch*/
X
X }/*while*/
X
X/* return whats required after setting yytext etc */
X if ( index > sind ) {
X int i;
X yylen = index - sind;
X
X for ( i = 0; i < yylen; i++ ) {
X yytext[i] = line[sind+i];
X }/*for*/
X
X yytext[yylen] = '\0';
X
X } else {
X yylen = 0;
X yytext[0] = '\0';
X
X }/*if*/
X
X/* debug report */
X if ( ldebug ) {
X fprintf( stderr, "yylex: token %d <%s>\n", tok, yytext );
X }/*if*/
X
X return( tok );
X
X}/*yylex*/
X
X/*************************************************************************/
X
Xm_nulline()
X/* return true if a null line */
X{
X
X int lindex=index; /* local index */
X
X/* tramp thru spaces */
X while ( line[lindex] == ' ' ) {
X lindex++;
X }/*while*/
X
X/* any comment ? */
X if ( line[lindex] == '-' && line[lindex+1] == '-' ) {
X yylineno++;
X return( TRUE );
X
X/* or we got to the end of the line */
X } else if ( line[lindex]== '\n' ) {
X yylineno++;
X return( TRUE );
X
X }/*if*/
X
X return( FALSE );
X
X}/*m_nulline*/
X
X/* end occamlex.c */
SHAR_EOF
chmod 0666 occamlex.c || echo "restore of occamlex.c fails"
set `wc -c occamlex.c`;Sum=$1
if test "$Sum" != "8622"
then echo original size 8622, current size $Sum;fi
fi
if test -f occam2.y; then echo "File occam2.y exists"; else
echo "x - extracting occam2.y (Text)"
sed 's/^X//' << 'SHAR_EOF' > occam2.y &&
X/*
X *
X * OCCAM2 yacc specification
X *
X * Peter Polkinghorne - GEC Research
X *
X */
X
X/*
X * This work is in the public domain.
X * It was written by Peter Polkinghorne in 1986 & 1989 at
X * GEC Hirst Research Centre, Wembley, England.
X * No liability is accepted or warranty given by the Author,
X * still less my employers.
X */
X
X/* revision history
X 0.0 initial attempt pjmp 9/3/89
X
Xend revisions */
X
X%token VAR CHAN ANY SKIP ID EOL
X%token VALUE BYTE DEF PROC NOT NUMBER BOOL
X%token NOW TABLE BOOLOP SHIFTOP COMPOP CHCON STR
X%token LOGOP SEQ ALT IF PAR WHILE FOR
X%token OF SIZE TRUNC ROUND MOSTNEG MOSTPOS RNUMBER
X%token STOP CASE ELSE IS VAL FROM PROTOCOL
X%token INT INT16 INT32 INT64 REAL REAL32 REAL64
X%token PLACE AT PLACED PROCESSOR FUNCTION
X%token AFTER RETYPES VALOF RESULT PORT PRI
X%token BEG END TO TIMER
X
X%start program
X
X%%
X
Xprogram : sep process
X | process
X ;
X
Xprocess : action sep
X | SKIP sep
X | STOP sep
X | CASE selector sep
X | CASE selector sep BEG selectlist END
X | construct
X | instance
X | specification sep process
X | caseinput
X | allocation sep process
X | error sep
X {
X yyerrok;
X }
X ;
X
Xaction : assignment
X | input
X | output
X ;
X
Xallocation : PLACE ID AT expr ':'
X ;
X
Xselectlist : select
X | selectlist select
X ;
X
Xselect : expr sep BEG process END
X | ELSE sep BEG process END
X ;
X
Xselector : expr
X ;
X
Xconstruct : sequence
X | parallel
X | conditional
X | alternation
X | loop
X ;
X
Xinstance : ID '(' actualist ')' sep
X | ID '(' ')' sep
X ;
X
Xactualist : actual
X | actualist comma actual
X ;
X
Xactual : element
X | expr
X ;
X
Xsequence : SEQ sep BEG proclist END
X | SEQ replic sep BEG process END
X | SEQ sep
X ;
X
Xparallel : PAR sep BEG proclist END
X | PAR replic sep BEG process END
X | PAR sep
X | PRI PAR sep BEG proclist END
X | PRI PAR replic sep BEG process END
X | PRI PAR sep
X | PLACED PAR sep BEG placelist END
X | PLACED PAR replic sep BEG placement END
X | PLACED PAR sep
X ;
X
Xconditional : IF sep BEG choicelist END
X | IF replic sep BEG choice END
X | IF sep
X ;
X
Xalternation : ALT sep BEG alternativelist END
X | ALT replic sep BEG alternative END
X | ALT sep
X | PRI ALT sep BEG alternativelist END
X | PRI ALT replic sep BEG alternative END
X | PRI ALT sep
X ;
X
Xloop : WHILE expr sep BEG process END
X ;
X
Xsep : EOL
X | sep EOL
X ;
X
Xcomma : ',' EOL
X | ','
X ;
X
Xsemicolon : ';' EOL
X | ';'
X ;
X
Xproclist : process
X | proclist process
X ;
X
Xchoicelist : choice
X | choicelist choice
X ;
X
Xplacelist : placement
X | placelist placement
X ;
X
Xalternativelist : alternative
X | alternativelist alternative
X ;
X
X
Xreplic : ID '=' base FOR count
X ;
X
Xbase : expr
X ;
X
Xcount : expr
X ;
X
Xchoice : boolean sep BEG process END
X | specification sep choice
X | conditional
X ;
X
Xplacement : PROCESSOR expr sep BEG process END
X ;
X
Xalternative : guard sep BEG process END
X | specification sep alternative
X | alternation
X ;
X
Xguard : boolean '&' input
X | input
X | boolean '&' SKIP
X ;
X
Xspecification : declaration
X | abbreviation
X | definition
X ;
X
Xdeclaration : type namelist ':'
X ;
X
Xnamelist : ID
X | namelist comma ID
X ;
X
Xabbreviation : specifier ID IS element ':'
X | VAL specifier ID IS element ':'
X | ID IS element ':'
X | VAL ID IS element ':'
X ;
X
Xspecifier : primtype
X | '['']' specifier
X | '[' expr ']' specifier
X ;
X
Xdefinition : PROTOCOL ID IS simpleproto ':'
X | PROTOCOL ID IS seqproto ':'
X | PROTOCOL ID sep BEG CASE sep END ':'
X | PROTOCOL ID sep BEG CASE sep BEG tagprotolist END END ':'
X | PROC ID '(' fparmlist ')' sep BEG process END ':'
X | PROC ID '(' ')' sep BEG process END ':'
X | typelist FUNCTION ID '(' fparmlist ')' sep BEG valof END ':'
X | typelist FUNCTION ID '(' ')' sep BEG valof END ':'
X | typelist FUNCTION ID '(' fparmlist ')' IS explist ':'
X | typelist FUNCTION ID '(' ')' IS explist ':'
X | specifier ID RETYPES element ':'
X | VAL specifier ID RETYPES expr ':'
X ;
X
Xsimpleproto : type
X | type ':' ':' '[' ']' type
X ;
X
Xseqproto : simpleproto
X | seqproto semicolon simpleproto
X ;
X
Xtagprotolist : tagproto
X | tagprotolist sep tagproto
X ;
X
Xtagproto : tag
X | tag semicolon protocol
X ;
X
Xtag : ID
X ;
X
Xprotocol : ANY
X | ID
X | simpleproto
X ;
X
Xassignment : varlist ':' '=' explist
X ;
X
Xinput : chan '?' inlist
X | chan '?' CASE taggedlist
X | port '?' var
X | timer '?' var
X | timer '?' AFTER expr
X ;
X
Xcaseinput : chan '?' CASE sep
X | chan '?' CASE sep BEG variantlist END
X ;
X
Xtaggedlist : tag
X | tag semicolon inlist
X ;
X
Xvariantlist : variant
X | variantlist sep variant
X ;
X
Xvariant : taggedlist sep BEG process END
X | specification sep variant
X ;
X
Xoutput : chan '!' outlist
X | chan '!' tag
X | chan '!' tag semicolon outlist
X | port '!' element
X | port '!' expr
X ;
X
Xinlist : var
X | var ':' ':' var
X | inlist semicolon var
X ;
X
Xoutlist : expr
X | expr ':' ':' expr
X | outlist semicolon expr
X ;
X
Xexplist : expr
X | explist comma expr
X | '(' valof sep ')'
X | ID '(' explist ')'
X | ID '(' ')'
X ;
X
Xvarlist : var
X | varlist comma var
X ;
X
Xtypelist : type
X | typelist comma type
X ;
X
Xfparmlist : fparm
X | fparmlist comma fparm
X ;
X
Xfparm : specifier ID
X | VAL specifier ID
X ;
X
Xvar : element
X ;
X
Xtimer : element
X ;
X
Xchan : element
X ;
X
Xport : element
X ;
X
Xelement : ID
X | element '[' subscript ']'
X | '[' element FROM subscript TO subscript ']'
X ;
X
Xsubscript : expr
X ;
X
Xexpr : monop operand
X | operand dyop operand
X | monop sep operand
X | operand dyop sep operand
X | operand
X | conversion
X | MOSTPOS type
X | MOSTNEG type
X ;
X
Xoperand : element
X | literal
X | '(' expr ')'
X | '[' explist ']'
X | '(' valof sep ')'
X | ID '(' explist ')'
X | ID '(' ')'
X ;
X
Xconversion : type operand
X | type ROUND operand
X | type TRUNC operand
X ;
X
Xmonop : '-'
X | NOT
X | SIZE
X | '~'
X ;
X
Xliteral : NUMBER
X | BOOL
X | RNUMBER
X | CHCON
X | STR
X | NUMBER '(' type ')'
X | RNUMBER '(' type ')'
X | CHCON '(' type ')'
X ;
X
Xdyop : COMPOP
X | '='
X | SHIFTOP
X | '+'
X | '*'
X | LOGOP
X | BOOLOP
X | '-'
X | '/'
X | '\\'
X ;
X
Xvalof : VALOF sep BEG process RESULT explist sep END
X | specification sep valof
X ;
X
Xtype : primtype
X | arrtype
X ;
X
Xprimtype : CHAN OF protocol
X | PORT OF type
X | TIMER
X | BOOL
X | BYTE
X | INT
X | INT16
X | INT32
X | INT64
X | REAL32
X | REAL64
X ;
X
Xarrtype : '[' expr ']' type
X ;
X
Xboolean : expr
X ;
X
X%%
X
X#include <stdio.h>
X
Xvoid main()
X{
X
X exit( yyparse() );
X
X}/*main*/
X
Xyyerror( str )
Xchar *str;
X/* our slightly more informative error routine */
X{
X
Xextern int yylineno;
Xextern char yytext[];
X
X fprintf( stderr, "ERROR <%s> near <%s> on line %d\n",
X str, yytext, yylineno );
X
X}/*yyerror*/
X
X/*end occam.y*/
SHAR_EOF
chmod 0666 occam2.y || echo "restore of occam2.y fails"
set `wc -c occam2.y`;Sum=$1
if test "$Sum" != "6613"
then echo original size 6613, current size $Sum;fi
fi
if test -f occam2lex.c; then echo "File occam2lex.c exists"; else
echo "x - extracting occam2lex.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > occam2lex.c &&
X/*
X * OCCAM2 lexical analysis routine
X *
X * pjmp HRC 9/3/89
X *
X */
X
X/*
X * This work is in the public domain.
X * It was written by Peter Polkinghorne in 1986 & 1989 at
X * GEC Hirst Research Centre, Wembley, England.
X * No liability is accepted or warranty given by the Author,
X * still less my employers.
X */
X
X/* revision history
X
X 0.0 first release pjmp 9/3/89
X
Xend revisions */
X
X#include <stdio.h>
X#include <ctype.h>
X#include "lex2.h"
X
X#define MAXLINE 256
X
X#define TRUE 1
X#define FALSE 0
X
X/************************************************************************/
X/* reserved word list - ordered for binary chomp */
X
Xstatic struct reserv { char * word; int tok, len; } rlist[] = {
X "AFTER", AFTER, 5,
X "ALT", ALT, 3,
X "AND", BOOLOP, 3,
X "ANY", ANY, 3,
X "AT", AT, 2,
X "BYTE", BYTE, 4,
X "CASE", CASE, 4,
X "CHAN", CHAN, 4,
X "DEF", DEF, 3,
X "ELSE", ELSE, 4,
X "FALSE", BOOL, 5,
X "FOR", FOR, 3,
X "FROM", FROM, 4,
X "FUNCTION", FUNCTION, 8,
X "IF", IF, 2,
X "INT", INT, 3,
X "INT16", INT16, 5,
X "INT32", INT32, 5,
X "INT64", INT64, 5,
X "IS", IS, 2,
X "MOSTNEG", MOSTNEG,7,
X "MOSTPOS", MOSTPOS,7,
X "NOT", NOT, 3,
X "NOW", NOW, 3,
X "OR", BOOLOP, 2,
X "OF", OF, 2,
X "PAR", PAR, 3,
X "PLACE", PLACE, 5,
X "PLACED", PLACED, 6,
X "PORT", PORT, 4,
X "PRI", PRI, 3,
X "PROC", PROC, 4,
X "PROCESSOR", PROCESSOR, 9,
X "PROTOCOL", PROTOCOL, 8,
X "ROUND", ROUND, 5,
X "REAL", REAL, 4,
X "REAL32", REAL32, 6,
X "REAL64", REAL64, 6,
X "RESULT", RESULT, 6,
X "RETYPES", RETYPES, 7,
X "SEQ", SEQ, 3,
X "SIZE", SIZE, 4,
X "SKIP", SKIP, 4,
X "STOP", STOP, 4,
X "TABLE", TABLE, 5,
X "TIMER", TIMER, 5,
X "TO", TO, 2,
X "TRUE", BOOL, 4,
X "TRUNC", TRUNC, 5,
X "VALUE", VALUE, 5,
X "VAL", VAL, 3,
X "VALOF", VALOF, 5,
X "VAR", VAR, 3,
X "WHILE", WHILE, 5,
X 0, 0, 0
X
X };
X
X/************************************************************************/
X
Xstatic char line[MAXLINE]; /* where we store the input, line as a time */
X
Xchar yytext[MAXLINE]; /* where we store text associated with token */
X
Xint yylineno=1, /* line number of input */
X yylen; /* amount of text stored */
X
Xstatic int llen, /* how much in line */
X curind, /* current indentation */
X indent=0; /* this lines indent */
X ldebug = TRUE, /* set to TRUE for debug */
X index; /* where we are in the line */
X
X/* state we are in: either start - get new input, decide what next
X ind - processing indentation
X rest - processing some occam stmt
X eof - tidy up processing
X*/
X
Xstatic enum lexstate { Start, Ind, Rest, Eof } state = Start;
X
X/************************************************************************/
X
Xyylex()
X/* this function returns the next token (defined by lex.h), a character
Xvalue or 0 for end of input. The tokens are defined by standard input
X*/
X{
X int tok = -1, /* token to return - init to impossible value */
X sind = index; /* start of input being processed */
X
X/* go round and round until token to return */
X while ( tok < 0 ) {
X
X/* decide by state */
X switch (state) {
X
X case Start: {
X/*grab some more line */
X if ( fgets( line, MAXLINE-1, stdin ) == NULL ) {
X state = Eof;
X break;
X
X } else if ( (llen=strlen(line)) >= MAXLINE-1 ) {
X fprintf( stderr,
X "line <%s> longer than %d\n",
X line, MAXLINE-1 );
X exit( 1 );
X }/*if*/
X
X index = 0;
X sind = 0;
X indent = 0;
X
X
X/* if blank line OR has just comment skip, otherwise got to appropriate state */
X
X if ( m_nulline() ) {
X /* do nowt */
X
X } else if ( line[0]==' ' && line[1]==' ' ) {
X state = Ind;
X
X } else {
X state = Rest;
X
X }/*if*/
X
X break;}/*Start*/
X
X case Ind: {
X/* work out indentation */
X if ( line[index]==' ' && line[index+1]==' ' ) {
X indent++;
X index+=2;
X sind+=2;
X } else {
X state = Rest;
X
X }/*if*/
X
X break;}/*Ind*/
X
X case Rest: {
X/* do we have some indentation to adjust for ... */
X if ( curind > indent ) {
X curind--;
X tok = END;
X break;
X
X } else if ( curind < indent ) {
X curind++;
X tok = BEG;
X break;
X
X }/*if*/
X
X/* process ch as appropriate */
X switch ( line[index] ) {
X
X/* space ignored */
X case ' ': {
X sind++;
X index++;
X break;}
X
X/* eol change state again */
X case '\n': {
X yylineno++;
X index++;
X state = Start;
X tok = EOL;
X break;}
X
X/* - a comment perhaps OR just itself */
X case '-': {
X if ( line[index+1] == '-' ) {
X index = llen+1;
X state = Start;
X tok = EOL;
X
X } else {
X tok = line[index++];
X
X }/*if*/
X break;}
X
X case '<': {
X if ( line[index+1] == '<' ) {
X index+=2;
X tok = SHIFTOP;
X
X } else {
X if ( line[index+1] == '=' ||
X line[index+1] == '>' ) {
X index++;
X }/*if*/
X index++;
X tok = COMPOP;
X }/*if*/
X break;}
X
X case '>': {
X if ( line[index+1] == '>' ) {
X index+=2;
X tok = SHIFTOP;
X
X } else if ( line[index+1] == '<' ) {
X index+=2;
X tok = LOGOP;
X
X } else {
X if ( line[index+1] == '=' ) {
X index++;
X }/*if*/
X index++;
X tok = COMPOP;
X }/*if*/
X
X break;}
X
X case '/': {
X if ( line[index+1] == '\\' ) {
X index+=2;
X tok = LOGOP;
X
X } else {
X tok = line[index++];
X
X }/*if*/
X break;}
X
X case '\\': {
X if ( line[index+1] == '/' ) {
X index+=2;
X tok = LOGOP;
X
X } else {
X tok = line[index++];
X
X }/*if*/
X break;}
X
X case '#': {
X if ( isxdigit( line[index+1] ) ) {
X/* gobble up hex digits */
X index++;
X while ( isxdigit(line[index]) ){
X index++;
X }/*while*/
X
X tok = NUMBER;
X
X } else {
X tok = line[index++];
X
X }/*if*/
X
X break;}
X
X case '\'': {
X if ( line[index+1] != '*'
X && line[index+2] == '\'' ) {
X
X index+=3;
X tok = CHCON;
X
X } else if ( line[index+1] == '*'
X && line[index+2] != '#'
X && line[index+3] == '\'' ) {
X
X index+=4;
X tok = CHCON;
X
X } else if ( line[index+1] == '*'
X && line[index+2] == '#'
X && isxdigit( line[index+3] )
X && isxdigit( line[index+4] )
X && line[index+5] == '\'' ) {
X
X index+=6;
X tok = CHCON;
X
X } else {
X tok = line[index++];
X
X }/*if*/
X
X break;}
X
X
X case '"': {
X int lindex=index+1;
X
X while ( line[lindex] != '"'
X && lindex <= llen ) {
X lindex++;
X }/*while*/
X
X if ( line[lindex] == '"' ) {
X index = lindex+1;
X tok = STR;
X
X } else {
X tok = line[index++];
X
X }/*if*/
X
X break;}
X
X/* oh well pass back to yacc & let it cope - if not digit or alpha */
X default: {
X if ( isdigit( line[index] ) ) {
X/* gobble up digits */
X index++;
X while ( isdigit(line[index]) ){
X index++;
X }/*while*/
X
X tok = NUMBER;
X break;
X
X } else if ( isalpha( line[index] ) ) {
X int i, wlen = 1;
X index++;
X/* gobble up associated chs */
X while ( isalpha( line[index] )
X || isdigit( line[index])
X || line[index] == '.' ){
X wlen++;
X index++;
X }/*while*/
X
X/* now check against reserved word list */
X for ( i=0;
X rlist[i].word != NULL;
X i++ ) {
X
X if ( rlist[i].len
X != wlen ) {
X continue;
X }/*if*/
X
X if ( strncmp(
X &line[index-wlen],
X rlist[i].word,
X wlen ) == 0 ) {
X
X tok = rlist[i].tok;
X break;
X }/*if*/
X }/*for*/
X
X/* not a reserved word */
X if ( tok < 0 ) {
X tok = ID;
X }/*if*/
X break;
X
X }/*if*/
X
X tok = line[index++];
X
X break;}/*default*/
X
X }/*switch*/
X
X break;}/*Rest*/
X
X case Eof: {
X/* do we have some indentation to adjust for ... */
X if ( curind > 0 ) {
X curind--;
X tok = END;
X } else {
X tok = 0;
X }/*if*/
X
X
X break;}/*Eof*/
X
X
X }/*switch*/
X
X }/*while*/
X
X/* return whats required after setting yytext etc */
X if ( index > sind ) {
X int i;
X yylen = index - sind;
X
X for ( i = 0; i < yylen; i++ ) {
X yytext[i] = line[sind+i];
X }/*for*/
X
X yytext[yylen] = '\0';
X
X } else {
X yylen = 0;
X yytext[0] = '\0';
X
X }/*if*/
X
X/* debug report */
X if ( ldebug ) {
X fprintf( stderr, "yylex: token %d <%s>\n", tok, yytext );
X }/*if*/
X
X return( tok );
X
X}/*yylex*/
X
X/*************************************************************************/
X
Xm_nulline()
X/* return true if a null line */
X{
X
X int lindex=index; /* local index */
X
X/* tramp thru spaces */
X while ( line[lindex] == ' ' ) {
X lindex++;
X }/*while*/
X
X/* any comment ? */
X if ( line[lindex] == '-' && line[lindex+1] == '-' ) {
X yylineno++;
X return( TRUE );
X
X/* or we got to the end of the line */
X } else if ( line[lindex]== '\n' ) {
X yylineno++;
X return( TRUE );
X
X }/*if*/
X
X return( FALSE );
X
X}/*m_nulline*/
X
X/* end occam2lex.c */
SHAR_EOF
chmod 0666 occam2lex.c || echo "restore of occam2lex.c fails"
set `wc -c occam2lex.c`;Sum=$1
if test "$Sum" != "8696"
then echo original size 8696, current size $Sum;fi
fi
if test -f test1; then echo "File test1 exists"; else
echo "x - extracting test1 (Text)"
sed 's/^X//' << 'SHAR_EOF' > test1 &&
XSEQ
X fred:=0
SHAR_EOF
chmod 0666 test1 || echo "restore of test1 fails"
set `wc -c test1`;Sum=$1
if test "$Sum" != "14"
then echo original size 14, current size $Sum;fi
fi
if test -f test2; then echo "File test2 exists"; else
echo "x - extracting test2 (Text)"
sed 's/^X//' << 'SHAR_EOF' > test2 &&
XVAR volume:
XSEQ
X volume:=0
X WHILE TRUE
X ALT
X louder?ANY
X SEQ
X volume:=volume+1
X amplifier!volume
X softer?ANY
X SEQ
X volume:=volume-1
X amplifier!volume
SHAR_EOF
chmod 0666 test2 || echo "restore of test2 fails"
set `wc -c test2`;Sum=$1
if test "$Sum" != "221"
then echo original size 221, current size $Sum;fi
fi
if test -f test3; then echo "File test3 exists"; else
echo "x - extracting test3 (Text)"
sed 's/^X//' << 'SHAR_EOF' > test3 &&
X -- this is a comprehensive exercise of occam syntax
X -- pjmp @ hrc 31/7/86
XVAR fred, joe[BYTE - #fAf], bill[ (20>>2)/\#0F]:
XVAR heinz:
XCHAN mary,jane[TRUE]:
XCHAN sue:
XDEF one =1, alphabet="abcdefghijklmnopq"
X"rstuvwxyz":
XDEF Tablet = TABLE [ BYTE 0 ]:
X
XPROC time =
X mary!NOW
X:
X
XPROC relay ( CHAN from, to, VAR via ) =
X SEQ
X from?via
X to!via
X:
X
XPROC zilch ( VALUE t[] ) =
X SKIP
X:
X
XWHILE NOT FALSE
X
X SEQ
X time
X bill[0] := TABLE [ 2, 3, 5, 7, 11, 13, 17, 19, 23] [fred]
X WAIT NOW AFTER bill[joe[BYTE 0]]
X
X VAR cats, dogs:
X CHAN raining[ one ]:
X PAR WHICH = [ 0 FOR one ]
X relay( raining[ cats AND dogs], jane[WHICH], alphabet[WHICH] )
X
X zilch( "abc"[2] )
X
X SEQ
X
X mary!ANY
X
X CHAN jane:
X jane?ANY
X
X PAR
X
X VAR john,tarzan:
X CHAN janet,jane:
X PAR
X janet?john;john
X jane!tarzan; tarzan
X
X IF
X 'a' << #2
X IF
X
X IF
X '**' >> ( 1 OR 2 )
X IF fred = [ 0 FOR '*#FF' ]
X fred <> ( alphabet[ fred >< bill[ fred /\ bill [ fred \/ fred ]]] )
X joe := (fred>0) AND (fred<100) AND (fred>='a') AND (fred<='-')
X
X VAR then:
X ALT fred = [ 1+1+1 FOR 2*2*(2-1)+(4\2)*(2/2) ]
X ALT
X ALT
X SKIP
X SKIP
X fred = 3 & SKIP
X SKIP
X fred >3 & WAIT NOW
X SKIP
X WAIT NOW AFTER then
X SKIP
X fred < 20 & mary?ANY
X then := NOW
X jane[fred]?then
X then := then + 4
SHAR_EOF
chmod 0666 test3 || echo "restore of test3 fails"
set `wc -c test3`;Sum=$1
if test "$Sum" != "1469"
then echo original size 1469, current size $Sum;fi
fi
if test -f test4; then echo "File test4 exists"; else
echo "x - extracting test4 (Text)"
sed 's/^X//' << 'SHAR_EOF' > test4 &&
X
X -- this is another comprehensive exercise of occam syntax
X -- pjmp @ hrc 31/7/86
XVAR fred, joe[BYTE - #fAf], bill[ (20>>2)/\#0F]:
XVAR heinz:
XCHAN mary,jane[TRUE]:
XCHAN sue:
XDEF one =1, alphabet="abcdefghijklmnopq"
X"rstuvwxyz":
XDEF Tablet = TABLE [ BYTE 0 ]:
X
XPROC time =
X mary!NOW
X:
X
XPROC relay ( CHAN from, to, VAR via ) =
X SEQ
X from?via
X to!via
X:
X
XPROC zilch ( VALUE t[] ) =
X SKIP
X:
X
XWHILE NOT FALSE
X
X SEQ
X time
X bill[0] := TABLE [ 2, 3, 5, 7, 11, 13, 17, 19, 23] [fred]
X WAIT NOW AFTER bill[joe[BYTE 0]]
X
X VAR cats, dogs:
X CHAN raining[ one ]:
X PAR WHICH = [ 0 FOR one ]
X relay( raining[ cats AND dogs], jane[WHICH], alphabet[WHICH] )
X
X zilch( "abc"[2] )
X
X SEQ fred = [ 0 FOR 3 ]
X
X mary!ANY
X
X CHAN jane:
X jane?ANY
X
X PAR
X
X VAR john,tarzan:
X CHAN janet,jane:
X PAR
X janet?john;john
X jane!tarzan; tarzan
X
X IF
X 'a' << #2
X IF
X
X IF
X '**' >> ( 1 OR 2 )
X IF fred = [ 0 FOR '*#FF' ]
X fred <> ( alphabet[ fred >< bill[ fred /\ bill [ fred \/ fred ]]] )
X joe := (fred>0) AND (fred<100) AND (fred>='a') AND (fred<='-')
X
X VAR then:
X ALT fred = [ 1+1+1 FOR 2*2*(2-1)+(4\2)*(2/2) ]
X ALT
X ALT
X SKIP
X SKIP
X fred = 3 & SKIP
X SKIP
X fred >3 & WAIT NOW
X SKIP
X WAIT NOW AFTER then
X SKIP
X fred < 20 & mary?ANY
X then := NOW
X jane[fred]?then
X then := then + 4
SHAR_EOF
chmod 0666 test4 || echo "restore of test4 fails"
set `wc -c test4`;Sum=$1
if test "$Sum" != "1495"
then echo original size 1495, current size $Sum;fi
fi
exit 0
More information about the Comp.sources.misc
mailing list