=============================================================================== uCalc LB Lisp implementation By Daniel Corbier www.ucalc.com The code below is to be loaded into the uCalc Language Builder interpreter, at which point it becomes an interactive interpreter for the Lisp programming language. To download the Windows version of the uCalc LB interpreter visit www.ucalc.com/download.html . =============================================================================== MainPrompt = "ucalc:LISP> " MultiLinePrompt = "ucalc:LISP>>" ucVersion = ucVersion + "uCalc Lisp. March 2007 (beta)"+\cr Print(ucVersion) // +++ for now setf works only as synonym for setq // +++ mapcar works only with a single list for now // +++ .{number} ::= 0.{number} (change so that it's not needed) // +++ String atom behavior not fully correct (should return w/ quotes, etc...) // +++ Add line-by-line .txt doc for this file like for basic.uc (or maybe not) // +++ Carriage return should come before in (print item) _AlphaNum = "[0-9a-z_\-\?\%\!\@\#\$\^\&\*\+]+" _AlphaNumV = _AlphaNum uCalc Load "Define.uc" uCalc Prefix "uCalc Define Pattern: " ['`] [0-9a-z_\-\?\%\!\@\#\$\^\&\*\+]+ ~~ Properties: ucAlphaNumeric [\+\-]?([0-9]+\.)?[0-9]*(e[-+]?[0-9]+)?\b ~~ Properties: ucLiteral ~~ DataType: Extended \\q ~~ \\q ~~ Properties: ucQuotedText + ucLiteral ~~ DataType: String \\y ~~ \\y ~~ Properties: ucQuotedText + ucLiteral ~~ DataType: String \\z ~~ \\z ~~ Properties: ucQuotedText + ucLiteral ~~ DataType: String uCalc Prefix "" uCalc Define Var: _Count uCalc Define Var: _cxyr As String uCalc Define Var: _Tmp As String uCalc Define Var: _VarStack As Stack uCalc Prefix "uCalc Syntax " .{number} ::= 0.{number} 1 REPL {S_Expr} [{Other}] ::= _Print(_Eval(_ToUpperCase({S_Expr}))) {Other: SetInput("{Other}")} 1 REPL ({Partial_S_Expr} ::= SetInput(\q({Partial_S_Expr}\q + " _") 1 REPL ([{S_Expr}]) [{Other}] ::= _Print(_Eval((_ToUpperCase({S_Expr})))) {Other: SetInput("{Other}")} _Append(({list1}) ({list2})) ::= ({list1} {list2}) _Append([NIL] [({list})] [NIL]) ::= _Eval('({list})) _Cons({member}{" +"}({list})) ::= ({member} {list}) _Cons({member}{" +"} NIL) ::= ({member}) _Eval({data}) ::= __Eval {data} _First(({first} [{rest}])) ::= {first} _First(NIL) ::= NIL _Last(({item})) ::= {item} _Last(({first} {rest})) ::= _Last(({rest})) _Last(NIL) ::= NIL _Length(NIL) ::= 0 _Length(({member})) ::= 1 _Length(({member} {rest})) ::= ~Eval(1 + _Length(({rest}))) _Length({string:" *\x22[^\x22]*\x22"}) ::= ~Eval(Len({string})) _LocalVarFree() ::= _LocalVarFree(({var} [{val}]) [{etc}]) ::= ReleaseItem("{var}") {etc: ::: _LocalVarFree({etc})} _LocalVarSet() ::= ~Eval(uc_Loop(uc_Count(_VarStack), uCalc(uc_Define, "Var: "+ _Pop +" As String =" + _Quote(_Pop)), 1)) _LocalVarSet(({var} [{val=NIL}]) [{etc}]) ::= ~Eval((_VarStack = _VarStack + {_Quote(_Eval({val}))} + {"{var}"})) ::: _LocalVarSet({etc}) _LocalVarSet*() ::= _LocalVarSet*(({var} [{val=NIL}]) [{etc}]) ::= (Dim {var} As String = _Quote(_Eval({val}))) {etc: ::: _LocalVarSet*({etc})} _Mapcar({func} NIL) ::= NIL _Mapcar({func}{" +"}({item})) ::= _Eval('(_Eval(({func} {item})))) _Mapcar({func}{" +"}({item1} {rest})) ::= _Eval('_Eval((append '_Mapcar({func} ({item1})) (mapcar '{func} '({rest}))))) _NthCdr({n}{" +"}({list})) ::= ~Expand(_NthCdr(~Eval({n} - 1) _Rest(({list})))) _NthCdr({n}{" +"}{()|NIL}) ::= NIL _NthCdr(0 ({list})) ::= ({list}) _Pair(({arg1}) ({item})) ::= ({arg1} {item}) _Pair(({arg1} {rest}) ({items}))::= _Pair(({arg1}) (_First(({items})))) _Pair(({rest}) _Rest(({items}))) _Pop ::= uc_PopStr(_VarStack) _Print({result}) ::= SetInput(ShowOutput, \quCalc Eval _Quote({result})\q, 1) _Quote([{text}]) ::= \y{text}\y _Reduce({func} NIL) ::= ({func}) _Reduce({func}{" +"}({arg1})) ::= {arg1} _Reduce({func}{" +"}({arg1} {arg2})) ::= _Eval(({func} {arg1} {arg2})) _Reduce({func}{" +"}({arg1} {arg2} {rest})) ::= _Reduce({func} (({func} {arg1} {arg2}) {rest})) _Rest({ ({item}) | NIL }) ::= NIL _Rest(({first} {rest})) ::= ({rest}) _Reverse(NIL) ::= NIL _Reverse(({list})) ::= (_ReverseB({list})) _ReverseB({item}) ::= {item} _ReverseB({first} {rest}) ::= _ReverseB({rest}) {first} _ToUpperCase([{code}]) ::= ~Eval(SpecialUCase(_Quote({code}))) setf ::= setq not ::= null second ::= cadr third ::= caddr fourth ::= cadddr fifth ::= caddddr uCalc Prefix "" uCalc Prefix "uCalc Syntax 2 __Eval " {atom:" +[^ \)]+"} ::= ~Eval({atom}) {string:" +\x22[^\x22]*\x22"} ::= {string} {" +"}{item:"[^ \(]+\("} ::= {item} ` ::= __Eval ' `[{q:"'+"}]{","}{code} ::= {q}_Eval({code}) `[{q:"'+"}]({item}) ::= {q}_Eval((cons `{item} nil)) `[{q:"'+"}]({first} {rest}) ::= {q}_Eval((cons `{first} `({rest}))) '{atom:"[^ \)]+"} ::= {atom} '() ::= NIL () ::= NIL NIL ::= NIL T ::= T ({" *1"}{op:"[+-] +"} {num}) ::= _Eval(({op} {num} 1)) ({op:" *[\+\-] +"} {num}) ::= ~Eval(0 {op} _Eval({num})) ({op:" *[\*\/] +"} {num}) ::= ~Eval(1 {op} _Eval({num})) ({op:" *[\+\-\*\/] +"} {num1} {num2}) ::= ~Eval(_Eval({num1}) {op} _Eval({num2})) ({op:" *[\+\-\*\/] +"} {num1} {num2} {other}) ::= _Eval(({op} ({op} {num1} {num2}) {other})) ({func:" *(sin|cos|tan|abs|exp|log)"} {num}) ::= ~Eval({func}(_Eval({num}))) ({pred:" *(==|<=|>=|<|>)"} {num}) ::= T ({pred:" *(==|<=|>=|<|>)"} {num1} {num2}) ::= ~Eval(IIf(~Eval(_Eval({num1}) {pred} _Eval({num2})), "T", "NIL")) ({pred:" *(==|<=|>=|<|>)"} {num1} {num2} {other}) ::= ~Eval(IIf(~Eval(_Eval({num1}) {pred} _Eval({num2})), _Quote(_Eval(({pred} {num2} {other}))), "NIL")) (= {other}) ::= _Eval((== {other})) (+) ::= 0 (*) ::= 1 ({ - | / | = }) ::= "Error: At least one arg required" (and) ::= T (and {item}) ::= _Eval({item}) (and {item} {other}) ::= _Eval((if {item} (and {other}))) (atom {item}) ::= ~Eval(IIf(_Quote(_Eval({item})) == _Quote(NIL) Or Asc(_Quote(_Eval({item}))) <> 40, "T", "NIL")) (append) ::= NIL (append {list1}) ::= _Eval('_Eval({list1})) (append {list1} {list2}) ::= _Eval('_Append(_Eval({list1}) _Eval({list2}))) (append {list1} {list2} {listn}) ::= _Eval((append {list1} (append {list2} {listn}))) (butlast {list}) ::= _Eval((reverse (rest (reverse {list})))) (butlast {list} {int}) ::= _Eval((reverse (nthcdr {int} (reverse {list})))) (bye) ::= Quit ({" *c"}{cxyr:"[ad]+"}{"r +"}{list}) ::= _ ~Eval( _ _cxyr = _Quote({list}) ::: _ uc_For(_Count, len(_Quote({cxyr})), 1, -1, _ _If(Asc(_Quote({cxyr}), _Count) == Asc("A"), _ _cxyr = "(first " + _cxyr + ")", 1, _ _cxyr = "(rest " + _cxyr + ")")) ::: "") _ _Eval(~Eval(_cxyr)) (cond ({test} {forms})) ::= _Eval((if {test} (progn {forms}))) (cond ({test1} {forms1}) {rest}) ::= _Eval((if {test1} (progn {forms1}) (cond {rest}))) (cons {member} {list}) ::= _Eval('_Cons(_Eval({member}) _Eval({list}))) (cons `{",@"}{item} {list}) ::= _Eval((append '_Eval({item}) {list})) (defmacro {name} ([{args}]) {def}) ::= SetInput(SetSyntaxParams("{args}", \quCalc Syntax 2 __Eval ({name} {args}) ::= _Eval({def})\q)) _Eval('{name}) (defun {name} ([{args}]) {body}) ::= _Eval((progn (setq {name} '(lambda ({args}) {body})) '{name})) SetInput(\quCalc Syntax 2 __Eval ({name} ::= __Eval (funcall {name}\q) (ed [{filename}])::= ~Eval(ShellExecute(0, "", "CMD.EXE", _Quote(/C notepad {filename}), "", 0)) (equal {x} {y}) ::= ~Eval(IIf(_Quote(_Eval({x})) == _Quote(_Eval({y})), "T", "NIL")) (eval {code}) ::= _Eval(_Eval({code})) (first {list}) ::= _Eval('_First(_Eval({list}))) (funcall {func} {args}) ::= _Eval((_Eval({func}) {args})) (if {test} {then}) ::= ~Eval(IIf(_Quote(_Eval({test})) <> "NIL", \z_Eval({then})\z, "NIL")) (if {test} {then} {else}) ::= ~Eval(IIf(_Quote(_Eval({test})) <> "NIL", \z_Eval({then})\z, \z_Eval({else})\z)) (lambda {code}) ::= (lambda {code}) ((lambda () {body})) ::= _Eval((progn {body})) ((lambda {args} {body}) {items}) ::= _Eval((let (_Pair({args} ({items}))) {body})) (last {list}) ::= _Eval('_Last(_Eval({list}))) (length {list}) ::= _Eval('_Length(_Eval({list}))) (let ({varlist}) [{code}]) ::= ~Eval(_LocalVarSet({varlist}) ::: _Tmp = _Quote(_Eval((progn {code}))) ::: _LocalVarFree({varlist}) ::: _Tmp) (let* ({varlist}) [{code}]) ::= ~Eval(_LocalVarSet*({varlist}) ::: _Tmp = _Quote(_Eval((progn {code}))) ::: _LocalVarFree({varlist}) ::: _Tmp) (list) ::= NIL (list {member}) ::= _Eval((cons {member} nil)) (list {member} {list}) ::= _Eval((cons {member} (list {list}))) (listp {item}) ::= ~Eval(IIf(_Quote(_Eval({item})) == _Quote(NIL) Or Asc(_Quote(_Eval({item}))) == 40, "T", "NIL")) (load {filename}) ::= SetInput(_Quote(uCalc Load {filename})) (mapcar [{" +#"}]{func} {list}) ::= _Eval('_Mapcar(_Eval({func}) _Eval({list}))) (nthcdr {index} {list}) ::= _Eval('_NthCdr(_Eval({index}) _Eval({list}))) (null {val}) ::= ~Eval(IIf(_Quote(_Eval({val})) == "NIL", "T", "NIL")) (or) ::= NIL (or {item}) ::= _Eval({item}) (or {item} {other}) ::= _Eval((if {item} {item} (or {other}))) (print {item}) ::= ~Eval(_Tmp = _Quote(_Eval({item})) ::: Print(_Tmp + Chr(13) + Chr(10)) ::: _Tmp) (progn) ::= NIL (progn {item}) ::= _Eval({item}) (progn {item} {other}) ::= ~Eval(_Quote(_Eval({item})) ::: "") _Eval((progn {other})) (reduce [{" +#"}]{func} {list}) ::= _Eval(_Reduce(_Eval({func}) _Eval({list}))) (rest [{list}]) ::= _Eval('_Rest(_Eval({list}))) (reverse {list}) ::= _Eval('_Reverse(_Eval({list}))) (setq {var} {val}) ::= ~Eval(IIf(Handle("{var}"), \q~Eval(({var}=_Quote(_Eval({val}))):::{var})\q, \q~Eval((Dim {var} As String = _Quote(_Eval({val}))):::{var})\q)) (symbolp {item}) ::= ~Eval(IIf(uCalc(uc_GetPatternType, _Quote(_Eval({item}))) == ucAlphaNumeric, "T", "NIL")) uCalc Prefix "" uCalc Prefix "REPL " (progn (defun nth (index list) (car (nthcdr index list))) "")