Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]


Groups > comp.lang.postscript > #3256

Structured Programming in PS

Newsgroups comp.lang.postscript
Date 2018-04-27 22:40 -0700
Message-ID <7553e2f7-26c3-4fef-bc69-3c46a4e8b554@googlegroups.com> (permalink)
Subject Structured Programming in PS
From luser droog <luser.droog@gmail.com>

Show all headers | View raw


I hope to kick off some fun with this nice inflammatory
subject line. Revisiting the ideas from some recent posts,
I decided to combine them all together into a mishmash.

There are 3 layers or strata of definitions which supplement
and/or depend upon the previous layer. But all three together
enable the nice syntax illustrated in the final block.
No multi-dispatch, but a nice syntax for typechecking arguments
IMO.

The first block defines the fundamental notion of 'pairs', ie.
an executable array which is dumped and fed to <<exch>> to
produce a dictionary. 'pairs-begin' does a 'begin' on this 
dictionary, whereas 'pairs-def' instead iterates through
and defines each pair in the current dictionary. 

Any name which begins with @ is treated specially and executed 
when encountered. You can see this with the @add in computing
the value of 'var'.

Since I'm not using dictionary-vs-array to determine what type
of function to build, I chose to use strings for the more 
complex definitions. This required a 'fortokens' control structure
to iterate through the string contents.


$ cat struct2.ps

<<
    /pairs-begin { pairs begin        }
    /pairs-def   { pairs {def} forall }
    /pairs       { << exch explode >> }
    /explode     { { @exec } forall   }
    /@exec       { dup type /nametype eq { exec-if-@ } if }
    /exec-if-@   { dup dup length string cvs dup first (@) first eq { exec@ }{ pop } ifelse }
    /exec@                                    { exch pop rest cvn cvx exec }
    /first       { 0 get }
    /rest        { 1 1 index length 1 sub getinterval }
>> begin 
{
    block { pairs-begin main end }
    func  { 1 index type /stringtype eq { typed-func }{ simple-func } ifelse }

    simple-func { func-begin { end } compose }
    typed-func  { exch args-and-types reverse /check-types load curry 3 1 roll
                  exch simple-func /exec cvx 2 array astore cvx compose  %pstack()=
                }
    func-begin  { exch reverse /args-begin load curry exch compose }
    args-begin  { dup length dict begin { exch def } forall }

    args-and-types { /was_x false def [ exch { each-specifier } fortokens ]
                     pairs dup keys exch values }
    each-specifier { dup xcheck /is_x exch def  is_x was_x and { null exch } if  /was_x is_x def }
    check-types { % [ types ]
        dup length 1 add copy true exch { check-type and } forall exch pop %pstack()=
        not { /user-function /typecheck signalerror } if
    }
    check-type {
        dup null eq { pop pop true }{
            make-type-name 3 -1 roll type eq
        } ifelse
    }
    make-type-name {
        dup length 4 add string dup 3 1 roll dup 3 1 roll cvs
        2 copy 0 exch putinterval length (type) putinterval cvn
    }

    keys   { {      pop } map }
    values { { exch pop } map }
    
    map     { 1 index xcheck 3 1 roll  [ 3 1 roll forall ]  exch {cvx} if }
    reduce  { exch dup first exch rest 3 -1 roll forall }
    rreduce { exch aload length 1 sub dup 3 add -1 roll repeat }
    curry   { [ 3 1 roll {} forall ] cvx }
    compose { 2 array astore cvx { {} forall } map }
    reverse { [ exch dup length 1 sub -1 0 { 2 copy get 3 1 roll pop } for pop ] }

    var 2 3 @add
} pairs-def
{
    fortuple {a n p}{
        0  n  /a load length 1 sub
        { /a exch /n getinterval /p exec } { load-if-literal-name } map
        end for
    } @func-begin

    load-if-literal-name { dup type /nametype eq 1 index xcheck not and { load } if }

    fortokens {src proc}{
        {
            src token { exch /src exch store }{ exit } ifelse
            proc
        } loop
    } @func
} pairs-def

{
    - sub + add * mul
    
    f{x y z}{ x  y z +  * } @func

    g(x/integer y/integer){ x y + } @func
    
    main {
        var ==
        [ 1 2 3 4 5 ] { - } rreduce ==
        3 4 5 f ==
        3 4 g =
        3.0 4.0 g =
        quit
    }


} block


$ gsnd -q struct2.ps
5
3
27
7
Error: /typecheck in /user-function
Operand stack:
   3.0   4.0
Execution stack:
   %interp_exit   .runexec2   --nostringval--   --nostringval--   --nostringval--   2   %stopped_push   --nostringval--   --nostringval--   --nostringval--   false   1   %stopped_push   2015   1   3   %oparray_pop   2014   1   3   %oparray_pop   1998   1   3   %oparray_pop   1884   1   3   %oparray_pop   --nostringval--   %errorexec_pop   .runexec2   --nostringval--   --nostringval--   --nostringval--   2   %stopped_push   --nostringval--   --nostringval--   --nostringval--   --nostringval--
Dictionary stack:
   --dict:984/1684(ro)(G)--   --dict:0/20(G)--   --dict:78/200(L)--   --dict:33/58(L)--   --dict:6/6(L)--
Current allocation mode is local
Current file position is 2609
GPL Ghostscript 9.22: Unrecoverable error, exit code 1

Back to comp.lang.postscript | Previous | NextNext in thread | Find similar


Thread

Structured Programming in PS luser droog <luser.droog@gmail.com> - 2018-04-27 22:40 -0700
  Re: Structured Programming in PS luser droog <luser.droog@gmail.com> - 2018-04-28 07:44 -0700
  Re: Structured Programming in PS luser droog <luser.droog@gmail.com> - 2018-04-28 08:22 -0700
    Re: Structured Programming in PS luser droog <luser.droog@gmail.com> - 2018-04-29 18:49 -0700
      Re: Structured Programming in PS luser droog <luser.droog@gmail.com> - 2018-05-02 18:38 -0700

csiph-web