diff options
Diffstat (limited to 'ps')
| -rw-r--r-- | ps/Makefile | 2 | ||||
| -rw-r--r-- | ps/core.ps | 126 | ||||
| -rw-r--r-- | ps/printer.ps | 61 | ||||
| -rw-r--r-- | ps/reader.ps | 1 | ||||
| -rw-r--r-- | ps/step1_read_print.ps | 1 | ||||
| -rw-r--r-- | ps/step2_eval.ps | 1 | ||||
| -rw-r--r-- | ps/step3_env.ps | 2 | ||||
| -rw-r--r-- | ps/step4_if_fn_do.ps | 5 | ||||
| -rw-r--r-- | ps/step5_tco.ps | 5 | ||||
| -rw-r--r-- | ps/step6_file.ps | 5 | ||||
| -rw-r--r-- | ps/step7_quote.ps | 5 | ||||
| -rw-r--r-- | ps/step8_macros.ps | 5 | ||||
| -rw-r--r-- | ps/step9_interop.ps | 5 | ||||
| -rw-r--r-- | ps/stepA_more.ps | 5 | ||||
| -rw-r--r-- | ps/types.ps | 310 |
15 files changed, 264 insertions, 275 deletions
diff --git a/ps/Makefile b/ps/Makefile index 231e8aa..fd5ca70 100644 --- a/ps/Makefile +++ b/ps/Makefile @@ -1,7 +1,7 @@ TESTS = -SOURCES = types.ps reader.ps step8_macros.ps +SOURCES = types.ps reader.ps printer.ps env.ps core.ps stepA_more.ps .PHONY: stats tests $(TESTS) diff --git a/ps/core.ps b/ps/core.ps new file mode 100644 index 0000000..09bfe2b --- /dev/null +++ b/ps/core.ps @@ -0,0 +1,126 @@ +(in core.ps\n) print + +% requires types.ps + +% Errors/Exceptions + +% data -> throw -> +% Takes an arbitrary data and puts it in $error:/errorinfo. Then calls +% stop to transfer control to end of nearest stopped context. +/throw { + $error exch /errorinfo exch put + $error /command /throw put + stop +} def + + +% sequence functions + +% [obj list] -> cons -> new_list +/cons { + /args exch def + /elem args 0 get def + /lst args 1 get def + lst length 1 add array + dup 0 elem put % first element + dup 1 lst putinterval % rest of the elements +} def + +% [listA listB] -> concat -> [listA... listB...] +/concat { % replaces matric concat + dup length 0 eq { %if just concat + 0 _list + }{ dup length 1 eq { %elseif concat of single item + 0 get % noop + }{ % else + [] exch + { + concatenate + } forall + } ifelse } ifelse +} def + +% [obj ...] -> first -> obj +/first { + 0 get _first +} def + +% [obj objs...] -> first -> [objs..] +/rest { + 0 get _rest +} def + +% [function args... arg_list] -> apply -> result +/apply { 1 dict begin + /args exch def + args 0 get callable % make sure function is callable + args 1 args length 2 sub getinterval + args args length 1 sub get + concatenate args 0 get % stack: args function + exec +end } def + +% [function list] -> _map -> new_list +/map { 1 dict begin + dup 0 get exch 1 get % stack: function list + /args exch def + callable % make sure function is callable + %/new_list args length array def + args { + 1 array astore + exch dup 3 1 roll % stack: fn arg fn + exec exch % stack: result fn + } forall + pop % remove the function + args length array astore +end } def + +/conj { 5 dict begin + /args exch def + /src_list args 0 get def + /new_len src_list length args length 1 sub add def + /new_list new_len array def + new_list new_len src_list length sub src_list putinterval + args length 1 sub -1 1 { + /idx exch def + new_list args length idx sub 1 sub args idx get put + } for + new_list +end } def + + +% core_ns is namespace of core functions + +/core_ns << + (pr-str) { ( ) true _pr_str_args } + (str) { () false _pr_str_args } + (prn) { ( ) true _pr_str_args print (\n) print null } + (println) { () false _pr_str_args print (\n) print null } + (=) { dup 0 get exch 1 get _equal? } + (symbol?) { 0 get _symbol? } + (nil?) { 0 get _nil? } + (true?) { 0 get _true? } + (false?) { 0 get _false? } + (<) { dup 0 get exch 1 get lt } + (<=) { dup 0 get exch 1 get le } + (>) { dup 0 get exch 1 get gt } + (>=) { dup 0 get exch 1 get ge } + (+) { dup 0 get exch 1 get add } + (-) { dup 0 get exch 1 get sub } + (*) { dup 0 get exch 1 get mul } + (/) { dup 0 get exch 1 get idiv } + (throw) { 0 get throw } + (list) { dup pop } % noop + (list?) { 0 get _list? } + (cons) { cons } + (concat) { concat } + (sequential?) { 0 get _sequential? } + (empty?) { 0 get length 0 eq } + (count) { 0 get length } + (nth) { dup 0 get exch 1 get _nth } + (first) { first } + (rest) { rest } + (apply) { apply } + (map) { map } + (conj) { conj } +>> def diff --git a/ps/printer.ps b/ps/printer.ps new file mode 100644 index 0000000..c2e42a5 --- /dev/null +++ b/ps/printer.ps @@ -0,0 +1,61 @@ +(in types.ps\n) print + +% requires types.ps to be included first + +/_pr_str { 4 dict begin + /print_readably exch def + dup + /func? exch xcheck def % executable function + /obj exch cvlit def + obj _mal_function? { % if user defined function + (<\(fn* ) + obj /params get print_readably _pr_str + ( ) + obj /ast get print_readably _pr_str + (\)>) + concatenate concatenate concatenate concatenate + }{ /arraytype obj type eq { % if list or code block + % accumulate an array of strings + func? { (<builtin_fn* { ) }{ (\() } ifelse + obj ( ) print_readably _pr_str_args + concatenate + func? { ( } >) }{ (\)) } ifelse + concatenate + }{ /integertype obj type eq { % if number + /slen obj 10 add log ceiling cvi def + obj 10 slen string cvrs + }{ /stringtype obj type eq { % if string + print_readably { + (") obj (") concatenate concatenate + }{ + obj + } ifelse + }{ null obj eq { % if nil + (nil) + }{ true obj eq { % if true + (true) + }{ false obj eq { % if false + (false) + }{ /nametype obj type eq { % if symbol + obj dup length string cvs + }{ + (<unknown>) + } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse +end } def + +% array delim print_readably -> _pr_str_args -> new_string +/_pr_str_args { 3 dict begin + /print_readably exch def + /delim exch def + /args exch def + () + args length 0 gt { %if any elements + [ + args { %foreach argument in array + print_readably _pr_str + } forall + ] + { concatenate delim concatenate } forall + dup length delim length sub 0 exch getinterval % strip off final delim + } if +end } def diff --git a/ps/reader.ps b/ps/reader.ps index dba2a4a..948bf3b 100644 --- a/ps/reader.ps +++ b/ps/reader.ps @@ -1,5 +1,6 @@ (in reader\n) print +% requires types.ps to be included first /token_delim (;,"` \n{}\(\)[]) def /token_number (0123456789-) def diff --git a/ps/step1_read_print.ps b/ps/step1_read_print.ps index aa2ce25..b4c6275 100644 --- a/ps/step1_read_print.ps +++ b/ps/step1_read_print.ps @@ -1,5 +1,6 @@ (types.ps) run (reader.ps) run +(printer.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def diff --git a/ps/step2_eval.ps b/ps/step2_eval.ps index b353f8e..7b03a99 100644 --- a/ps/step2_eval.ps +++ b/ps/step2_eval.ps @@ -1,5 +1,6 @@ (types.ps) run (reader.ps) run +(printer.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def diff --git a/ps/step3_env.ps b/ps/step3_env.ps index a86e036..49d37c4 100644 --- a/ps/step3_env.ps +++ b/ps/step3_env.ps @@ -1,5 +1,7 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def diff --git a/ps/step4_if_fn_do.ps b/ps/step4_if_fn_do.ps index 11c475f..f703830 100644 --- a/ps/step4_if_fn_do.ps +++ b/ps/step4_if_fn_do.ps @@ -1,5 +1,8 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run +(core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def @@ -113,7 +116,7 @@ end } def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -types_ns { _ref } forall +core_ns { _ref } forall (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop diff --git a/ps/step5_tco.ps b/ps/step5_tco.ps index a501b06..2bc898a 100644 --- a/ps/step5_tco.ps +++ b/ps/step5_tco.ps @@ -1,5 +1,8 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run +(core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def @@ -123,7 +126,7 @@ end } def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -types_ns { _ref } forall +core_ns { _ref } forall (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop diff --git a/ps/step6_file.ps b/ps/step6_file.ps index b90bac5..f6f4377 100644 --- a/ps/step6_file.ps +++ b/ps/step6_file.ps @@ -1,5 +1,8 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run +(core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def @@ -123,7 +126,7 @@ end } def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -types_ns { _ref } forall +core_ns { _ref } forall (read-string) { 0 get read_str } _ref (eval) { 0 get repl_env EVAL } _ref diff --git a/ps/step7_quote.ps b/ps/step7_quote.ps index 9ca3eb5..9858b4f 100644 --- a/ps/step7_quote.ps +++ b/ps/step7_quote.ps @@ -1,5 +1,8 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run +(core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def @@ -155,7 +158,7 @@ end } def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -types_ns { _ref } forall +core_ns { _ref } forall (read-string) { 0 get read_str } _ref (eval) { 0 get repl_env EVAL } _ref diff --git a/ps/step8_macros.ps b/ps/step8_macros.ps index cfce140..869bf96 100644 --- a/ps/step8_macros.ps +++ b/ps/step8_macros.ps @@ -1,5 +1,8 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run +(core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def @@ -198,7 +201,7 @@ end } def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -types_ns { _ref } forall +core_ns { _ref } forall (read-string) { 0 get read_str } _ref (eval) { 0 get repl_env EVAL } _ref diff --git a/ps/step9_interop.ps b/ps/step9_interop.ps index 743422b..f8d3250 100644 --- a/ps/step9_interop.ps +++ b/ps/step9_interop.ps @@ -1,5 +1,8 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run +(core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def @@ -212,7 +215,7 @@ end } def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -types_ns { _ref } forall +core_ns { _ref } forall (read-string) { 0 get read_str } _ref (eval) { 0 get repl_env EVAL } _ref diff --git a/ps/stepA_more.ps b/ps/stepA_more.ps index 66494cc..a273c02 100644 --- a/ps/stepA_more.ps +++ b/ps/stepA_more.ps @@ -1,5 +1,8 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run +(core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def @@ -254,7 +257,7 @@ end } def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -types_ns { _ref } forall +core_ns { _ref } forall (readline) { 0 get _readline not { null } if } _ref (read-string) { 0 get read_str } _ref diff --git a/ps/types.ps b/ps/types.ps index 30019b9..c696d35 100644 --- a/ps/types.ps +++ b/ps/types.ps @@ -1,5 +1,7 @@ (in types.ps\n) print +% General functions + % concatenate: concatenate two strings or two arrays % From Thinking in PostScript 1990 Reid % (string1) (string2) concatenate string3 @@ -30,64 +32,6 @@ ] } bind def -/_pr_str { 4 dict begin - /print_readably exch def - dup - /func? exch xcheck def % executable function - /obj exch cvlit def - obj _mal_function? { % if user defined function - (<\(fn* ) - obj /params get print_readably _pr_str - ( ) - obj /ast get print_readably _pr_str - (\)>) - concatenate concatenate concatenate concatenate - }{ /arraytype obj type eq { % if list or code block - % accumulate an array of strings - func? { (<builtin_fn* { ) }{ (\() } ifelse - obj ( ) print_readably _pr_str_args - concatenate - func? { ( } >) }{ (\)) } ifelse - concatenate - }{ /integertype obj type eq { % if number - /slen obj 10 add log ceiling cvi def - obj 10 slen string cvrs - }{ /stringtype obj type eq { % if string - print_readably { - (") obj (") concatenate concatenate - }{ - obj - } ifelse - }{ null obj eq { % if nil - (nil) - }{ true obj eq { % if true - (true) - }{ false obj eq { % if false - (false) - }{ /nametype obj type eq { % if symbol - obj dup length string cvs - }{ - (<unknown>) - } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse -end } def - -% array delim print_readably -> _pr_str_args -> new_string -/_pr_str_args { 3 dict begin - /print_readably exch def - /delim exch def - /args exch def - () - args length 0 gt { %if any elements - [ - args { %foreach argument in array - print_readably _pr_str - } forall - ] - { concatenate delim concatenate } forall - dup length delim length sub 0 exch getinterval % strip off final delim - } if -end } def - % objA objB -> _equal? -> bool /_equal? { 6 dict begin /b exch def @@ -120,54 +64,22 @@ end } def } ifelse end } def -/_nil? { null eq } def -/_true? { true eq } def -/_false? { false eq } def - +/_sequential? { _list? } def -% -% Symbols -% -/_symbol? { - type /nametype eq +/_first { + dup length 0 gt { 0 get }{ pop null } ifelse } def - -% -% Functions -% -/_mal_function? { - dup type /dicttype eq { - /type get /_maltype_function eq +/_rest { + dup length 0 gt { + dup length 1 sub 1 exch getinterval }{ - pop false + pop 0 array } ifelse } def -% args mal_function -> fload -> ast new_env -% fload: sets up arguments on the stack for an EVAL call -/fload { - dup /ast get 3 1 roll % stack: ast args mal_function - dup /env get 3 1 roll % stack: ast env args mal_function - /params get exch % stack: ast env params args - env_new % stack: ast new_env -} def -% function_or_block -> callable -> block -% if this is a user defined mal function, get its executable block -/callable { dup _mal_function? { /data get } if } def -% % Errors/Exceptions -% - -% data -> throw -> -% Takes an arbitrary data and puts it in $error:/errorinfo. Then calls -% stop to transfer control to end of nearest stopped context. -/throw { - $error exch /errorinfo exch put - $error /command /throw put - stop -} def /errorinfo? { $error /errorinfo known { % if set @@ -198,187 +110,51 @@ end } def } def +% Scalars -% -% list operations -% -/_list { - array astore -} def -/_list? { - dup xcheck not exch type /arraytype eq and -} def -/_nth { get } def +/_nil? { null eq } def +/_true? { true eq } def +/_false? { false eq } def -/_cons { - /lst exch def - /elem exch def - lst length 1 add array - dup 0 elem put % first element - dup 1 lst putinterval % rest of the elements -} def -/concat { % replaces matric concat - dup length 0 eq { %if just concat - 0 _list - }{ dup length 1 eq { %elseif concat of single item - 0 get % noop - }{ % else - [] exch - { - concatenate - } forall - } ifelse } ifelse -} def +% Symbols -% -% Sequence operations -% -/_first { - dup length 0 gt { 0 get }{ pop null } ifelse -} def -/_rest { - dup length 0 gt { - dup length 1 sub 1 exch getinterval - }{ - pop 0 array - } ifelse +/_symbol? { + type /nametype eq } def -% [function args... arg_list] -> apply -> result -/apply { 1 dict begin - /args exch def - args 0 get callable % make sure function is callable - args 1 args length 2 sub getinterval - args args length 1 sub get - concatenate args 0 get % stack: args function - exec -end } def - -% function list -> _map -> new_list -/_map { 1 dict begin - /args exch def - callable % make sure function is callable - %/new_list args length array def - args { - 1 array astore - exch dup 3 1 roll % stack: fn arg fn - exec exch % stack: result fn - } forall - pop % remove the function - args length array astore -end } def -/_sequential? { _list? } def +% Functions -/conj { 5 dict begin - /args exch def - /src_list args 0 get def - /new_len src_list length args length 1 sub add def - /new_list new_len array def - new_list new_len src_list length sub src_list putinterval - args length 1 sub -1 1 { - /idx exch def - new_list args length idx sub 1 sub args idx get put - } for - new_list -end } def +/_mal_function? { + dup type /dicttype eq { + /type get /_maltype_function eq + }{ + pop false + } ifelse +} def +% args mal_function -> fload -> ast new_env +% fload: sets up arguments on the stack for an EVAL call +/fload { + dup /ast get 3 1 roll % stack: ast args mal_function + dup /env get 3 1 roll % stack: ast env args mal_function + /params get exch % stack: ast env params args + env_new % stack: ast new_env +} def -% -% Env implementation -% -% outer binds exprs -> env_new -> new_env -/env_new { 3 dict begin - %(in env_new\n) print - /exprs exch def - /binds exch def - /outer exch def - << - /__outer__ outer - 0 1 binds length 1 sub { - /idx exch def - binds idx get (&) eq { %if & - binds idx 1 add get % key - exprs idx exprs length idx sub getinterval % value - exit - } if - binds idx get % key - exprs idx get % value - } for - >> -end } def +% function_or_block -> callable -> block +% if this is a user defined mal function, get its executable block +/callable { dup _mal_function? { /data get } if } def -/env_find { 2 dict begin - /key exch def - /env exch def - env key known { %if key in env - env - }{ env /__outer__ get null ne { %elseif __outer__ not null - env /__outer__ get key env_find - }{ %else - null - } ifelse } ifelse -end } def -/env_set { 4 dict begin - dup - /func? exch xcheck def % executable function - /val exch cvlit def - /key exch def - /env exch def - env key val func? { cvx } if put - val func? { cvx } if -end } def +% Lists -/env_get { 2 dict begin - /key exch def - /env exch def - env key env_find - dup null eq { - (') - key 99 string cvs - (' not found) - concatenate concatenate - throw - }{ - key get - } ifelse -end } def +/_list { + array astore +} def +/_list? { + dup xcheck not exch type /arraytype eq and +} def +/_nth { get } def -% -% types_ns is namespace of type functions -% -/types_ns << - (pr-str) { ( ) true _pr_str_args } - (str) { () false _pr_str_args } - (prn) { ( ) true _pr_str_args print (\n) print null } - (println) { () false _pr_str_args print (\n) print null } - (=) { dup 0 get exch 1 get _equal? } - (symbol?) { 0 get _symbol? } - (nil?) { 0 get _nil? } - (true?) { 0 get _true? } - (false?) { 0 get _false? } - (<) { dup 0 get exch 1 get lt } - (<=) { dup 0 get exch 1 get le } - (>) { dup 0 get exch 1 get gt } - (>=) { dup 0 get exch 1 get ge } - (+) { dup 0 get exch 1 get add } - (-) { dup 0 get exch 1 get sub } - (*) { dup 0 get exch 1 get mul } - (/) { dup 0 get exch 1 get idiv } - (throw) { 0 get throw } - (list) { dup pop } % noop - (list?) { 0 get _list? } - (cons) { dup 0 get exch 1 get _cons } - (concat) { concat } - (sequential?) { 0 get _sequential? } - (empty?) { 0 get length 0 eq } - (count) { 0 get length } - (nth) { dup 0 get exch 1 get _nth } - (first) { 0 get _first } - (rest) { 0 get _rest } - (apply) { apply } - (map) { dup 0 get exch 1 get _map } - (conj) { conj } ->> def |