-(types.ps) run
-(reader.ps) run
+/runlibfile where { pop }{ /runlibfile { run } def } ifelse %
+(types.ps) runlibfile
+(reader.ps) runlibfile
+(printer.ps) runlibfile
+(env.ps) runlibfile
+(core.ps) runlibfile
% read
+/_readline { print flush (%stdin) (r) file 1024 string readline } def
+
/READ {
/str exch def
str read_str
% is_pair?: ast -> is_pair? -> bool
% return true if non-empty list, otherwise false
/is_pair? {
- dup _list? { length 0 gt }{ pop false } ifelse
+ dup _sequential? { _count 0 gt }{ pop false } ifelse
} def
% ast -> quasiquote -> new_ast
ast is_pair? not { %if not is_pair?
/quote ast 2 _list
}{
- /a0 ast 0 get def
+ /a0 ast 0 _nth def
a0 /unquote eq { %if a0 unquote symbol
- ast 1 get
+ ast 1 _nth
}{ a0 is_pair? { %elseif a0 is_pair?
- /a00 a0 0 get def
+ /a00 a0 0 _nth def
a00 /splice-unquote eq { %if splice-unquote
- /concat a0 1 get ast _rest quasiquote 3 _list
+ /concat a0 1 _nth ast _rest quasiquote 3 _list
}{ %else not splice-unquote
/cons a0 quasiquote ast _rest quasiquote 3 _list
} ifelse
/env exch def
/ast exch def
ast _list? {
- /a0 ast 0 get def
+ /a0 ast 0 _nth def
a0 _symbol? { %if a0 is symbol
env a0 env_find null ne { %if a0 is in env
env a0 env_get _mal_function? { %if user defined function
/ast exch def
{
ast env is_macro_call? {
- /mac env ast 0 get env_get def
+ /mac env ast 0 _nth env_get def
/ast ast _rest mac fload EVAL def
}{
exit
%(eval_ast: ) print ast ==
ast _symbol? { %if symbol
env ast env_get
- }{ ast _list? { %elseif list
+ }{ ast _sequential? { %elseif list or vector
[
- ast {
+ ast /data get { %forall items
+ env EVAL
+ } forall
+ ] ast _list? { _list_from_array }{ _vector_from_array } ifelse
+ }{ ast _hash_map? { %elseif list or vector
+ <<
+ ast /data get { %forall entries
env EVAL
} forall
- ]
+ >> _hash_map_from_dict
}{ % else
ast
- } ifelse } ifelse
+ } ifelse } ifelse } ifelse
end } def
/EVAL { 13 dict begin
}{ %else apply the list
/ast ast env macroexpand def
ast _list? not { %if no longer a list
- ast
+ ast env eval_ast
}{ %else still a list
- /a0 ast 0 get def
- /def! a0 eq { %if def!
- /a1 ast 1 get def
- /a2 ast 2 get def
+ /a0 ast 0 _nth def
+ a0 _nil? { %if ()
+ ast
+ }{ /def! a0 eq { %if def!
+ /a1 ast 1 _nth def
+ /a2 ast 2 _nth def
env a1 a2 env EVAL env_set
}{ /let* a0 eq { %if let*
- /a1 ast 1 get def
- /a2 ast 2 get def
- /let_env env [ ] [ ] env_new def
- 0 2 a1 length 1 sub { %for each pair
+ /a1 ast 1 _nth def
+ /a2 ast 2 _nth def
+ /let_env env null null env_new def
+ 0 2 a1 _count 1 sub { %for each pair
/idx exch def
let_env
- a1 idx get
- a1 idx 1 add get let_env EVAL
+ a1 idx _nth
+ a1 idx 1 add _nth let_env EVAL
env_set
pop % discard the return value
} for
- a2 let_env EVAL
+ a2
+ let_env
+ /loop? true def % loop
}{ /quote a0 eq { %if quote
- ast 1 get
+ ast 1 _nth
}{ /quasiquote a0 eq { %if quasiquote
- ast 1 get quasiquote env EVAL
+ ast 1 _nth quasiquote
+ env
+ /loop? true def % loop
}{ /defmacro! a0 eq { %if defmacro!
- /a1 ast 1 get def
- /a2 ast 2 get def
+ /a1 ast 1 _nth def
+ /a2 ast 2 _nth def
a2 env EVAL
dup /macro? true put % set macro flag
env exch a1 exch env_set % def! it
}{ /macroexpand a0 eq { %if defmacro!
- ast 1 get env macroexpand
+ ast 1 _nth env macroexpand
}{ /do a0 eq { %if do
- ast length 2 gt { %if ast has more than 2 elements
- ast 1 ast length 2 sub getinterval env eval_ast pop
+ ast _count 2 gt { %if ast has more than 2 elements
+ ast 1 ast _count 2 sub _slice env eval_ast pop
} if
- ast ast length 1 sub get % last ast becomes new ast
+ ast ast _count 1 sub _nth % last ast becomes new ast
env
/loop? true def % loop
}{ /if a0 eq { %if if
- /a1 ast 1 get def
+ /a1 ast 1 _nth def
/cond a1 env EVAL def
cond null eq cond false eq or { % if cond is nil or false
- ast length 3 gt { %if false branch with a3
- ast 3 get env
+ ast _count 3 gt { %if false branch with a3
+ ast 3 _nth env
/loop? true def
}{ % else false branch with no a3
null
} ifelse
}{ % true branch
- ast 2 get env
+ ast 2 _nth env
/loop? true def
} ifelse
}{ /fn* a0 eq { %if fn*
- /a1 ast 1 get def
- /a2 ast 2 get def
- <<
- /type /_maltype_function % user defined function
- /macro? false % macro flag, false by default
- /params null % close over parameters
- /ast null % close over ast
- /env null % close over environment
- >>
- dup length dict copy % make an actual copy/new instance
- dup /params a1 put % insert closed over a1 into position 2
- dup /ast a2 put % insert closed over a2 into position 3
- dup /env env put % insert closed over env into position 4
+ /a1 ast 1 _nth def
+ /a2 ast 2 _nth def
+ a2 env a1 _mal_function
}{
/el ast env eval_ast def
- el _first _mal_function? { % if user defined function
- el _rest el _first fload % stack: ast new_env
+ el _rest el _first % stack: ast function
+ dup _mal_function? { %if user defined function
+ fload % stack: ast new_env
/loop? true def
+ }{ dup _function? { %else if builtin function
+ /data get exec
}{ %else (regular procedure/function)
- el _rest el _first exec % apply function to args
- } ifelse
- } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse
+ (cannot apply native proc!\n) print quit
+ } ifelse } ifelse
+ } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse
} ifelse
} ifelse
% repl
-/repl_env null [ ] [ ] env_new def
+/repl_env null null null env_new def
/RE { READ repl_env EVAL } def
/REP { READ repl_env EVAL PRINT } def
-/_ref { repl_env 3 1 roll env_set pop } def
-
-types_ns { _ref } forall
-(read-string) { 0 get read_str } _ref
-(eval) { 0 get repl_env EVAL } _ref
-/slurp { (r) file dup bytesavailable string readstring pop } def
-(slurp) { 0 get slurp } _ref
-(pstack) { (vvv\n) print pstack (^^^\n) print } _ref
-(p1) { 1 index true _pr_str print (\n) print } _ref
+% core.ps: defined using postscript
+/_ref { repl_env 3 1 roll env_set pop } def
+core_ns { _function _ref } forall
+(eval) { 0 _nth repl_env EVAL } _function _ref
+(*ARGV*) [ ] _list_from_array _ref
+% core.mal: defined using the language itself
(\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop
(\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\)"\)\)\)\)\)) RE pop
-
-/stdin (%stdin) (r) file def
+(\(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\)\)\)\)\)\)\)) RE pop
+(\(defmacro! or \(fn* \(& xs\) \(if \(empty? xs\) nil \(if \(= 1 \(count xs\)\) \(first xs\) `\(let* \(or_FIXME ~\(first xs\)\) \(if or_FIXME or_FIXME \(or ~@\(rest xs\)\)\)\)\)\)\)\)) RE pop
userdict /ARGUMENTS known { %if command line arguments
ARGUMENTS length 0 gt { %if more than 0 arguments
- ARGUMENTS {
- (\(load-file ") exch ("\)) concatenate concatenate RE pop
- } forall
+ (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval
+ _list_from_array _ref
+ ARGUMENTS 0 get
+ (\(load-file ") exch ("\)) concatenate concatenate RE pop
quit
} if
} if
-{ % loop
- (user> ) print flush
-
- stdin 99 string readline
+% repl loop
+{ %loop
+ (user> ) _readline
not { exit } if % exit if EOF
- %(\ngot line: ) print dup print (\n) print flush
-
{ %try
REP print (\n) print
} stopped {
$error /newerror false put
$error /errorinfo null put
clear
+ cleardictstack
} if
} bind loop
HCoop / jackhill / mal.git / blobdiff