%!PS % -*-mode:ps;-*- (Time-stamp: "2006-06-25 01:19:41 ADT") % % Skreeth - an implementation of Lisp in PostScript % by Sean M. Burke sburke@cpan.org % %--------------------------------------------------------------------------- % % A word of warning: This is not the best PostScript code in the world. % At many points, I break down and use variables in my routines, instead of % being proper and just keeping everything on the stack. I am lame. % For examples of great PostScript, see Glenn Reid's book /Thinking % in PostScript/, and Bill Casselman's /Mathematical Illustrations: % A Manual of Geometry and PostScript/, namely: % => http://www.rightbrain.com/pages/books.html % => http://www.math.ubc.ca/~cass/graphics/manual/ % Both are well worth the read! % Furthermore, I encourage you to read "The Evolution of Lisp": % => http://interglacial.com/~sburke/pub/Evolution-of-Lisp.ps.gz % which might clarify Skreeth's role in the apophatic aporia of Lispdom. % %--------------------------------------------------------------------------- % We start with some general utilities and conveniences. /skreeth-version exch 13 10 getinterval def /skreeth-debug-level 10 def %--------------------------------------------------------------------------- /!! { (skreeth.psl) run } def true setpacking % I.e., we promise not to try mutating {...} objects. /! { bind def } def % TODO: make ! also do aliasing if the second param is a name? /alias { load dup type /arraytype eq {bind} if def }! /x /exch alias /last /exit alias /break /exit alias /halt /stop alias /q { quit } ! /Q { quit } ! /? { pstack } def /?? { (Stack: \253\n) print pstack (\273\n) print } def /S { pstack } ! /typeof /type alias /typename {type cvlit }! /cr (\n) def /CR (\n) def /nl (\n) def /NL (\n) def /dictkeys { [ x { pop dup type /marktype eq { pop (*MARK*) } if } forall ]}! /dictvalues { [ x { x pop dup type /marktype eq { pop (*MARK*) } if } forall ]}! /abc--cab { 3 1 roll }! /abc--bca { 3 -1 roll }! /abcd--dabc { 4 1 roll }! /abcd--bcda { 4 -1 roll }! /sub1 { 1 sub }! /add1 { 1 add }! /len /length alias /name2string { dup length string cvs }! /num2string { 40 string cvs }! % TODO: redo to make more efficient! /int2string /num2string alias /stackbottomindex { count sub1 }! /stackbottom { count sub1 index }! /stackbottombut1 { count 2 sub index }! /Noop {} ! /println { print (\n) print }! /trace { skreeth-debug-level le { (~ ) print println } { pop } ifelse }! skreeth-debug-level 0 le { /trace {pop pop} def } if /newseq { % array-or-str 5 newseq >> array-or-str newobjOfSize5 % Note that it does not consume the array-or-str, but does consume the length 1 index type /arraytype eq { array } { string } ifelse }! /@ { %% string1 string2 @ >> string ("@" because it ATpends strings/arrays) %% array1 array2 @ >> array 2 copy length exch length add % - seq1 seq2 newsize newseq % - seq1 seq2 newseq dup 4 2 roll 2 index 0 3 index putinterval exch length exch putinterval }! /@names { x name2string x name2string @ cvn }! %% /foo /bar >> /foobar %--------------------------------------------------------------------------- % Some baseline-sanity inits: /realtime where { pop realtime } { 1 } ifelse srand % TODO: init the font and font size and maybe encoding? %--------------------------------------------------------------------------- % Assertion functions % Assertions TODO: /have1 /Noop alias /have2 /Noop alias /have3 /Noop alias /have4 /Noop alias /becell /Noop alias /bearray /Noop alias /bedict /Noop alias /beblock /Noop alias /bename /Noop alias /++ { dup load add1 store }! % increments the symbol's value. /-- { dup load sub1 store }! % decrements the symbol's value. /assert_count 0 def /assert_verbosity 10 def /assertnote { (t: ) x @ assert_verbosity trace } def /stackempty? { count 0 eq } ! /stack-empty? /stackempty? alias /stack-empty /stackempty? alias /stackempty /stackempty? alias /printem { % stacktop be MUST a (array of)* strings! dup typeof /arraytype eq { { printem } forall } { print } ifelse }! /die { printem (Aborting.\n\n) print % TODO: use a 'signalerror' instead? is signalerror real % PostScript, or just GhostScript? stop }! /_assert_failure_common { % prefaceMsg >> -- (!!!!!!!!!!!!!!! ) print print (Assertion ) print assert_count num2string print ( failed !! !!!!!!!!!!!!!!!\n Assertion code: ) print /assertBlock load == }! /assert { % Yay, test driven development... in PostScript! beblock /assertBlock x ! /assert_count ++ count 0 eq not { (Precondition for ) _assert_failure_common (Stack is not empty from preceding code! ) print ?? () die } if assertBlock count 1 eq not { (Postcondition for ) _assert_failure_common (Stack is not empty after assertion code! ) print ?? () die } if not { () _assert_failure_common () die } if assert_verbosity skreeth-debug-level le {(t) assert_count num2string ( okay) @ @ 0 trace} if }def /assert_T /assert alias (Checking assertions for Skreeth v) skreeth-version ( under ) product ( ...) @ @ @ @ assertnote { 1 1 eq } assert { 1 2 ne } assert /delayed_assertions 100 array def /delayed_assertions_index 0 def /assert_later { delayed_assertions delayed_assertions_index 3 -1 roll put /delayed_assertions_index ++ }! /run_delayed_assertions { 0 1 delayed_assertions_index 1 sub { delayed_assertions x get assert } for /delayed_assertions 0 store } def { 1 1 eq } assert_later { 1 2 ne } assert_later %--------------------------------------------------------------------------- % more utility functions /lastindex { bearray length 1 sub }! % consumes, as most things do /for-backwards { % non-nestable! /fbBlock x def bearray /fbArray x def fbArray length 1 sub -1 0 { fbArray x get fbBlock } for }! /bury { count 1 sub x roll } bind def /unbury { count 1 sub x neg roll } bind def %/T { { token not {last} if == } loop } ! % dump how this string tokensizes /T { % dump how this string tokensizes { token not {last} if dup typeof 20 string cvs print (: ) print == } loop }! % like: (abc def ghij) T % TODO: token2array? token2list? % If you try reading off the end of an array, you get an error: % Error: /rangecheck in --get-- % Also happens if you try accessing a nonexistent hash entry! % Error: /undefined in --get-- % So we have getsafe to avoid this: % /getsafe { % a range-checking wrapper around 'get' 1 index type dup /arraytype eq 1 index /stringtype eq or { pop dup 0 lt 1 index 3 index length ge or { pop pop null } { get } ifelse } { dup /dicttype eq { pop 2 copy known {get} { pop pop null } ifelse } { % No idea what this is, so just do a raw 'get': pop get } ifelse } ifelse } def /array2packedarray { aload length packedarray } ! % ary > packedary /pack_its_array { dup load array2packedarray store } ! % sym > - /backwards_charnums_list2string { % list > str % E.g., [101 102 103 104 105] array2list backwards_charnums_list2string % > (ihgfe) % dup Pair? not { pop () } % an easy degenerate case { dup listlength dup string x 3 -1 roll { % Stack: string atindex currentlist | dup Pair? not { last } if x sub1 x dup Cdr x Car 3 index 3 index 3 -1 roll put } loop pop pop % returning the string } ifelse }! /str+charnum { % string charnum > newstr x dup length dup 1 add string dup 5 -1 roll 4 -1 roll x put % writing charnum to lastindex dup 0 4 -1 roll putinterval % duping in the input string }! {(abc) 252 str+charnum (abc\374) eq } assert {(ab) 252 str+charnum (ab\374) eq } assert {(a) 252 str+charnum (a\374) eq } assert {() 252 str+charnum (\374) eq } assert {(a) 0 str+charnum (a\000) eq } assert % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /ord { 0 get }! % str > chrnum /chr { 1 string dup 0 4 -1 roll put }! % chrnum > str /new_char_table { 257 array 0 1 256 { 1 index x false put } for } ! /A_numbermakers new_char_table def % characters that could make up a number token (+-.#) { A_numbermakers x true put } forall (0) ord 1 (9) ord { A_numbermakers x true put } for (A) ord 1 (Z) ord { A_numbermakers x true put } for (a) ord 1 (z) ord { A_numbermakers x true put } for /A_numbermakers A_numbermakers array2packedarray store /is_numbermaker { A_numbermakers x get }! % charnum >> bool /string2number { % Returns false if nonnumeric, otherwise returns the number-value. % But note that calling this can result in limitcheck errors, e.g., with: % clear (8#11766666666666666) string2number. That seems fine with me. % Note that string2number would be a snap if the "cvr" builtin were tolerant % of being given non-numeric input. (Instead, it throws an error on, % e.g., (x123) cvr {% This loop is here just so we can use 'last' to bail out. dup len 0 eq { pop false last } if dup true x { is_numbermaker not { pop false last } if } forall not { pop false last } if % It contained non-numeric chars % It's all numeric % inputstr - token not { false last } if % it wasn't tokenizable at all?! (sanity-checking) x len 0 ne { pop false last } if % toking it left a remainder! dup type /integertype eq { last } if % most common case: return the int dup type /realtype eq { last } if % return the real pop false last } loop }! /OLDstring2number { % returns false if nonnumeric, otherwise returns the number dup len 0 eq { pop false } { dup true x { is_numbermaker not { pop false last } if } forall % inputstr bool - { % it's all numeric token { % it's tokenizable x len 0 eq { % exhaustively so dup type /integertype eq { % most common case % and return this integer } { dup type /realtype eq { % and return this real number } { pop false } ifelse } ifelse } { % only partially tokenizable pop false } ifelse } { % it's not tokenizable at all (should be unreachable) false } ifelse } { % it contains non-numeric chars pop false } ifelse } ifelse }! %-------------------------------------------------------------------------- % A PostScript implementation of dynamic scope. % (= Perl's local(...) and Elisp's (let ...)) /LetCache 30 dict def /_LetInit { (starting letinit) 25 trace %(<<)print ? (>>)println /vals x def /vars x def /padname x def vals type /nulltype eq { /vals array vars length def } if vals type /integertype eq { % pop that many things from the stack % TODO: assert that there are that many things on the stack %count vals lt { // /stackunderflow signalerror } if [ vals 1 add 1 roll ] /vals x def } if }! /_LetNewCache { /cache vars length dict def LetCache padname [cache LetCache padname getsafe] put }! /_LetNewVars { vars { dup dup where { x get } { pop null } ifelse cache 3 1 roll put } forall 0 1 vars lastindex { dup vars x get x vals x getsafe %(stack: \253\n) print pstack (\273\n) print store } for }! /let { % TODO: redo this to use begin...end (the dictionary stack) % and make sure that global setting is done with "store" _LetInit (letinit done) 25 trace _LetNewCache (letnewcache done) 25 trace _LetNewVars (letnewcars done) 25 trace }! /unlet { /padname x def % TODO: assert LetCache padname known, and is non-null LetCache padname get 0 get { store } forall % restoring old variable values LetCache padname LetCache padname get 1 get put % eject the old cache }! /case { % [ {cond1} {...} {cond2} {...} ] case % like: [ {1 2 eq} { (foo\n) print } {2 2 eq } {(bar\n) print } ] case /case [/cases /caseindex] 1 let (letdone) 24 trace 0 2 cases lastindex { /caseindex x def % We can't keep this on the stack, because we % want the following execs to see the stack just as they left it. cases caseindex get exec { cases caseindex 1 add get exec exit } if } for /case unlet } def /typecase { % obj <> typecase % Each entry in the dict is typename {block} or typename expr % Each block gets the object as its parameter bedict dup 2 index typeof known { 1 index typeof get % obj handler| } { dup tOther known { tOther get } { pop null % No handler, so just use null } ifelse } ifelse % obj handler| dup xcheck { exec } { x pop } ifelse }! /typeswitch /typecase alias /switchtype /typecase alias /casetype /typecase alias /ontype /typecase alias % clear 123 <> typecase == %--------------------------------------------------------------------------- % Literal constants for the typenames: % ( first some utility functions for the typename maker ) /tfoo2isfoo { % turns /tArray => /isArray dup length string cvs dup length sub1 1 x getinterval dup len 2 add string dup 0 (is) putinterval dup 2 4 -1 roll putinterval cvn }! /make_typetester { % /typename /isFoo >> -- % Watch us MAKE CODE here! [ /type cvx 4 -1 roll cvlit /eq cvx ] cvx bind def }! /typedef { typename 2 copy def % defines tFoo constant x tfoo2isfoo make_typetester % defines isFoo function } ! /tArray [] typedef /tName /x typedef /tBoolean true typedef /tString (x) typedef /tInteger 1 typedef /tReal 1.1 typedef /tNull null typedef % The (increasingly) minor types: /tDict 1 pop <<>> typedef /tMark mark typedef /tOperator /add load typedef /tFile currentfile typedef /tPackedarray 0 packedarray typedef /tCondition condition typedef /tFont currentfont typedef % might be same as tDict! /tGstate gstate typedef /tSave save typedef /tLock lock typedef {tFont tString eq not } assert {tOperator /def load type eq } assert {tOperator /! name2string type eq not } assert {/def load isOperator } assert {/! load isOperator not } assert /tElse /Othertype def /tOther /Othertype def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Lispish things: /Cell { 2 array } ! /Cons { have2 [ 3 1 roll ] } ! /Car { bearray 0 get } ! /Cdr { bearray 1 get } ! /First /Car alias /Rest /Cdr alias /Nil {null} ! % or alias to false? /EmptyCell { [ 0 Nil ] } ! /Pair? { dup type /arraytype eq { length 2 eq } { pop false } ifelse }! /Pairp /Pair? alias /Consp /Pair? alias /Cons? /Pair? alias /Cellp /Pair? alias /Cell? /Pair? alias {4 5 Cons Car 4 eq } assert {4 5 Cons Cdr 5 eq } assert % the compositions... /Caar {Car Car}! /Cadr {Cdr Car}! /Cdar {Car Cdr}! /Cddr {Cdr Cdr}! /Caaar {Car Car Car}! /Caadr {Cdr Car Car}! /Cadar {Car Cdr Car}! /Caddr {Cdr Cdr Car}! /Cdaar {Car Car Cdr}! /Cdadr {Cdr Car Cdr}! /Cddar {Car Cdr Cdr}! /Cdddr {Cdr Cdr Cdr}! /Caaaar {Car Car Car Car}! /Caaadr {Cdr Car Car Car}! /Caadar {Car Cdr Car Car}! /Caaddr {Cdr Cdr Car Car}! /Cadaar {Car Car Cdr Car}! /Cadadr {Cdr Car Cdr Car}! /Caddar {Car Cdr Cdr Car}! /Cadddr {Cdr Cdr Cdr Car}! /Cdaaar {Car Car Car Cdr}! /Cdaadr {Cdr Car Car Cdr}! /Cdadar {Car Cdr Car Cdr}! /Cdaddr {Cdr Cdr Car Cdr}! /Cddaar {Car Car Cdr Cdr}! /Cddadr {Cdr Car Cdr Cdr}! /Cdddar {Car Cdr Cdr Cdr}! /Cddddr {Cdr Cdr Cdr Cdr}! /array2list { bearray Nil x { x Cons } for-backwards }! /L /array2list alias /Le {array2list root_env Eval } def % TODO: array2list-deep? % TODO: list2array? list2packedarray? etc? /listlength { 0 x { dup Pair? not { pop last } if Cdr x add1 x } loop } ! /dictkeys2list { Nil x { pop x Cons } forall}! % dict >> list /dictvalues2list { Nil x { x pop x Cons } forall}! % dict >> list % an example dict << /a 101 /b 102 >> /min { dup 2 index lt { x pop } { pop } ifelse }! /max { dup 2 index lt { pop } { x pop } ifelse }! { 123 456 min 123 eq } assert { 123 456 x min 123 eq } assert { 123 456 max 456 eq } assert { 123 456 x max 456 eq } assert % TODO: an 'error' routine % try: /orstop { not {stop} if } alias /new_frame_size 30 def /new_frame { new_frame_size dict } def /root_frame new_frame def /root_env [root_frame Nil] def /grow_env { [ x new_frame x ] } def /VarNotFound Nil def /get_var { % env varname >> val x {%loop dup 1 get x 0 get dup % >> nextcell dict dict 3 index known { 2 index get 3 1 roll pop pop % toss out the preceding nextcell and symbol exit } if pop dup Nil eq { pop pop VarNotFound exit } if % TODO error ? just under strict mode? } loop } def /$ { root_frame 3 1 roll put }! % symbol value >> -- % binds this symbol to this value, in the root frame /Pi 3.14159265358979323846264338327 def % ... % cross my heart and hope to die / these are the digits that make up pi /Define_var { % env varname val >> val 3 -1 roll 0 get 3 1 roll % operates on topmost frame % TODO: complain if already defined! dup 4 1 roll put }! {root_frame /pi known not } assert {root_env /pi Pi Define_var Pi eq } assert {root_frame /pi known } assert {root_frame /pi get Pi eq } assert { root_env 0 get /pi get Pi eq } assert { root_env /pi get_var Pi eq } assert { root_env /pi get_var VarNotFound ne } assert { root_env grow_env /pi get_var Pi eq } assert { root_env grow_env dup 0 get /zaz 123 put /zaz get_var 123 eq } assert % check that lookup failures are nonlethal { root_env /florm get_var VarNotFound eq } assert { root_env grow_env /florm get_var VarNotFound eq } assert { root_env grow_env dup 0 get /zaz 123 put /florm get_var VarNotFound eq } assert (Making sure shadowing works) assertnote { root_env grow_env dup 0 get /pi 666 put /pi get_var 666 eq } assert % TODO: tests for a narrower frame % TODO: tests /set_var! { % env varname val >> val 3 -1 roll {%loop dup 1 get x 0 get dup % >> nextcell dict dict 4 index known { 2 index x 5 -2 roll put x pop exit } if pop dup Nil eq { pop pop pop VarNotFound exit % TODO error? just under strict mode? } if } loop } def % Make sure we can store arbitrary types in a variable: {root_env /pi 4 set_var! 4 eq } assert {root_frame /pi get 4 eq } assert {root_env /pi (pies) set_var! (pies) eq } assert {root_frame /pi get (pies) eq } assert {root_env /pi true set_var! true eq } assert {root_frame /pi get true eq } assert {root_env /pi false set_var! false eq } assert {root_frame /pi get false eq } assert % TODO: a list, a vector, etc % Restore pi to a sane value {root_env /pi Pi set_var! Pi eq } assert /Setcar { x bearray x 0 x put }! % list val - %% right order? Lisp has (setcar list val) /Setcdr { x bearray x 1 x put }! % list val - %% right order? Lisp has (setcdr list val) {4 5 Cons dup 11 Setcar Car 11 eq } assert {4 5 Cons dup 11 Setcar Cdr 5 eq } assert {4 5 Cons dup 13 Setcdr Cdr 13 eq } assert {4 5 Cons dup 13 Setcdr Car 4 eq } assert /Set-car! /Setcar alias /Set-cdr! /Setcdr alias /Setfirst /Setcar alias /Setrest /Setcdr alias /Setfirst /Setcar alias /Setrest /Setcdr alias %--------------------------------------------------------------------------- % Special forms and their accoutrements... /Specials 30 dict def /defspecial { Specials abc--cab put }! /Special-form? { Car Specials x known } def /Handle-special-form { % Env Exp >> retval 50 skreeth-debug-level le { (Handling special form ') print dup Car name2string print ('\n) print } if dup Car Specials x get exec } def /quote { x pop Cadr } defspecial (Making sure defspecial works) assertnote {Specials /quote known } assert /define { % Env Exp >> assignedvalue % TODO: assert right number of arguments dup Cadr Pair? { Defun } % It's a function definition { dup Cadr x Caddr Define_var } % normal variable declaration ifelse } defspecial /set! { % Exp Env >> assignedvalue dup Cadr x Caddr % Env symbol value-epr >> -- 2 index Eval % Env symbol val set_var! } defspecial {Specials /set! known } assert %--------------------------------------------------------------------------- /begin { % Env Exp >> lastvalue % And so it begins! Cdr % toss out the actual 'begin' symbol false % initial value { x pop % toss out the previous value 1 index Eval % and compute a new one } 3 -1 roll Dolist % get our ducks in a row x pop % toss out the env leaving the final value } defspecial { [/begin ] Le false eq } assert_later { [/begin 2 ] Le 2 eq } assert_later { [/begin 2 3 ] Le 3 eq } assert_later { [/begin 2 3 4 ] Le 4 eq } assert_later { [/begin [/+ 9 10]L ]Le 19 eq } assert_later %--------------------------------------------------------------------------- /if { % Env Exp >> lastvalue Cdr dup Car 2 index Eval True? { Cadr x Eval } % do thenclause { Cddr dup Pair? { Car x Eval } % do elseclause { pop pop false } % (or the lack thereof) ifelse } ifelse } defspecial { [/if 4 5 ]Le 5 eq } assert_later { [/if 4 5 6 ]Le 5 eq } assert_later { [/if 0 5 6 ]Le 6 eq } assert_later { [/if 0 5 ]Le false eq } assert_later { [/if [/+ 3 -3 ]L [/+ 10 11 ]L [/+ 20 21 ]L ]Le 41 eq } assert_later { [/if [/+ 4 -3 ]L [/+ 10 11 ]L [/+ 20 21 ]L ]Le 21 eq } assert_later %--------------------------------------------------------------------------- /and { % Env Exp >> value Cdr % toss out the actual 'and' symbol true % initial value x % At each iteration start: env lastvalue pair | { dup Pair? not { pop x pop last} if % We went off the end! Return the prev value x pop % nix lastvalue dup Car 2 index Eval dup True? not { x pop x pop last } if % we found a false value: return it x Cdr } loop % On loop exit, leave just the value. } defspecial { [/and ]Le true eq } assert_later { [/and 4 ]Le 4 eq } assert_later { [/and 4 5 ]Le 5 eq } assert_later { [/and 4 5 6 ]Le 6 eq } assert_later { [/and 4 ]Le 4 eq } assert_later { [/and 4 0 false ]Le 0 eq } assert_later { [/and 4 false 0 ]Le false eq } assert_later % Mostly like 'and': /or { % Env Exp >> value Cdr % toss out the actual 'or' symbol false % initial value x % At each iteration start: env lastvalue pair | { dup Pair? not { pop x pop last} if % We went off the end! Return the prev value x pop % nix lastvalue dup Car 2 index Eval dup True? { x pop x pop last } if % we found a true value: return it x Cdr } loop % On loop exit, leave just the value. } defspecial { [/or ]Le false eq } assert_later { [/or 4 ]Le 4 eq } assert_later { [/or 4 5 ]Le 4 eq } assert_later { [/or 4 5 6 ]Le 4 eq } assert_later { [/or 0 4 ]Le 4 eq } assert_later { [/or 0 4 5 ]Le 4 eq } assert_later { [/or 0 4 5 6 ]Le 4 eq } assert_later { [/or 0 ]Le 0 eq } assert_later { [/or false 0 ]Le 0 eq } assert_later { [/or 0 false ]Le false eq } assert_later % TODO: test for non-evalling of unused conditions in and/or % by having those conds be (set! Pi 123) or something, then % testing Pi's value. %--------------------------------------------------------------------------- /TODO { (Not yet implemented\n) print false } def /Defun { TODO } ! % Env Exp /cond { TODO } defspecial /let { TODO } defspecial %~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ % Here we implement the concept of truth in Skreeth: /True? { % anyvalue >> boolean % A values is true if it's not 0, false, or Nil (=emptylist). dup null ne 1 index false ne 2 index 0 ne and and x pop % (discarding the orig value) }! % TODO: assertlater tests %~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ /Self-evaluating? { /itemtype x typename def itemtype tBoolean eq itemtype tString eq itemtype tInteger eq itemtype tReal eq itemtype tNull eq or or or or }! {5 Self-evaluating? } assert {5.234 Self-evaluating? } assert {(abc) Self-evaluating? } assert {false Self-evaluating? } assert {true Self-evaluating? } assert {null Self-evaluating? } assert {[8 9] Self-evaluating? not} assert {/abc Self-evaluating? not} assert /Variable? { type tName eq }! {5 Variable? not} assert {5.234 Variable? not} assert {(abc) Variable? not} assert {false Variable? not} assert {true Variable? not} assert {null Variable? not} assert {/abc Variable? } assert %~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ /Dolist { % proc inlist >> -- dup Pair? not { pop pop } { /Dolist [/Proc /Incell] 2 let { Incell Car Proc % Proc is expected to consume one value and put no values % but if any values are put, they accrue on the stack. Incell Cdr Pair? not { last } if /Incell Incell Cdr store } loop /Dolist unlet } ifelse } def /forall-list /Dolist alias /foreach-list /Dolist alias /Maplist { % proc inlist >> outlist dup Pair? not { pop pop Nil } { Nil Nil Cons dup /Maplist [/Proc /Incell /Outlist /Outcell] 4 let { Incell Car Proc % Proc is expected to consume one value and put one value Outcell x Setcar Incell Cdr Pair? not { last } if /Incell Incell Cdr store /Outcell Outcell Nil Nil Cons dup 3 1 roll Setcdr store } loop Outlist /Maplist unlet } ifelse } def % This: { 2 mul } [101 102 103] array2list Maplist === % Should show: [202 [204 [206 null]]] % 5 { 1 index mul } [101 102 103] array2list Maplist ? % [505 [510 [515 null]]] % 5 % This shows that Maplist is stack-invisible! % 5 { 1 index mul } Nil Maplist ? should show 5 nil /Copylist { % inlist >> outlist % but doesn't copy the string objects, just their pointers dup Pair? not { pop Nil } { dup Car null Cons dup % outhead 3 -1 roll Cdr { % At each iteration start: Outcell-prev Incell dup Cdr Pair? not { Car null Cons Setcdr % >> Outhead last } if dup Car null Cons x Cdr 1 index 4 2 roll Setcdr x } loop } ifelse } def %~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ /iLambdaEnv 2 def /iLambdaVarnames 3 def /iLambdaCodetree 4 def /iLambdaExtras 5 def /_ApplyExtendEnv { % ProcedureObj Arguments >> LambdaObj NewEnv % TODO: assert that the iLambdaVarnames and Arguments have the same length % Add a new frame to the env: 10 dict dup 3 index iLambdaEnv get Cons x % Add new bindings 3 -1 roll 3 index iLambdaVarnames get { dup Nil eq { pop pop pop last } if % Loop ends only when we've run out of vars to bind 1 index Nil eq { x pop Nil Nil Cons x } if % We ran out of values but not vars. Pad! 2 index 1 index Car 3 index Car put Cdr x Cdr x } loop }! /Apply { % ProcedureObj Arguments % Note that it doesn't need an env! 1 index xcheck { x exec } % It's a primitive, yay! { % It's a "compound-procedure" (i.e., one calling for variable-bindings) _ApplyExtendEnv false % initial value 2 index iLambdaCodetree get { %(POPPING: ) == x == (\n) == x pop % toss out the previous value 1 index Eval % and compute a new one } x Dolist % TODO: rewrite this (for speed) to not use Dolist x pop x pop % Tossing out the env and lambda obj, leaving the final value. } ifelse }! % TODO: make (define (x y z) ...) work to call lambda and then set! on it % Notes: clear [ [ /lambda [/foo /bar /baz]L 123 1123 11123 ]L 456 789 901 ] Le { [/lambda [/foo /bar /baz]L [/+ 10000 /foo]L ]Le isLambda } assert_later { [ [/lambda [/foo /bar /baz]L [/+ 10000 /foo]L ]L 456 789 901 ] Le % Arguments 10456 eq } assert_later { [ [/lambda [/foo /bar /baz]L [/+ 10000 /foo]L [/+ 20000 /foo]L ]L 456 789 901 ] Le % Arguments 20456 eq } assert_later { [ [ /lambda [/foo /bar /baz]L [/set! /foo 60001]L [/+ 20000 /foo]L ]L 456 789 901 ]Le 80001 eq } assert_later { [ [ /lambda [/foo /bar /baz]L [/set! /foo 60001]L [/+ 20000 /foo]L ]L 456 789 901 ]Le pop root_frame /foo known not % make sure the narrower frame's x hasn't mutated the higher one's. } assert_later % Now make sure that the shadowing works: { [ [ /lambda [/pi]L % making sure that pi in the narrower frame isn't pi in the larger one [/set! /pi 60001]L [/+ 20000 /pi]L ]L 456 ]Le 80001 eq } assert_later { [ [ /lambda [/foo]L [/set! /foo 60001]L /pi % making sure that we can still access the wider-frame pi ]L 456 ]Le Pi eq } assert_later { [ [ /lambda [/foo]L [/set! /foo 60001]L [/set! /pi [/+ 1 /pi]L]L % making sure that we can still change the wider-frame pi ]L 456 ]Le Pi add1 sub abs .01 lt % i.e., approx-eq } assert_later { root_frame /pi get Pi add1 eq } assert_later { % Revert pi %[/set! /pi [/- /pi 1 ]L]Le [/set! /pi Pi ]Le Pi %sub abs .01 lt % i.e., approx-eq eq } assert_later /Application { % Env Exp >> retval {1 index Eval} x Maplist x pop % evaluate each item dup Car x Cdr % operator argslist Apply }! /Eval { % Exp Env >> value (yes, Exp Env, even tho all else is Env Exp) /Eval [/Exp /Env] 2 let 50 skreeth-debug-level le { (To eval: ) print Exp === } if {% this loop is here just so we can use 'last' to break out. Exp Nil eq { Nil last } if ( It's not nil...) 51 trace % evaluating nil is a semi-special case Exp Self-evaluating? { Exp last } if ( It's not self-evaluating...) 51 trace Exp Variable? { Env Exp get_var last } if ( It's not a variable...) 51 trace Exp Pair? not { (Unevaluable ) print Exp === last } if ( It's a pair...) 51 trace Exp Special-form? { Env Exp Handle-special-form last } if ( It's not a special form, so we'll apply it...) 51 trace % Otherwise: Env Exp Application last } loop /Eval unlet }def (Tests for eval:) assertnote {Nil root_env Eval Nil eq } assert {123 root_env Eval 123 eq } assert {/pi root_env Eval Pi eq } assert {[/quote [(pies) Nil ]] root_env Eval (pies) eq } assert {[/quote [/pies Nil ]] root_env Eval /pies eq } assert ( Defining and setting variables... ) assertnote {[/set! [/pi [4 Nil]]] root_env Eval 4 eq } assert { /pi root_env Eval 4 eq } assert {[/set! [/pi [(pies) Nil]]] root_env Eval (pies) eq } assert { /pi root_env Eval (pies) eq } assert {[/set! [/pi [Pi Nil]]] root_env Eval Pi eq } assert /false 345 $ % Make sure "$" works. {[/define[/true [123 Nil]]] root_env Eval 123 eq } assert { /true root_env Eval 123 eq } assert {root_frame /false known } assert {root_frame /false get 345 eq } assert {root_frame /true known } assert {root_frame /true get 123 eq } assert % Now set true and false to sane values: {[/set! [/true [true Nil]]] root_env Eval true eq } assert { /true root_env Eval true eq } assert {[/set! [/false [false Nil]]] root_env Eval false eq } assert { /false root_env Eval false eq } assert {[/set! [/nil [Nil Nil]]] root_env Eval Nil eq } assert { /nil root_env Eval Nil eq } assert %~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ % We use fancy objects in cases where there's no native PostScript % type that we can use. /Fanciness (SpecialObj) 1 packedarray def % That's our "this is a funky data type" flag To wit: /isFancy { % Fancy objects are ones of the form: % * A packedarray of size 2+ whose element 0 is the fanciness flag. % * Element 1 should be a symbol expressing the extended type. dup type tPackedarray eq { dup length 1 gt { 0 get Fanciness eq } { pop false } % It's a packed array but, oddly, it's too small ifelse } { pop false } % It's not a packed array. ifelse }! /Char2int { 2 get }! % TODO: assert that it's a char? /MakeChar % charint >> charobj { Fanciness /Char 3 -1 roll 3 packedarray }! /MakeVector % n >> make a vector of size N { Fanciness /Vector 3 -1 roll array 3 packedarray }! /IsFancyOfKind % obj kind >> boolean { 1 index isFancy { x 1 get eq } { pop pop false } ifelse }! % TODO: the lambda maker /lambda { % Env Exp >> new-lambda-obj Cdr % toss out the actual "lambda" part dup Car x Cdr 10 dict % for extra stuff. TODO: store line number here Fanciness /Lambda 6 2 roll 6 packedarray % Structure of a lambda: % [ % 0: Specialness obj % 1: /Lambda % 2: an environment object (list of frames) % 3: list of variable names % 4: codetree (list of exprs to eval) % 5: the extra-stuff dictionary % ] } defspecial /isChar { /Char IsFancyOfKind }! /isVector { /Vector IsFancyOfKind }! /isLambda { /Lambda IsFancyOfKind }! { Fanciness (SpecialObj) 1 packedarray eq not } assert { 123 isFancy not } assert { [] isFancy not } assert { [1 2 3] isFancy not } assert { 123 MakeChar isFancy } assert { 123 MakeChar isChar } assert { 123 MakeChar isVector not } assert { 8 MakeVector isFancy } assert { 8 MakeVector isVector } assert { 8 MakeVector isChar not } assert %~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ % TODO: a cond that uses 'bury'? % TODO: kill all unused routines % TODO: words % str - array of words % a 'nextword' obj? % other things: look in mushman-2.008/man2x3 % What does s s copy s do? /E { root_env Eval === } def % = shortcut for "eval this in the root env and show it" %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Primitives... % All called with argument list as the only parameter, which they must consume. % All should, in turn, leave one value as the return value % ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ % First some dumb math things /+ { 0 { add } 3 -1 roll Dolist } $ { [/+ ]Le 0 eq } assert { [/+ 45 ]Le 45 eq } assert { [/+ 45 10 ]Le 55 eq } assert { [/+ 45 10 -9 ]Le 46 eq } assert /* { 1 { mul } 3 -1 roll Dolist } $ { [/* ]Le 1 eq } assert { [/* 45 10 ]Le 450 eq } assert { [/* 45 10 -9 ]Le -4050 eq } assert /1+ { Car add1 } $ { [/1+ 45 ]Le 46 eq } assert /1- { Car sub1 } $ { [/1- 45 ]Le 44 eq } assert /- { dup Cdr Pair? { % n-arg form dup Car x Cdr { % at every loop entry: runningtotal currentcell | dup Pair? not {pop last} if dup Car x Cdr 3 1 roll sub x } loop } { % one-arg special-case: just negate it Car neg } ifelse } $ { [/- 45 ]Le -45 eq } assert { [/- 45 32 ]Le 13 eq } assert { [/- 45 32 10 ]Le 3 eq } assert /DIV (/) cvn def % because "//" doesn't work as expected. DIV { dup Cdr Pair? { % n-arg form dup Car x Cdr { % at every loop entry: runningtotal currentcell | dup Pair? not {pop last} if dup Car x Cdr 3 1 roll div x } loop } { % one-arg special-case: get the reciprocal Car 1 x div } ifelse } $ {[DIV 2 ]Le .5 eq } assert {[DIV 123 1]Le 123 eq } assert {[DIV 123 10]Le 12.3 eq } assert {[DIV 123 10 4]Le 3.075 eq } assert /abs { Car abs } $ {[/abs 12.4 ]Le 12.4 eq } assert {[/abs -12.4 ]Le 12.4 eq } assert {[/abs 0 ]Le 0 eq } assert /even? { Car 2 div dup truncate eq } $ /odd? { Car 1 add 2 div dup truncate eq } $ /positive? { Car 0 gt } $ /negative? { Car 0 lt } $ /zero? { Car 0 eq } $ %TODO: tests for the above %TODO: the more forgiving type-testers integer? etc %TODO: make assertion-routines for SomeArgs, OneArg, OneOrMoreArgs, TwoArgs, etc % ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ /exit { clear stop } $ % nonlocally exits the program % untestable /print-one-string { Car dup print }$ %{ [/print-one-string (Guh) ] L (Guh) eq } assert /realtime { pop realtime } $ /usertime { pop usertime } $ /list { Copylist } $ /random-fraction { pop rand 16#7FFFFFFF div } $ /true? { Car True? } $ %~~~~~~ % % TODO from elisp: % nthcdr ( = Scheme list-tail, I think) % nth ( = Scheme list-ref, I think) % car-safe, cdr-safe % caar cdar, etc % last % safe-length % butlast nbutlast % push append reverse remq memq delq % % TODO from CL: % first ... ninth % "the" from Common%20Lisp%20The%20Language/HTML/clm/node106.html % % TODO from Scheme: % eqv? eq? equal? % caar cadr .. cddar cdddr (all 28 of them) % length append reverse % number? real? integer? % min max = < > <= >= % quotient remainder modulo gcd lcm % exp log sin cos tan asin acos % atan x or atan y x % sqrt expt % number2string % string2number % floor ceiling truncate round % "Scheme distinguishes both #f and the empty list from the symbol nil." % i.e., 'nil is just a symbol ref. but nil is the var whose value is.... nil ? % % any Scheme value can be used as a boolean value for the purpose of a % conditional test. As explained in section 6.3.1, all values count as % true in such a test except for #f. This report uses the word ``true'' % to refer to any Scheme value except #f, and the word ``false'' to % refer to #f. % Wait... the empty list is true?! % % not boolean? % set-cdr! => setcdr % set-car! => setcar % null? list? pair? % memq memv member % assq assv assoc % symbol? % string2symbol % char=? char? char<=? char>=? % char-ci=? char-ci? char-ci<=? char-ci>=? % char-alphabetic? char-numeric? char-whitespace? char-upper-case? char-lower-case? % integer2char char2integer % char-upcase char-downcase % string? make-string string string-length string-ref string-set! % string=? string-ci=? % string? string<=? string>=? string-ci? % string-ci<=? string-ci>=? % substring string-append string2list list2string string-copy string-fill! % vector? % make-vector vector-length vector-ref vector-set! vector2list list2vector % vector-fill! % % %Misc... % procedure? apply for-each map % null-environment %maybe % interaction-environment %maybe % call-with-input-file call-with-output-file % input-port? output-port? % current-input-port current-output-port % with-input-from-file with-output-to-file % open-input-file open-output-file % close-input-port close-output-port read read-char peek-char % eof-object? char-ready? write display newline write-char % load transcript-on transcript-off % % %--------------------------------------------------------------------------- /skreeth_source currentfile def /skreeth_source_index 0 def /skreeth_source_char_waiting null def /EOF 256 def /skreeth_set_source { % source > - /skreeth_source_char_waiting null def /skreeth_source_index 0 def /skreeth_source x def }! /_tokv_is_printable new_char_table def % characters that are printable 32 1 255 { _tokv_is_printable x true put } for _tokv_is_printable 127 false put % exception is the Del character /_tokv_is_printable pack_its_array /chrnum2parensy_maybe { % num > str dup _tokv_is_printable x get { chr (\)) @ ( \() x @ } { pop () } ifelse }! /Ungetc { % charnum >> - null skreeth_source_char_waiting ne { num2string (But I can't unget ) x @ ( because ) @ skreeth_source_char_waiting num2string @ ( is already in waiting!) @ die } { skreeth-debug-level 4 ge { dup dup chrnum2parensy_maybe x num2string ( Ungetting ) x @ x @ 4 trace } if /skreeth_source_char_waiting x def } ifelse }! /Getc { % - >> charnum % Get a character from the current skreeth_source null skreeth_source_char_waiting ne { skreeth_source_char_waiting /skreeth_source_char_waiting null def } { % No char is waiting, so actually do a get skreeth_source dup type /filetype eq { ( Getc: Input is a file...) 11 trace % Source is a FH read pstack not { ( Getc: file-source is EOF) 11 trace EOF } if } { ( Getc: Input isn't a file...) 11 trace dup type /stringtype eq { ( Getc: Source is a string.) 11 trace skreeth_source_index dup 2 index length ge { ( Getc: We've exhausted this source) 11 trace pop pop EOF } { skreeth-debug-level 11 ge { dup num2string ( Getc: Getting char at index ) x @ 11 trace } if get /skreeth_source_index ++ } ifelse } { % I guess the source is null! pop EOF } ifelse } ifelse } ifelse skreeth-debug-level 11 ge { dup dup chrnum2parensy_maybe x num2string ( Getc: Returning ) x @ x @ 4 trace } if }! /ReadDie { % TODO: make this report the line number, etc die } ! % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - % Now the parse-level routines. /_tok_am_quoting false def /_tok_am_quoting_true { /_tok_am_quoting true store }! /_tok_am_quoting_false { /_tok_am_quoting false store }! /Reset_Open { % pointers of what parens-levels are open and where /Open Nil def _tok_am_quoting_false % TODO set_eof_false }! /Set_Root { % set the given value to be the root any >> - % (It could be a cell, or could be just a non-cell value) [ x ] /Open x def }! /Am_At_Root { Open Nil eq { true } { Open length 1 eq } ifelse }! /get_parentstate { Open 2 get } def % - >> val /get_grandparentstate { Open 2 get 2 get } def % - >> val /set_parentstate { Open 2 3 -1 roll put } def % val >> - /AddItem { % item >> - Am_At_Root { (TokParse: Setroot!) 9 trace Set_Root } { (TokParse: Appending to a list) 1 trace % Normal case: we're appending to a list Nil Cons dup % make a new cell Open 0 get Open 1 get 4 -1 roll put % Replace the current nil with this new cell Open 0 3 -1 roll put % Set this new cell to be the current nil-container Open 1 1 put % And note the index of the nil in it } ifelse }! /OpenParens { % - >> - Am_At_Root { (TokParse: Rooty OpenParens) 9 trace Nil AddItem /Open [ Open 0 Open ] def } { (TokParse: NonRooty OpenParens) 9 trace Nil AddItem /Open [ Open 0 get 0 Open ] def } ifelse _tok_am_quoting { _tok_am_quoting_false % Otherwise we get stuck in a poo loop /quote AddItem OpenParens get_grandparentstate set_parentstate % So that the ) on '(...) will act like )) for (quote (...)) } if }! /CloseParens { % - >> - (TokParse: ClosingParens) 9 trace Am_At_Root { (Misbalance: \) when at root-level!) ReadDie } if % Sanity /Open get_parentstate def % Normal case }! % Open can be: % Nil - Root not yet seen % [ Obj ] - This object is the root % Or: [ % Nonroot: % Nil %0: the cell containing the current list's Nil (or Nil if we're root) % 0 %1: that Nil's index in that container % false %2: parentstate. false = top level, unpoppable % ] % - - - - - - - - - - - - - - - - - - - - - - - - - /_tokv_is_ws new_char_table def % characters that are WS (\n\r\f\t ) { _tokv_is_ws x true put } forall /_tokv_is_ws pack_its_array /AnyWhitespace { % consume whitespace - >> - { Getc dup _tokv_is_ws x get not { Ungetc last } if pop } loop }! /_tok_whitespace { pop (TOK: whitespace) 9 trace AnyWhitespace % Just tosses out the WS seq }! /_tokv_is_comment_ender new_char_table def % characters that are WS (\n\r\f) { _tokv_is_comment_ender x true put } forall _tokv_is_comment_ender EOF true put /_tokv_is_comment_ender pack_its_array /_tok_comment { pop (TOK: comment-starting ";") 9 trace { Getc dup _tokv_is_comment_ender x get { Ungetc last } if pop } loop % Just tosses out the ;-etc seq }! % - - - - - - - - - - - - - - - - - - - - - - - - - /_tok_open_parens { pop (TOK: Open-parens) 9 trace OpenParens }! /_tok_close_parens { pop (TOK: Close-parens) 9 trace CloseParens }! /_tok_q { pop (TOK: Setting '-mode for next real token) 9 trace _tok_am_quoting_true % yup, we do it all with a flag }! % - - - - - - - - - - - - - - - - - - - - - - - - - /_tok_eof { pop (TOK: EOF) 9 trace _tok_am_quoting_false % TODO: bitch unless am at root last % TODO: replace with a set_eof_true }! % - - - - - - - - - - - - - - - - - - - - - - - - - /_tokv_quote_bs new_char_table def % Maps characters (by num) to what they mean when backslashed in a "...". 0 1 255 { _tokv_quote_bs x dup put } for % The five magics: _tokv_quote_bs (n) ord (\n) ord put _tokv_quote_bs (r) ord (\r) ord put _tokv_quote_bs (t) ord (\t) ord put _tokv_quote_bs (b) ord (\b) ord put _tokv_quote_bs (f) ord (\f) ord put /_tokv_quote_bs pack_its_array /_tok_qq { (TOK: " start) 9 trace pop _tok_am_quoting_false % So \"foo" just does the same as "foo". () % the string we'll append to { Getc dup 34 eq { pop last } if dup 92 eq { % 92=backslash pop Getc dup EOF eq { (Unterminated "-string!) ReadDie } if dup dup 120 eq x 88 eq or { % \x12 or \X12 TODO pop (X) ord } { dup dup 48 ge x 57 le and { % \123 TODO pop (X) ord } { % \_ _tokv_quote_bs x get } ifelse } ifelse } if str+charnum } loop AddItem ifelse }! % - - - - - - - - - - - - - - - - - - - - - - - - - /_tokv_is_symbol_char new_char_table def 0 1 255 { % (leaving EOF false) _tokv_is_symbol_char x true put } for (\n\r\f\t \(\)\"\') { _tokv_is_symbol_char x false put } forall /_tokv_is_symbol_char pack_its_array /_tok_symbol { (TOK: Symbol-start) 9 trace chr % making it the beginning of our string for this item { Getc dup _tokv_is_symbol_char x get not { Ungetc last } if dup 92 eq { % 92=backslash pop Getc % And leave it (instead) to get appended when we fall thru dup EOF eq { (EOF after backslash in symbol!?) ReadDie } if % sanity } if str+charnum } loop % Convert to a number value if it's an actual number, otherwise symbol dup string2number dup false eq { pop cvn } { x pop } ifelse _tok_am_quoting { % 'foo => (quote foo) _tok_am_quoting_false OpenParens /quote AddItem AddItem CloseParens } { AddItem } ifelse }! % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /_tokv_dispatch1 new_char_table def 0 1 256 { _tokv_dispatch1 x /_tok_symbol load put % that's the default } for _tokv_dispatch1 EOF /_tok_eof load put _tokv_dispatch1 (\)) ord /_tok_close_parens load put _tokv_dispatch1 (\() ord /_tok_open_parens load put % TODO: change first three to increment linenumber count _tokv_dispatch1 (\n) ord /_tok_whitespace load put _tokv_dispatch1 (\r) ord /_tok_whitespace load put _tokv_dispatch1 (\f) ord /_tok_whitespace load put _tokv_dispatch1 (\t) ord /_tok_whitespace load put % TODO maybe track colnum? _tokv_dispatch1 ( ) ord /_tok_whitespace load put _tokv_dispatch1 (;) ord /_tok_comment load put _tokv_dispatch1 (") ord /_tok_qq load put _tokv_dispatch1 (') ord /_tok_q load put /_tokv_dispatch1 pack_its_array /Read { % given a string or a fh 10 dict begin % Right? Reset_Open skreeth_set_source { _tokv_dispatch1 Getc dup 3 1 roll get exec } loop (Read: done.) 9 trace }! % TODO eventually: change all _'s in symbol names to -'s? %~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ run_delayed_assertions (Done checking assertions.) assertnote (Skreeth ready.) 10 trace %~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ % "I'm interested in making something that I don't understand." -- John Cage %End ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~