1)package "BOOT"
2
3DEFPARAMETER($prev_line_number, 0)
4DEFPARAMETER($curent_line_number, 0)
5DEFPARAMETER($prev_line, nil)
6DEFPARAMETER($curent_line, nil)
7
8DEFPARAMETER($compiler_InteractiveFrame,
9             addBinding('$DomainsInScope,
10                    [["FLUID", :true],
11                      ["special", :(COPY_-TREE $InitialDomainsInScope)]],
12                    addBinding('$Information, nil,
13                                makeInitialModemapFrame())))
14
15make_BF(mant, expo) == [$BFtag, mant, expo]
16
17make_float(int, frac, fraclen, expo) ==
18    frac = 0 => make_BF(int, expo)
19    make_BF(int*EXPT(10, fraclen) + frac, expo - fraclen)
20
21current_line_number() ==
22    tok := current_token()
23    tok =>
24         pos := TOKEN_-LINE_NUM(tok)
25         pos and INTEGERP(pos) => pos
26         nil
27    nil
28
29current_token_is_nonblank() ==
30    tok := current_token()
31    tok => TOKEN_-NONBLANK(tok)
32    nil
33
34spad_syntax_error(wanted, parsing) ==
35    FORMAT(true, '"******** Spad syntax error detected ********")
36    if wanted then
37        FORMAT(true, '"~&Expected: ~S~%", wanted)
38    if $prev_line then
39        FORMAT(true, '"~&The prior line was:~%~%~5D> ~A~%~%",
40           $prev_line_number, $prev_line)
41    if $curent_line then
42        FORMAT(true, '"~&The current line is:~%~%~5D> ~A~%~%",
43           $curent_line_number, $curent_line)
44    TOKEN_-STACK_-SHOW()
45    THROW('SPAD_READER, nil)
46
47fakeloopInclude(name, n) ==
48    handle_input_file(name, function fakeloopInclude0, [name, n])
49
50
51DEFPARAMETER($COMBLOCKLIST, nil)
52DEFPARAMETER($docList, nil)
53DEFVAR($spad_scanner, false)
54DEFVAR($restore_list, nil)
55
56DEFVAR($compiler_output_stream, nil)
57
58DEFPARAMETER($file_apply, nil)
59
60output_lisp_form(form) ==
61    if $file_apply then FUNCALL($file_apply, form, form)
62
63output_lisp_defparameter(x, y) ==
64    form := ['DEFPARAMETER, x, ["QUOTE", y]]
65    output_lisp_form(form)
66    EVAL(form)
67
68print_defun(name, body) ==
69    print_full2(body, $compiler_output_stream)
70
71DEFVAR($nopiles, false)
72
73spadCompile(name) == spadCompile1(name, $nopiles)
74
75spadCompile1(name, pile_mode) ==
76    $nopiles : local := pile_mode
77    $comp370_apply : local := FUNCTION print_defun
78    $file_apply : local := FUNCTION print_defun
79    _*EOF_* : local := false
80    $edit_file : local := name
81    $InteractiveMode : local := false
82    $spad_scanner : local := true
83    $COMBLOCKLIST : local := nil
84    $docList : local := nil
85    $curent_line_number := 0
86    $prev_line := nil
87    $InteractiveFrame : local := $compiler_InteractiveFrame
88    $MacroTable := MAKE_HASHTABLE('EQUAL)
89    $restore_list := nil
90    $ncMsgList : local := nil
91    a := ncloopIncFileName name
92    res := fakeloopInclude(name, nil)
93    if not($ncMsgList = nil) then
94        processMsgList($ncMsgList, nil)
95    true
96
97DEFPARAMETER($toklst, nil)
98
99$trans_table := [["id", "IDENTIFIER"], ["key", "KEYWORD"], _
100                  ["string", "SPADSTRING"], ["char", "SPADSTRING"], _
101                  ["integer", "NUMBER"], ["float", "SPADFLOAT"]]
102
103$trans_key := [ _
104                ["ARROW", "->"], _
105                ["SEG", ".."], _
106                ["BACKSET", ";"]]
107
108$trans_key_id := [ _
109                ["break", "break"], _
110                ["DEFAULT", "default"], _
111                ["RULE", "rule"] _
112                ]
113
114$expression_nostarters := [ "ARROW", "BACKSET", ":=", ":", _
115    ",", "==", "=>", "+->", "==>", ";",
116    "has", "is", "pretend", "where", ")"]
117
118starts_expression?(sym, type) ==
119    type ~= "key" => true
120    MEMBER(sym, $expression_nostarters) => false
121    true
122
123DEFVAR($paren_level)
124DEFVAR($settab_level)
125DEFVAR($tab_states)
126DEFVAR($ignored_tab)
127DEFVAR($maybe_insert_semi)
128
129ntokreader(token) ==
130    nonblank_flag := nil
131    if $toklst then
132        tok1 := first $toklst
133        $toklst := rest $toklst
134        type1 := first(tok1)
135        sym := tok1.1
136        pos := tok1.4
137        line_info := first(rest(pos))
138        line_no := first(rest(rest(line_info)))
139        char_no := rest(rest(pos))
140        $maybe_insert_semi and starts_expression?(sym, type) =>
141            $toklst := cons(tok1, $toklst)
142            $maybe_insert_semi := false
143            token_install(";", "KEYWORD", false, line_no, char_no, token)
144        $maybe_insert_semi := false
145        if not($curent_line_number = line_no) then
146            $prev_line := $curent_line
147            $prev_line_number := $curent_line_number
148            $curent_line := line_info.1
149            $curent_line_number := line_no
150        if type1 = "integer" and STRINGP(sym) then
151            sym := READ_-FROM_-STRING(sym)
152        if type1 = "float" then
153            mant_i := READ_-FROM_-STRING(first(sym))
154            exp := READ_-FROM_-STRING(sym.2)
155            mant_fl := #(sym.1)
156            mant_f := READ_-FROM_-STRING(sym.1)
157            sym := make_float(mant_i, mant_f, mant_fl, exp)
158        if sym = "(" and type1 = "key" and tok1.3 = "nonblank" then
159            nonblank_flag := true
160        type := ASSQ(type1, $trans_table)
161        greater_SI($paren_level, 0) and type1 = "key" and _
162          sym in ["BACKSET", "BACKTAB", "SETTAB"] =>
163            if sym = "SETTAB" then
164                $settab_level := inc_SI($settab_level)
165            if sym = "BACKTAB" then
166                $settab_level := dec_SI($settab_level)
167            ntokreader(token)
168        greater_SI($settab_level, 0) and type1 = "key" and sym = "BACKTAB" =>
169            $settab_level := dec_SI($settab_level)
170            ntokreader(token)
171        -- Fix bad piles
172        if type1 = "key" and sym = "BACKSET" and $toklst then
173            ntok1 := first $toklst
174            ntype1 := first(ntok1)
175            nsym := ntok1.1
176            if ntype1 = "key" and nsym in ["then", "else"] then
177                return ntokreader(token)
178        if type1 = "key" and sym = "SETTAB" and $toklst then
179            ntok1 := first $toklst
180            ntype1 := first(ntok1)
181            nsym := ntok1.1
182            if ntype1 = "key" and nsym in ["then", "else",
183                  ",", ";"] then
184                PUSH($ignored_tab, $tab_states)
185                $ignored_tab := true
186                return ntokreader(token)
187            else
188                PUSH($ignored_tab, $tab_states)
189                $ignored_tab := false
190        if type1 = "key" and sym = "BACKSET" and $ignored_tab then
191            return ntokreader(token)
192        if type1 = "key" and sym = "BACKTAB" then
193            $ignored_tab0 := $ignored_tab
194            $ignored_tab := POP($tab_states)
195            if $ignored_tab0 then
196                return ntokreader(token)
197        if type then
198            type := type.1
199        else
200            SAY([sym, type1])
201        if type1 = "key" then
202            sym = "(" =>
203                $paren_level := inc_SI($paren_level)
204            sym = ")" =>
205                $paren_level := dec_SI($paren_level)
206            sym = "#1" => type := "ARGUMENT-DESIGNATOR"
207            $maybe_insert_semi := sym = "}"
208            sym1 := ASSQ(sym, $trans_key)
209            sym2 := ASSQ(sym, $trans_key_id)
210            if sym2 then
211                type := "IDENTIFIER"
212                sym1 := sym2
213            sym :=
214                sym1 => sym1.1
215                sym
216        token_install(sym, type, nonblank_flag, line_no, char_no, token)
217    else
218        token_install(nil, "*EOF", nil, nil, 0, token)
219
220fakeloopInclude0(st, name, n) ==
221    $lines : local := incStream(st, name)
222    fakeloopProcess(n,
223      next(function insertpile,
224        next(function lineoftoks,$lines)))
225    nil
226
227fakeloopProcess1(tok_list) ==
228    $toklst := tok_list
229    $paren_level := 0
230    $settab_level := 0
231    $tab_states := nil
232    $ignored_tab := false
233    $ignorable_backset := false
234    $maybe_insert_semi := false
235    $docList := nil
236    finish_comment()
237    TOKEN_-STACK_-CLEAR()
238    parse_new_expr()
239    parseout := pop_stack_1()
240    if parseout then S_process(parseout)
241    nil
242
243
244processSymbol(s) ==
245    sym1 := first s
246    pos := first(rest(sym1))
247    npos := rest rest pos
248    rest rest sym1 => [first sym1, rest s, npos, "nonblank", pos]
249    [first sym1, rest s, npos, false, pos]
250
251processCommand(line) ==
252    cl := rest(line)
253    InterpExecuteSpadSystemCommand(cl)
254
255fakeloopProcess(n, s) ==
256    StreamNull s => nil
257    lp := first s
258    line := first first lp
259    kind := first first first line
260    kind = "command" =>
261        processCommand(first(line))
262        fakeloopProcess(n, rest s)
263    nline := [processSymbol(sym) for sym in line]
264    fakeloopProcess1(nline)
265    fakeloopProcess(n, rest s)
266