Extending a BlockClosure by a meta field gives a segfault for whatever
reason. Yes, seriously.
- [ :args | MALNumber new: args first value + args second value ].
+ (Fn new: [ :args | MALNumber new: args first value + args second value ]).
- [ :args | MALNumber new: args first value - args second value ].
+ (Fn new: [ :args | MALNumber new: args first value - args second value ]).
- [ :args | MALNumber new: args first value * args second value ].
+ (Fn new: [ :args | MALNumber new: args first value * args second value ]).
- [ :args | MALNumber new: args first value // args second value ].
+ (Fn new: [ :args | MALNumber new: args first value // args second value ]).
Core Ns at: #'pr-str' put:
Core Ns at: #'pr-str' put:
- [ :args | MALString new: (Core printedArgs: args readable: true sep: ' ') ].
+ (Fn new: [ :args | MALString new: (Core printedArgs: args readable: true
+ sep: ' ') ]).
- [ :args | MALString new: (Core printedArgs: args readable: false sep: '') ].
+ (Fn new: [ :args | MALString new: (Core printedArgs: args readable: false
+ sep: '') ]).
- [ :args | (Core printedArgs: args readable: true sep: ' ') displayNl.
- MALObject Nil ].
+ (Fn new: [ :args |
+ (Core printedArgs: args readable: true sep: ' ') displayNl.
+ MALObject Nil ]).
Core Ns at: #println put:
Core Ns at: #println put:
- [ :args | (Core printedArgs: args readable: false sep: ' ') displayNl.
- MALObject Nil ].
+ (Fn new: [ :args |
+ (Core printedArgs: args readable: false sep: ' ') displayNl.
+ MALObject Nil ]).
-Core Ns at: #list put: [ :args | MALList new: (OrderedCollection from: args) ].
+Core Ns at: #list put:
+ (Fn new: [ :args | MALList new: (OrderedCollection from: args) ]).
Core Ns at: #'list?' put:
Core Ns at: #'list?' put:
- [ :args | Core coerce: [ args first type = #list ] ].
+ (Fn new: [ :args | Core coerce: [ args first type = #list ] ]).
Core Ns at: #'empty?' put:
Core Ns at: #'empty?' put:
- [ :args | Core coerce: [ args first value isEmpty ] ].
+ (Fn new: [ :args | Core coerce: [ args first value isEmpty ] ]).
- [ :args | MALNumber new: args first value size ].
+ (Fn new: [ :args | MALNumber new: args first value size ]).
- [ :args | Core coerce: [ args first = args second ] ].
+ (Fn new: [ :args | Core coerce: [ args first = args second ] ]).
- [ :args | Core coerce: [ args first value < args second value ] ].
+ (Fn new: [ :args | Core coerce: [ args first value < args second value ] ]).
- [ :args | Core coerce: [ args first value <= args second value ] ].
+ (Fn new: [ :args | Core coerce: [ args first value <= args second value ] ]).
- [ :args | Core coerce: [ args first value > args second value ] ].
+ (Fn new: [ :args | Core coerce: [ args first value > args second value ] ]).
- [ :args | Core coerce: [ args first value >= args second value ] ].
+ (Fn new: [ :args | Core coerce: [ args first value >= args second value ] ]).
Core Ns at: #'read-string' put:
Core Ns at: #'read-string' put:
- [ :args | Reader readStr: args first value ].
+ (Fn new: [ :args | Reader readStr: args first value ]).
- [ :args | MALString new: (File path: args first value) contents ].
+ (Fn new: [ :args | MALString new: (File path: args first value) contents ]).
- [ :args | MALCustomError new signal: args first ].
+ (Fn new: [ :args | MALCustomError new signal: args first ]).
- [ :args | MALAtom new: args first ].
+ (Fn new: [ :args | MALAtom new: args first ]).
Core Ns at: #'atom?' put:
Core Ns at: #'atom?' put:
- [ :args | Core coerce: [ args first type = #atom ] ].
+ (Fn new: [ :args | Core coerce: [ args first type = #atom ] ]).
- [ :args | args first value ].
+ (Fn new: [ :args | args first value ]).
Core Ns at: #'reset!' put:
Core Ns at: #'reset!' put:
- [ :args | args first value: args second. args second ].
+ (Fn new: [ :args | args first value: args second. args second ]).
Core Ns at: #'swap!' put:
Core Ns at: #'swap!' put:
| a f x xs result |
a := args first.
| a f x xs result |
a := args first.
- f := args second.
- f class = Func ifTrue: [ f := f fn ].
x := a value.
xs := args allButFirst: 2.
result := f value: (xs copyWithFirst: x).
a value: result.
x := a value.
xs := args allButFirst: 2.
result := f value: (xs copyWithFirst: x).
a value: result.
- [ :args | MALList new: (args second value copyWithFirst: args first) ].
+ (Fn new: [ :args | MALList new: (args second value copyWithFirst: args first) ]).
- [ :args | MALList new: (OrderedCollection join:
- (args collect: [ :arg | arg value ])) ].
+ (Fn new: [ :args | MALList new: (OrderedCollection join:
+ (args collect: [ :arg | arg value ])) ]).
| items index |
items := args first value.
index := args second value + 1.
| items index |
items := args first value.
index := args second value + 1.
- items at: index ifAbsent: [ MALOutOfBounds new signal ]
- ].
+ items at: index ifAbsent: [ MALOutOfBounds new signal ] ]).
- [ :args | Core nilable: args else: [
- args first value at: 1 ifAbsent: [ MALObject Nil ] ] ].
+ (Fn new: [ :args | Core nilable: args else: [
+ args first value at: 1 ifAbsent: [ MALObject Nil ] ] ]).
| items rest |
items := args first value.
(args first type = #nil or: [ items isEmpty ]) ifTrue: [
| items rest |
items := args first value.
(args first type = #nil or: [ items isEmpty ]) ifTrue: [
] ifFalse: [
rest := items allButFirst
].
] ifFalse: [
rest := items allButFirst
].
- MALList new: (OrderedCollection from: rest)
- ].
+ MALList new: (OrderedCollection from: rest) ]).
- f := args first.
- f class = Func ifTrue: [ f := f fn ].
args size < 3 ifTrue: [
rest := {}
] ifFalse: [
rest := args copyFrom: 2 to: args size - 1
].
rest := rest, args last value.
args size < 3 ifTrue: [
rest := {}
] ifFalse: [
rest := args copyFrom: 2 to: args size - 1
].
rest := rest, args last value.
- f := args first.
- f class = Func ifTrue: [ f := f fn ].
items := args second value.
result := items collect: [ :item | f value: {item} ].
items := args second value.
result := items collect: [ :item | f value: {item} ].
- MALList new: (OrderedCollection from: result)
- ].
+ MALList new: (OrderedCollection from: result) ]).
- [ :args | Core coerce: [ args first type = #nil ] ].
+ (Fn new: [ :args | Core coerce: [ args first type = #nil ] ]).
Core Ns at: #'true?' put:
Core Ns at: #'true?' put:
- [ :args | Core coerce: [ args first type = #true ] ].
+ (Fn new: [ :args | Core coerce: [ args first type = #true ] ]).
Core Ns at: #'false?' put:
Core Ns at: #'false?' put:
- [ :args | Core coerce: [ args first type = #false ] ].
+ (Fn new: [ :args | Core coerce: [ args first type = #false ] ]).
Core Ns at: #'symbol?' put:
Core Ns at: #'symbol?' put:
- [ :args | Core coerce: [ args first type = #symbol ] ].
+ (Fn new: [ :args | Core coerce: [ args first type = #symbol ] ]).
Core Ns at: #'keyword?' put:
Core Ns at: #'keyword?' put:
- [ :args | Core coerce: [ args first type = #keyword ] ].
+ (Fn new: [ :args | Core coerce: [ args first type = #keyword ] ]).
Core Ns at: #'vector?' put:
Core Ns at: #'vector?' put:
- [ :args | Core coerce: [ args first type = #vector ] ].
+ (Fn new: [ :args | Core coerce: [ args first type = #vector ] ]).
- [ :args | Core coerce: [ args first type = #map ] ].
+ (Fn new: [ :args | Core coerce: [ args first type = #map ] ]).
Core Ns at: #'sequential?' put:
Core Ns at: #'sequential?' put:
- [ :args | Core coerce: [ args first type = #list or:
- [ args first type = #vector ] ] ].
+ (Fn new: [ :args | Core coerce: [ args first type = #list or:
+ [ args first type = #vector ] ] ]).
- [ :args | MALSymbol new: args first value asSymbol ].
+ (Fn new: [ :args | MALSymbol new: args first value asSymbol ]).
Core Ns at: #keyword put:
Core Ns at: #keyword put:
- [ :args | MALKeyword new: args first value asSymbol ].
+ (Fn new: [ :args | MALKeyword new: args first value asSymbol ]).
- [ :args | MALVector new: (OrderedCollection from: args) ].
+ (Fn new: [ :args | MALVector new: (OrderedCollection from: args) ]).
Core Ns at: #'hash-map' put:
Core Ns at: #'hash-map' put:
- [ :args | MALMap new: args asDictionary ].
+ (Fn new: [ :args | MALMap new: args asDictionary ]).
| result keyVals |
result := Dictionary from: args first value associations.
keyVals := args allButFirst.
1 to: keyVals size by: 2 do:
[ :i | result add: (keyVals at: i) -> (keyVals at: i + 1) ].
| result keyVals |
result := Dictionary from: args first value associations.
keyVals := args allButFirst.
1 to: keyVals size by: 2 do:
[ :i | result add: (keyVals at: i) -> (keyVals at: i + 1) ].
- MALMap new: result
- ].
| result keys |
result := Dictionary from: args first value associations.
keys := args allButFirst.
keys do: [ :key | result removeKey: key ifAbsent: [ nil ] ].
| result keys |
result := Dictionary from: args first value associations.
keys := args allButFirst.
keys do: [ :key | result removeKey: key ifAbsent: [ nil ] ].
- MALMap new: result
- ].
- [ :args | Core nilable: args else:
- [ args first value at: args second ifAbsent: [ MALObject Nil ] ] ].
+ (Fn new: [ :args | Core nilable: args else:
+ [ args first value at: args second ifAbsent: [ MALObject Nil ] ] ]).
Core Ns at: #'contains?' put:
Core Ns at: #'contains?' put:
- [ :args | Core coerce: [ args first value includesKey: args second ] ].
+ (Fn new: [ :args | Core coerce: [ args first value includesKey: args second ] ]).
- [ :args | MALList new: (OrderedCollection from: args first value keys) ].
+ (Fn new: [ :args | MALList new: (OrderedCollection from: args first value keys) ]).
- [ :args | MALList new: (OrderedCollection from: args first value values) ].
+ (Fn new: [ :args | MALList new: (OrderedCollection from: args first value values) ]).
-Object subclass: Func [
- | ast params env fn isMacro meta |
+MALObject subclass: Func [
+ | ast params env fn isMacro |
ast [ ^ast ]
params [ ^params ]
env [ ^env ]
fn [ ^fn ]
isMacro [ ^isMacro ]
ast [ ^ast ]
params [ ^params ]
env [ ^env ]
fn [ ^fn ]
isMacro [ ^isMacro ]
isMacro: bool [
isMacro := bool
]
isMacro: bool [
isMacro := bool
]
- meta: aMeta [
- meta := aMeta
- ]
-
Func class >> new: ast params: params env: env fn: fn [
| func |
Func class >> new: ast params: params env: env fn: fn [
| func |
+ func := super new: #func value: fn meta: nil.
func init: ast params: params env: env fn: fn.
^func
]
func init: ast params: params env: env fn: fn.
^func
]
fn := aFn.
isMacro := false
]
fn := aFn.
isMacro := false
]
-
- withMeta: meta [
- | func |
- func := self deepCopy.
- func meta: meta.
- ^func
- ]
Object subclass: Printer [
Printer class >> prStr: sexp printReadably: printReadably [
Object subclass: Printer [
Printer class >> prStr: sexp printReadably: printReadably [
- sexp class = BlockClosure ifTrue: [ ^'#<block>' ].
- sexp class = Func ifTrue: [ ^'#<func>' ].
+ sexp type = #fn ifTrue: [ ^'#<fn>' ].
+ sexp type = #func ifTrue: [ ^'#<func>' ].
sexp type = #true ifTrue: [ ^'true' ].
sexp type = #false ifTrue: [ ^'false' ].
sexp type = #nil ifTrue: [ ^'nil' ].
sexp type = #true ifTrue: [ ^'true' ].
sexp type = #false ifTrue: [ ^'false' ].
sexp type = #nil ifTrue: [ ^'nil' ].
a1_ := ast second value.
binds := a1_ collect: [ :item | item value ].
a2 := ast third.
a1_ := ast second value.
binds := a1_ collect: [ :item | item value ].
a2 := ast third.
- ^[ :args | self EVAL: a2 env:
+ ^Fn new: [ :args | self EVAL: a2 env:
(Env new: env binds: binds exprs: args) ]
].
forms := (self evalAst: sexp env: env) value.
(Env new: env binds: binds exprs: args) ]
].
forms := (self evalAst: sexp env: env) value.
- function := forms first.
+ function := forms first fn.
args := forms allButFirst asArray.
^function value: args
]
args := forms allButFirst asArray.
^function value: args
]
function := forms first.
args := forms allButFirst asArray.
function := forms first.
args := forms allButFirst asArray.
- function class = BlockClosure ifTrue: [ ^function value: args ].
- function class = Func ifTrue: [
+ function type = #fn ifTrue: [ ^function fn value: args ].
+ function type = #func ifTrue: [
| env_ |
sexp := function ast.
env_ := Env new: function env binds: function params
| env_ |
sexp := function ast.
env_ := Env new: function env binds: function params
function := forms first.
args := forms allButFirst asArray.
function := forms first.
args := forms allButFirst asArray.
- function class = BlockClosure ifTrue: [ ^function value: args ].
- function class = Func ifTrue: [
+ function type = #fn ifTrue: [ ^function fn value: args ].
+ function type = #func ifTrue: [
| env_ |
sexp := function ast.
env_ := Env new: function env binds: function params
| env_ |
sexp := function ast.
env_ := Env new: function env binds: function params
argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]).
Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ].
argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]).
Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ].
-replEnv set: #eval value: [ :args | MAL EVAL: args first env: replEnv ].
+replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]).
replEnv set: #'*ARGV*' value: (MALList new: argv).
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
replEnv set: #'*ARGV*' value: (MALList new: argv).
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
function := forms first.
args := forms allButFirst asArray.
function := forms first.
args := forms allButFirst asArray.
- function class = BlockClosure ifTrue: [ ^function value: args ].
- function class = Func ifTrue: [
+ function type = #fn ifTrue: [ ^function fn value: args ].
+ function type = #func ifTrue: [
| env_ |
sexp := function ast.
env_ := Env new: function env binds: function params
| env_ |
sexp := function ast.
env_ := Env new: function env binds: function params
argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]).
Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ].
argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]).
Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ].
-replEnv set: #eval value: [ :args | MAL EVAL: args first env: replEnv ].
+replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]).
replEnv set: #'*ARGV*' value: (MALList new: argv).
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
replEnv set: #'*ARGV*' value: (MALList new: argv).
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
a0_ := a0 value.
a0 type = #symbol ifTrue: [
f := env find: a0_.
a0_ := a0 value.
a0 type = #symbol ifTrue: [
f := env find: a0_.
- (f notNil and: [ f class = Func ]) ifTrue: [
+ (f notNil and: [ f type = #func ]) ifTrue: [
function := forms first.
args := forms allButFirst asArray.
function := forms first.
args := forms allButFirst asArray.
- function class = BlockClosure ifTrue: [ ^function value: args ].
- function class = Func ifTrue: [
+ function type = #fn ifTrue: [ ^function fn value: args ].
+ function type = #func ifTrue: [
| env_ |
sexp := function ast.
env_ := Env new: function env binds: function params
| env_ |
sexp := function ast.
env_ := Env new: function env binds: function params
argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]).
Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ].
argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]).
Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ].
-replEnv set: #eval value: [ :args | MAL EVAL: args first env: replEnv ].
+replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]).
replEnv set: #'*ARGV*' value: (MALList new: argv).
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
replEnv set: #'*ARGV*' value: (MALList new: argv).
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
a0_ := a0 value.
a0 type = #symbol ifTrue: [
f := env find: a0_.
a0_ := a0 value.
a0 type = #symbol ifTrue: [
f := env find: a0_.
- (f notNil and: [ f class = Func ]) ifTrue: [
+ (f notNil and: [ f type = #func ]) ifTrue: [
function := forms first.
args := forms allButFirst asArray.
function := forms first.
args := forms allButFirst asArray.
- function class = BlockClosure ifTrue: [ ^function value: args ].
- function class = Func ifTrue: [
+ function type = #fn ifTrue: [ ^function fn value: args ].
+ function type = #func ifTrue: [
| env_ |
sexp := function ast.
env_ := Env new: function env binds: function params
| env_ |
sexp := function ast.
env_ := Env new: function env binds: function params
argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]).
Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ].
argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]).
Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ].
-replEnv set: #eval value: [ :args | MAL EVAL: args first env: replEnv ].
+replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]).
replEnv set: #'*ARGV*' value: (MALList new: argv).
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
replEnv set: #'*ARGV*' value: (MALList new: argv).
MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
+MALObject subclass: Fn [
+ | fn |
+
+ fn [ ^fn ]
+
+ Fn class >> new: fn [
+ | f |
+ f := super new: #fn value: fn meta: nil.
+ f init: fn.
+ ^f
+ ]
+
+ init: f [
+ fn := f.
+ ]
+]
+
Error subclass: MALError [
description [ ^'A MAL-related error' ]
isResumable [ ^true ]
Error subclass: MALError [
description [ ^'A MAL-related error' ]
isResumable [ ^true ]