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

Groups > comp.lang.postscript > #3259

Re: Structured Programming in PS

Show all headers | View raw

On Saturday, April 28, 2018 at 10:22:36 AM UTC-5, luser droog wrote:
> On Saturday, April 28, 2018 at 12:40:22 AM UTC-5, luser droog wrote:
> > 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.
> > 
> 
> Slight improvements. Tightened up the formatting a little.
> Added /stackunderflow as a distinct error that a typed
> function may signal. Added %currentfile flushfile to show
> where prologue ends and the script begins.
> 
> 

Got it to use the actual function's name in the call to signalerror
in response to typecheck or stackunderflow, which gave rise to 2
latent bugs. I had misspelled it as /stackundeflow. And since I 
was checking the stack size while there was an array of types AND
the length of that array on the stack, the check should be

  count 2 sub gt

rather than

  count 1 sub gt

. This was revealed by printing the /command field from $error.
The previous stackunderflow error result was a false positive
(or negative).




$ cat struct2.ps
%!
% struct2.ps
% An enhanced PostScript syntax for defining functions with named, type-checked arguments.
% Using @func within a block or other construct using 'pairs' implements a sort of
% compile-time macro expansion of the shorthand function definition.
<<
    /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 }
    /first       { 0 get }            /exec@ {  exch pop rest cvn cvx exec  }
    /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-stack 3 1 roll
                  exch simple-func   compose }
    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-stack { % /name {body} [args] [types-reversed]
        3 index cvlit { cvx /stackunderflow signalerror } curry {pop} exch compose
        /if cvx 2 array astore cvx {check-count} exch compose
        4 index cvlit { cvx /typecheck signalerror } curry
        /if cvx 2 array astore cvx {check-types} exch compose
        compose  %{ check-count { pop /user-function /stackunderflow signalerror } if
                 %  check-types { /user-function /typecheck signalerror } if }
        curry    %  /name {body} [args] {stack-checking}
    }
    check-count { dup length count 2 sub gt }
    check-types { dup length 1 add copy true exch { check-type and } forall exch pop not }
    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 dup 4 2 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 ] }
} pairs-def {
    fortokens {src proc}{
        {   src token { exch /src exch store }{ exit } ifelse   proc   } loop
    } @func
    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 }
} pairs-def

/debug where{pop}{currentfile flushfile}ifelse
{
    - sub + add * mul
    := {exch def}
    += {dup load 3 -1 roll + store}

    var 2 3 @add
    
    f{x y z}{ x  y z +  * } @func

    g(x/integer y/integer){ x y + } @func

    h {a b c}{ a b * c *  end} @func-begin

    j { {a b c}args-begin  a b * c *  end }
    
    main {
        var ==
        [ 1 2 3 4 5 ] { - } rreduce ==
        3 4 5 f ==
        3 4 g =
        { 3.0 4.0   g = } stopped { $error /errorname get =only ( in ) print $error /command get = } if
        { clear  2  g = } stopped { $error /errorname get =only ( in ) print $error /command get = } if
        2 3 4 h =
        3 4 5 j =
        quit
    }

} block




$ gsnd -q -ddebug struct2.ps
5
3
27
7
typecheck in g
stackunderflow in g
24
60

Back to comp.lang.postscript | Previous | Next — Previous in thread | Next 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