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

Groups > comp.lang.postscript > #3256 > unrolled thread

Structured Programming in PS

Back to article view | Back to comp.lang.postscript

Contents

  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

#3256 — Structured Programming in PS

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

[toc] | [next] | [standalone]

#3257

On Saturday, April 28, 2018 at 12:40:22 AM UTC-5, luser droog wrote:
> 
> {
>     - sub + add * mul
>     
>     f{x y z}{ x  y z +  * } @func
> 
[snip]
> 
> } block
> 

The '- sub' etc part is finally making use of the "Name Chains"
idea I posted about some time ago. The value of '+' is the
executable name 'add' which then undergoes additional lookup 
when '+' gets called.

[toc] | [prev] | [next] | [standalone]

#3258

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.


$ 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 }

    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 {
        dup length count 1 sub gt { pop /user-function /stackunderflow signalerror }{
            dup length 1 add copy true exch { check-type and } forall exch pop %pstack()=
            not { /user-function /typecheck signalerror } if
        } ifelse
    }
    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

%currentfile flushfile
{
    - sub + add * mul
    := {exch def}
    += {dup load 3 -1 roll + store}
    
    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 = } stopped { $error /errorname get = } if
        { clear  2  g = } stopped { $error /errorname get = } if
        quit
    }


} block


$ gsnd -q struct2.ps
5
3
27
7
typecheck
stackunderflow

[toc] | [prev] | [next] | [standalone]

#3259

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

[toc] | [prev] | [next] | [standalone]

#3260

On Sunday, April 29, 2018 at 8:49:49 PM UTC-5, luser droog wrote:
> 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).
> 
> 
> 

A few minor revisions, and the result is available for review 
(and comment) at:

https://codereview.stackexchange.com/questions/193520/an-enhanced-syntax-for-defining-functions-in-postscript

[toc] | [prev] | [standalone]

Back to top | Article view | comp.lang.postscript

csiph-web