diff options
Diffstat (limited to 'ps')
| -rw-r--r-- | ps/reader.ps | 14 | ||||
| -rw-r--r-- | ps/step1_read_print.ps | 16 | ||||
| -rw-r--r-- | ps/step2_eval.ps | 19 | ||||
| -rw-r--r-- | ps/step3_env.ps | 16 | ||||
| -rw-r--r-- | ps/types.ps | 133 |
5 files changed, 149 insertions, 49 deletions
diff --git a/ps/reader.ps b/ps/reader.ps index 0fa4c02..8575d64 100644 --- a/ps/reader.ps +++ b/ps/reader.ps @@ -63,8 +63,8 @@ /cnt 0 def { % loop idx str length ge { %if EOF - (Error: unexpected EOF reading string\n) print - error + (unexpected EOF reading string) + throw } if /ch str idx get def % current character /idx idx 1 add def @@ -119,8 +119,8 @@ { % loop str idx read_spaces /idx exch def pop str length idx le { %if EOF - (Error: unexpected EOF reading list\n) print - error + (unexpected EOF reading list) + throw } if /ch str idx get def % current character ch 41 eq { exit } if % ')' is end of list @@ -159,9 +159,13 @@ /ch str idx get def % current character ch 40 eq { %if ( str idx read_list + }{ ch 91 eq { %elseif [ + (unexpected '[') throw + }{ ch 93 eq { %elseif ] + (unexpected ']') throw }{ % else str idx read_atom - } ifelse + } ifelse } ifelse } ifelse %(stack vvv\n) print %pstack diff --git a/ps/step1_read_print.ps b/ps/step1_read_print.ps index d08579c..e03c8cc 100644 --- a/ps/step1_read_print.ps +++ b/ps/step1_read_print.ps @@ -9,19 +9,17 @@ % eval -/EVAL { +/EVAL { 2 dict begin % just "return" the "ast" /env exch def /ast exch def ast -} def +end } def % print /PRINT { - /exp exch def - %(printing: ) print exp == - exp pr_str + pr_str } def @@ -39,7 +37,13 @@ not { exit } if % exit if EOF %(\ngot line: ) print dup print (\n) print flush - REP print (\n) print + { %try + REP print (\n) print + } stopped { + (Error: ) print + get_error_data pr_str print (\n) print + clear + } if } bind loop (\n) print % final newline before exit for cleanliness diff --git a/ps/step2_eval.ps b/ps/step2_eval.ps index 72a91fa..dec403c 100644 --- a/ps/step2_eval.ps +++ b/ps/step2_eval.ps @@ -14,7 +14,12 @@ /ast exch def %(eval_ast: ) print ast == /nametype ast type eq { %if symbol - env ast get + env ast known { + env ast get + }{ + (') ast pr_str (' not found) + concatenate concatenate throw + } ifelse }{ /arraytype ast type eq { %elseif list [ ast { @@ -44,9 +49,7 @@ end } def % print /PRINT { - /exp exch def - %(printing: ) print exp == - exp pr_str + pr_str } def @@ -71,7 +74,13 @@ end } def not { exit } if % exit if EOF %(\ngot line: ) print dup print (\n) print flush - REP print (\n) print + { %try + REP print (\n) print + } stopped { + (Error: ) print + get_error_data pr_str print (\n) print + clear + } if } bind loop (\n) print % final newline before exit for cleanliness diff --git a/ps/step3_env.ps b/ps/step3_env.ps index c2e65cb..908ff43 100644 --- a/ps/step3_env.ps +++ b/ps/step3_env.ps @@ -41,7 +41,7 @@ end } def }{ /let* a0 eq { %if let* /a1 ast 1 get def /a2 ast 2 get def - /let_env env env_new def + /let_env env [ ] [ ] env_new def 0 2 a1 length 1 sub { %for each pair /idx exch def let_env @@ -63,14 +63,12 @@ end } def % print /PRINT { - /exp exch def - %(printing: ) print exp == - exp pr_str + pr_str } def % repl -/repl_env null env_new def +/repl_env null [ ] [ ] env_new def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def @@ -91,7 +89,13 @@ end } def not { exit } if % exit if EOF %(\ngot line: ) print dup print (\n) print flush - REP print (\n) print + { %try + REP print (\n) print + } stopped { + (Error: ) print + get_error_data pr_str print (\n) print + clear + } if } bind loop (\n) print % final newline before exit for cleanliness diff --git a/ps/types.ps b/ps/types.ps index 5028c58..8843841 100644 --- a/ps/types.ps +++ b/ps/types.ps @@ -28,29 +28,29 @@ aload % push array onto stack length -1 0 { 1 roll } for % reverse ] -} def +} bind def -/pr_str { - %(in pr_str\n) print - /obj exch def +/_pr_str { 4 dict begin + /print_readably exch def + dup + /func? exch xcheck def % executable function + /obj exch cvlit def /arraytype obj type eq { % if list % accumulate an array of strings - (\() - obj length 0 gt { %if any elements - [ - obj { - pr_str - } forall - ] - { concatenate ( ) concatenate } forall - dup length 1 sub 0 exch getinterval % strip off final space - } if - (\)) concatenate + func? { (<fn* { ) }{ (\() } ifelse + obj ( ) print_readably _pr_str_args + concatenate + func? { ( } >) }{ (\)) } ifelse + concatenate }{ /integertype obj type eq { % if number /slen obj 10 idiv 1 add def obj 10 slen string cvrs }{ /stringtype obj type eq { % if string - (") obj (") concatenate concatenate + print_readably { + (") obj (") concatenate concatenate + }{ + obj + } ifelse }{ null obj eq { % if nil (nil) }{ true obj eq { % if true @@ -58,18 +58,79 @@ }{ false obj eq { % if false (false) }{ /nametype obj type eq { % if symbol - obj obj length string cvs + obj dup length string cvs }{ (<unknown>) } 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 +} 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 - %(pr_str2 stack vvv\n) print - %pstack - %(pr_str2 stack ^^^\n) print +/errorinfo? { + $error /errorinfo known { % if set + $error /errorinfo get null ne { + true + }{ + false + } ifelse + }{ + false + } ifelse } def +/get_error_data { + errorinfo? { %if + $error /errorinfo get + }{ + $error /errorname get 255 string cvs + (: ) + $error /command get 99 string cvs + ( at ) + $error /position get 10 99 string cvrs + concatenate + concatenate + concatenate + concatenate + } ifelse +} def + + +% % list operations +% +/_list? { + dup xcheck not exch type /arraytype eq and +} def /_first { 0 get } def /_rest { dup length 1 sub 1 exch getinterval } def /_nth { get } def @@ -78,10 +139,24 @@ % % Env implementation % -/env_new { 1 dict begin +% 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 @@ -97,13 +172,14 @@ end } def } ifelse } ifelse end } def -/env_set { 3 dict begin - /func dup xcheck 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 + env key val func? { cvx } if put + val func? { cvx } if end } def /env_get { 2 dict begin @@ -111,8 +187,11 @@ end } def /env exch def env key env_find dup null eq { - (Error: ') print key 99 string cvs print (' not found\n) print - error + (') + key 99 string cvs + (' not found) + concatenate concatenate + throw }{ key get } ifelse |