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