path: root/js/games/nluqo.github.io/~bh/v2ch6/basic.lg

to basic
make "linenumbers []
make "readline []
forever [basicprompt]
end

to basicprompt
print []
print "READY
print []
make "line basicread
if emptyp :line [stop]
ifelse numberp first :line [compile split :line] [immediate :line]
end

to compile :commands
make "number first :commands
make :number :line
ifelse emptyp butfirst :commands ~
       [eraseline :number] ~
       [makedef (word "basic% :number) butfirst :commands]
end

to makedef :name :commands
make "definition [[]]
foreach :commands [run list (word "compile. first ?) ?]
queue "definition (list "nextline :number)
define :name :definition
make "linenumbers insert :number :linenumbers
end

to insert :num :list
if emptyp :list [output (list :num)]
if :num = first :list [output :list]
if :num < first :list [output fput :num :list]
output fput first :list (insert :num butfirst :list)
end

to eraseline :num
make "linenumbers remove :num :linenumbers
end

to immediate :line
if equalp :line [list] [foreach :linenumbers [print thing ?] stop]
if equalp :line [run] [run (list (word "basic% first :linenumbers))
                       stop]
if equalp :line [exit] [throw "toplevel]
print sentence [Invalid command:] :line
end

;; Compiling each BASIC command

to compile.end :command
queue "definition [stop]
end

to compile.goto :command
queue "definition (list (word "basic% last :command) "stop)
end

to compile.gosub :command
queue "definition (list (word "basic% last :command))
end

to compile.return :command
queue "definition [stop]
end

to compile.print :command
make "command butfirst :command
while [not emptyp :command] [c.print1]
queue "definition [print []]
end

to c.print1
make "exp expression
ifelse equalp first first :exp "" ~
       [make "sym gensym
        make word "%% :sym butfirst butlast first :exp
        queue "definition list "type word ":%% :sym] ~
       [queue "definition fput "type :exp]
if emptyp :command [stop]
make "delimiter pop "command
if equalp :delimiter ", [queue "definition [type char 9] stop]
if equalp :delimiter "\; [stop]
(throw "error [Comma or semicolon needed in print.])
end

to compile.input :command
make "command butfirst :command
if equalp first first :command "" ~
   [make "sym gensym
    make "prompt pop "command
    make word "%% :sym butfirst butlast :prompt
    queue "definition list "type word ":%% :sym]
while [not emptyp :command] [c.input1]
end

to c.input1
make "var pop "command
queue "definition (list "make (word ""% :var) "readvalue)
if emptyp :command [stop]
make "delimiter pop "command
if not equalp :delimiter ", (throw "error [Comma needed in input.])
end

to compile.let :command
make "command butfirst :command
make "var pop "command
make "delimiter pop "command
if not equalp :delimiter "= [(throw "error [Need = in let.])]
make "exp expression
queue "definition (sentence "make (word ""% :var) :exp)
end

to compile.for :command
make "command butfirst :command
make "var pop "command
make "delimiter pop "command
if not equalp :delimiter "= [(throw "error [Need = after for.])]
make "start expression
make "delimiter pop "command
if not equalp :delimiter "to [(throw "error [Need to after for.])]
make "end expression
queue "definition (sentence "make (word ""% :var) :start)
queue "definition (sentence "make (word ""let% :var) :end)
make "newname word "% gensym
queue "definition (sentence "make (word ""next% :var)
                                  (list (list :newname)))
queue "definition (list :newname)
define :name :definition
make "name :newname
make "definition [[]]
end

to compile.next :command
make "command butfirst :command
make "var pop "command
queue "definition (sentence "make (word ""% :var) (word ":% :var) [+ 1])
queue "definition (sentence [if not greaterp]
                            (word ":% :var) (word ":let% :var)
                            (list (list "run (word ":next% :var)
                                        "stop)))
end

to compile.if :command
make "command butfirst :command
make "exp expression
make "delimiter pop "command
if not equalp :delimiter "then [(throw "error [Need then after if.])]
queue "definition (sentence "if :exp (list c.if1))
end

to c.if1
local "definition
make "definition [[]]
run list (word "compile. first :command) :command
ifelse (count :definition) = 2 ~
       [output last :definition] ~
       [make "newname word "% gensym
        define :newname :definition
	output (list :newname)]
end

;; Compile an expression for LET, IF, PRINT, or FOR

to expression
make "expr []
make "token expr1
while [not emptyp :token] [queue "expr :token
                           make "token expr1]
output :expr
end

to expr1
if emptyp :command [output []]
make "token pop "command
if memberp :token [+ - * / = < > ( )] [output :token]
if memberp :token [, \; : then to] [push "command :token  output []]
if numberp :token [output :token]
if equalp first :token "" [output :token]
output word ":% :token
end



;; reading input

to basicread
output basicread1 readword [] "
end

to basicread1 :input :output :token
if emptyp :input [if not emptyp :token [push "output :token]
                  output reverse :output]
if equalp first :input "| | [if not emptyp :token [push "output :token]
                             output basicread1 (butfirst :input)
                                               :output "]
if equalp first :input "" [if not emptyp :token [push "output :token]
                             output breadstring butfirst :input
                                                :output "]
if memberp first :input [+ - * / = < > ( ) , \; :] ~
   [if not emptyp :token [push "output :token]
    output basicread1 (butfirst :input) (fput first :input :output) "]
output basicread1 (butfirst :input) :output (word :token first :input)
end

to breadstring :input :output :string
if emptyp :input [(throw "error [String needs ending quote.])]
if equalp first :input "" ~
   [output basicread1 (butfirst :input)
                      (fput (word "" :string "") :output)
                      "]
output breadstring (butfirst :input) :output (word :string first :input)
end

to split :line
output fput first :line split1 (butfirst :line) [] []
end

to split1 :input :output :command
if emptyp :input [if not emptyp :command [push "output reverse :command]
                  output reverse :output]
if equalp first :input ": [if not emptyp :command
                              [push "output reverse :command]
                           output split1 (butfirst :input) :output []]
output split1 (butfirst :input) :output (fput first :input :command)
end

;; Runtime library

to nextline :num
make "target member :num :linenumbers
if not emptyp :target [make "target butfirst :target]
if not emptyp :target [run (list (word "basic% first :target))]
end

to readvalue
while [emptyp :readline] [make "readline basicread]
output pop "readline
end