2017-07-10 00:57:14 +03:00
|
|
|
String extend [
|
|
|
|
String >> loadRelative [
|
|
|
|
| scriptPath scriptDirectory |
|
2017-07-20 18:37:08 +03:00
|
|
|
scriptPath := thisContext currentFileName.
|
2017-07-10 00:57:14 +03:00
|
|
|
scriptDirectory := FilePath stripFileNameFor: scriptPath.
|
|
|
|
FileStream fileIn: (FilePath append: self to: scriptDirectory)
|
|
|
|
]
|
|
|
|
]
|
|
|
|
|
|
|
|
'readline.st' loadRelative.
|
|
|
|
'util.st' loadRelative.
|
|
|
|
'types.st' loadRelative.
|
|
|
|
'reader.st' loadRelative.
|
|
|
|
'printer.st' loadRelative.
|
|
|
|
'env.st' loadRelative.
|
|
|
|
'func.st' loadRelative.
|
|
|
|
'core.st' loadRelative.
|
2017-07-09 21:10:16 +03:00
|
|
|
|
|
|
|
Object subclass: MAL [
|
|
|
|
MAL class >> READ: input [
|
|
|
|
^Reader readStr: input
|
|
|
|
]
|
|
|
|
|
2022-01-10 02:15:40 +03:00
|
|
|
MAL class >> evalList: list env: env [
|
|
|
|
^list collect:
|
2017-07-09 21:10:16 +03:00
|
|
|
[ :item | self EVAL: item env: env ].
|
|
|
|
]
|
|
|
|
|
2020-07-21 19:01:48 +03:00
|
|
|
MAL class >> starts_with: ast sym: sym [
|
|
|
|
| a a0 |
|
|
|
|
ast type = #list ifFalse: [ ^false. ].
|
|
|
|
a := ast value.
|
|
|
|
a isEmpty ifTrue: [ ^false. ].
|
|
|
|
a0 := a first.
|
|
|
|
^a0 type = #symbol and: [ a0 value = sym ].
|
|
|
|
]
|
|
|
|
|
2017-07-09 21:10:16 +03:00
|
|
|
MAL class >> quasiquote: ast [
|
2020-07-21 19:01:48 +03:00
|
|
|
| result acc |
|
|
|
|
(ast type = #symbol or: [ ast type = #map ]) ifTrue: [
|
2017-07-09 21:10:16 +03:00
|
|
|
result := {MALSymbol new: #quote. ast}.
|
|
|
|
^MALList new: (OrderedCollection from: result)
|
|
|
|
].
|
2020-07-21 19:01:48 +03:00
|
|
|
(ast type = #list or: [ ast type = #vector ]) ifFalse: [
|
|
|
|
^ast
|
|
|
|
].
|
2017-07-09 21:10:16 +03:00
|
|
|
|
2020-07-21 19:01:48 +03:00
|
|
|
(self starts_with: ast sym: #unquote) ifTrue: [
|
|
|
|
^ast value second
|
2017-07-09 21:10:16 +03:00
|
|
|
].
|
|
|
|
|
2020-07-21 19:01:48 +03:00
|
|
|
result := {}.
|
|
|
|
acc := MALList new: (OrderedCollection from: result).
|
|
|
|
ast value reverseDo: [ : elt |
|
|
|
|
(self starts_with: elt sym: #'splice-unquote') ifTrue: [
|
|
|
|
result := {MALSymbol new: #concat. elt value second. acc}
|
|
|
|
] ifFalse: [
|
|
|
|
result := {MALSymbol new: #cons. self quasiquote: elt. acc}
|
|
|
|
].
|
|
|
|
acc := MALList new: (OrderedCollection from: result)
|
|
|
|
].
|
|
|
|
ast type = #vector ifTrue: [
|
|
|
|
result := {MALSymbol new: #vec. acc}.
|
|
|
|
acc := MALList new: (OrderedCollection from: result)
|
|
|
|
].
|
|
|
|
^acc
|
2017-07-09 21:10:16 +03:00
|
|
|
]
|
|
|
|
|
|
|
|
MAL class >> EVAL: aSexp env: anEnv [
|
2022-01-10 02:15:40 +03:00
|
|
|
| sexp env ast a0 a0_ a1 a1_ a2 a2_ a3 function args |
|
2017-07-09 21:10:16 +03:00
|
|
|
|
|
|
|
"NOTE: redefinition of method arguments is not allowed"
|
|
|
|
sexp := aSexp.
|
|
|
|
env := anEnv.
|
|
|
|
|
|
|
|
[
|
|
|
|
[ :continue |
|
2022-01-10 02:15:40 +03:00
|
|
|
|
|
|
|
a0 := env get: #'DEBUG-EVAL'.
|
|
|
|
(a0 isNil or: [ a0 type = #false or: [ a0 type = #nil ] ] )
|
|
|
|
ifFalse: [
|
|
|
|
('EVAL: ' , (Printer prStr: sexp printReadably: true))
|
|
|
|
displayNl.
|
|
|
|
].
|
|
|
|
|
|
|
|
sexp type = #symbol ifTrue: [
|
|
|
|
| key value |
|
|
|
|
key := sexp value.
|
|
|
|
value := env get: key.
|
|
|
|
value isNil ifTrue: [
|
|
|
|
^MALUnknownSymbol new signal: key
|
|
|
|
].
|
|
|
|
^value
|
|
|
|
].
|
|
|
|
sexp type = #vector ifTrue: [
|
|
|
|
^MALVector new: (self evalList: sexp value env: env)
|
|
|
|
].
|
|
|
|
sexp type = #map ifTrue: [
|
|
|
|
^MALMap new: (self evalList: sexp value env: env)
|
|
|
|
].
|
2017-07-09 21:10:16 +03:00
|
|
|
sexp type ~= #list ifTrue: [
|
2022-01-10 02:15:40 +03:00
|
|
|
^sexp
|
2017-07-09 21:10:16 +03:00
|
|
|
].
|
|
|
|
sexp value isEmpty ifTrue: [
|
|
|
|
^sexp
|
|
|
|
].
|
|
|
|
|
|
|
|
ast := sexp value.
|
|
|
|
a0 := ast first.
|
|
|
|
|
|
|
|
a0_ := ast first value.
|
|
|
|
a0_ = #'def!' ifTrue: [
|
|
|
|
| result |
|
|
|
|
a1_ := ast second value.
|
|
|
|
a2 := ast third.
|
|
|
|
result := self EVAL: a2 env: env.
|
|
|
|
env set: a1_ value: result.
|
|
|
|
^result
|
|
|
|
].
|
|
|
|
|
|
|
|
a0_ = #'defmacro!' ifTrue: [
|
|
|
|
| result |
|
|
|
|
a1_ := ast second value.
|
|
|
|
a2 := ast third.
|
2021-08-15 10:43:51 +03:00
|
|
|
result := (self EVAL: a2 env: env) deepCopy.
|
2017-07-09 21:10:16 +03:00
|
|
|
result isMacro: true.
|
|
|
|
env set: a1_ value: result.
|
|
|
|
^result
|
|
|
|
].
|
|
|
|
|
|
|
|
a0_ = #'let*' ifTrue: [
|
|
|
|
| env_ |
|
|
|
|
env_ := Env new: env.
|
|
|
|
a1_ := ast second value.
|
|
|
|
a2 := ast third.
|
|
|
|
1 to: a1_ size by: 2 do:
|
|
|
|
[ :i | env_ set: (a1_ at: i) value
|
|
|
|
value: (self EVAL: (a1_ at: i + 1)
|
|
|
|
env: env_) ].
|
|
|
|
env := env_.
|
|
|
|
sexp := a2.
|
|
|
|
continue value "TCO"
|
|
|
|
].
|
|
|
|
|
|
|
|
a0_ = #do ifTrue: [
|
|
|
|
| forms last |
|
|
|
|
ast size < 2 ifTrue: [
|
|
|
|
forms := {}.
|
|
|
|
last := MALObject Nil.
|
|
|
|
] ifFalse: [
|
|
|
|
forms := ast copyFrom: 2 to: ast size - 1.
|
|
|
|
last := ast last.
|
|
|
|
].
|
|
|
|
|
|
|
|
forms do: [ :form | self EVAL: form env: env ].
|
|
|
|
sexp := last.
|
|
|
|
continue value "TCO"
|
|
|
|
].
|
|
|
|
|
|
|
|
a0_ = #if ifTrue: [
|
|
|
|
| condition |
|
|
|
|
a1 := ast second.
|
|
|
|
a2 := ast third.
|
|
|
|
a3 := ast at: 4 ifAbsent: [ MALObject Nil ].
|
|
|
|
condition := self EVAL: a1 env: env.
|
|
|
|
|
|
|
|
(condition type = #false or:
|
|
|
|
[ condition type = #nil ]) ifTrue: [
|
|
|
|
sexp := a3
|
|
|
|
] ifFalse: [
|
|
|
|
sexp := a2
|
|
|
|
].
|
|
|
|
continue value "TCO"
|
|
|
|
].
|
|
|
|
|
|
|
|
a0_ = #quote ifTrue: [
|
|
|
|
a1 := ast second.
|
|
|
|
^a1
|
|
|
|
].
|
|
|
|
|
|
|
|
a0_ = #quasiquote ifTrue: [
|
|
|
|
| result |
|
|
|
|
a1 := ast second.
|
|
|
|
sexp := self quasiquote: a1.
|
|
|
|
continue value "TCO"
|
|
|
|
].
|
|
|
|
|
|
|
|
a0_ = #'try*' ifTrue: [
|
|
|
|
| A B C |
|
|
|
|
A := ast second.
|
Test uncaught throw, catchless try* . Fix 46 impls.
Fixes made to: ada, c, chuck, clojure, coffee, common-lisp, cpp,
crystal, d, dart, elm, erlang, es6, factor, fsharp, gnu-smalltalk,
groovy, guile, haxe, hy, js, livescript, matlab, miniMAL, nasm, nim,
objc, objpascal, ocaml, perl, perl6, php, plsql, ps, python, r,
rpython, ruby, scheme, swift3, tcl, ts, vb, vimscript, wasm, yorick.
Catchless try* test is an optional test. Not all implementations
support catchless try* but a number were fixed so they at least don't
crash on catchless try*.
2018-12-03 22:20:44 +03:00
|
|
|
ast at: 3 ifAbsent: [
|
|
|
|
^self EVAL: A env: env.
|
|
|
|
].
|
2017-07-09 21:10:16 +03:00
|
|
|
a2_ := ast third value.
|
|
|
|
B := a2_ second value.
|
|
|
|
C := a2_ third.
|
|
|
|
^[ self EVAL: A env: env ] on: MALError do:
|
|
|
|
[ :err |
|
|
|
|
| data env_ result |
|
|
|
|
data := err data.
|
|
|
|
data isString ifTrue: [
|
|
|
|
data := MALString new: data
|
|
|
|
].
|
|
|
|
env_ := Env new: env binds: {B} exprs: {data}.
|
|
|
|
err return: (self EVAL: C env: env_)
|
|
|
|
]
|
|
|
|
].
|
|
|
|
|
|
|
|
a0_ = #'fn*' ifTrue: [
|
|
|
|
| binds env_ fn |
|
|
|
|
a1_ := ast second value.
|
|
|
|
binds := a1_ collect: [ :item | item value ].
|
|
|
|
a2 := ast third.
|
|
|
|
fn := [ :args |
|
|
|
|
self EVAL: a2 env:
|
|
|
|
(Env new: env binds: binds exprs: args) ].
|
|
|
|
^Func new: a2 params: binds env: env fn: fn
|
|
|
|
].
|
|
|
|
|
2022-01-10 02:15:40 +03:00
|
|
|
function := self EVAL: a0 env: env.
|
|
|
|
args := ast allButFirst asArray.
|
|
|
|
(function type = #func and: [ function isMacro ]) ifTrue: [
|
|
|
|
sexp := function fn value: args.
|
|
|
|
continue value TCO
|
|
|
|
].
|
|
|
|
args := self evalList: args env: env.
|
2017-07-09 21:10:16 +03:00
|
|
|
function type = #fn ifTrue: [ ^function fn value: args ].
|
|
|
|
function type = #func ifTrue: [
|
|
|
|
| env_ |
|
|
|
|
sexp := function ast.
|
|
|
|
env_ := Env new: function env binds: function params
|
|
|
|
exprs: args.
|
|
|
|
env := env_.
|
|
|
|
continue value "TCO"
|
|
|
|
]
|
|
|
|
] valueWithExit
|
|
|
|
] repeat.
|
|
|
|
]
|
|
|
|
|
|
|
|
MAL class >> PRINT: sexp [
|
|
|
|
^Printer prStr: sexp printReadably: true
|
|
|
|
]
|
|
|
|
|
|
|
|
MAL class >> rep: input env: env [
|
|
|
|
^self PRINT: (self EVAL: (self READ: input) env: env)
|
|
|
|
]
|
|
|
|
]
|
|
|
|
|
|
|
|
| input historyFile replEnv argv |
|
|
|
|
|
|
|
|
historyFile := '.mal_history'.
|
|
|
|
ReadLine readHistory: historyFile.
|
|
|
|
replEnv := Env new: nil.
|
|
|
|
|
|
|
|
argv := Smalltalk arguments.
|
|
|
|
argv notEmpty ifTrue: [ argv := argv allButFirst ].
|
|
|
|
argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]).
|
|
|
|
|
|
|
|
Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ].
|
|
|
|
replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]).
|
|
|
|
replEnv set: #'*ARGV*' value: (MALList new: argv).
|
|
|
|
replEnv set: #'*host-language*' value: (MALString new: 'smalltalk').
|
|
|
|
|
|
|
|
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
|
2019-07-16 00:57:02 +03:00
|
|
|
MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))' env: replEnv.
|
2017-07-09 21:10:16 +03:00
|
|
|
MAL rep: '(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))' env: replEnv.
|
|
|
|
|
|
|
|
Smalltalk arguments notEmpty ifTrue: [
|
|
|
|
MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv
|
|
|
|
] ifFalse: [
|
|
|
|
MAL rep: '(println (str "Mal [" *host-language* "]"))' env: replEnv.
|
|
|
|
[ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [
|
|
|
|
input isEmpty ifFalse: [
|
|
|
|
ReadLine addHistory: input.
|
|
|
|
ReadLine writeHistory: historyFile.
|
|
|
|
[ (MAL rep: input env: replEnv) displayNl ]
|
|
|
|
on: MALEmptyInput do: [ #return ]
|
|
|
|
on: MALError do:
|
|
|
|
[ :err | ('error: ', err messageText) displayNl. #return ].
|
|
|
|
]
|
|
|
|
].
|
|
|
|
|
|
|
|
'' displayNl.
|
|
|
|
]
|