Category:Initlib: Difference between revisions

From Rosetta Code
Content added Content deleted
No edit summary
Line 51: Line 51:
[ rup [ /dup rdown /exec /not [{pop}] aif ] atox forall ]
[ rup [ /dup rdown /exec /not [{pop}] aif ] atox forall ]
end}.
end}.
/zip {
[ rup {
dup length 0 eq rdown dup length 0 eq rdown or {exit} if
uncons rdown uncons rdown 4 2 roll unit cons rup exch
} loop pop pop ]
}.
% [1 3 5 7] [2 4 6 8] zip
% ifs with stack invariant predicates.
% ifs with stack invariant predicates.
/ift {
/ift {

Revision as of 09:20, 26 March 2011

Library

Here is a library of functions tested in ghostscript. It is assumed to be loaded before startup with a command line such as <lang> ghostscript -q -dNODISPLAY -c '(initlib.ps) run' </lang>

initlib.ps <lang postscript> % given [sym x y z] get sym and [x y z] separately /getname {dup 0 get exch} bind def /getbody {dup length 1 sub 1 exch getinterval} bind def /rup {3 1 roll} bind def /rdown {3 -1 roll} bind def % convenience for binding. /. {bind def} bind def /' {load} bind def % .makeoperator is ghostscript specific. But this gives us lexical binding. /# {exch dup rdown .makeoperator bind def} bind def % A few lispy words /first {0 get}. /car {first}. /!first {dup first}. /rest {dup length 1 sub 1 exch getinterval}. /cdr {rest}. /!rest {dup rest}. /head {dup length 1 sub 0 exch getinterval}. /!head {dup head}. /tail {dup length 1 sub get}. /!tail {dup tail}. /cons {[rup aload pop] }. /tadd {[rup aload length 1 add -1 roll] }. /uncons {getname getbody}. /concat {exch [ rup aload pop counttomark -1 roll aload pop ] }. % higher order /map {

  [ rup forall ]

}. % [1 2 3 4] {1 add} map /fold {rup exch rdown forall}. % [1 2 3 4 5] 1 {add} fold % let requires "end" to denote end of scope /let {dup length dict begin reverse {exch def} forall}. % let* assumes dictionary management is separate. /let* {reverse {exch def} forall}. % [1 2 3 4] 0 {+} fold % name - filter is taken so we are left with.. /find { 4 dict begin

   /aif {0 /get /if}.
   /atox { [ exch cvx {cvx} forall ] cvx}.
   [ rup [ /dup rdown /exec /not [{pop}] aif ] atox forall ]

end}. /zip { [ rup {

    dup length 0 eq rdown dup length 0 eq rdown or {exit} if
    uncons rdown uncons rdown 4 2 roll unit cons rup exch

} loop pop pop ] }. % [1 3 5 7] [2 4 6 8] zip % ifs with stack invariant predicates. /ift {

   4 dict begin
   [/.if /.then] let*
   count array astore /.stack exch def
   /_restore {clear .stack aload pop}.
   .stack aload pop .if {
      _restore .then
   } {
      _restore
   } ifelse

end}. % 2 {1 gt} {=} ift

/ifte {

   4 dict begin
   [/.if /.then /.else] let*
   count array astore /.stack exch def
   /_restore {count array astore pop .stack aload pop}.
   .stack aload pop .if {
      _restore .then
   } {
      _restore .else
   } ifelse

end}. % 1 {2 gt} {3 * =} {2 * =} ifte

/is? {{exit} concat cvx ift}. /cond {{exit} concat cvx loop}. % 100 { {0 eq} {(not-hun) puts} is? {100 eq} {(hundred) puts} is? } cond /apply {exec}. /i {cvx exec}.

% make a unit list. /unit {1 array astore cvx}. /succ {1 add}. /pred {1 sub}. /range {

   [ rup exch aload pop rup exch rdown {} for ]

}. % [0 10] 2 range % combinators /linrec {

   [/.if /.then /.rec /.join] let
   .if {.then} {.rec /.if ' /.then ' /.rec ' /.join ' linrec .  join } ifelse

end}.

% and convenience /reverse {{} {exch cons} fold}. /puts {print (\n) print flush}. /, {(=============\n)

   print pstack
   (=============\n) print}.

% set the prompt /prompt {(>| ) print flush} bind def </lang>