2014-05-11 01:29:07 +04:00
|
|
|
/runlibfile where { pop }{ /runlibfile { run } def } ifelse %
|
|
|
|
(types.ps) runlibfile
|
|
|
|
(reader.ps) runlibfile
|
|
|
|
(printer.ps) runlibfile
|
|
|
|
(env.ps) runlibfile
|
|
|
|
(core.ps) runlibfile
|
2014-03-30 03:20:07 +04:00
|
|
|
|
|
|
|
% read
|
2014-04-02 06:50:24 +04:00
|
|
|
/_readline { print flush (%stdin) (r) file 99 string readline } def
|
|
|
|
|
2014-03-30 03:20:07 +04:00
|
|
|
/READ {
|
|
|
|
/str exch def
|
|
|
|
str read_str
|
|
|
|
} def
|
|
|
|
|
|
|
|
|
|
|
|
% eval
|
|
|
|
/eval_ast { 2 dict begin
|
|
|
|
/env exch def
|
|
|
|
/ast exch def
|
|
|
|
%(eval_ast: ) print ast ==
|
2014-03-31 07:39:44 +04:00
|
|
|
ast _symbol? { %if symbol
|
2014-03-30 03:20:07 +04:00
|
|
|
env ast env_get
|
2014-04-07 00:23:40 +04:00
|
|
|
}{ ast _sequential? { %elseif list or vector
|
2014-03-30 03:20:07 +04:00
|
|
|
[
|
2014-04-07 00:23:40 +04:00
|
|
|
ast /data get { %forall items
|
2014-03-30 03:20:07 +04:00
|
|
|
env EVAL
|
|
|
|
} forall
|
2014-04-07 00:23:40 +04:00
|
|
|
] 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
|
2014-03-30 03:20:07 +04:00
|
|
|
}{ % else
|
|
|
|
ast
|
2014-04-07 00:23:40 +04:00
|
|
|
} ifelse } ifelse } ifelse
|
2014-03-30 03:20:07 +04:00
|
|
|
end } def
|
|
|
|
|
2014-03-30 03:35:22 +04:00
|
|
|
/EVAL { 9 dict begin
|
2014-03-30 03:20:07 +04:00
|
|
|
/env exch def
|
|
|
|
/ast exch def
|
2014-04-01 08:05:41 +04:00
|
|
|
|
|
|
|
%(EVAL: ) print ast true _pr_str print (\n) print
|
2014-03-31 07:39:44 +04:00
|
|
|
ast _list? not { %if not a list
|
2014-03-30 03:20:07 +04:00
|
|
|
ast env eval_ast
|
|
|
|
}{ %else apply the list
|
2014-04-07 00:23:40 +04:00
|
|
|
/a0 ast 0 _nth def
|
2014-03-30 03:20:07 +04:00
|
|
|
/def! a0 eq { %if def!
|
2014-04-07 00:23:40 +04:00
|
|
|
/a1 ast 1 _nth def
|
|
|
|
/a2 ast 2 _nth def
|
2014-03-30 03:20:07 +04:00
|
|
|
env a1 a2 env EVAL env_set
|
|
|
|
}{ /let* a0 eq { %if let*
|
2014-04-07 00:23:40 +04:00
|
|
|
/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
|
2014-03-30 03:20:07 +04:00
|
|
|
/idx exch def
|
|
|
|
let_env
|
2014-04-07 00:23:40 +04:00
|
|
|
a1 idx _nth
|
|
|
|
a1 idx 1 add _nth let_env EVAL
|
2014-03-30 03:20:07 +04:00
|
|
|
env_set
|
2014-04-01 08:05:41 +04:00
|
|
|
pop % discard the return value
|
2014-03-30 03:20:07 +04:00
|
|
|
} for
|
|
|
|
a2 let_env EVAL
|
|
|
|
}{ /do a0 eq { %if do
|
|
|
|
/el ast _rest env eval_ast def
|
2014-04-07 00:23:40 +04:00
|
|
|
el el _count 1 sub _nth % return last value
|
2014-03-30 03:20:07 +04:00
|
|
|
}{ /if a0 eq { %if if
|
2014-04-07 00:23:40 +04:00
|
|
|
/a1 ast 1 _nth def
|
2014-03-30 03:20:07 +04:00
|
|
|
/cond a1 env EVAL def
|
|
|
|
cond null eq cond false eq or { % if cond is nil or false
|
2014-04-07 00:23:40 +04:00
|
|
|
ast _count 3 gt { %if false branch with a3
|
|
|
|
ast 3 _nth env
|
2014-04-01 08:05:41 +04:00
|
|
|
EVAL
|
|
|
|
}{ % else false branch with no a3
|
2014-03-30 03:20:07 +04:00
|
|
|
null
|
|
|
|
} ifelse
|
2014-04-01 08:05:41 +04:00
|
|
|
}{ % true branch
|
2014-04-07 00:23:40 +04:00
|
|
|
ast 2 _nth env
|
2014-04-01 08:05:41 +04:00
|
|
|
EVAL
|
2014-03-30 03:20:07 +04:00
|
|
|
} ifelse
|
|
|
|
}{ /fn* a0 eq { %if fn*
|
2014-04-07 00:23:40 +04:00
|
|
|
/a1 ast 1 _nth def
|
|
|
|
/a2 ast 2 _nth def
|
2014-04-15 07:46:54 +04:00
|
|
|
a2 env a1 _mal_function
|
2014-03-30 03:20:07 +04:00
|
|
|
}{
|
|
|
|
/el ast env eval_ast def
|
2014-04-02 06:50:24 +04:00
|
|
|
el _rest el _first % stack: ast function
|
2014-04-15 07:46:54 +04:00
|
|
|
dup _mal_function? { %if user defined function
|
2014-04-02 06:50:24 +04:00
|
|
|
fload % stack: ast new_env
|
2014-04-01 08:05:41 +04:00
|
|
|
EVAL
|
2014-04-15 07:46:54 +04:00
|
|
|
}{ dup _function? { %else if builtin function
|
|
|
|
/data get exec
|
2014-04-01 08:05:41 +04:00
|
|
|
}{ %else (regular procedure/function)
|
2014-04-15 07:46:54 +04:00
|
|
|
(cannot apply native proc!\n) print quit
|
|
|
|
} ifelse } ifelse
|
2014-03-30 03:20:07 +04:00
|
|
|
} ifelse } ifelse } ifelse } ifelse } ifelse
|
|
|
|
} ifelse
|
|
|
|
end } def
|
|
|
|
|
|
|
|
|
|
|
|
% print
|
|
|
|
/PRINT {
|
|
|
|
true _pr_str
|
|
|
|
} def
|
|
|
|
|
|
|
|
|
|
|
|
% repl
|
2014-04-07 00:23:40 +04:00
|
|
|
/repl_env null null null env_new def
|
2014-03-30 03:20:07 +04:00
|
|
|
|
|
|
|
/RE { READ repl_env EVAL } def
|
|
|
|
/REP { READ repl_env EVAL PRINT } def
|
|
|
|
|
2014-04-17 08:57:50 +04:00
|
|
|
% core.ps: defined using postscript
|
2014-04-19 22:04:09 +04:00
|
|
|
/_ref { repl_env 3 1 roll env_set pop } def
|
|
|
|
core_ns { _function _ref } forall
|
2014-03-30 03:20:07 +04:00
|
|
|
|
2014-04-17 08:57:50 +04:00
|
|
|
% core.mal: defined using the language itself
|
2014-03-30 03:20:07 +04:00
|
|
|
(\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop
|
|
|
|
|
2014-04-19 22:04:09 +04:00
|
|
|
% repl loop
|
|
|
|
{ %loop
|
2014-04-02 06:50:24 +04:00
|
|
|
(user> ) _readline
|
2014-03-30 03:20:07 +04:00
|
|
|
not { exit } if % exit if EOF
|
|
|
|
|
|
|
|
{ %try
|
|
|
|
REP print (\n) print
|
|
|
|
} stopped {
|
|
|
|
(Error: ) print
|
|
|
|
get_error_data false _pr_str print (\n) print
|
2014-03-31 07:39:44 +04:00
|
|
|
$error /newerror false put
|
|
|
|
$error /errorinfo null put
|
2014-03-30 03:20:07 +04:00
|
|
|
clear
|
2014-04-02 06:50:24 +04:00
|
|
|
cleardictstack
|
2014-03-30 03:20:07 +04:00
|
|
|
} if
|
|
|
|
} bind loop
|
|
|
|
|
|
|
|
(\n) print % final newline before exit for cleanliness
|
|
|
|
quit
|