(FILECREATED " 1-Mar-86 22:22:14" {PHYLUM}<STANSBURY>PARSER>WINTER86>PARSERG.;2 15792
changes to: (VARS PARSERGCOMS)
previous date: " 1-Mar-86 16:12:54" {PHYLUM}<STANSBURY>PARSER>WINTER86>G.;19)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PARSERGCOMS)
(RPAQQ PARSERGCOMS ((* * TOY1 stuff %. This grammar is "LALR(0)" and the language is "ABC")
(UGLYVARS TOY1)
(VARS TOY1G)
(FNS READCHAR)
(FNS TEST.TOY1)
(* * TOY2 stuff %. This grammar is "LALR(1)" and the language is
"(aa*)|(aa*+aa*)"
%. This is G1 from the Brosgol paper.)
(UGLYVARS TOY2)
(VARS TOY2G)
(FNS TEST.TOY2)
(* * TOY3 stuff %. This grammar is "LALR(1)" and the language is "b|(bb)" %.
This is G2 from the Brosgol paper.)
(UGLYVARS TOY3)
(VARS TOY3G)
(FNS TEST.TOY3)
(* * TOY4 stuff %. This grammar is "LALR(2)" and the language is
"a|(aaa)|(aab)"
%.)
(UGLYVARS TOY4)
(VARS TOY4G)
(FNS TEST.TOY4)
(* * TOY5 stuff %. The language is "(afc)|(afd)|(bfd)|(bfc)" , but the grammar
is not "LALR(k)" for any k, so the parser-generator will loop forever,
indicating its progress.)
(UGLYVARS TOY5)
(VARS TOY5G)
(FNS TEST.TOY5)
(* * ARITH stuff %. This translates a conventional arithmetic expression
language into something evaluable by Interlisp EVAL. The language is
"LALR(1)"
%. Special features: It has a lexical analyzer, ARITHLEX, generated by the
same mechanism. The lexical analyzer uses semantic actions cleverly to
remove whitespace and construct number values. The structure parser uses
semantic actions to generate the Lisp function calls from the parse tree.
Since the language is "LALR(1)" , the lookahead queue need only be one token
deep, and so is specially implemented that way to avoid consing. Similarly,
because of the order of reduction implied by the grammar rules, the stack
can never be very deep, and it is implemented with a small array to minimize
consing.)
(UGLYVARS ARITH ARITHLEX)
(VARS ARITHG ARITHLEXG)
(MACROS ARITHDQ FUNNYCAR FUNNYCDR ARITHTOP ARITHPUSH ARITHPOP ARITHSTACK)
(RECORDS ARITHSTACK)
(FNS TEST.ARITH TEST.ARITHLEX)))
(* * TOY1 stuff %. This grammar is "LALR(0)" and the language is "ABC")
(READVARS TOY1)
({$PARSERSPEC (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER)TOY1 {$GRAMMAR (POINTER POINTER POINTER)TOP ((TOP ((A B C)
(CONS LHS RHS)))) {H(40 NIL) 5 TERMINAL C TERMINAL B TERMINAL A NONTERMINAL TOP TERMINAL EOF } }
READCHAR SELF SELF STRICTEOF NILL push pop CAR SELF CONS TCONC TCONC.FRONT CDR SELF })
(RPAQQ TOY1G [(TOP ((A B C)
(CONS LHS RHS])
(DEFINEQ
(READCHAR
[LAMBDA (EXPECTED STATE) (* hts: "28-Feb-86 22:02")
(if (EOFP (CAR STATE))
then (QUOTE EOF)
else (READC (CAR STATE])
)
(DEFINEQ
(TEST.TOY1
[LAMBDA NIL (* hts: "28-Feb-86 22:20")
(* * Run the parser on the file {core}foo)
(CLOSEF? (QUOTE {CORE}FOO))
(LET [(S (OPENSTREAM (QUOTE {CORE}FOO)
(QUOTE INPUT]
(PROG1 (TOY1 NIL (LIST (CONS)
S))
(CLOSEF S])
)
(* * TOY2 stuff %. This grammar is "LALR(1)" and the language is "(aa*)|(aa*+aa*)" %. This is
G1 from the Brosgol paper.)
(READVARS TOY2)
({$PARSERSPEC (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER)TOY2 {$GRAMMAR (POINTER POINTER POINTER)S ((S ((S + A) (
CONS LHS RHS)) ((A) (CONS LHS RHS))) (A ((a A) (CONS LHS RHS)) ((a) (CONS LHS RHS)))) {H(40
NIL) 5 NONTERMINAL A TERMINAL + TERMINAL a NONTERMINAL S TERMINAL EOF } } READCHAR SELF SELF STRICTEOF
NILL push pop CAR SELF CONS TCONC TCONC.FRONT CDR SELF })
(RPAQQ TOY2G [(S ((S + A)
(CONS LHS RHS))
((A)
(CONS LHS RHS)))
(A ((a A)
(CONS LHS RHS))
((a)
(CONS LHS RHS])
(DEFINEQ
(TEST.TOY2
[LAMBDA NIL (* hts: "28-Feb-86 22:23")
(* * Run the parser on the file {core}foo)
(CLOSEF? (QUOTE {CORE}FOO))
(LET [(S (OPENSTREAM (QUOTE {CORE}FOO)
(QUOTE INPUT]
(PROG1 (TOY2 NIL (LIST (CONS)
S))
(CLOSEF S])
)
(* * TOY3 stuff %. This grammar is "LALR(1)" and the language is "b|(bb)" %. This is G2 from
the Brosgol paper.)
(READVARS TOY3)
({$PARSERSPEC (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER)TOY3 {$GRAMMAR (POINTER POINTER POINTER)S ((S ((A A) (
CONS LHS RHS)) ((b) (CONS LHS RHS))) (A ((B) (CONS LHS RHS))) (B ((b) (CONS LHS RHS)))) {H(40
NIL) 5 NONTERMINAL B NONTERMINAL A TERMINAL b NONTERMINAL S TERMINAL EOF } } READCHAR SELF SELF
STRICTEOF NILL push pop CAR SELF CONS TCONC TCONC.FRONT CDR SELF })
(RPAQQ TOY3G [(S ((A A)
(CONS LHS RHS))
((b)
(CONS LHS RHS)))
(A ((B)
(CONS LHS RHS)))
(B ((b)
(CONS LHS RHS])
(DEFINEQ
(TEST.TOY3
[LAMBDA NIL (* hts: "28-Feb-86 22:28")
(* * Run the parser on the file {core}foo)
(CLOSEF? (QUOTE {CORE}FOO))
(LET [(S (OPENSTREAM (QUOTE {CORE}FOO)
(QUOTE INPUT]
(PROG1 (TOY3 NIL (LIST (CONS)
S))
(CLOSEF S])
)
(* * TOY4 stuff %. This grammar is "LALR(2)" and the language is "a|(aaa)|(aab)" %.)
(READVARS TOY4)
({$PARSERSPEC (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER)TOY4 {$GRAMMAR (POINTER POINTER POINTER)S ((S ((A a a) (
CONS LHS RHS)) ((B a b) (CONS LHS RHS)) ((C) (CONS LHS RHS))) (A ((a) (CONS LHS RHS))) (B ((a
) (CONS LHS RHS))) (C ((a) (CONS LHS RHS)))) {H(40 NIL) 7 NONTERMINAL C NONTERMINAL B NONTERMINAL
A TERMINAL b TERMINAL a NONTERMINAL S TERMINAL EOF } } READCHAR SELF SELF STRICTEOF NILL push pop CAR
SELF CONS TCONC TCONC.FRONT CDR SELF })
(RPAQQ TOY4G [(S ((A a a)
(CONS LHS RHS))
((B a b)
(CONS LHS RHS))
((C)
(CONS LHS RHS)))
(A ((a)
(CONS LHS RHS)))
(B ((a)
(CONS LHS RHS)))
(C ((a)
(CONS LHS RHS])
(DEFINEQ
(TEST.TOY4
[LAMBDA NIL (* hts: " 1-Mar-86 21:08")
(* * Run the parser on the file {core}foo)
(CLOSEF? (QUOTE {CORE}FOO))
(LET [(S (OPENSTREAM (QUOTE {CORE}FOO)
(QUOTE INPUT]
(PROG1 (TOY4 NIL (LIST (CONS)
S))
(CLOSEF S])
)
(* * TOY5 stuff %. The language is "(afc)|(afd)|(bfd)|(bfc)" , but the grammar is not
"LALR(k)" for any k, so the parser-generator will loop forever, indicating its progress.)
(READVARS TOY5)
({$PARSERSPEC (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER)TOY5 {$GRAMMAR (POINTER POINTER POINTER)S ((S ((a A1 c) (
CONS LHS RHS)) ((a A2 d) (CONS LHS RHS)) ((b A1 d) (CONS LHS RHS)) ((b A2 c) (CONS LHS RHS))) (
A1 ((f) (CONS LHS RHS))) (A2 ((f) (CONS LHS RHS)))) {H(40 NIL) 9 NONTERMINAL A1 NONTERMINAL A2
TERMINAL f TERMINAL d TERMINAL c TERMINAL b TERMINAL a NONTERMINAL S TERMINAL EOF } } READCHAR SELF
SELF STRICTEOF NILL push pop CAR SELF CONS TCONC TCONC.FRONT CDR SELF })
(RPAQQ TOY5G [(S ((a A1 c)
(CONS LHS RHS))
((a A2 d)
(CONS LHS RHS))
((b A1 d)
(CONS LHS RHS))
((b A2 c)
(CONS LHS RHS)))
(A1 ((f)
(CONS LHS RHS)))
(A2 ((f)
(CONS LHS RHS])
(DEFINEQ
(TEST.TOY5
[LAMBDA NIL (* hts: " 1-Mar-86 21:47")
(* * Run the parser on the file {core}foo)
(CLOSEF? (QUOTE {CORE}FOO))
(LET [(S (OPENSTREAM (QUOTE {CORE}FOO)
(QUOTE INPUT]
(PROG1 (TOY5 NIL (LIST (CONS)
S))
(CLOSEF S])
)
(* * ARITH stuff %. This translates a conventional arithmetic expression language into
something evaluable by Interlisp EVAL. The language is "LALR(1)" %. Special features: It has a
lexical analyzer, ARITHLEX, generated by the same mechanism. The lexical analyzer uses semantic
actions cleverly to remove whitespace and construct number values. The structure parser uses
semantic actions to generate the Lisp function calls from the parse tree. Since the language is
"LALR(1)" , the lookahead queue need only be one token deep, and so is specially implemented
that way to avoid consing. Similarly, because of the order of reduction implied by the grammar
rules, the stack can never be very deep, and it is implemented with a small array to minimize
consing.)
(READVARS ARITH ARITHLEX)
({$PARSERSPEC (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER)ARITH {$GRAMMAR (POINTER POINTER POINTER)EXP ((EXP ((EXP +
FACTOR) (LIST (QUOTE PLUS) (CAR RHS) (CADDR RHS))) ((EXP - FACTOR) (LIST (QUOTE DIFFERENCE) (
CAR RHS) (CADDR RHS))) ((FACTOR) (CAR RHS))) (FACTOR ((FACTOR * POWER) (LIST (QUOTE TIMES) (
CAR RHS) (CADDR RHS))) ((FACTOR / POWER) (LIST (QUOTE FQUOTIENT) (CAR RHS) (CADDR RHS))) ((
POWER) (CAR RHS))) (POWER ((MINUS %↑ POWER) (LIST (QUOTE EXPT) (CAR RHS) (CADDR RHS))) ((MINUS
) (CAR RHS))) (MINUS ((- PAREN) (LIST (QUOTE MINUS) (CADR RHS))) ((PAREN) (CAR RHS))) (PAREN
((%( EXP %)) (CADR RHS)) ((NUMBER) (CAR RHS)))) {H(40 NIL) 14 NONTERMINAL POWER NONTERMINAL PAREN
TERMINAL / TERMINAL - NONTERMINAL MINUS NONTERMINAL EXP NONTERMINAL FACTOR TERMINAL + TERMINAL *
TERMINAL %) TERMINAL %( TERMINAL NUMBER TERMINAL %↑ TERMINAL EOF } } ARITHLEX FUNNYCAR FUNNYCDR
STRICTEOF ARITHSTACK ARITHPUSH ARITHPOP ARITHTOP SELF NILL SETQ ARITHDQ SELF SELF } {$PARSERSPEC
ARITHLEX {$GRAMMAR TOKEN ((TOKEN ((SPACES REALTOKEN) (CADR RHS))) (SPACES (NIL NIL) ((SPACES %
) NIL)) (REALTOKEN ((+) (QUOTE (+ . +))) ((-) (QUOTE (- . -))) ((*) (QUOTE (* . *))) ((/)
(QUOTE (/ . /))) ((%↑) (QUOTE (%↑ . %↑))) ((%() (QUOTE (%( . %())) ((%)) (QUOTE (%) . %))))
((NUMBER) (CONS (QUOTE NUMBER) (CAR RHS))) ((EOF) (QUOTE (EOF . EOF)))) (NUMBER ((DIGITS %.
DIGITS) (PLUS (CAR RHS) (LET ((FRAC (CADDR RHS))) (while (GREATERP FRAC 1.0) do (SETQ FRAC (
FQUOTIENT FRAC 10))) FRAC))) ((%. DIGITS) (LET ((FRAC (CADR RHS))) (while (GREATERP FRAC 1.0)
do (SETQ FRAC (FQUOTIENT FRAC 10))) FRAC)) ((DIGITS %.) (CAR RHS)) ((DIGITS) (CAR RHS))) (
DIGITS ((DIGITS DIGIT) (PLUS (TIMES 10 (CAR RHS)) (CADR RHS))) ((DIGIT) (CAR RHS))) (DIGIT ((
0) 0) ((1) 1) ((2) 2) ((3) 3) ((4) 4) ((5) 5) ((6) 6) ((7) 7) ((8) 8) ((9) 9))) {H(40 NIL)
26 NONTERMINAL DIGITS TERMINAL / TERMINAL %. TERMINAL - TERMINAL %) TERMINAL + TERMINAL * TERMINAL %(
NONTERMINAL SPACES TERMINAL % NONTERMINAL TOKEN NONTERMINAL NUMBER TERMINAL %↑ NONTERMINAL REALTOKEN
TERMINAL 5 TERMINAL 1 TERMINAL 0 TERMINAL 3 TERMINAL 2 TERMINAL 4 TERMINAL EOF TERMINAL 7 TERMINAL 6
TERMINAL 9 TERMINAL 8 NONTERMINAL DIGIT } } READCHAR SELF SELF TRUE ARITHSTACK ARITHPUSH ARITHPOP
ARITHTOP SELF NILL SETQ ARITHDQ SELF SELF })
(RPAQQ ARITHG [(EXP ((EXP + FACTOR)
(LIST (QUOTE PLUS)
(CAR RHS)
(CADDR RHS)))
((EXP - FACTOR)
(LIST (QUOTE DIFFERENCE)
(CAR RHS)
(CADDR RHS)))
((FACTOR)
(CAR RHS)))
(FACTOR ((FACTOR * POWER)
(LIST (QUOTE TIMES)
(CAR RHS)
(CADDR RHS)))
((FACTOR / POWER)
(LIST (QUOTE FQUOTIENT)
(CAR RHS)
(CADDR RHS)))
((POWER)
(CAR RHS)))
(POWER ((MINUS ↑ POWER)
(LIST (QUOTE EXPT)
(CAR RHS)
(CADDR RHS)))
((MINUS)
(CAR RHS)))
(MINUS ((- PAREN)
(LIST (QUOTE MINUS)
(CADR RHS)))
((PAREN)
(CAR RHS)))
(PAREN ((%( EXP %))
(CADR RHS))
((NUMBER)
(CAR RHS])
(RPAQQ ARITHLEXG ((TOKEN ((SPACES REALTOKEN)
(CADR RHS)))
(SPACES (NIL NIL)
((SPACES % )
NIL))
[REALTOKEN ((+)
(QUOTE (+ . +)))
((-)
(QUOTE (- . -)))
((*)
(QUOTE (* . *)))
((/)
(QUOTE (/ . /)))
((↑)
(QUOTE (↑ . ↑)))
((%()
(QUOTE (%( . %()))
((%))
(QUOTE (%) . %))))
((NUMBER)
(CONS (QUOTE NUMBER)
(CAR RHS)))
((EOF)
(QUOTE (EOF . EOF]
(NUMBER ((DIGITS %. DIGITS)
(PLUS (CAR RHS)
(LET ((FRAC (CADDR RHS)))
(while (GREATERP FRAC 1.0)
do
(SETQ FRAC (FQUOTIENT FRAC 10)))
FRAC)))
((%. DIGITS)
(LET ((FRAC (CADR RHS)))
(while (GREATERP FRAC 1.0)
do
(SETQ FRAC (FQUOTIENT FRAC 10)))
FRAC))
((DIGITS %.)
(CAR RHS))
((DIGITS)
(CAR RHS)))
(DIGITS ((DIGITS DIGIT)
(PLUS (TIMES 10 (CAR RHS))
(CADR RHS)))
((DIGIT)
(CAR RHS)))
(DIGIT ((0)
0)
((1)
1)
((2)
2)
((3)
3)
((4)
4)
((5)
5)
((6)
6)
((7)
7)
((8)
8)
((9)
9))))
(DECLARE: EVAL@COMPILE
[PUTPROPS ARITHDQ MACRO ((Q)
(PROG1 Q (SETQ Q NIL]
(PUTPROPS FUNNYCAR MACRO ((A B)
(CAR A)))
(PUTPROPS FUNNYCDR MACRO ((A B)
(CDR A)))
[PUTPROPS ARITHTOP MACRO (OPENLAMBDA (S)
(ELT (fetch STACK of S)
(fetch STACKPTR of S]
(PUTPROPS ARITHPUSH MACRO (OPENLAMBDA (S NEW)
(add (fetch STACKPTR of S)
1)
(SETA (fetch STACK of S)
(fetch STACKPTR of S)
NEW)))
[PUTPROPS ARITHPOP MACRO (OPENLAMBDA (S)
(PROG1 (ARITHTOP S)
(add (fetch STACKPTR of S)
-1]
[PUTPROPS ARITHSTACK MACRO (NIL (create ARITHSTACK STACKPTR ← 0 STACK ← (ARRAY 7]
)
[DECLARE: EVAL@COMPILE
(DATATYPE ARITHSTACK (STACKPTR STACK))
]
(/DECLAREDATATYPE (QUOTE ARITHSTACK)
(QUOTE (POINTER POINTER))
(QUOTE ((ARITHSTACK 0 POINTER)
(ARITHSTACK 2 POINTER)))
(QUOTE 4))
(DEFINEQ
(TEST.ARITH
[LAMBDA NIL (* hts: " 1-Mar-86 19:14")
(* * Run the parser on the file {core}foo)
(CLOSEF? (QUOTE {CORE}FOO))
(LET [(S (OPENSTREAM (QUOTE {CORE}FOO)
(QUOTE INPUT]
(PROG1 (ARITH NIL (LIST NIL NIL S))
(CLOSEF S])
(TEST.ARITHLEX
[LAMBDA NIL (* hts: " 1-Mar-86 19:10")
(* * Run the parser on the file {core}foo)
(CLOSEF? (QUOTE {CORE}FOO))
(LET [(S (OPENSTREAM (QUOTE {CORE}FOO)
(QUOTE INPUT]
(bind S TOKEN DONE STATE
first (SETQ DONE NIL)
(SETQ S (OPENSTREAM (QUOTE {CORE}FOO)
(QUOTE INPUT)))
(SETQ STATE (LIST NIL S))
while (NOT DONE)
collect (SETQ TOKEN (ARITHLEX NIL STATE))
(OR (NEQ (QUOTE EOF)
(CAR TOKEN))
(SETQ DONE T))
TOKEN
finally (CLOSEF S])
)
(PUTPROPS PARSERG COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2926 3151 (READCHAR 2936 . 3149)) (3152 3534 (TEST.TOY1 3162 . 3532)) (4300 4682 (
TEST.TOY2 4310 . 4680)) (5440 5822 (TEST.TOY3 5450 . 5820)) (6705 7087 (TEST.TOY4 6715 . 7085)) (8107
8489 (TEST.TOY5 8117 . 8487)) (14631 15714 (TEST.ARITH 14641 . 15000) (TEST.ARITHLEX 15002 . 15712))))
)
STOP