1-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
2-- All rights reserved.
3--
4-- Redistribution and use in source and binary forms, with or without
5-- modification, are permitted provided that the following conditions are
6-- met:
7--
8--     - Redistributions of source code must retain the above copyright
9--       notice, this list of conditions and the following disclaimer.
10--
11--     - Redistributions in binary form must reproduce the above copyright
12--       notice, this list of conditions and the following disclaimer in
13--       the documentation and/or other materials provided with the
14--       distribution.
15--
16--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
17--       names of its contributors may be used to endorse or promote products
18--       derived from this software without specific prior written permission.
19--
20-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
21-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
22-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
23-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
24-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
25-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
26-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
27-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
28-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
29-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
30-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31
32
33)package "BOOT"
34
35-- npTerm introduced between npRemainder and npSum
36-- rhs of assignment changed from npStatement to npGives
37
38DEFVAR($inputStream)
39DEFVAR($stack)
40DEFVAR($stok)
41DEFVAR($ttok)
42
43npParse stream ==
44    $inputStream:local := stream
45    $stack:local       :=nil
46    $stok:local:=nil
47    $ttok:local:=nil
48    npFirstTok()
49    found:=CATCH("TRAPPOINT",npItem())
50    if found="TRAPPED"
51    then
52      ncSoftError(tokPosn $stok,'S2CY0006, [])
53      pfWrong(pfDocument  '"top level syntax error" ,pfListOf nil)
54    else if not null $inputStream
55         then
56          ncSoftError(tokPosn $stok,'S2CY0002,[])
57          pfWrong(pfDocument ['"input stream not exhausted"],pfListOf [])
58         else if null $stack
59              then
60                 ncSoftError(tokPosn $stok,'S2CY0009, [])
61                 pfWrong(pfDocument ['"stack empty"],pfListOf [])
62              else
63                 first $stack
64
65npItem()==
66     npQualDef() =>
67            npEqKey(";") =>
68                      [a,b]:=npItem1 npPop1 ()
69                      c:=pfEnSequence b
70                      a => npPush c
71                      npPush pfNovalue c
72            npPush pfEnSequence npPop1 ()
73     false
74
75npItem1 c==
76     npQualDef() =>
77            npEqKey(";") =>
78                      [a,b]:=npItem1 npPop1 ()
79                      [a,append(c,b)]
80            [true,append (c,npPop1())]
81     [false,c]
82
83npFirstTok()==
84      $stok:=
85          if null $inputStream
86          then tokConstruct("ERROR","NOMORE",tokPosn $stok)
87          else first $inputStream
88      $ttok:=tokPart $stok
89
90npNext() ==
91     $inputStream := rest($inputStream)
92     npFirstTok()
93
94npState()==cons($inputStream,$stack)
95
96npRestore(x)==
97      $inputStream := first x
98      npFirstTok()
99      $stack := rest x
100      true
101
102npPush x==$stack:=CONS(x,$stack)
103
104npPushId()==
105   a:=GET($ttok,'INFGENERIC)
106   $ttok:= if a then a else $ttok
107   $stack:=CONS(tokConstruct("id",$ttok,tokPosn $stok),$stack)
108   npNext()
109
110npPop1()==
111       a := first $stack
112       $stack := rest $stack
113       a
114
115npPop2()==
116       a:=CADR $stack
117       RPLACD($stack,CDDR $stack)
118       a
119
120npPop3()==
121       a:=CADDR $stack
122       RPLACD(rest $stack, CDDDR $stack)
123       a
124
125npParenthesized f==
126   npParenthesize("(",")",f)
127
128npParenthesize (open,close,f)==
129    a:=$stok
130    npEqKey open =>
131         APPLY(f,nil) and (npEqKey close or npMissingMate(close,a))=> true
132         npEqKey close  =>  npPush  []
133         npMissingMate(close,a)
134    false
135
136npEnclosed(open,close,fn,f)==
137    a:=$stok
138    npEqKey open =>
139        npEqKey close  => npPush FUNCALL(fn,a,pfTuple pfListOf [])
140        APPLY(f,nil) and (npEqKey close or npMissingMate(close,a))=>
141                   npPush FUNCALL (fn,a,pfEnSequence npPop1())
142        false
143    false
144
145npParened f ==
146    npEnclosed("(",")",function pfParen,f)
147
148npBracked f ==
149    npEnclosed("[","]",function pfBracket,f)
150
151npBraced f ==
152    npEnclosed("{","}",function pfBrace,f)
153
154npBracketed f==
155    npParened f or npBracked f or npBraced f
156
157npPileBracketed f==
158 if npEqKey "SETTAB"
159 then if npEqKey "BACKTAB"
160      then npPush pfNothing()     -- never happens
161      else if APPLY(f,nil) and (npEqKey "BACKTAB" or npMissing "backtab")
162           then npPush pfPile npPop1()
163           else false
164 else false
165
166npListofFun(f,h,g)==
167    if APPLY(f,nil)
168    then
169        if APPLY(h,nil) and (APPLY(f,nil) or npTrap())
170        then
171          a:=$stack
172          $stack:=nil
173          while APPLY(h,nil) and (APPLY(f,nil) or npTrap()) repeat 0
174          $stack:=cons(NREVERSE $stack,a)
175          npPush FUNCALL(g, [npPop3(),npPop2(),:npPop1()])
176        else
177          true
178    else false
179
180npList(f,str1,g)== -- always produces a list, g is applied to it
181    if APPLY(f,nil)
182    then
183        if npEqKey str1 and (npEqKey "BACKSET" or true)
184                       and (APPLY(f,nil) or npTrap())
185        then
186          a:=$stack
187          $stack:=nil
188          while npEqKey str1 and (npEqKey "BACKSET" or true) and
189                             (APPLY(f,nil) or npTrap()) repeat 0
190          $stack:=cons(NREVERSE $stack,a)
191          npPush FUNCALL(g,  [npPop3(),npPop2(),:npPop1()])
192        else
193          npPush FUNCALL(g, [npPop1()])
194    else npPush FUNCALL(g, [])
195
196
197++ rewrite flets, using global scoping
198$npPParg := nil
199
200npPPff() ==
201  FUNCALL $npPParg and npPush [npPop1()]
202
203npPPf() ==
204  npSemiListing function npPPff
205
206npPPg() ==
207  npListAndRecover function npPPf
208    and npPush pfAppend npPop1()
209
210npPP(f) ==
211  $npPParg := f
212  npParened function npPPf
213    or npPileBracketed function npPPg and
214      npPush pfEnSequence npPop1()
215        or FUNCALL f
216
217++ rewrite flets, using global scoping
218$npPCff := nil
219
220npPCff() ==
221  FUNCALL $npPCff and npPush [npPop1()]
222
223npPCg() ==
224  npListAndRecover function npPCff
225    and npPush pfAppend npPop1()
226
227npPC(f) ==
228  $npPCff := f
229  npPileBracketed function npPCg and
230    npPush pfEnSequence npPop1()
231      or FUNCALL f
232
233
234-- s must transform the head of the stack
235
236npAnyNo s==
237     while APPLY(s,nil) repeat 0
238     true
239
240npAndOr(keyword,p,f)==
241   npEqKey keyword and (APPLY(p,nil) or npTrap())
242             and npPush FUNCALL(f, npPop1())
243
244npRightAssoc(o,p)==
245    a:=npState()
246    if APPLY(p,nil)
247    then
248       while  npInfGeneric o and (npRightAssoc(o,p)
249               or (npPush pfApplication(npPop2(),npPop1());false)) repeat
250             npPush pfInfApplication(npPop2(),npPop2(),npPop1())
251       true
252    else
253       npRestore a
254       false
255
256-- p o p o p o p = (((p o p) o p) o p)
257-- p o p o = (p o p) o
258
259npLeftAssoc(operations,parser)==
260    if APPLY(parser,nil)
261    then
262       while npInfGeneric(operations)
263         and (APPLY(parser,nil) or
264              (npPush pfApplication(npPop2(),npPop1());false))
265           repeat
266             npPush pfInfApplication(npPop2(),npPop2(),npPop1())
267       true
268    else false
269
270npInfixOp()==
271  EQ(CAAR $stok,"key") and
272    GET($ttok,"INFGENERIC") and npPushId()
273
274npInfixOperator()== npInfixOp() or
275        a:=npState()
276        b:=$stok
277        npEqKey "'" and npInfixOp() =>
278                npPush pfSymb (npPop1 (),tokPosn b)
279        npRestore a
280        npEqKey "BACKQUOTE" and  npInfixOp() =>
281                a:=npPop1()
282                npPush tokConstruct("idsy",tokPart a,tokPosn a)
283        npRestore a
284        false
285
286npInfKey s==  EQ(CAAR $stok,"key") and  MEMQ($ttok,s) and npPushId()
287
288npDDInfKey s==
289    npInfKey s or
290        a:=npState()
291        b:=$stok
292        npEqKey "'" and npInfKey s =>
293                 npPush pfSymb (npPop1 () ,tokPosn b)
294        npRestore a
295        npEqKey "BACKQUOTE" and  npInfKey s =>
296                a:=npPop1()
297                npPush tokConstruct("idsy",tokPart a,tokPosn a)
298        npRestore a
299        false
300
301npInfGeneric s== npDDInfKey s  and
302                   (npEqKey "BACKSET" or true)
303
304npConditional f==
305  if  npEqKey "if" and (npLogical() or npTrap()) and
306                   (npEqKey "BACKSET" or true)
307  then
308           if npEqKey "SETTAB"
309           then if npEqKey "then"
310                then  (APPLY(f,nil) or npTrap()) and npElse(f)
311                        and npEqKey "BACKTAB"
312                else  npMissing "then"
313           else if npEqKey "then"
314                then (APPLY(f,nil) or npTrap()) and npElse(f)
315                else npMissing "then"
316  else false
317
318npElse(f)==
319           a:=npState()
320           if npBacksetElse()
321           then  (APPLY(f,nil) or npTrap()) and
322                 npPush pfIf(npPop3(),npPop2(),npPop1())
323           else
324              npRestore a
325              npPush pfIfThenOnly(npPop2(),npPop1())
326
327npBacksetElse()==
328    if npEqKey "BACKSET"
329    then npEqKey "else"
330    else npEqKey "else"
331
332npWConditional f==
333    if npConditional f
334    then npPush pfTweakIf npPop1()
335    else false
336
337-- Parsing functions
338
339-- peek for keyword s, no advance of token stream
340
341npEqPeek s ==  EQ(CAAR $stok,"key") and EQ(s,$ttok)
342
343-- test for keyword s, if found advance token stream
344
345npEqKey s ==
346    EQ(CAAR $stok,"key") and EQ(s,$ttok) and npNext()
347
348$npTokToNames:= ["~","#","[]","{}", "[||]","{||}"]
349
350npId() ==
351        EQ(CAAR $stok,"id") =>
352               npPush $stok
353               npNext()
354        EQ(CAAR $stok,"key") and MEMQ($ttok,$npTokToNames)=>
355               npPush tokConstruct("id",$ttok,tokPosn $stok)
356               npNext()
357        false
358
359npSymbolVariable()==
360     a:=npState()
361     npEqKey "BACKQUOTE" and  npId()  =>
362          a:=npPop1()
363          npPush tokConstruct("idsy",tokPart a,tokPosn a)
364     npRestore a
365     false
366
367npName()==npId() or npSymbolVariable()
368
369npConstTok() ==
370     MEMQ(tokType $stok, '(integer string char float command)) =>
371          npPush $stok
372          npNext()
373     npEqPeek "'" =>
374          a:=$stok
375          b:=npState()
376          npNext()
377          if
378              npPrimary1() and npPush pfSymb(npPop1(),tokPosn a)
379          then true
380          else
381            npRestore b
382            false
383     false
384
385
386npPrimary1() ==
387   npEncAp function npAtom1 or
388   npMacro() or
389   npBPileDefinition() or npDefn() or
390   npRule()
391
392npPrimary2()== npEncAp function npAtom2 -- or  npBPileDefinition()
393               or npAdd(pfNothing()) or npWith(pfNothing())
394
395
396npAtom1()== npPDefinition() or ((npName() or npConstTok() or
397       npDollar() or npBDefinition()) and npFromdom())
398
399npAtom2()== (npInfixOperator() or npAmpersand() or npPrefixColon())
400                           and npFromdom()
401
402npDollar()== npEqPeek "$" and
403   npPush tokConstruct("id","$",tokPosn $stok)
404   npNext()
405
406npPrefixColon()== npEqPeek(":") and
407   npPush tokConstruct("id",":",tokPosn $stok)
408   npNext()
409
410-- silly
411
412npEncAp(f)== APPLY(f,nil) and npAnyNo function npEncl
413                   and npFromdom()
414
415
416npEncl()==  npBDefinition() and npPush pfApplication(npPop2(),npPop1())
417
418npFromdom()==
419  npEqKey "$" and (npApplication() or npTrap())
420      and npFromdom1 npPop1() and npPush pfFromDom(npPop1(),npPop1())
421         or true
422
423npFromdom1 c==
424  npEqKey "$" and (npApplication() or npTrap())
425    and npFromdom1 npPop1()  and npPush pfFromDom(npPop1(),c)
426        or npPush c
427
428
429npPrimary()==   npPrimary1() or npPrimary2()
430
431npDotted f== APPLY(f,nil) and npAnyNo function npSelector
432
433npSelector()==
434            npEqKey(".") and (npPrimary() or npTrap()) and
435              npPush(pfApplication(npPop2(),npPop1()))
436
437npApplication()==
438   npDotted function npPrimary and
439      (npApplication2() and
440            npPush(pfApplication(npPop2(),npPop1())) or true)
441
442
443npApplication2()==
444   npDotted function npPrimary1 and
445      (npApplication2() and
446            npPush(pfApplication(npPop2(),npPop1())) or true)
447
448npTypedForm1(sy,fn) ==
449     npEqKey sy  and (npType() or npTrap()) and
450        npPush FUNCALL(fn,npPop2(),npPop1())
451
452npTypedForm(sy,fn) ==
453     npEqKey sy  and (npApplication() or npTrap()) and
454        npPush FUNCALL(fn,npPop2(),npPop1())
455
456npRestrict() == npTypedForm("@", function pfRestrict)
457
458npCoerceTo() == npTypedForm("::", function pfCoerceto)
459
460npPretend() == npTypedForm("pretend", function pfPretend)
461
462npTypeStyle()==
463    npCoerceTo() or npRestrict() or npPretend()
464
465npTypified ()==npApplication() and npAnyNo function npTypeStyle
466
467npTagged() == npTypedForm1(":", function pfTagged)
468
469npColon () == npTypified() and npAnyNo function npTagged
470
471npPower() == npRightAssoc(["**", "^"], function npColon)
472
473npProduct()==
474    npLeftAssoc(["*", "/", "\", "SLASHSLASH",
475       "BACKSLASHBACKSLASH", "/\", "\/"], function npPower)
476
477npRemainder()==
478    npLeftAssoc(["rem", "quo", "exquo"], function npProduct)
479
480npTerm()==
481   npInfGeneric(["-", "+"]) and (npRemainder()
482        and npPush(pfApplication(npPop2(),npPop1())) or true)
483             or npRemainder()
484
485
486npSum()==npLeftAssoc(["-", "+"], function npTerm)
487
488npArith()==npLeftAssoc(["mod"], function npSum)
489
490npSegment()==  npEqPeek "SEG"  and npPushId() and npFromdom()
491
492npInterval()==
493  npArith() and
494   (npSegment() and ((npEqPeek("|")
495      and npPush(pfApplication(npPop1(),npPop1()))) or
496     (npArith() and npPush(pfInfApplication(npPop2(),npPop2(),npPop1())))
497            or npPush(pfApplication(npPop1(),npPop1()))) or true)
498
499npBy()== npLeftAssoc(["by"], function npInterval)
500
501npAmpersand()==  npEqKey "AMPERSAND" and (npName() or npTrap())
502npAmpersandFrom()== npAmpersand()  and npFromdom()
503
504npSynthetic()==
505    if npBy()
506    then
507       while npAmpersandFrom()  and (npBy() or
508          (npPush pfApplication(npPop2(),npPop1());false)) repeat
509             npPush pfInfApplication(npPop2(),npPop2(),npPop1())
510       true
511    else false
512
513npRelation()==
514   npLeftAssoc(["=", "~=", "<", "<=", ">", ">=", "<<", ">>"],
515            function npSynthetic)
516
517npQuiver()  ==    npRightAssoc('(ARROW LARROW),function npRelation)
518npDiscrim() ==    npLeftAssoc(["case", "has"], function npQuiver)
519
520npDisjand() == npLeftAssoc(["and"], function npDiscrim)
521
522npLogical() == npLeftAssoc(["or"], function npDisjand)
523npSuch() == npLeftAssoc(["|"], function npLogical)
524npMatch()   ==  npLeftAssoc(["is", "isnt"], function npSuch)
525
526npType()    ==  npMatch()  and
527                a:=npPop1()
528                npWith(a) or npPush a
529
530npADD()    ==   npType() and
531                a:=npPop1()
532                npAdd(a) or npPush a
533
534npConditionalStatement()==npConditional function npQualifiedDefinition
535
536npExpress1()==npConditionalStatement() or  npADD()
537
538npCommaBackSet()== npEqKey(",") and (npEqKey "BACKSET" or true)
539
540npExpress()==
541     npExpress1() and
542        (npIterators() and
543             npPush pfCollect (npPop2(),pfListOf npPop1()) or true)
544
545npZeroOrMore f==
546       APPLY(f,nil)=>
547         a:=$stack
548         $stack:=nil
549         while APPLY(f,nil) repeat 0
550         $stack:=cons(NREVERSE $stack,a)
551         npPush cons(npPop2(),npPop1())
552       npPush nil
553       true
554
555npIterators()==
556         npForIn() and npZeroOrMore function npIterator
557             and npPush cons(npPop2(),npPop1())  or
558              npWhile() and (npIterators() and
559                    npPush cons(npPop2(),npPop1()) or npPush [npPop1()])
560
561npIterator()==   npForIn() or npSuchThat() or npWhile()
562
563npStatement()==
564        npExpress() or
565        npLoop() or
566        npIterate() or
567        npReturn() or
568        npBreak() or
569        npFree() or
570        npImport() or
571        npInline() or
572        npLocal() or
573        npExport() or
574        npTyping() or
575        npVoid()
576
577npBackTrack(p1,p2,p3)==
578     a:=npState()
579     APPLY(p1,nil) =>
580         npEqPeek p2   =>
581            npRestore a
582            APPLY(p3,nil) or npTrap()
583         true
584     false
585
586npMDEF()== npBackTrack(function npStatement, "==>", function npMDEFinition)
587
588npMDEFinition() == npPP function npMdef
589
590npAssign()== npBackTrack(function npMDEF, ":=", function npAssignment)
591
592npAssignment()==
593    npAssignVariable() and
594      (npEqKey(":=") or npTrap()) and
595        (npGives() or npTrap()) and
596           npPush pfAssign (npPop2(),npPop1())
597
598npAssignVariableName()==npApplication() and
599      a:=npPop1()
600      if pfId? a
601      then
602         (npPush a and npDecl() or npPush pfTyped(npPop1(),pfNothing()))
603      else npPush a
604
605npAssignVariable()== npColon() and npPush pfListOf [npPop1()]
606
607npAssignVariablelist()== npListing function npAssignVariableName
608
609npExit()== npBackTrack(function npAssign, "=>", function npPileExit)
610
611npPileExit()==
612     npAssign() and (npEqKey("=>") or npTrap()) and
613         (npStatement() or npTrap())
614           and npPush pfExit (npPop2(),npPop1())
615
616npGives()== npBackTrack(function npExit, "+->", function npLambda)
617
618npDefinitionOrStatement()==
619            npBackTrack(function npGives, "==", function npDef)
620
621npVoid()== npAndOr("DO",function npStatement,function pfNovalue)
622
623npReturn()==
624         npEqKey "return" and
625          (npExpress() or npPush pfNothing()) and
626           (npEqKey "from" and (npName() or npTrap()) and
627              npPush pfReturn (npPop2(),npPop1()) or
628                npPush pfReturnNoName npPop1())
629npLoop()==
630     npIterators() and
631      (npCompMissing "repeat" and
632         (npAssign() or npTrap()) and
633            npPush pfLp(npPop2(),npPop1()))
634                or
635                  npEqKey "repeat" and (npAssign() or npTrap()) and
636                       npPush pfLoop1 npPop1 ()
637
638npSuchThat()==npAndOr("|", function npLogical, function pfSuchthat)
639
640npWhile() == npAndOr("while", function npLogical, function pfWhile)
641
642npForIn()==
643  npEqKey "for" and (npVariable() or npTrap()) and (npCompMissing "in")
644      and ((npBy()  or npTrap()) and
645         npPush pfForin(npPop2(),npPop1()))
646
647npBreak()==
648     npEqKey "break" and  npPush pfBreak pfNothing ()
649
650npIterate()==
651     npEqKey "ITERATE" and  npPush pfIterate pfNothing ()
652
653npQualType()==
654     npType() and
655            npPush pfQualType(npPop1(),pfNothing())
656
657npSQualTypelist()== npListing function npQualType
658                and npPush pfParts npPop1 ()
659
660npQualTypelist()== npPC function npSQualTypelist
661                             and npPush pfUnSequence npPop1 ()
662
663npImport() == npAndOr("import", function npQualTypelist, function pfImport)
664
665npInline()==npAndOr("INLINE",function npQualTypelist,function pfInline)
666
667npLocalDecl()== npEqKey(":") and (npType() or npTrap()) and
668             npPush pfSpread (pfParts npPop2(),npPop1()) or
669              npPush pfSpread (pfParts npPop1(),pfNothing())
670
671npLocalItem()==npTypeVariable() and  npLocalDecl()
672
673npLocalItemlist()== npPC function npSLocalItem
674                             and npPush pfUnSequence npPop1 ()
675
676npSLocalItem()== npListing function npLocalItem
677        and npPush  pfAppend pfParts npPop1()
678
679npFree()== npEqKey "FREE" and (npLocalItemlist() or npTrap())
680     and npPush pfFree npPop1()
681
682npLocal()== npEqKey "local" and (npLocalItemlist() or npTrap())
683     and npPush pfLocal npPop1()
684npExport()== npEqKey "EXPORT" and (npLocalItemlist() or npTrap())
685     and npPush pfExport npPop1()
686
687npDefn()== npEqKey "DEFN" and  npPP function npDef
688
689npMacro()== npEqKey "MACRO" and  npPP function npMdef
690
691npRule()== npEqKey "RULE" and  npPP function npSingleRule
692
693npAdd(extra)==
694     npEqKey "add" and
695       a:=npState()
696       npDefinitionOrStatement() or npTrap()
697       npEqPeek "in" =>
698               npRestore a
699               (npVariable() or npTrap()) and
700                     npCompMissing "in"  and
701                         (npDefinitionOrStatement() or npTrap()) and
702                            npPush pfAdd(npPop2(),npPop1(),extra)
703       npPush pfAdd(pfNothing(),npPop1(),extra)
704
705npDefaultValue()==
706      npEqKey "DEFAULT" and
707             (npDefinitionOrStatement() or npTrap())
708         and  npPush [pfAdd(pfNothing(),npPop1(),pfNothing())]
709
710npWith(extra)==
711     npEqKey "with" and
712       a:=npState()
713       npCategoryL() or npTrap()
714       npEqPeek "in" =>
715               npRestore a
716               (npVariable() or npTrap()) and
717                     npCompMissing "in"  and
718                          (npCategoryL() or npTrap()) and
719                              npPush pfWith(npPop2(),npPop1(),extra)
720       npPush pfWith(pfNothing(),npPop1(),extra)
721
722npCategoryL()== npCategory() and npPush pfUnSequence npPop1 ()
723
724pfUnSequence x==
725        pfSequence? x =>   pfListOf pfAppend pf0SequenceArgs  x
726        pfListOf x
727
728npCategory()== npPP function npSCategory
729
730npSCategory()==
731  if npWConditional function npCategoryL
732  then  npPush [npPop1()]
733  else
734    if npDefaultValue()
735    then true
736    else
737      a:=npState()
738      if npPrimary()
739      then if npEqPeek(":")
740           then
741              npRestore a
742              npSignature()
743           else
744              npRestore a
745              npApplication() and npPush [pfAttribute (npPop1())]
746                           or npTrap()
747
748      else false
749
750
751npSignatureDefinee()==
752   npName() or npInfixOperator() or npPrefixColon()
753
754
755npSigDecl()== npEqKey(":") and (npType() or npTrap()) and
756           npPush pfSpread (pfParts npPop2(),npPop1())
757
758npSigItem()==npTypeVariable() and  (npSigDecl() or npTrap())
759
760npSigItemlist()== npListing function npSigItem
761        and npPush pfListOf pfAppend pfParts npPop1()
762
763npSignature()==
764    npSigItemlist() and
765            npPush pfWDec(pfNothing(),npPop1())
766
767npSemiListing (p)==
768       npListofFun(p,function npSemiBackSet,function pfAppend)
769
770npSemiBackSet()== npEqKey(";") and (npEqKey "BACKSET" or true)
771npDecl()== npEqKey(":") and (npType() or npTrap()) and
772           npPush pfTyped (npPop2(),npPop1())
773
774npVariableName()==npName() and
775      (npDecl() or npPush pfTyped(npPop1(),pfNothing()))
776
777npVariable()== npParenthesized function npVariablelist or
778      (npVariableName() and npPush pfListOf [npPop1()])
779
780npVariablelist()== npListing function npVariableName
781
782npListing (p)==npList(p, ",", function pfListOf)
783npQualified(f)==
784    FUNCALL f =>
785        while npEqKey "where" and (npDefinition() or npTrap()) repeat
786             npPush pfWhere(npPop1(),npPop1())
787        true
788    false
789
790npQualifiedDefinition()==
791       npQualified function npDefinitionOrStatement
792
793npTuple (p)==
794    npListofFun(p,function npCommaBackSet,function pfTupleListOf)
795npComma()==  npTuple function npQualifiedDefinition
796
797npQualDef()== npComma() and npPush [npPop1()]
798
799npDefinitionlist ()==npSemiListing(function npQualDef)
800
801npPDefinition ()==
802     npParenthesized function npDefinitionlist and
803                 npPush pfEnSequence npPop1()
804
805npBDefinition()== npPDefinition() or
806            npBracketed function npDefinitionlist
807
808npPileDefinitionlist()==
809 npListAndRecover function npDefinitionlist
810    and npPush pfAppend npPop1()
811
812
813npTypeVariable()== npParenthesized function npTypeVariablelist or
814           npSignatureDefinee() and npPush pfListOf [npPop1()]
815
816npTypeVariablelist()== npListing function npSignatureDefinee
817
818npTyping()==
819      npEqKey "DEFAULT" and  (npDefaultItemlist() or npTrap())
820                and npPush pfTyping npPop1()
821
822npDefaultItemlist()== npPC function npSDefaultItem
823                             and npPush pfUnSequence npPop1 ()
824
825npDefaultDecl()== npEqKey(":") and (npType() or npTrap()) and
826           npPush pfSpread (pfParts npPop2(),npPop1())
827
828npDefaultItem()==npTypeVariable() and (npDefaultDecl() or npTrap())
829
830npSDefaultItem()== npListing function npDefaultItem
831        and npPush pfAppend pfParts npPop1()
832
833npBPileDefinition()==
834     npPileBracketed function npPileDefinitionlist
835       and npPush pfSequence pfListOf npPop1 ()
836
837
838npLambda()==
839     (npVariable() and
840      ((npLambda() or npTrap()) and
841       npPush pfLam(npPop2(),npPop1()))) or
842         npEqKey("+->") and (npDefinitionOrStatement() or npTrap()) or
843          npEqKey(":") and (npType() or npTrap()) and
844            npEqKey("+->") and (npDefinitionOrStatement() or npTrap())
845               and
846                  npPush pfReturnTyped(npPop2(),npPop1())
847
848npDef()==
849    npMatch() =>
850         [op,arg,rt]:=  pfCheckItOut(npPop1())
851         npDefTail() or npTrap()
852         body:=npPop1()
853         null arg => npPush pfDefinition (op,body)
854         npPush pfDefinition (op,pfPushBody(rt,arg,body))
855    false
856
857--npDefTail()== npEqKey "DEF" and npDefinitionOrStatement()
858npDefTail()== (npEqKey("==") or npEqKey("==>")) and npDefinitionOrStatement()
859
860npMdef()==
861    npQuiver() =>
862         [op,arg]:=  pfCheckMacroOut(npPop1())
863         npDefTail() or npTrap()
864         body:=npPop1()
865         null arg => npPush pfMacro (op,body)
866         npPush pfMacro (op,pfPushMacroBody(arg,body))
867    false
868
869
870npSingleRule()==
871    npQuiver() =>
872         npDefTail() or npTrap()
873         npPush pfRule (npPop2(),npPop1())
874    false
875
876npDefinitionItem()==
877   npTyping() or
878      npImport()  or
879          a:=npState()
880          npStatement() =>
881               npEqPeek("==") =>
882                  npRestore a
883                  npDef()
884               npRestore a
885               npMacro() or npDefn()
886          npTrap()
887
888npDefinition()== npPP function npDefinitionItem
889            and npPush  pfSequenceToList npPop1 ()
890
891pfSequenceToList x==
892        pfSequence? x =>  pfSequenceArgs  x
893        pfListOf [x]
894