1)package "BOOT"
2
3DEFPARAMETER($ParseMode, NIL)
4DEFPARAMETER($LABLASOC, NIL)
5DEFVAR($NONBLANK, nil)
6
7
8-- PURPOSE: This file sets up properties which are used by the Boot lexical
9--          analyzer for bottom-up recognition of operators.  Also certain
10--          other character-class definitions are included, as well as
11--          table accessing functions.
12--
13-- 1. Led and Nud Tables
14--
15-- TABLE PURPOSE
16
17-- Led and Nud have to do with operators. An operator with a Led property takes
18-- an operand on its left (infix/suffix operator).
19
20-- An operator with a Nud takes no operand on its left (prefix/nilfix).
21-- Some have both (e.g. - ).  This terminology is from the Pratt parser.
22-- The translator for Scratchpad II is a modification of the Pratt parser which
23-- branches to special handlers when it is most convenient and practical to
24-- do so (Pratt's scheme cannot handle local contexts very easily).
25
26-- Both LEDs and NUDs have right and left binding powers.  This is meaningful
27-- for prefix and infix operators.  These powers are stored as the values of
28-- the LED and NUD properties of an atom, if the atom has such a property.
29-- The format is:
30
31--     <Operator Left-Binding-Power  Right-Binding-Power <Special-Handler>>
32
33-- where the Special-Handler is the name of a function to be evaluated when
34-- that keyword is encountered.
35
36-- The default values of Left and Right Binding-Power are NIL.  NIL is a
37-- legitimate value signifying no precedence.  If the Special-Handler is NIL,
38-- this is just an ordinary operator (as opposed to a surfix operator like
39-- if-then-else).
40
41-- ** TABLE CREATION
42
43MAKEOP(X, Y) ==
44    if OR(NOT (CDR X), NUMBERP (SECOND X)) then
45        X := CONS(first X, X)
46    MAKEPROP(first X, Y, X)
47
48init_parser_properties() ==
49    for j in _
50         [["*", 800, 801],   ["rem", 800, 801], _
51          ["quo", 800, 801], _
52          ["/", 800, 801],    ["**", 901, 900],  ["^", 901, 900], _
53          ["exquo", 800, 801], ["+", 700, 701], _
54          ["-", 700, 701],    ["->", 1002, 1001],  ["<-", 1001, 1002], _
55          [":", 996, 997],    ["::", 996, 997], _
56          ["@", 996, 997],    ["pretend", 995, 996], _
57          ["."],            ["!", 1002, 1001], _
58          [",", 110, 111], _
59          [";", 81, 82, ["parse_SemiColon"]], _
60          ["<", 400, 400],    [">", 400, 400], _
61          ["<<", 400, 400],  [">>", 400, 400], _
62          ["<=", 400, 400],   [">=", 400, 400], _
63          ["=", 400, 400],     ["^=", 400, 400], _
64          ["~=", 400, 400], _
65          ["in", 400, 400],    ["case", 400, 400], _
66          ["add", 400, 120],   ["with", 2000, 400, ["parse_InfixWith"]], _
67          ["has", 400, 400], _
68          ["where", 121, 104], _
69          ["is", 400, 400],    ["isnt", 400, 400], _
70          ["and", 250, 251],   ["or", 200, 201], _
71          ["/\", 250, 251],   ["\/", 200, 201], _
72          ["..", "SEGMENT", 401, 699, ["parse_Seg"]], _
73          ["=>", 123, 103], _
74          ["+->", 995, 112], _
75          ["==", "DEF", 122, 121], _
76          ["==>", "MDEF", 122, 121], _
77          ["|", 108, 111], _
78          [":=", "LET", 125, 124]] repeat
79        MAKEOP(j, "Led")
80
81    for j in _
82         [["for", 130, 350, ["parse_Loop"]], _
83          ["while", 130, 190, ["parse_Loop"]], _
84          ["until", 130, 190, ["parse_Loop"]], _
85          ["repeat", 130, 190, ["parse_Loop"]], _
86          ["import", 120, 0, ["parse_Import"]], _
87          ["add", 900, 120], _
88          ["with", 1000, 300, ["parse_With"]], _
89          ["has", 400, 400], _
90          ["-", 701, 700], _
91          ["#", 999, 998], _
92          ["'", 999, 999, ["parse_Data"]], _
93          ["->", 1001, 1002], _
94          [":", 194, 195], _
95          ["not", 260, 259, NIL], _
96          ["~", 260, 259, nil], _
97          ["=", 400, 700], _
98          ["return", 202, 201, ["parse_Return"]], _
99          ["from"], _
100          ["iterate"], _
101          ["yield"], _
102          ["if", 130, 0, ["parse_Conditional"]], _
103          ["try", 130, 0, ["parse_Try"]], _
104          ["catch", 0, 114], _
105          ["finally", 0, 114], _
106          ["|", 0, 190], _
107          ["then", 0, 114], _
108          ["else", 0, 114]] repeat
109        MAKEOP(j, "Nud")
110
111init_parser_properties()
112
113-- Parsing functions return true if successful or false if not.
114-- If successful the result is left on the reduction stack.
115
116-- Signal error if not successful.  Used for mandatory elements
117-- in the grammar.
118MUST(x) ==
119    x => true
120    spad_syntax_error(nil, nil)
121
122-- Return successfully regardless of status of x.  Used for
123-- optional elements in the grammar.  Code matching 'x' must
124-- preserve number of elements on the reduction stack.
125OPTIONAL(x) == true
126
127-- The same as OPTIONAL, but used for actions.
128ACTION(x) == true
129
130symbol_is?(x) == EQ(current_symbol(), x)
131
132match_symbol(x) ==
133    match_current_token("KEYWORD", x) => (advance_token(); true)
134    false
135
136expect_symbol(x) ==
137    match_symbol(x) => true
138    spad_syntax_error(x, nil)
139
140DEFPARAMETER($reduction_stack, nil)
141
142push_reduction(x, y) ==
143    PUSH(y, $reduction_stack)
144    true
145
146pop_stack_1() == POP($reduction_stack)
147
148pop_stack_2() ==
149    el1 := POP($reduction_stack)
150    el2 := POP($reduction_stack)
151    PUSH(el1, $reduction_stack)
152    el2
153
154pop_stack_3() ==
155    el1 := POP($reduction_stack)
156    el2 := POP($reduction_stack)
157    el3 := POP($reduction_stack)
158    PUSH(el2, $reduction_stack)
159    PUSH(el1, $reduction_stack)
160    el3
161
162top_of_stack() == first($reduction_stack)
163
164parse_token(token) ==
165    tok := match_current_token(token, nil)
166    not(tok) => nil
167    symbol := TOKEN_-SYMBOL(tok)
168    push_reduction(token, COPY_-TREE(symbol))
169    advance_token()
170    true
171
172parse_SPADSTRING() == parse_token("SPADSTRING")
173parse_KEYWORD() == parse_token("KEYWORD")
174parse_ARGUMENT_DESIGNATOR() == parse_token("ARGUMENT-DESIGNATOR")
175parse_SPADFLOAT() == parse_token("SPADFLOAT")
176parse_IDENTIFIER() == parse_token("IDENTIFIER")
177parse_NUMBER() == parse_token("NUMBER")
178
179push_lform0(tag) ==
180    push_reduction("dummy", tag)
181
182push_form0(tag) ==
183    push_reduction("dummy", [tag])
184
185push_lform1(tag, arg1) ==
186    push_reduction("dummy", [tag, :arg1])
187
188push_form1(tag, arg1) ==
189    push_reduction("dummy", [tag, arg1])
190
191push_lform2(tag, arg1, arg2) ==
192    push_reduction("dummy", [tag, arg1, :arg2])
193
194push_form2(tag, arg1, arg2) ==
195    push_reduction("dummy", [tag, arg1, arg2])
196
197push_form3(tag, arg1, arg2, arg3) ==
198    push_reduction("dummy", [tag, arg1, arg2, arg3])
199
200dollarTran(dom, expr) ==
201    expr is [fun, :args] =>
202        [["Sel", dom, fun], :args]
203    ["Sel", dom, expr]
204
205parse_new_expr() ==
206    $reduction_stack := nil
207    parse_Expr 0
208
209parse_InfixWith() ==
210    not(parse_With()) => nil
211    push_form2("Join", pop_stack_2(), pop_stack_1())
212
213parse_With() ==
214    not(match_symbol "with") => nil
215    MUST parse_Category()
216    push_form1("with", pop_stack_1())
217
218repetition(delimiter, fn) ==
219    val := nil
220    repeat
221        if delimiter then
222            if not(match_symbol(delimiter)) then return nil -- break loop
223            MUST(FUNCALL fn)
224        else
225            if not(FUNCALL fn) then return nil -- break loop
226        val := [pop_stack_1(), :val]
227    val => push_lform0(nreverse(val))
228    nil
229
230getSignatureDocumentation2(n1, n2) ==
231    val1 := getSignatureDocumentation(n1) => val1
232    not(n2) =>
233        $COMBLOCKLIST is [[n, :val], :rr] and n1 <= n =>
234            $COMBLOCKLIST := rr
235            val
236        nil
237    nr := n2 + 1
238    for pp in $COMBLOCKLIST repeat
239        if pp is [n, :val] and n1 <= n and n <= n2 then
240            nr := n
241    nr <= n2 => getSignatureDocumentation(nr)
242    nil
243
244-- category : if expression then category [else category]
245--          | '(' category* ')'
246--          | application [':' expression]
247--          ;
248
249parse_category_list(closer) ==
250    MUST
251        match_symbol(closer) => push_form0("CATEGORY")
252        MUST(parse_Category())
253        tail_val :=
254            repetition(";", FUNCTION parse_Category) => pop_stack_1()
255            nil
256        expect_symbol(closer)
257        val1 := pop_stack_1()
258        IFCAR(val1) = "if" and tail_val = nil => push_lform0(val1)
259        push_lform2("CATEGORY", val1, tail_val)
260
261parse_Category() ==
262    match_symbol("if") =>
263        MUST parse_Expression()
264        cond := pop_stack_1()
265        expect_symbol "then"
266        MUST parse_Category()
267        else_val :=
268            match_symbol "else" =>
269                MUST parse_Category()
270                pop_stack_1()
271            nil
272        push_form3("if", cond, pop_stack_1(), else_val)
273    match_symbol("(") => parse_category_list(")")
274    match_symbol("{") => parse_category_list("}")
275    match_symbol("SETTAB") => parse_category_list("BACKTAB")
276    G1 := current_line_number()
277    not(parse_Application()) => nil
278    MUST
279        OR(
280              AND(match_symbol ":", MUST parse_Expression(),
281                  push_form3("Signature", pop_stack_2(), pop_stack_1(),
282                      getSignatureDocumentation2(G1, current_line_number()))),
283              AND(push_form1("ATTRIBUTE", pop_stack_1()),
284                  ACTION recordAttributeDocumentation(top_of_stack(), G1)))
285
286parse_Expression() ==
287    prior_sym := MAKE_-SYMBOL_-OF PRIOR_-TOKEN
288    prior_sym :=
289        SYMBOLP(prior_sym) => prior_sym
290        nil
291    parse_Expr
292     parse_rightBindingPowerOf(prior_sym, $ParseMode)
293
294parse_Expr1000() == parse_Expr 1000
295
296-- import : 'import' expr_1000 [',' expr_1000]*
297parse_Import() ==
298    not(match_symbol "import") => nil
299    match_symbol "from" or true
300    MUST parse_Expr 1000
301    tail_val :=
302        repetition(",", FUNCTION parse_Expr1000) => pop_stack_1()
303        nil
304    push_lform2("import", pop_stack_1(), tail_val)
305
306parse_Infix() ==
307    push_reduction("parse_Infix", current_symbol())
308    advance_token()
309    parse_TokTail()
310    MUST parse_Expression()
311    push_reduction("parse_Infix",
312                   [pop_stack_2(), pop_stack_2(), pop_stack_1()])
313
314parse_Prefix() ==
315    push_reduction("parse_Prefix", current_symbol())
316    advance_token()
317    parse_TokTail()
318    MUST parse_Expression()
319    push_reduction("parse_Prefix", [pop_stack_2(), pop_stack_1()])
320
321parse_Suffix() ==
322    push_reduction("parse_Suffix", current_symbol())
323    advance_token()
324    parse_TokTail()
325    push_reduction("parse_Suffix", [pop_stack_1(), pop_stack_1()])
326
327parse_TokTail() ==
328    current_symbol() ~= "$" => nil
329    not(OR(match_next_token("IDENTIFIER", NIL), next_symbol() = "%",
330           next_symbol() = "(")) => nil                     -- )
331    G1 := COPY_-TOKEN PRIOR_-TOKEN
332    not(parse_Qualification()) => nil
333    SETF(PRIOR_-TOKEN, G1)
334
335parse_Qualification() ==
336    not(match_symbol "$") => nil
337    MUST parse_Primary1()
338    push_reduction("parse_Qualification",
339                   dollarTran(pop_stack_1(), pop_stack_1()))
340
341parse_SemiColon() ==
342    not(match_symbol ";") => nil
343    parse_Expr 82 =>
344        push_form2(";", pop_stack_2(), pop_stack_1())
345    true
346
347parse_Return() ==
348    not(match_symbol "return") => nil
349    MUST parse_Expression()
350    push_form1("return", pop_stack_1())
351
352parse_Seg() ==
353    not(parse_GliphTok "..") => nil
354    right_val :=
355        parse_Expression() => pop_stack_1()
356        nil
357    push_form2("SEGMENT", pop_stack_1(), right_val)
358
359parse_Conditional() ==
360    not(match_symbol "if") => nil
361    MUST parse_Expression()
362    expect_symbol "then"
363    MUST parse_Expression()
364    else_val :=
365        match_symbol "else" =>
366            MUST parse_ElseClause()
367            pop_stack_1()
368        nil
369    push_form3("if", pop_stack_2(), pop_stack_1(), else_val)
370
371parse_ElseClause() ==
372    current_symbol() = "if" => parse_Conditional()
373    parse_Expression()
374
375parse_Try() ==
376    not(match_symbol "try") => nil
377    MUST parse_Expression()
378    expr := pop_stack_1()
379    expr :=
380        expr is [";", expr1, "/throwAway"] => expr1
381        expr
382    catcher := nil
383    if match_symbol "catch" then
384        MUST parse_Expression()
385        catcher := pop_stack_1()
386        MUST(catcher is ["in", var, expr])
387    finalizer := nil
388    if match_symbol "finally" then
389        MUST parse_Expression()
390        finalizer := pop_stack_1()
391    MUST(catcher or finalizer)
392    push_form3("try", expr, catcher, finalizer)
393
394parse_Loop() ==
395    OR(AND(repetition(nil, FUNCTION parse_Iterator),
396           expect_symbol "repeat", MUST parse_Expr 110,
397           push_lform1("REPEAT", [:pop_stack_2(), pop_stack_1()])),
398       AND(expect_symbol "repeat", MUST parse_Expr 110,
399           push_form1("REPEAT", pop_stack_1())))
400
401parse_Iterator() ==
402    match_symbol "for" =>
403        MUST parse_Primary()
404        expect_symbol "in"
405        MUST parse_Expression()
406        by_val :=
407              AND(match_symbol "by", MUST parse_Expr 200) => pop_stack_1()
408              nil
409        bar_val :=
410            AND(match_symbol "|", MUST parse_Expr 111) => pop_stack_1()
411            nil
412        in_val := pop_stack_1()
413        if bar_val then
414            in_val := ["|", in_val, bar_val]
415        if by_val then
416            push_form3("INBY", pop_stack_1(), in_val, by_val)
417        else
418            push_form2("IN", pop_stack_1(), in_val)
419    match_symbol "while" =>
420        MUST parse_Expr 190
421        push_form1("WHILE", pop_stack_1())
422    match_symbol "until" =>
423        MUST parse_Expr 190
424        push_form1("UNTIL", pop_stack_1())
425    nil
426
427parse_Expr($RBP) ==
428    not(parse_NudPart($RBP)) => nil
429    while parse_LedPart($RBP) repeat nil
430    push_reduction("parse_Expr", pop_stack_1())
431
432parse_LabelExpr() ==
433    not(parse_Label()) => nil
434    MUST parse_Expr(120)
435    push_form2("LABEL", pop_stack_2(), pop_stack_1())
436
437parse_Label() ==
438    not(match_symbol "<<") => nil
439    MUST parse_Name()
440    MUST match_symbol ">>"
441
442parse_LedPart($RBP) ==
443    not(parse_Operation("Led", $RBP)) => nil
444    push_reduction("parse_LedPart", pop_stack_1())
445
446parse_NudPart($RBP) ==
447    AND(OR(parse_Operation("Nud", $RBP), parse_Reduction(), parse_Form()),
448        push_reduction("parse_NudPart", pop_stack_1()))
449
450parse_Operation($ParseMode, $RBP) ==
451    match_current_token("IDENTIFIER", NIL) => nil
452    tmptok := current_symbol()
453    SYMBOLP(tmptok) and GET(tmptok, $ParseMode) and
454      $RBP < parse_leftBindingPowerOf(tmptok, $ParseMode) =>
455        $RBP := parse_rightBindingPowerOf(tmptok, $ParseMode)
456        parse_getSemanticForm($ParseMode,
457                               ELEMN(GET(tmptok, $ParseMode), 5, NIL))
458
459parse_leftBindingPowerOf(x, ind) ==
460    (y := GET(x, ind)) => ELEMN(y, 3, 0)
461    0
462
463parse_rightBindingPowerOf(x, ind) ==
464    (y := GET(x, ind)) => ELEMN(y, 4, 105)
465    105
466
467parse_getSemanticForm(ind, y) ==
468    AND(y, FUNCALL(first y)) => true
469    ind = "Nud" => parse_Prefix()
470    ind = "Led" => parse_Infix()
471    nil
472
473parse_Reduction() ==
474    parse_ReductionOp() =>
475        MUST parse_Expr 1000
476        push_form2("Reduce", pop_stack_2(), pop_stack_1())
477    nil
478
479parse_ReductionOp() ==
480    cur_sym := current_symbol()
481    AND(SYMBOLP(cur_sym), GET(cur_sym, "Led"),
482        match_next_token("KEYWORD", "/"),
483        push_reduction("parse_ReductionOp", cur_sym),
484        ACTION advance_token(), ACTION advance_token())
485
486parse_Form() ==
487    match_symbol "iterate" =>
488        from_val :=
489            match_symbol "from" =>
490                MUST parse_Label()
491                [pop_stack_1()]
492            nil
493        push_lform1("iterate", from_val)
494    match_symbol "yield" =>
495        MUST parse_Application()
496        push_form1("yield", pop_stack_1())
497    parse_Application()
498
499parse_Application() ==
500    not(parse_Primary()) => nil
501    while parse_Selector() repeat nil
502    parse_Application() =>
503        push_reduction("parse_Application", [pop_stack_2(), pop_stack_1()])
504    true
505
506parse_Selector() ==
507    not(match_symbol ".") => nil
508    MUST parse_Primary()
509    push_reduction("parse_Selector",
510                         [pop_stack_2(), pop_stack_1()])
511
512parse_PrimaryNoFloat() ==
513    AND(parse_Primary1(), OPTIONAL(parse_TokTail()))
514
515parse_Primary() == OR(parse_Float(), parse_PrimaryNoFloat())
516
517parse_Primary1() ==
518    OR(
519       AND(parse_VarForm(),
520           OPTIONAL AND(current_token_is_nonblank(),
521              current_symbol() = "(", MUST parse_Enclosure(),
522              push_reduction("parse_Primary1",
523                             [pop_stack_2(), pop_stack_1()]))),
524       parse_String(), parse_IntegerTok(),
525       parse_FormalParameter(),
526       AND(symbol_is? "'",
527          MUST AND(match_symbol "'", MUST parse_Expr 999,
528                   push_form1("QUOTE", pop_stack_1()))),
529       parse_Sequence(), parse_Enclosure())
530
531parse_Float() == parse_SPADFLOAT()
532
533parse_Enclosure1(closer) ==
534    MUST OR(
535            AND(parse_Expr 6, expect_symbol(closer)),
536            AND(expect_symbol(closer), push_form0("@Tuple")))
537
538parse_Enclosure() ==
539    match_symbol "(" => parse_Enclosure1(")")
540    match_symbol "{" => parse_Enclosure1("}")
541    match_symbol "SETTAB" => parse_Enclosure1("BACKTAB")
542    nil
543
544parse_IntegerTok() == parse_NUMBER()
545
546parse_FormalParameter() == parse_ARGUMENT_DESIGNATOR()
547
548parse_String() == parse_SPADSTRING()
549
550parse_VarForm() == parse_IDENTIFIER()
551
552parse_Name() == parse_IDENTIFIER()
553
554parse_Data() == AND(ACTION(advance_token()),
555                    OR(parse_IDENTIFIER(), parse_KEYWORD()),
556                    push_form1("QUOTE", pop_stack_1()))
557
558parse_GliphTok(tok) ==
559  AND(match_current_token('KEYWORD, tok), ACTION(advance_token()))
560
561parse_Sequence() ==
562    match_symbol "[" =>
563        MUST(parse_Sequence1())
564        expect_symbol "]"
565    nil
566
567parse_Sequence1() ==
568    val :=
569        parse_Expression() => [pop_stack_1()]
570        nil
571    push_reduction("parse_Sequence1", ["construct", :val])
572    OPTIONAL
573      AND(parse_IteratorTail(),
574          push_lform1("COLLECT", [:pop_stack_1(),
575                                       pop_stack_1()]))
576
577-- IteratorTail : [Iterator*]
578parse_IteratorTail() ==
579    repetition(nil, FUNCTION parse_Iterator)
580