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


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

Parser combinators

Started byluser droog <luser.droog@gmail.com>
First post2017-05-28 21:22 -0700
Last post2017-06-15 13:36 -0700
Articles 17 — 2 participants

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


Contents

  Parser combinators luser droog <luser.droog@gmail.com> - 2017-05-28 21:22 -0700
    Re: Parser combinators luser droog <luser.droog@gmail.com> - 2017-06-03 15:15 -0700
      Re: Parser combinators luser droog <luser.droog@gmail.com> - 2017-06-04 11:13 -0700
        Re: Parser combinators luser droog <luser.droog@gmail.com> - 2017-06-04 18:57 -0700
          Re: Parser combinators luser droog <luser.droog@gmail.com> - 2017-06-04 19:39 -0700
            Re: Parser combinators luser droog <luser.droog@gmail.com> - 2017-06-06 23:38 -0700
              Re: Parser combinators luser droog <luser.droog@gmail.com> - 2017-06-08 22:18 -0700
                Re: Parser combinators luser droog <luser.droog@gmail.com> - 2017-06-09 14:54 -0700
                  Re: Parser combinators luser droog <luser.droog@gmail.com> - 2017-06-10 23:36 -0700
                    Re: Parser combinators luser droog <luser.droog@gmail.com> - 2017-06-12 21:19 -0700
                      Re: Parser combinators Carlos <carlos@cvkm.cz> - 2017-06-13 07:40 +0200
                        Re: Parser combinators luser droog <luser.droog@gmail.com> - 2017-06-13 01:53 -0700
                          Re: Parser combinators luser droog <luser.droog@gmail.com> - 2017-06-13 03:48 -0700
                            Re: Parser combinators luser droog <luser.droog@gmail.com> - 2017-06-13 04:22 -0700
                              Re: Parser combinators luser droog <luser.droog@gmail.com> - 2017-06-13 23:28 -0700
                                Re: Parser combinators Carlos <carlos@cvkm.cz> - 2017-06-14 21:52 +0200
                                  Re: Parser combinators luser droog <luser.droog@gmail.com> - 2017-06-15 13:36 -0700

#3102 — Parser combinators

Fromluser droog <luser.droog@gmail.com>
Date2017-05-28 21:22 -0700
SubjectParser combinators
Message-ID<8ebd95de-c888-458c-9597-9418988a940a@googlegroups.com>
cf. https://en.wikipedia.org/wiki/Parser_combinator

$ cat pc.ps

/empty {} def

/term {         % x => { x term-body } -> [ i+1 | ]
    /term-body cvx 2 array astore cvx
} def

/term-body {    % str i x  -> [ i+1 | ]
    3 1 roll  1 index length  1 index  le { pop pop pop [] }{   % x str i
        2 copy  4 index length  getinterval     % x str i s[i #x]
        3 index  eq {                           % x str i
            3 2 roll length add  exch pop       % i+1
            1 array astore
        }{      % x str i
            pop pop pop []
        } ifelse
    } ifelse
} def

/comb {  2 array astore [ exch  { {}forall } forall ]  } def
/stuf {  [ 3 1 roll  {}forall ]  } def

[ 1 2 3 ] [ 4 5 6 ] comb ==

/alt {          % p1 p2 => { 2 copy p1 3 1 roll p2 comb }
    { 2 copy } 3 2 roll comb    % p2 { 2 copy p1 }
    { 3 1 roll } comb           % p2 { 2 copy p1 3 1 roll }
    exch comb                   % { 2 copy p1 3 1 roll p2 }
    { comb } comb cvx           % } 2 copy p1 3 1 roll p2 comb }
} def

/seq {          % p1 p2 => { 2 copy p1
    { 2 copy } 3 2 roll comb    % p2 { 2 copy p1 }
    { dup length 0 gt } comb    % p2 { 2 copy p1 ... }
    { {} forall add } 3 2 roll comb cvx
    { { pop pop [] } ifelse } stuf comb cvx
} def

(3 )
0

(1) term  (2) term alt  (3) term alt
( ) term seq
dup ==

exec pstack quit


%%-----------snip-------------

Output is:
[2]

indicating it successfully parsed up to position 2 
in the string (3 )

[toc] | [next] | [standalone]


#3104

Fromluser droog <luser.droog@gmail.com>
Date2017-06-03 15:15 -0700
Message-ID<e30c88b0-d059-464b-84bc-a30206c163fd@googlegroups.com>
In reply to#3102
On Sunday, May 28, 2017 at 11:22:09 PM UTC-5, luser droog wrote:
> cf. https://en.wikipedia.org/wiki/Parser_combinator
> 
> $ cat pc.ps

Round 2. Norah is my computer's name.

$ cat pc.ps
%/forall { pstack/ = //forall } def
/empty {} def

/z {   dup   } def
/y { 1 index } def
/x { 2 index } def
/w { 3 index } def
/v { 4 index } def

/yx {      } def
/zy { exch } def

/xyz { } def
/zxy { 3 1 roll } def
/yzx { 3 2 roll } def

/+  {   dup  } def
/++ { 2 copy } def

/term {         % x => { x term-body } -> [ i+1 | ]
    /test-term cvx 2 array astore cvx
} def

/test-term {    % str i x  -> [ i+1 | ]
    zxy  y length  y  le { pop pop pop [] }{    % x str i
        ++  v length  getinterval       % x str i s[i #x]
        w  eq {                         % x str i
            yzx length add  exch pop    % i+1
            1 array astore
        }{      % x str i
            pop pop pop []
        } ifelse
    } ifelse
} def

/combine {  2 array astore [ zy  { {}forall } forall ]  } def
/curry {  [ zxy  {}forall ]  } def

{
    [ 1 2 3 ] [ 4 5 6 ] combine ==
} pop

/alt {          % p1 p2 => { 2 copy p1 3 1 roll p2 combine }
    dup type /nulltype eq {
        pop {}
    }{
        { 2 copy } 3 2 roll combine     % p2 { 2 copy p1 }
        { 3 1 roll } combine            % p2 { 2 copy p1 3 1 roll }
        exch combine                    % { 2 copy p1 3 1 roll p2 }
        { combine } combine cvx         % } 2 copy p1 3 1 roll p2 combine }
    } ifelse
} def

/seq {          % p1 p2 => { 2 copy p1
    { 2 copy } 3 2 roll combine % p2 { 2 copy p1 }
    { dup length 0 gt } combine % p2 { 2 copy p1 ... }
    { {} forall add } 3 2 roll combine cvx
    { { pop pop [] } ifelse } curry combine cvx
} def


/map { [ 3 1 roll  forall  ] } def

/reduce {       % arr oroc
    1 index 0 get       % arr proc arr_0
    3 1 roll exch       % arr_0 proc arr
    1 1 index length 1 sub getinterval  % arr_0 proc arr[1..#arr-1]
    exch  forall
} def


{
(3 )
0

%(1) term  (2) term alt  (3) term alt
%( ) term seq

[(1) (2) (3)] {term} map {alt} reduce
( ) term seq
dup ==

exec pstack quit
} pop


/build-parser {
    dup type /arraytype  eq {   {build-parser} map  {seq} reduce    }{
    dup type /stringtype eq {   term    }{
    dup type /dicttype   eq {   {} map  { fixup } map  {build-parser} map  {alt} reduce     }{
    dup type /nulltype   eq {       }{
          } ifelse
        } ifelse
      } ifelse
    } ifelse
} def

/fixup {
    dup type /nulltype eq {    pop    }{
    dup type /nametype eq { to-string }{
      } ifelse
    } ifelse
} def

/to-string {
    dup length string cvs
} def

%(hello)


%(12) 0
%[ (1) << (2) (3) >> ]  build-parser

%(1) 0
%<< (1) null >> build-parser

(Hello)
0
[ << (H) (h) >> (e) (l) (l) (o) ] build-parser

pstack/ = exec pstack quit

Norah@laptop ~
$ gsnd -q pc.ps
{2 copy 2 copy 2 copy 2 copy 2 copy (H) test-term 3 1 roll (h) test-term combine dup length 0 gt {{} forall add (e) test-term} {pop pop [ ]} ifelse dup length 0 gt {{} forall add (l) test-term} {pop pop [ ]} ifelse dup length 0 gt {{} forall add (l) test-term} {pop pop [ ]} ifelse dup length 0 gt {{} forall add (o) test-term} {pop pop [ ]} ifelse}
0
(Hello)

[5]

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


#3105

Fromluser droog <luser.droog@gmail.com>
Date2017-06-04 11:13 -0700
Message-ID<eaa60376-161d-4a80-9b8f-9d2c431bd757@googlegroups.com>
In reply to#3104
On Saturday, June 3, 2017 at 5:15:48 PM UTC-5, luser droog wrote:
> On Sunday, May 28, 2017 at 11:22:09 PM UTC-5, luser droog wrote:
> > cf. https://en.wikipedia.org/wiki/Parser_combinator
> > 
> > $ cat pc.ps
> 
> Round 2. Norah is my computer's name.
> 
> $ cat pc.ps

Getting pretty crazy now, and torturous to debug.
But I think I got all the big bugs now.

There's no golfing competition for this that I'm aware of,
but my instinct was to tighten it up.

Norah@laptop ~
$ cat pc2.ps
%/forall { pstack/ = //forall } def
<<
    /z { dup }  /+ { z }  /++ { 2 copy }  /_ { pop } /# { length }
    /y { 1 index }  /zy { exch }       /| { array astore }
    /x { 2 index }  /yzx { 3 2 roll }  /? { ifelse }
    /w { 3 index }  /zxy { 3 1 roll }  /@ { forall }
    /v { 4 index }  /zyx { zxy zy }    /... { getinterval }

    /curry { [ zxy {} @ ] }            /&  { curry }
    /combine { 2 | [ zy { {} @ } @ ] } /&& { combine }
    /map { [ zxy @ ] }  /reduce { y 0 get zyx 1 y # 1 sub ... zy @ }

    /test { zxy y # y le    { _ _ _ []           }{
            ++ v # ... w eq { yzx # add zy _ 1 | }{
                _ _ _ []
            }? }? }
    /term { /test cvx 2 | cvx }
    /alt { {++} yzx && {z # 0 eq} && { _     } yzx && cvx {{zy _ zy _}?} & && cvx }
    /seq { {++} yzx && {z # 0 gt} && {{}@ add} yzx && cvx {{_ _ _ []}? } & && cvx }
    
    /build-parser { 
        z type /stringtype eq {                     term                           }{
        z type /arraytype  eq {                    {build-parser} map {seq} reduce }{
        z type /dicttype   eq { {} map {fixup} map {build-parser} map {alt} reduce }{
        }? }? }? }
    /fixup {
        z type /nulltype eq { _         }{
        z type /nametype eq { to-string }{
        }? }? }
    /to-string { z # string cvs }
    /ps { pstack/ = } /pq { ps quit }
>>begin

%(123) 0 (123) build-parser exec pq
%(Hello) 0 [ <<(H)(h)>> (e)(l)(l)(o) ] build-parser exec pq


/digit   << (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) >> def
/alpha   << (a) (b) (c) (d) (e) (f) (g) (h) (i) (j) (k) (l) (m)
            (n) (o) (p) (q) (r) (s) (t) (u) (v) (w) (x) (y) (z)
            (A) (B) (C) (D) (E) (F) (G) (H) (I) (J) (K) (L) (M)
            (N) (O) (P) (Q) (R) (S) (T) (U) (V) (W) (X) (Y) (Z) >> def
/medial <<//digit //alpha>> def

/id [ //alpha //medial //medial ] build-parser def

(X23) 0 //id ps exec pq

Norah@laptop ~
$ gsnd -q pc2.ps
{++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ (W) test z # 0 eq {_ (X) test} {zy _ zy _} ? z # 0 eq {_ (w) test} {zy _ zy _} ? z # 0 eq {_ (x) test} {zy _ zy _} ? z # 0 eq {_ (I) test} {zy _ zy _} ? z # 0 eq {_ (J) test} {zy _ zy _} ? z # 0 eq {_ (i) test} {zy _ zy _} ? z # 0 eq {_ (j) test} {zy _ zy _} ? z # 0 eq {_ (M) test} {zy _ zy _} ? z # 0 eq {_ (N) test} {zy _ zy _} ? z # 0 eq {_ (m) test} {zy _ zy _} ? z # 0 eq {_ (n) test} {zy _ zy _} ? z # 0 eq {_ (Q) test} {zy _ zy _} ? z # 0 eq {_ (R) test} {zy _ zy _} ? z # 0 eq {_ (q) test} {zy _ zy _} ? z # 0 eq {_ (r) test} {zy _ zy _} ? z # 0 eq {_ (C) test} {zy _ zy _} ? z # 0 eq {_ (D) test} {zy _ zy _} ? z # 0 eq {_ (c) test} {zy _ zy _} ? z # 0 eq {_ (d) test} {zy _ zy _} ? z # 0 eq {_ (U) test} {zy _ zy _} ? z # 0 eq {_ (V) test} {zy _ zy _} ? z # 0 eq {_ (u) test} {zy _ zy _} ? z # 0 eq {_ (v) test} {zy _ zy _} ? z # 0 eq {_ (G) test} {zy _ zy _} ? z # 0 eq {_ (H) test} {zy _ zy _} ? z # 0 eq {_ (g) test} {zy _ zy _} ? z # 0 eq {_ (h) test} {zy _ zy _} ? z # 0 eq {_ (Y) test} {zy _ zy _} ? z # 0 eq {_ (Z) test} {zy _ zy _} ? z # 0 eq {_ (y) test} {zy _ zy _} ? z # 0 eq {_ (z) test} {zy _ zy _} ? z # 0 eq {_ (K) test} {zy _ zy _} ? z # 0 eq {_ (L) test} {zy _ zy _} ? z # 0 eq {_ (k) test} {zy _ zy _} ? z # 0 eq {_ (l) test} {zy _ zy _} ? z # 0 eq {_ (O) test} {zy _ zy _} ? z # 0 eq {_ (P) test} {zy _ zy _} ? z # 0 eq {_ (o) test} {zy _ zy _} ? z # 0 eq {_ (p) test} {zy _ zy _} ? z # 0 eq {_ (A) test} {zy _ zy _} ? z # 0 eq {_ (B) test} {zy _ zy _} ? z # 0 eq {_ (a) test} {zy _ zy _} ? z # 0 eq {_ (b) test} {zy _ zy _} ? z # 0 eq {_ (S) test} {zy _ zy _} ? z # 0 eq {_ (T) test} {zy _ zy _} ? z # 0 eq {_ (s) test} {zy _ zy _} ? z # 0 eq {_ (t) test} {zy _ zy _} ? z # 0 eq {_ (E) test} {zy _ zy _} ? z # 0 eq {_ (F) test} {zy _ zy _} ? z # 0 eq {_ (e) test} {zy _ zy _} ? z # 0 eq {_ (f) test} {zy _ zy _} ? z # 0 gt {{} @ add ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ (8) test z # 0 eq {_ (9) test} {zy _ zy _} ? z # 0 eq {_ (0) test} {zy _ zy _} ? z # 0 eq {_ (1) test} {zy _ zy _} ? z # 0 eq {_ (2) test} {zy _ zy _} ? z # 0 eq {_ (3) test} {zy _ zy _} ? z # 0 eq {_ (4) test} {zy _ zy _} ? z # 0 eq {_ (5) test} {zy _ zy _} ? z # 0 eq {_ (6) test} {zy _ zy _} ? z # 0 eq {_ (7) test} {zy _ zy _} ? z # 0 eq {_ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ (W) test z # 0 eq {_ (X) test} {zy _ zy _} ? z # 0 eq {_ (w) test} {zy _ zy _} ? z # 0 eq {_ (x) test} {zy _ zy _} ? z # 0 eq {_ (I) test} {zy _ zy _} ? z # 0 eq {_ (J) test} {zy _ zy _} ? z # 0 eq {_ (i) test} {zy _ zy _} ? z # 0 eq {_ (j) test} {zy _ zy _} ? z # 0 eq {_ (M) test} {zy _ zy _} ? z # 0 eq {_ (N) test} {zy _ zy _} ? z # 0 eq {_ (m) test} {zy _ zy _} ? z # 0 eq {_ (n) test} {zy _ zy _} ? z # 0 eq {_ (Q) test} {zy _ zy _} ? z # 0 eq {_ (R) test} {zy _ zy _} ? z # 0 eq {_ (q) test} {zy _ zy _} ? z # 0 eq {_ (r) test} {zy _ zy _} ? z # 0 eq {_ (C) test} {zy _ zy _} ? z # 0 eq {_ (D) test} {zy _ zy _} ? z # 0 eq {_ (c) test} {zy _ zy _} ? z # 0 eq {_ (d) test} {zy _ zy _} ? z # 0 eq {_ (U) test} {zy _ zy _} ? z # 0 eq {_ (V) test} {zy _ zy _} ? z # 0 eq {_ (u) test} {zy _ zy _} ? z # 0 eq {_ (v) test} {zy _ zy _} ? z # 0 eq {_ (G) test} {zy _ zy _} ? z # 0 eq {_ (H) test} {zy _ zy _} ? z # 0 eq {_ (g) test} {zy _ zy _} ? z # 0 eq {_ (h) test} {zy _ zy _} ? z # 0 eq {_ (Y) test} {zy _ zy _} ? z # 0 eq {_ (Z) test} {zy _ zy _} ? z # 0 eq {_ (y) test} {zy _ zy _} ? z # 0 eq {_ (z) test} {zy _ zy _} ? z # 0 eq {_ (K) test} {zy _ zy _} ? z # 0 eq {_ (L) test} {zy _ zy _} ? z # 0 eq {_ (k) test} {zy _ zy _} ? z # 0 eq {_ (l) test} {zy _ zy _} ? z # 0 eq {_ (O) test} {zy _ zy _} ? z # 0 eq {_ (P) test} {zy _ zy _} ? z # 0 eq {_ (o) test} {zy _ zy _} ? z # 0 eq {_ (p) test} {zy _ zy _} ? z # 0 eq {_ (A) test} {zy _ zy _} ? z # 0 eq {_ (B) test} {zy _ zy _} ? z # 0 eq {_ (a) test} {zy _ zy _} ? z # 0 eq {_ (b) test} {zy _ zy _} ? z # 0 eq {_ (S) test} {zy _ zy _} ? z # 0 eq {_ (T) test} {zy _ zy _} ? z # 0 eq {_ (s) test} {zy _ zy _} ? z # 0 eq {_ (t) test} {zy _ zy _} ? z # 0 eq {_ (E) test} {zy _ zy _} ? z # 0 eq {_ (F) test} {zy _ zy _} ? z # 0 eq {_ (e) test} {zy _ zy _} ? z # 0 eq {_ (f) test} {zy _ zy _} ?} {zy _ zy _} ?} {_ _ _ [ ]} ? z # 0 gt {{} @ add ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ (8) test z # 0 eq {_ (9) test} {zy _ zy _} ? z # 0 eq {_ (0) test} {zy _ zy _} ? z # 0 eq {_ (1) test} {zy _ zy _} ? z # 0 eq {_ (2) test} {zy _ zy _} ? z # 0 eq {_ (3) test} {zy _ zy _} ? z # 0 eq {_ (4) test} {zy _ zy _} ? z # 0 eq {_ (5) test} {zy _ zy _} ? z # 0 eq {_ (6) test} {zy _ zy _} ? z # 0 eq {_ (7) test} {zy _ zy _} ? z # 0 eq {_ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ (W) test z # 0 eq {_ (X) test} {zy _ zy _} ? z # 0 eq {_ (w) test} {zy _ zy _} ? z # 0 eq {_ (x) test} {zy _ zy _} ? z # 0 eq {_ (I) test} {zy _ zy _} ? z # 0 eq {_ (J) test} {zy _ zy _} ? z # 0 eq {_ (i) test} {zy _ zy _} ? z # 0 eq {_ (j) test} {zy _ zy _} ? z # 0 eq {_ (M) test} {zy _ zy _} ? z # 0 eq {_ (N) test} {zy _ zy _} ? z # 0 eq {_ (m) test} {zy _ zy _} ? z # 0 eq {_ (n) test} {zy _ zy _} ? z # 0 eq {_ (Q) test} {zy _ zy _} ? z # 0 eq {_ (R) test} {zy _ zy _} ? z # 0 eq {_ (q) test} {zy _ zy _} ? z # 0 eq {_ (r) test} {zy _ zy _} ? z # 0 eq {_ (C) test} {zy _ zy _} ? z # 0 eq {_ (D) test} {zy _ zy _} ? z # 0 eq {_ (c) test} {zy _ zy _} ? z # 0 eq {_ (d) test} {zy _ zy _} ? z # 0 eq {_ (U) test} {zy _ zy _} ? z # 0 eq {_ (V) test} {zy _ zy _} ? z # 0 eq {_ (u) test} {zy _ zy _} ? z # 0 eq {_ (v) test} {zy _ zy _} ? z # 0 eq {_ (G) test} {zy _ zy _} ? z # 0 eq {_ (H) test} {zy _ zy _} ? z # 0 eq {_ (g) test} {zy _ zy _} ? z # 0 eq {_ (h) test} {zy _ zy _} ? z # 0 eq {_ (Y) test} {zy _ zy _} ? z # 0 eq {_ (Z) test} {zy _ zy _} ? z # 0 eq {_ (y) test} {zy _ zy _} ? z # 0 eq {_ (z) test} {zy _ zy _} ? z # 0 eq {_ (K) test} {zy _ zy _} ? z # 0 eq {_ (L) test} {zy _ zy _} ? z # 0 eq {_ (k) test} {zy _ zy _} ? z # 0 eq {_ (l) test} {zy _ zy _} ? z # 0 eq {_ (O) test} {zy _ zy _} ? z # 0 eq {_ (P) test} {zy _ zy _} ? z # 0 eq {_ (o) test} {zy _ zy _} ? z # 0 eq {_ (p) test} {zy _ zy _} ? z # 0 eq {_ (A) test} {zy _ zy _} ? z # 0 eq {_ (B) test} {zy _ zy _} ? z # 0 eq {_ (a) test} {zy _ zy _} ? z # 0 eq {_ (b) test} {zy _ zy _} ? z # 0 eq {_ (S) test} {zy _ zy _} ? z # 0 eq {_ (T) test} {zy _ zy _} ? z # 0 eq {_ (s) test} {zy _ zy _} ? z # 0 eq {_ (t) test} {zy _ zy _} ? z # 0 eq {_ (E) test} {zy _ zy _} ? z # 0 eq {_ (F) test} {zy _ zy _} ? z # 0 eq {_ (e) test} {zy _ zy _} ? z # 0 eq {_ (f) test} {zy _ zy _} ?} {zy _ zy _} ?} {_ _ _ [ ]} ?}
0
(X23)

[3]

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


#3106

Fromluser droog <luser.droog@gmail.com>
Date2017-06-04 18:57 -0700
Message-ID<91f043e3-caba-424c-841e-45da1905644d@googlegroups.com>
In reply to#3105
On Sunday, June 4, 2017 at 1:13:16 PM UTC-5, luser droog wrote:
> On Saturday, June 3, 2017 at 5:15:48 PM UTC-5, luser droog wrote:
> > On Sunday, May 28, 2017 at 11:22:09 PM UTC-5, luser droog wrote:
> > > cf. https://en.wikipedia.org/wiki/Parser_combinator
> > > 
> > > $ cat pc.ps
> > 
> > Round 2. Norah is my computer's name.
> > 
> > $ cat pc.ps
> 
> Getting pretty crazy now, and torturous to debug.
> But I think I got all the big bugs now.
> 
> There's no golfing competition for this that I'm aware of,
> but my instinct was to tighten it up.

Added actions. And we can stop looking at that ugly generated code.
Since I chose to (ab)use dictionaries for extra syntax in the
constructor description language, I had to add (and debug) a
bubble sort to get the alphabet right.

The "payload" or 'user' code is the lines
    cvi = / =
and
    cvn = / =
which receives the substring matched. 

I'm not sure how to eat the space in ( Foo). In the description,
it's call opt-space because it can match or be skipped. But it
doesn't advance the starting position. 

Perhaps if the constructor was more robust and could accept
pre-compiled parsers in the description. Then /opt-space could
eat its space, and it could still be stiched-up into a larger
parser.

Norah@laptop ~
$ cat pc2.ps
%/forall { pstack/ = //forall } def
<<
    /z { dup }  /+ { z }  /++ { 2 copy }  /_ { pop }  /# { length }
    /y { 1 index }   /zy  { exch     }    /| { array astore }
    /x { 2 index }  /yzx  { 3 2 roll }    /? { ifelse       }
    /w { 3 index }   /zxy { 3 1 roll }    /@ { forall       }
    /v { 4 index }   /zyx { zxy zy   }  /... { getinterval  }

    /curry   { [ zxy {} @ ]          } /&  { curry   }
    /combine { 2 | [ zy { {} @ } @ ] } /&& { combine }
    /map     { [ zxy @ ] }         /reduce { y 0 get zyx 1 y # 1 sub ... zy @ }

    /fail  { _ _ _ []  }
    /0=    { z # 0 eq  }
    /0^    { z # 0 gt  }
    /mov   { {} @ add  }
    /ret   { zy _ zy _ }
    /test  { zxy y # y le    { fail               }{
             ++ v # ... w eq { yzx # add zy _ 1 | }{    fail    }? }? }
    /term  { /test cvx 2 | cvx }
    /empty { zy _ 1 | }
    /alt   { {++} yzx && {0=      } && {_     } yzx && cvx {{ret }? } & && cvx }
    /seq   { {++} yzx && {0^      } && {mov   } yzx && cvx {{fail}? } & && cvx }
    %      {++  p1      z # 0 gt     {{}@ add p2}         {fail}? } 
    /build-parser {
        z type /stringtype  eq {                            term                           }{
        z type /booleantype eq { {{empty}}{{0 fail}}?                                      }{
        z type /arraytype   eq {                           {build-parser} map {seq} reduce }{
        z type /dicttype    eq { {} map {fixup} map bubble {build-parser} map {alt} reduce }{   }? }? }? }? }
    /fixup {
        z type /nulltype eq { _         }{
        z type /nametype eq { to-string }{      }? }? }
    /to-string { z # string cvs }
    /ps { pstack/ = } /pq { ps quit }
    /bubble {   { z sorted {exit} if  [ zy {++ comp{zy}if} reduce ] } loop   }
    /sorted {  true zy { ++ comp { _ _ _ false 0 exit } if  zy _ } reduce _ }
    /switch? << /stringtype  << /stringtype{    gt  } /dicttype{_ _ false} /booleantype{ _ _ false} >>
                /dicttype    << /stringtype{_ _ true} /dicttype{_ _ false} /booleantype{ _ _ false} >>
                /booleantype << /stringtype{_ _ true} /dicttype{_ _ true } /booleantype{ _ _ false} >> >>
    /comp { switch? x type get y type get exec }
    /build-parser-action {      % parse-description {action}
        {z # zy} zy &&
        {add y # y sub ...} &&
        zy build-parser { 0 ++ ++ } zy &&               % {action}' {0 ++++ parser}
        { 0^ } &&                               % {action}' {0++++ parser z # 0 gt}
        {{}@ ...} yzx && cvx                    % {0++++ parser z # 0 gt} {{}@ ... action'} 
        {{ /parser-fail == }? } & && cvx        % {0++++ parser z # 0 gt  {{}@ ... action'} { FAIL }? }
    }
    
>>begin

%(123) 0 (123) build-parser exec pq
%(Hello) 0 [ <<(H)(h)>> (e)(l)(l)(o) ] build-parser exec pq


/digit   << (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) >> def
/alpha   << (a) (b) (c) (d) (e) (f) (g) (h) (i) (j) (k) (l) (m)
            (n) (o) (p) (q) (r) (s) (t) (u) (v) (w) (x) (y) (z)
            (A) (B) (C) (D) (E) (F) (G) (H) (I) (J) (K) (L) (M)
            (N) (O) (P) (Q) (R) (S) (T) (U) (V) (W) (X) (Y) (Z) >> def
/medial <<//digit //alpha>> def
/opt-space <<( ) true>> def

/number [ //opt-space //digit << //digit true >> ]
{       % (string) i (str) 
%    z # zy             % (string) i (str)# (str)
    cvi = / =           % (string) i str#
%    add y # y sub ...  % (ing)
} build-parser-action def

/id     [ //opt-space //alpha //alpha //alpha ]
{
%    z # zy
    cvn = / =
%    add y # y sub ...
} build-parser-action def

%(Foo) 0 //id exec ps clear

( 22 Foo 47)
number
id
number

quit




Norah@laptop ~
$ gsnd -q pc2.ps
22

 Foo

47

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


#3107

Fromluser droog <luser.droog@gmail.com>
Date2017-06-04 19:39 -0700
Message-ID<5a83d009-e230-4662-a037-25df709a13fa@googlegroups.com>
In reply to#3106
On Sunday, June 4, 2017 at 8:57:56 PM UTC-5, luser droog wrote:
> On Sunday, June 4, 2017 at 1:13:16 PM UTC-5, luser droog wrote:
> > On Saturday, June 3, 2017 at 5:15:48 PM UTC-5, luser droog wrote:
> > > On Sunday, May 28, 2017 at 11:22:09 PM UTC-5, luser droog wrote:
> > > > cf. https://en.wikipedia.org/wiki/Parser_combinator
> > > > 
> > > > $ cat pc.ps
> > > 
> > > Round 2. Norah is my computer's name.
> > > 
> > > $ cat pc.ps
> > 
> > Getting pretty crazy now, and torturous to debug.
> > But I think I got all the big bugs now.
> > 
> > There's no golfing competition for this that I'm aware of,
> > but my instinct was to tighten it up.
> 
> Added actions. And we can stop looking at that ugly generated code.
> Since I chose to (ab)use dictionaries for extra syntax in the
> constructor description language, I had to add (and debug) a
> bubble sort to get the alphabet right.
> 
> The "payload" or 'user' code is the lines
>     cvi = / =
> and
>     cvn = / =
> which receives the substring matched. 
> 
> I'm not sure how to eat the space in ( Foo). In the description,
> it's call opt-space because it can match or be skipped. But it
> doesn't advance the starting position. 
> 
> Perhaps if the constructor was more robust and could accept
> pre-compiled parsers in the description. Then /opt-space could
> eat its space, and it could still be stiched-up into a larger
> parser.
> 

That part doesn't work quite yet. Need to think through it all very
carefully to figure out why. But I really need to work on other 
more important projects.

Having opt-space in the 'outer' descriptor is not so bad, I think.
I dump the //number parser since it's less ugly than //id (less huge).

Norah@laptop ~
$ cat pc2.ps
%/forall { pstack/ = //forall } def
<<
    /z { dup }  /+ { z }  /++ { 2 copy }  /_ { pop }  /# { length }
    /y { 1 index }   /zy  { exch     }    /| { array astore }
    /x { 2 index }  /yzx  { 3 2 roll }    /? { ifelse       }
    /w { 3 index }   /zxy { 3 1 roll }    /@ { forall       }
    /v { 4 index }   /zyx { zxy zy   }  /... { getinterval  }

    /curry   { [ zxy {} @ ]          } /&  { curry   }
    /combine { 2 | [ zy { {} @ } @ ] } /&& { combine }
    /map     { [ zxy @ ] }         /reduce { y 0 get zyx 1 y # 1 sub ... zy @ }

    /fail  { _ _ _ []  }
    /0=    { z # 0 eq  }
    /0^    { z # 0 gt  }
    /mov   { {} @ add  }
    /ret   { zy _ zy _ }
    /test  { zxy y # y le    { fail               }{
             ++ v # ... w eq { yzx # add zy _ 1 | }{    fail    }? }? }
    /term  { /test cvx 2 | cvx }
    /empty { zy _ 1 | }
    /alt   { {++} yzx && {0=      } && {_     } yzx && cvx {{ret }? } & && cvx }
    /seq   { {++} yzx && {0^      } && {mov   } yzx && cvx {{fail}? } & && cvx }
    %      {++  p1      z # 0 gt     {{}@ add p2}         {fail}? } 
    /build-parser {
        z type /stringtype  eq {                            term                           }{
        z type /booleantype eq { {{empty}}{{0 fail}}?                                      }{
        z type /arraytype   eq {
            z xcheck {          }{      {build-parser} map {seq} reduce     }?      }{
        z type /dicttype    eq { {} map {fixup} map bubble {build-parser} map {alt} reduce }{   }? }? }? }? }
    /fixup {
        z type /nulltype eq { _         }{
        z type /nametype eq { to-string }{      }? }? }
    /to-string { z # string cvs }
    /ps { pstack/ = } /pq { ps quit }
    /bubble {   { z sorted {exit} if  [ zy {++ comp{zy}if} reduce ] } loop   }
    /sorted {  true zy { ++ comp { _ _ _ false 0 exit } if  zy _ } reduce _ }
    /switch? << /stringtype  << /stringtype{    gt  } /dicttype{_ _ false} /booleantype{ _ _ false} >>
                /dicttype    << /stringtype{_ _ true} /dicttype{_ _ false} /booleantype{ _ _ false} >>
                /booleantype << /stringtype{_ _ true} /dicttype{_ _ true } /booleantype{ _ _ false} >> >>
    /comp { switch? x type get y type get exec }
    /build-parser-action {      % parse-description {action}
        {z # zy} zy &&
        {add y # y sub ... 0} &&
        zy build-parser { ++ ++ } zy &&         % {action}' {0 ++++ parser}
        { 0^ } &&                               % {action}' {0++++ parser z # 0 gt}
        {{}@ ...} yzx && cvx                    % {0++++ parser z # 0 gt} {{}@ ... action'} 
        {{ /parser-fail == ps }? } & && cvx     % {0++++ parser z # 0 gt  {{}@ ... action'} { FAIL }? }
    }
    
>>begin

%(123) 0 (123) build-parser exec pq
%(Hello) 0 [ <<(H)(h)>> (e)(l)(l)(o) ] build-parser exec pq


/digit   << (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) >> def
/alpha   << (a) (b) (c) (d) (e) (f) (g) (h) (i) (j) (k) (l) (m)
            (n) (o) (p) (q) (r) (s) (t) (u) (v) (w) (x) (y) (z)
            (A) (B) (C) (D) (E) (F) (G) (H) (I) (J) (K) (L) (M)
            (N) (O) (P) (Q) (R) (S) (T) (U) (V) (W) (X) (Y) (Z) >> def
/medial <<//digit //alpha>> def
/opt-space <<( ) true>>
{       % (string) i (str)# (str)
    _ 
} build-parser-action def

/number [ %//opt-space
          //digit << //digit true >> ]
{       % (string) i (str) 
%    z # zy             % (string) i (str)# (str)
    %cvi = / =          % (string) i str#
    4 1 roll
%    add y # y sub ...  % (ing)
} build-parser-action def

//number ==

/id     [ %//opt-space
          //alpha //alpha //alpha ]
{
%    z # zy
    %cvn = / =
    4 1 roll
%    add y # y sub ...
} build-parser-action def

%(Foo) 0 //id exec ps clear

(22Foo47)    [ zy 0  opt-space number  opt-space id  opt-space number  _ _ ] ==
( 22 Foo47)  [ zy 0  opt-space number  opt-space id  opt-space number  _ _ ] ==
(22 Foo 47 ) [ zy 0  opt-space number  opt-space id  opt-space number  _ _ ] ==

quit




Norah@laptop ~
$ gsnd -q pc2.ps
{++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ (0) test 0= {_ (1) test} {ret} ? 0= {_ (2) test} {ret} ? 0= {_ (3) test} {ret} ? 0= {_ (4) test} {ret} ? 0= {_ (5) test} {ret} ? 0= {_ (6) test} {ret} ? 0= {_ (7) test} {ret} ? 0= {_ (8) test} {ret} ? 0= {_ (9) test} {ret} ? 0^ {mov ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ (0) test 0= {_ (1) test} {ret} ? 0= {_ (2) test} {ret} ? 0= {_ (3) test} {ret} ? 0= {_ (4) test} {ret} ? 0= {_ (5) test} {ret} ? 0= {_ (6) test} {ret} ? 0= {_ (7) test} {ret} ? 0= {_ (8) test} {ret} ? 0= {_ (9) test} {ret} ? 0= {_ empty} {ret} ?} {fail} ? 0^ {{} @ ... z # zy 4 1 roll add y # y sub ... 0} {/parser-fail == ps} ?}
[(22) (Foo) (47)]
[(22) (Foo) (47)]
[(22) (Foo) (47)]

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


#3108

Fromluser droog <luser.droog@gmail.com>
Date2017-06-06 23:38 -0700
Message-ID<bf96c8d8-fba3-4598-8ff4-c77b33aa4a51@googlegroups.com>
In reply to#3107
On Sunday, June 4, 2017 at 9:39:37 PM UTC-5, luser droog wrote:
> On Sunday, June 4, 2017 at 8:57:56 PM UTC-5, luser droog wrote:
> > On Sunday, June 4, 2017 at 1:13:16 PM UTC-5, luser droog wrote:
> > > On Saturday, June 3, 2017 at 5:15:48 PM UTC-5, luser droog wrote:
> > > > On Sunday, May 28, 2017 at 11:22:09 PM UTC-5, luser droog wrote:
> > > > > cf. https://en.wikipedia.org/wiki/Parser_combinator
> > > > > 
> > > > > $ cat pc.ps
> > > > 
> > > > Round 2. Norah is my computer's name.
> > > > 
> > > > $ cat pc.ps
> > > 
> > > Getting pretty crazy now, and torturous to debug.
> > > But I think I got all the big bugs now.
> > > 
> > > There's no golfing competition for this that I'm aware of,
> > > but my instinct was to tighten it up.
> > 
> > Added actions. And we can stop looking at that ugly generated code.
> > Since I chose to (ab)use dictionaries for extra syntax in the
> > constructor description language, I had to add (and debug) a
> > bubble sort to get the alphabet right.
> > 
> > The "payload" or 'user' code is the lines
> >     cvi = / =
> > and
> >     cvn = / =
> > which receives the substring matched. 
> > 
> > I'm not sure how to eat the space in ( Foo). In the description,
> > it's call opt-space because it can match or be skipped. But it
> > doesn't advance the starting position. 
> > 
> > Perhaps if the constructor was more robust and could accept
> > pre-compiled parsers in the description. Then /opt-space could
> > eat its space, and it could still be stiched-up into a larger
> > parser.
> > 
> 
> That part doesn't work quite yet. Need to think through it all very
> carefully to figure out why. But I really need to work on other 
> more important projects.
> 
> Having opt-space in the 'outer' descriptor is not so bad, I think.
> I dump the //number parser since it's less ugly than //id (less huge).
> 

One more workaround for the syntax snafu. <<alternates>> which hijack
the dictionary mechanism to use its syntax normally requires an
even number of things. Strictly key/val pairs. So, wrapping it, we
check and add an extra null to even things out if odd.

And it goes ahead and converts numbers to numbers and ids to names like
a good parser should. :)


Norah@laptop ~
$ !g
gsnd -q pc2.ps
{++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ (0) test 0= {_ (1) test} {ret} ? 0= {_ (2) test} {ret} ? 0= {_ (3) test} {ret} ? 0= {_ (4) test} {ret} ? 0= {_ (5) test} {ret} ? 0= {_ (6) test} {ret} ? 0= {_ (7) test} {ret} ? 0= {_ (8) test} {ret} ? 0= {_ (9) test} {ret} ? 0^ {mov ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ (0) test 0= {_ (1) test} {ret} ? 0= {_ (2) test} {ret} ? 0= {_ (3) test} {ret} ? 0= {_ (4) test} {ret} ? 0= {_ (5) test} {ret} ? 0= {_ (6) test} {ret} ? 0= {_ (7) test} {ret} ? 0= {_ (8) test} {ret} ? 0= {_ (9) test} {ret} ? 0= {_ empty} {ret} ?} {fail} ? 0^ {{} @ ... z # zy cvi 4 1 roll add y # y sub ... 0} {/parser-fail == ps} ?}
[22 /Foo 47]
[22 /Foo 47]
[22 /Foo 47]

Norah@laptop ~
$ cat pc2.ps
%/forall { pstack/ = //forall } def
<<
    /z { dup }  /+ { z }  /++ { 2 copy }  /_ { pop }  /# { length }
    /y { 1 index }   /zy  { exch     }    /| { array astore }
    /x { 2 index }  /yzx  { 3 2 roll }    /? { ifelse       }
    /w { 3 index }   /zxy { 3 1 roll }    /@ { forall       }
    /v { 4 index }   /zyx { zxy zy   }  /... { getinterval  }

    /curry   { [ zxy {} @ ]          } /&  { curry   }
    /combine { 2 | [ zy { {} @ } @ ] } /&& { combine }
    /map     { [ zxy @ ] }         /reduce { y 0 get zyx 1 y # 1 sub ... zy @ }

    /fail  { _ _ _ []  }
    /0=    { z # 0 eq  }
    /0^    { z # 0 gt  }
    /mov   { {} @ add  }
    /ret   { zy _ zy _ }
    /test  { zxy y # y le    { fail               }{
             ++ v # ... w eq { yzx # add zy _ 1 | }{    fail    }? }? }
    /term  { /test cvx 2 | cvx }
    /empty { zy _ 1 | }
    /alt   { {++} yzx && {0=      } && {_     } yzx && cvx {{ret }? } & && cvx }
    /seq   { {++} yzx && {0^      } && {mov   } yzx && cvx {{fail}? } & && cvx }
    %        {++  p1      z # 0 gt     {{}@ add p2}         {fail}? } 
    /build-parser {
        z type /stringtype  eq {                            term                           }{
        z type /booleantype eq { {{empty}}{{0 fail}}?                                      }{
        z type /arraytype   eq {
            z xcheck {          }{      {build-parser} map {seq} reduce     }?      }{
        z type /dicttype    eq { {} map {fixup} map bubble {build-parser} map {alt} reduce }{   }? }? }? }? }
    /fixup {
        z type /nulltype eq { _         }{
        z type /nametype eq { to-string }{      }? }? }
    /to-string { z # string cvs }
    /ps { pstack/ = } /pq { ps quit }
    /bubble {   { z sorted {exit} if  [ zy {++ comp{zy}if} reduce ] } loop   }
    /sorted {  true zy { ++ comp { _ _ _ false 0 exit } if  zy _ } reduce _ }
    /switch? << /stringtype  << /stringtype{    gt  } /dicttype{_ _ false} /booleantype{ _ _ false} >>
                /dicttype    << /stringtype{_ _ true} /dicttype{_ _ false} /booleantype{ _ _ false} >>
                /booleantype << /stringtype{_ _ true} /dicttype{_ _ true } /booleantype{ _ _ false} >> >>
    /comp { switch? x type get y type get exec }
    /build-parser-action {      % parse-description {action}
        {z # zy} zy &&
        {add y # y sub ... 0} &&
        zy build-parser { ++ ++ } zy &&         % {action}' {0 ++++ parser}
        { 0^ } &&                               % {action}' {0++++ parser z # 0 gt}
        {{}@ ...} yzx && cvx                    % {0++++ parser z # 0 gt} {{}@ ... action'} 
        {{ /parser-fail == ps }? } & && cvx     % {0++++ parser z # 0 gt  {{}@ ... action'} { FAIL }? }
    }
    
>>begin
/dicttomark (>>) load def
(>>) {    counttomark 2 mod 1 eq { null } if    dicttomark } def        % permit odd number


%(123) 0 (123) build-parser exec pq
%(Hello) 0 [ <<(H)(h)>> (e)(l)(l)(o) ] build-parser exec pq


/digit   << (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) >> def
/alpha   << (_) (a) (b) (c) (d) (e) (f) (g) (h) (i) (j) (k) (l) (m)
            (n) (o) (p) (q) (r) (s) (t) (u) (v) (w) (x) (y) (z)
            (A) (B) (C) (D) (E) (F) (G) (H) (I) (J) (K) (L) (M)
            (N) (O) (P) (Q) (R) (S) (T) (U) (V) (W) (X) (Y) (Z) >> def
/medial <<//digit //alpha>> def
/opt-space <<( ) true>>
{       % (string) i (str)# (str)
    _ 
} build-parser-action def

/number [ %//opt-space
          //digit << //digit true >> ]
{       % (string) i (str) 
%    z # zy             % (string) i (str)# (str)
    %cvi = / =          % (string) i str#
    cvi  4 1 roll
%    add y # y sub ...  % (ing)
} build-parser-action def

//number ==

/id     [ %//opt-space
          //alpha //alpha //alpha ]
{
%    z # zy
    %cvn = / =
    cvn  4 1 roll
%    add y # y sub ...
} build-parser-action def

%(Foo) 0 //id exec ps clear

(22Foo47)    [ zy 0  opt-space number  opt-space id  opt-space number  _ _ ] ==
( 22 Foo47)  [ zy 0  opt-space number  opt-space id  opt-space number  _ _ ] ==
(22 Foo 47 ) [ zy 0  opt-space number  opt-space id  opt-space number  _ _ ] ==

quit



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


#3110

Fromluser droog <luser.droog@gmail.com>
Date2017-06-08 22:18 -0700
Message-ID<3e0df99a-2bbe-4f32-9f7c-61492432b623@googlegroups.com>
In reply to#3108
On Wednesday, June 7, 2017 at 1:38:14 AM UTC-5, luser droog wrote:
> On Sunday, June 4, 2017 at 9:39:37 PM UTC-5, luser droog wrote:
> > On Sunday, June 4, 2017 at 8:57:56 PM UTC-5, luser droog wrote:
> > > On Sunday, June 4, 2017 at 1:13:16 PM UTC-5, luser droog wrote:
> > > > On Saturday, June 3, 2017 at 5:15:48 PM UTC-5, luser droog wrote:
> > > > > On Sunday, May 28, 2017 at 11:22:09 PM UTC-5, luser droog wrote:
> > > > > > cf. https://en.wikipedia.org/wiki/Parser_combinator
> > > > > > 
> > > > > > $ cat pc.ps
> > > > > 
> > > > > Round 2. Norah is my computer's name.
> > > > > 
> > > > > $ cat pc.ps
> > > > 
> > > > Getting pretty crazy now, and torturous to debug.
> > > > But I think I got all the big bugs now.
> > > > 
> > > > There's no golfing competition for this that I'm aware of,
> > > > but my instinct was to tighten it up.
> > > 
> > > Added actions. And we can stop looking at that ugly generated code.
> > > Since I chose to (ab)use dictionaries for extra syntax in the
> > > constructor description language, I had to add (and debug) a
> > > bubble sort to get the alphabet right.
> > > 
> > > The "payload" or 'user' code is the lines
> > >     cvi = / =
> > > and
> > >     cvn = / =
> > > which receives the substring matched. 
> > > 
> > > I'm not sure how to eat the space in ( Foo). In the description,
> > > it's call opt-space because it can match or be skipped. But it
> > > doesn't advance the starting position. 
> > > 
> > > Perhaps if the constructor was more robust and could accept
> > > pre-compiled parsers in the description. Then /opt-space could
> > > eat its space, and it could still be stiched-up into a larger
> > > parser.
> > > 
> > 
> > That part doesn't work quite yet. Need to think through it all very
> > carefully to figure out why. But I really need to work on other 
> > more important projects.
> > 
> > Having opt-space in the 'outer' descriptor is not so bad, I think.
> > I dump the //number parser since it's less ugly than //id (less huge).
> > 
> 
> One more workaround for the syntax snafu. <<alternates>> which hijack
> the dictionary mechanism to use its syntax normally requires an
> even number of things. Strictly key/val pairs. So, wrapping it, we
> check and add an extra null to even things out if odd.
> 
> And it goes ahead and converts numbers to numbers and ids to names like
> a good parser should. :)
> 

Rewritten with a simpler return convention. Rather than empty array for
false and array of matched length, it returns -1 for false and the length
if >=0.

I have a thread over in comp.lang.c working up the same (similar) ideas in C .
I've got quantifiers there, so I guess those are needed here too.


Norah@laptop ~
$ cat pc3.ps
%/forall{pstack/ =//forall}def
[/z {   dup   } /zy  {     exch } /++ {     2 copy   } /_ { pop    }
 /y { 1 index } /yzx { 3 2 roll }  /| { array astore } /# { length }
 /x { 2 index } /zxy { 3 1 roll }  /? { ifelse       } /Z { {} @   }
 /w { 3 index } /zyx { zxy zy   }  /@ { forall       }
 /v { 4 index } /zwxy{ 4 1 roll } /.. { getinterval  }
/&   { [ zxy Z ] }   /&&     { 2 | [ zy { Z } @ ] }
/map { [ zxy @ ] }   /reduce { y 0 get zyx 1 y # 1 sub .. zy @ }
/ps  { pstack/ = }   /pq     { ps quit }  /pc { ps clear }

/ini  { 0 zy .. }  /fin  { y # y sub .. }
/fail { _ -1 }  /fail? { z -1 le }  /!fail? { fail? not }
/ret  { # } /pass { zy _ } /mov { z zxy fin } /vom { fail? { _ _ fail }{ zy _ add }? }
/test { y # y # lt { fail }{ ++ # ini y eq { ret }{ fail } ? }? }
/term { /test cvx 2 | cvx }
/alt  { {z} yzx && {  fail? } && { _   } yzx && { zy _ } && cvx {{pass} ?} & && cvx }
%       {z  p1        fail?      { _     p2 }     {pass} ?}
/seq  { {z} yzx && { !fail? } && { mov } yzx && { vom  } && cvx {{fail} ?} & && cvx }
%       {z  p1       !fail?      { mov   p2 }     vom            {fail} ?}
/build-parser {     z type /stringtype  eq { term       }{
                    z type /arraytype   eq { build-seq  }{
                    z type /dicttype    eq { build-alt  }{
                    z type /booleantype eq { build-bool }{    }? }? }? }? }
/build-seq  { z xcheck {  }{  {build-parser} map {seq} reduce  }? }
/build-alt  { {} map {fixup} map bubble {build-parser} map {alt} reduce }
/build-bool { {{0}}{{-1}}? }
/fixup   {  z type /nulltype eq { _              }{
            z type /nametype eq { z # string cvs }{    }? }? }
/bubble  {  { z sorted {exit} if  [ zy {++ comp{zy}if} reduce ] } loop   }
/sorted  {  true zy { ++ comp { _ _ _ false 0 exit } if  zy _ } reduce _ }
/arrcomp { y xcheck {  z xcheck { _ _ false }{ _ _ false }?  }
                    {  z xcheck { _ _ true  }{ _ _ false }?  }? }
/switch? <<
 /arraytype   << /arraytype{arrcomp } /stringtype{_ _ false} /dicttype{_ _ false} /booleantype{_ _ false} >>
 /stringtype  << /arraytype{_ _ true} /stringtype{    gt   } /dicttype{_ _ false} /booleantype{_ _ false} >>
 /dicttype    << /arraytype{_ _ true} /stringtype{_ _ true } /dicttype{_ _ false} /booleantype{ _ _ false} >>
 /booleantype << /arraytype{_ _ true} /stringtype{_ _ true } /dicttype{_ _ true } /booleantype{ _ _ false} >> >>
/comp    { switch? x type get y type get exec }
/build-parser-action {
    zy build-parser {  } zy &&
    { !fail? } &&  { ++ ini } yzx && { fin } && cvx {{ /parser-fail == ps }? } & && cvx }
>> begin
(>>) cvn [ { counttomark 2 mod 1 eq { null } if } Z counttomark 1 add index load ] cvx def
({
(hello world) [<<(H)(h)(j)>> (ello) ( ) (world)] build-parser dup == exec pc
(hello world) [<<(H)(h)>>(ello)] {    cvn ==  } build-parser-action dup == exec pc

/h <<(H)(h)(j)>> def
/H h build-parser def
(hello) [//h (ello)] build-parser dup == exec pc
(hello) [//H (ello)] build-parser dup == exec pc
(hello world) [ //H (ello) ] { cvn cvx == / = } build-parser-action dup == exec pc
(jello world) [ <<//H (j)>> (ello) ] { cvn cvx == / = } build-parser-action dup == exec pc
})pop
/digit   << (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) >>def
/alpha   << (a) (b) (c) (d) (e) (f) (g) (h) (i) (j) (k) (l) (m)
            (n) (o) (p) (q) (r) (s) (t) (u) (v) (w) (x) (y) (z)
            (A) (B) (C) (D) (E) (F) (G) (H) (I) (J) (K) (L) (M)
            (N) (O) (P) (Q) (R) (S) (T) (U) (V) (W) (X) (Y) (Z) (_) >> def

/sp     <<( ) true>> {    _  } build-parser-action def
/number [ //digit //digit //digit ] {    cvi  zxy      } build-parser-action def
/id     [ //alpha //alpha //alpha ] {    cvn cvx  zxy  } build-parser-action def
%//sp ==//number ==//id ==

/record {[zy   sp  number  sp  id  sp  number   _]==} def
(123Foo999) record
( 234fOO888) record
( 345 FQQ777) record
( 456 fqq 666) record

pq


Norah@laptop ~
$ gsnd -q pc3.ps
[123 Foo 999]
[234 fOO 888]
[345 FQQ 777]
[456 fqq 666]

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


#3111

Fromluser droog <luser.droog@gmail.com>
Date2017-06-09 14:54 -0700
Message-ID<8c08b559-58ab-4546-b480-f3a44ff914fa@googlegroups.com>
In reply to#3110
On Friday, June 9, 2017 at 12:18:47 AM UTC-5, luser droog wrote:
> On Wednesday, June 7, 2017 at 1:38:14 AM UTC-5, luser droog wrote:
> > On Sunday, June 4, 2017 at 9:39:37 PM UTC-5, luser droog wrote:
> > > On Sunday, June 4, 2017 at 8:57:56 PM UTC-5, luser droog wrote:
> > > > On Sunday, June 4, 2017 at 1:13:16 PM UTC-5, luser droog wrote:
> > > > > On Saturday, June 3, 2017 at 5:15:48 PM UTC-5, luser droog wrote:
> > > > > > On Sunday, May 28, 2017 at 11:22:09 PM UTC-5, luser droog wrote:
> > > > > > > cf. https://en.wikipedia.org/wiki/Parser_combinator

> Rewritten with a simpler return convention. Rather than empty array for
> false and array of matched length, it returns -1 for false and the length
> if >=0.
> 
> I have a thread over in comp.lang.c working up the same (similar) ideas in C .
> I've got quantifiers there, so I guess those are needed here too.
> 
> 

Now I've got a tricky/annoying problem. My quantifiers, 'many' (*) and
'some' (+) are both yield correct match/no-match results. But they aren't
"greedy", so not terribly useful. I'm trying to use them to eat whitespace
but it doesn't work.

The /many combinator which implements the BNF or regex star (*) operator
ie. Kleene closure, takes as input a parser p.

It constructs a new seq parser q whose left branch is
p and whose right branch is q itself.

    p =>   q={p||q}

Then it constructs an alt parser whose left branch is q
and whose right branch is 'succeeds'.

    return {q||succeed}

So it runs along the sequence part until it stops matching
and fails, then the right branch of the alt always succeeds.
But formulating it this way loses the count of how much was
mapped. Need to think up a better machine for this.

Similar problem with the /some combinator which implements the BNF
or regex plus (+) operator to match 1 or more times.
It starts with the same q built the same way then returns an
alt whose left branch is the original p and whose right
branch is q.

    return {p||q}

Except that's probably wrong. As well as not accumulating a count.

But the rest of it is getting tighter and simpler, and seems to
be working if you believe in fairies.

Comments or questions welcome.


Norah@laptop ~
$ cat pc3.ps
%/forall{pstack/ =//forall}def
[/z {   dup   } /zy  {     exch } /++ {     2 copy   } /_ { pop    }
 /y { 1 index } /yzx { 3 2 roll }  /| { array astore } /# { length }
 /x { 2 index } /zxy { 3 1 roll }  /? { ifelse       } /Z { {} @   }
 /w { 3 index } /zyx { zxy zy   }  /@ { forall       }
 /v { 4 index } /zwxy{ 4 1 roll } /.. { getinterval  }
/&   { [ zxy Z ] }   /&&     { 2 | [ zy { Z } @ ] }
/map { [ zxy @ ] }   /reduce { y 0 get zyx 1 y # 1 sub .. zy @ }
/ps  { pstack/ = }   /pq     { ps quit }  /pc { ps clear }
/is  { y type eq }

/ini  { 0 zy .. }  /fin  { y # y sub .. }
/fail { _ -1 }  /fail? { z -1 le }  /!fail? { fail? not }
/ret  { # } /pass { zy _ } /mov { z zxy fin } /vom { fail? { _ _ fail }{ zy _ add }? }
/test { y # y # lt { fail }{ ++ # ini y eq { ret }{ fail } ? }? }
/term { /test cvx 2 | cvx }
/alt  { {z} yzx && {  fail? } && { _   } yzx && { zy _ } && cvx {{pass} ?} & && cvx }
%       {z  p1        fail?      { _     p2 }     {pass} ?}
/seq  { {z} yzx && { !fail? } && { mov } yzx && { vom  } && cvx {{fail} ?} & && cvx }
%       {z  p1       !fail?      { mov   p2 }     vom            {fail} ?}
/many {      {{{}exec}exec} z 0 get zxy seq        ++ 0 zy put zy _  {0} alt }
/some {    z {{{}exec}exec} z 0 get zxy seq        ++ 0 zy put zy _      alt }
/build-parser {     /stringtype  is { term       }{
                    /arraytype   is { build-seq  }{
                    /dicttype    is { build-alt  }{
                    /booleantype is { build-bool }{    }? }? }? }? }
/build-seq  { z xcheck {  }{  {build-parser} map {seq} reduce  }? }
/build-alt  { {} map {fixup} map bubble {build-parser} map {alt} reduce }
/build-bool { {{0}}{{-1}}? }
/fixup   {  /nulltype is { _              }{
            /nametype is { z # string cvs }{    }? }? }
/bubble  {  { z sorted {exit} if  [ zy {++ comp{zy}if} reduce ] } loop   }
/sorted  {  true zy { ++ comp { _ _ _ false 0 exit } if  zy _ } reduce _ }
/arrcomp { y xcheck {  z xcheck { _ _ false }{ _ _ false }?  }
                    {  z xcheck { _ _ true  }{ _ _ false }?  }? }
/switch? <<
 /arraytype   << /arraytype{arrcomp } /stringtype{_ _ false} /dicttype{_ _ false} /booleantype{_ _ false} >>
 /stringtype  << /arraytype{_ _ true} /stringtype{    gt   } /dicttype{_ _ false} /booleantype{_ _ false} >>
 /dicttype    << /arraytype{_ _ true} /stringtype{_ _ true } /dicttype{_ _ false} /booleantype{_ _ false} >>
 /booleantype << /arraytype{_ _ true} /stringtype{_ _ true } /dicttype{_ _ true } /booleantype{_ _ false} >> >>
/comp    { switch? x type get y type get exec }
/build-parser-action {
    zy build-parser {  } zy &&
    { !fail? } &&  { ++ ini } yzx && { fin } && cvx {{ /parser-fail == ps }? } & && cvx }
>> begin
(>>) cvn [ { counttomark 2 mod 1 eq { null } if } Z counttomark 1 add index load ] cvx def


({
(hello world) [<<(H)(h)(j)>> (ello) ( ) (world)] build-parser dup == exec pc
(hello world) [<<(H)(h)>>(ello)] {    cvn ==  } build-parser-action dup == exec pc

/h <<(H)(h)(j)>> def
/H h build-parser def
(hello) [//h (ello)] build-parser dup == exec pc
(hello) [//H (ello)] build-parser dup == exec pc
(hello world) [ //H (ello) ] { cvn cvx == / = } build-parser-action dup == exec pc
(jello world) [ <<//H (j)>> (ello) ] { cvn cvx == / = } build-parser-action dup == exec pc
})pop
/digit   << (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) >> def
/alpha   << (a) (b) (c) (d) (e) (f) (g) (h) (i) (j) (k) (l) (m)
            (n) (o) (p) (q) (r) (s) (t) (u) (v) (w) (x) (y) (z)
            (A) (B) (C) (D) (E) (F) (G) (H) (I) (J) (K) (L) (M)
            (N) (O) (P) (Q) (R) (S) (T) (U) (V) (W) (X) (Y) (Z) (_) >> def

/sp     << ( ) true >>              {    _             } build-parser-action def
/number [ //digit //digit //digit ] {    cvi      zxy  } build-parser-action def
/id     [ //alpha //alpha //alpha ] {    cvn cvx  zxy  } build-parser-action def
%//sp ==//number ==//id ==

/record {[zy   sp  number  sp  id  sp  number   _]==} def
(123Foo999) record
( 234fOO888) record
( 345 FQQ777) record
( 456 fqq 666) record

(   x      )
( ) term some exec pq

pq


Norah@laptop ~
$ gsnd -q pc3.ps
[123 Foo 999]
[234 fOO 888]
[345 FQQ 777]
[456 fqq 666]
1
(   x      )


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


#3113

Fromluser droog <luser.droog@gmail.com>
Date2017-06-10 23:36 -0700
Message-ID<87cb3ae9-2580-45af-b6a2-38f7cecd533c@googlegroups.com>
In reply to#3111
On Friday, June 9, 2017 at 4:54:22 PM UTC-5, luser droog wrote:
> On Friday, June 9, 2017 at 12:18:47 AM UTC-5, luser droog wrote:
> > On Wednesday, June 7, 2017 at 1:38:14 AM UTC-5, luser droog wrote:
> > > On Sunday, June 4, 2017 at 9:39:37 PM UTC-5, luser droog wrote:
> > > > On Sunday, June 4, 2017 at 8:57:56 PM UTC-5, luser droog wrote:
> > > > > On Sunday, June 4, 2017 at 1:13:16 PM UTC-5, luser droog wrote:
> > > > > > On Saturday, June 3, 2017 at 5:15:48 PM UTC-5, luser droog wrote:
> > > > > > > On Sunday, May 28, 2017 at 11:22:09 PM UTC-5, luser droog wrote:
> > > > > > > > cf. https://en.wikipedia.org/wiki/Parser_combinator
> 
> > Rewritten with a simpler return convention. Rather than empty array for
> > false and array of matched length, it returns -1 for false and the length
> > if >=0.
> > 
> > I have a thread over in comp.lang.c working up the same (similar) ideas in C .
> > I've got quantifiers there, so I guess those are needed here too.
> > 
> > 
> 
> Now I've got a tricky/annoying problem. My quantifiers, 'many' (*) and
> 'some' (+) are both yield correct match/no-match results. But they aren't
> "greedy", so not terribly useful. I'm trying to use them to eat whitespace
> but it doesn't work.
> 
> The /many combinator which implements the BNF or regex star (*) operator
> ie. Kleene closure, takes as input a parser p.
> 
> It constructs a new seq parser q whose left branch is
> p and whose right branch is q itself.
> 
>     p =>   q={p||q}
> 
> Then it constructs an alt parser whose left branch is q
> and whose right branch is 'succeeds'.
> 
>     return {q||succeed}
> 
> So it runs along the sequence part until it stops matching
> and fails, then the right branch of the alt always succeeds.
> But formulating it this way loses the count of how much was
> mapped. Need to think up a better machine for this.

I've got a better one now. The idea is it's a sequence. In my
builder notation,

  [ x ]

where x is whatever, the input parser to this combinator. 
This is the zero-or-more quantifier, so there may be matching
input but if not, the matcher still succeeds.

  << [ x ] true >>

Then we stitch this into a loop by inserting the whole matcher
into the inner sequence.

  y = <<[ x y ] true>>

And it works!

> Similar problem with the /some combinator which implements the BNF
> or regex plus (+) operator

I'll do that later.

Norah@laptop ~
$ cat pc3.ps
%/forall{pstack/ =//forall}def
[/z {   dup   } /zy  {     exch } /++ {     2 copy   }  /_ { pop       }
 /y { 1 index } /yzx { 3 2 roll }  /| { array astore }  /# { length    }
 /x { 2 index } /zxy { 3 1 roll }  /? { ifelse       }  /Z { {} @      }
 /w { 3 index } /zyx { zxy zy   }  /@ { forall       } /is { y type eq }
 /v { 4 index } /zwxy{ 4 1 roll } /.. { getinterval  }
/&   { [ zxy Z ] }   /&&     { 2 | [ zy { Z } @ ] }
/map { [ zxy @ ] }   /reduce { y 0 get zyx 1 y # 1 sub .. zy @ }
/ps  { pstack/ = }   /pq     { ps quit }  /pc { ps clear }
/ini  { 0 zy .. }  /fin   { y # y sub .. }
/fail { _ -1    }  /fail? { z -1 le }  /!fail? { fail? not }
/ret  { # } /pass { zy _ }
/mov { z zxy fin } /vom { fail? { _ _ fail }{ zy _ add }? }
/test { y # y # lt { fail }{ ++ # ini y eq { ret }{ fail } ? }? }
/term { /test cvx 2 | cvx }
/alt  { {z} yzx && {  fail? } && { _   } yzx && { zy _ } && cvx {{pass} ?} & && cvx }
/seq  { {z} yzx && { !fail? } && { mov } yzx && { vom  } && cvx {{fail} ?} & && cvx }
%       {z  p1       !fail?      { mov   p2       vom  }         {fail} ?}
%/many { {0} alt  {{{}exec}exec} z 0 get zxy seq  ++ 0 zy put zy _ }  %  q={p||0} r={q;;r}
/many { {{{}exec}exec} z 0 get zxy seq  {_ 0} alt  ++ 0 zy put zy _ }  % y = <<[ x y ] true>>

%/many {      {{{}exec}exec} z 0 get zxy seq        ++ 0 zy put zy _  {0} alt }
%/some {    z {{{}exec}exec} z 0 get zxy seq       ++ 0 zy put zy _      alt }
/build-parser-action {    zy build-parser  { !fail? } &&
    { ++ ini } yzx && { fin } &&  cvx {{ /parser-fail == ps }? } & && cvx }
/build-parser {     /stringtype  is { term       }{
                    /arraytype   is { build-seq  }{
                    /dicttype    is { build-alt  }{
                    /booleantype is { build-bool }{    }? }? }? }? }
/build-seq  { z xcheck {  }{  {build-parser} map {seq} reduce  }? }
/build-alt  { {} map {fixup} map bubble {build-parser} map {alt} reduce }
/build-bool { {{0}}{{-1}}? }
/fixup   {  /nulltype is { _              }{
            /nametype is { z # string cvs }{    }? }? }
/bubble  {  { z sorted {exit} if  [ zy {++ comp{zy}if} reduce ] } loop   }
/sorted  {  true zy { ++ comp { _ _ _ false 0 exit } if  zy _ } reduce _ }
/comp    { switch? x type get y type get exec }                /switch? <<
 /arraytype   << /arraytype{arrcomp } /stringtype{_ _ false} /dicttype{_ _ false} /booleantype{_ _ false} >>
 /stringtype  << /arraytype{_ _ true} /stringtype{    gt   } /dicttype{_ _ false} /booleantype{_ _ false} >>
 /dicttype    << /arraytype{_ _ true} /stringtype{_ _ true } /dicttype{_ _ false} /booleantype{_ _ false} >>
 /booleantype << /arraytype{_ _ true} /stringtype{_ _ true } /dicttype{_ _ true } /booleantype{_ _ false} >> >>
/arrcomp { y xcheck {  z xcheck { _ _ false }{ _ _ false }?  }
                    {  z xcheck { _ _ true  }{ _ _ false }?  }? }
>> begin
(>>) cvn [ { counttomark 2 mod 1 eq { null } if } Z counttomark 1 add index load ] cvx def


({
(hello world) [<<(H)(h)(j)>> (ello) ( ) (world)] build-parser dup == exec pc
(hello world) [<<(H)(h)>>(ello)] {    cvn ==  } build-parser-action dup == exec pc

/h <<(H)(h)(j)>> def
/H h build-parser def
(hello) [//h (ello)] build-parser dup == exec pc
(hello) [//H (ello)] build-parser dup == exec pc
(hello world) [ //H (ello) ] { cvn cvx == / = } build-parser-action dup == exec pc
(jello world) [ <<//H (j)>> (ello) ] { cvn cvx == / = } build-parser-action dup == exec pc
})pop
/digit   << (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) >> def
/alpha   << (a) (b) (c) (d) (e) (f) (g) (h) (i) (j) (k) (l) (m)
            (n) (o) (p) (q) (r) (s) (t) (u) (v) (w) (x) (y) (z)
            (A) (B) (C) (D) (E) (F) (G) (H) (I) (J) (K) (L) (M)
            (N) (O) (P) (Q) (R) (S) (T) (U) (V) (W) (X) (Y) (Z) (_) >> def

/sp     << ( ) true >>              {    _             } build-parser-action def
/number [ //digit //digit //digit ] {    cvi      zxy  } build-parser-action def
/id     [ //alpha //alpha //alpha ] {    cvn cvx  zxy  } build-parser-action def
%//sp ==//number ==//id ==

/record {[zy   sp  number  sp  id  sp  number   _]==} def
(123Foo999) record
( 234fOO888) record
( 345 FQQ777) record
( 456 fqq 666) record

(   x      )( ) term many exec pq

pq


Norah@laptop ~
$ gsnd -q pc3.ps
[123 Foo 999]
[234 fOO 888]
[345 FQQ 777]
[456 fqq 666]
3
(   x      )

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


#3114

Fromluser droog <luser.droog@gmail.com>
Date2017-06-12 21:19 -0700
Message-ID<f27c0490-4a15-4a50-9d2b-40ab28664e5e@googlegroups.com>
In reply to#3113
On Sunday, June 11, 2017 at 1:36:15 AM UTC-5, luser droog wrote:
> On Friday, June 9, 2017 at 4:54:22 PM UTC-5, luser droog wrote:
> > On Friday, June 9, 2017 at 12:18:47 AM UTC-5, luser droog wrote:
> > > On Wednesday, June 7, 2017 at 1:38:14 AM UTC-5, luser droog wrote:
> > > > On Sunday, June 4, 2017 at 9:39:37 PM UTC-5, luser droog wrote:
> > > > > On Sunday, June 4, 2017 at 8:57:56 PM UTC-5, luser droog wrote:
> > > > > > On Sunday, June 4, 2017 at 1:13:16 PM UTC-5, luser droog wrote:
> > > > > > > On Saturday, June 3, 2017 at 5:15:48 PM UTC-5, luser droog wrote:
> > > > > > > > On Sunday, May 28, 2017 at 11:22:09 PM UTC-5, luser droog wrote:
> > > > > > > > > cf. https://en.wikipedia.org/wiki/Parser_combinator
> > So it runs along the sequence part until it stops matching
> > and fails, then the right branch of the alt always succeeds.
> > But formulating it this way loses the count of how much was
> > mapped. Need to think up a better machine for this.
> 
> I've got a better one now. The idea is it's a sequence. In my
> builder notation,
> 
>   [ x ]
> 
> where x is whatever, the input parser to this combinator. 
> This is the zero-or-more quantifier, so there may be matching
> input but if not, the matcher still succeeds.
> 
>   << [ x ] true >>
> 
> Then we stitch this into a loop by inserting the whole matcher
> into the inner sequence.
> 
>   y = <<[ x y ] true>>
> 
> And it works!
> 

It came up in the comp.lang.c thread that this is not the usual
behavior of BNF quantifiers. There's no backtracking so a greedy
quantifier with this program is also "possessive". So with 
something like

    (x) term some
    (xy) term alt

which corresponds to the regex

    x+xy

the 'x+' consumes all 'x's that may be present, and the 'xy' part
will never match.

I may not be able to fix this quickly or easily. Need to rethink
the whole deal.

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


#3115

FromCarlos <carlos@cvkm.cz>
Date2017-06-13 07:40 +0200
Message-ID<20170613074059.02058fe1@samara.DOMA>
In reply to#3114
[luser droog <luser.droog@gmail.com>, 2017-06-12 21:19]
> On Sunday, June 11, 2017 at 1:36:15 AM UTC-5, luser droog wrote:
> > I've got a better one now. The idea is it's a sequence. In my
> > builder notation,
> > 
> >   [ x ]
> > 
> > where x is whatever, the input parser to this combinator. 
> > This is the zero-or-more quantifier, so there may be matching
> > input but if not, the matcher still succeeds.
> > 
> >   << [ x ] true >>
> > 
> > Then we stitch this into a loop by inserting the whole matcher
> > into the inner sequence.
> > 
> >   y = <<[ x y ] true>>
> > 
> > And it works!
> >   
> 
> It came up in the comp.lang.c thread that this is not the usual
> behavior of BNF quantifiers. There's no backtracking so a greedy
> quantifier with this program is also "possessive". So with 
> something like
> 
>     (x) term some
>     (xy) term alt
> 
> which corresponds to the regex
> 
>     x+xy
> 
> the 'x+' consumes all 'x's that may be present, and the 'xy' part
> will never match.
> 
> I may not be able to fix this quickly or easily. Need to rethink
> the whole deal.

According to https://qntm.org/combinators shouldn't "x+" return a set of
all matches?

-- 

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


#3116

Fromluser droog <luser.droog@gmail.com>
Date2017-06-13 01:53 -0700
Message-ID<6d6a42eb-737a-4bf1-b1ad-3eb333221deb@googlegroups.com>
In reply to#3115
On Tuesday, June 13, 2017 at 12:41:00 AM UTC-5, Carlos wrote:
> [luser droog <luser.droog@gmail.com>, 2017-06-12 21:19]
> > On Sunday, June 11, 2017 at 1:36:15 AM UTC-5, luser droog wrote:
> > > I've got a better one now. The idea is it's a sequence. In my
> > > builder notation,
> > > 
> > >   [ x ]
> > > 
> > > where x is whatever, the input parser to this combinator. 
> > > This is the zero-or-more quantifier, so there may be matching
> > > input but if not, the matcher still succeeds.
> > > 
> > >   << [ x ] true >>
> > > 
> > > Then we stitch this into a loop by inserting the whole matcher
> > > into the inner sequence.
> > > 
> > >   y = <<[ x y ] true>>
> > > 
> > > And it works!
> > >   
> > 
> > It came up in the comp.lang.c thread that this is not the usual
> > behavior of BNF quantifiers. There's no backtracking so a greedy
> > quantifier with this program is also "possessive". So with 
> > something like
> > 
> >     (x) term some
> >     (xy) term alt
> > 
> > which corresponds to the regex
> > 
> >     x+xy
> > 
> > the 'x+' consumes all 'x's that may be present, and the 'xy' part
> > will never match.
> > 
> > I may not be able to fix this quickly or easily. Need to rethink
> > the whole deal.
> 
> According to https://qntm.org/combinators shouldn't "x+" return a set of
> all matches?
> 

Thanks. That's a nice, short reference. And multiple results seems
like the right answer. I was going mad trying to come up with a
backtracking algorithm. My first version returned [] or [n], but
I didn't understand the purpose or how to use it correctly.

For exercise, and before reading this message and the link, I rewrote 
what I have in more straightforward postscript. Perhaps easier to look
at and/or read.

Norah@laptop ~
$ cat pc4.ps
<<
    /curry { [ 3 1 roll {} forall ] }
    /combine { 2 array astore [ exch { {} forall } forall ] }
    /map { [ 3 1 roll  forall ] }
    /reduce { 1 index 0 get 3 1 roll exch 1 1 index length 1 sub getinterval exch forall }
    /head { 0 exch getinterval }
    /tail { 1 index length 1 index sub getinterval }
    /is { 1 index type eq }

    /pass { pop 0 }
    /fail { pop -1 }
    /failed { dup -1 le }
    /passed { failed not }
    /next { dup 3 1 roll tail }
    /sum-of { failed { pop pop fail }{ exch pop add } ifelse }

    /test { 1 index length 1 index length lt {  fail  }{
                2 copy length head 1 index eq {  length  }{  fail  } ifelse
            } ifelse }
    
    /term { /test cvx 2 array astore cvx }
    /alt { {dup} 3 2 roll combine
           {failed} combine
           {pop} 3 2 roll combine
           {exch pop} combine cvx
           {{exch pop}ifelse} curry combine cvx }
    /seq { {dup} 3 2 roll combine
           {passed} combine
           {next} 3 2 roll combine
           {sum-of} combine cvx
           {{fail} ifelse} curry combine cvx }

    /many { {{{}exec}exec} dup 0 get 3 1 roll seq
            {pass} alt
            2 copy 0 exch put exch pop }
    /some { dup many seq }

    /build-parser-action {
        exch build-parser {passed} combine
        {2 copy head} 3 2 roll combine
        {tail} combine cvx
        {{/parser-fail = pstack/ =}ifelse} curry combine cvx }
    /build-parser {
        /stringtype  is { term       }{
        /arraytype   is { build-seq  }{
        /dicttype    is { build-alt  }{
        /booleantype is { build-bool }{
        } ifelse } ifelse } ifelse } ifelse }
    /build-seq {
        dup xcheck {  }{
            { build-parser } map
            { seq } reduce
        } ifelse }
    /build-alt {
        { } map
        { fix-up } map
        bubble-sort
        { build-parser } map
        { alt } reduce }
    /build-bool {
        { {0}
        }{ {-1}
        } ifelse }
    /fixup {
        /nulltype is { pop                   }{
        /nametype is { dup length string cvx }{
        } ifelse } ifelse }
    /bubble-sort {
        {
            dup sorted { exit } if
            [ exch { 2 copy comp { exch } if } reduce ]
        } loop
    }
    /sorted {
        true exch
        {
            2 copy comp {
                pop pop pop false 0 exit
            } if
            exch pop
        } reduce
        pop
    }
    /comp { switch? 2 index type get 1 index type get exec }
    /switch? <<
                 /arraytype   << /arraytype   { arrcomp       }
                                 /stringtype  { pop pop false }
                                 /dicttype    { pop pop false }
                                 /booleantype { pop pop false } >>
                 /stringtype  << /arraytype   { pop pop true  }
                                 /stringtype  { gt            }
                                 /dicttype    { pop pop false }
                                 /booleantype { pop pop false } >>
                 /dicttype    << /arraytype   { pop pop true  }
                                 /stringtype  { pop pop true  }
                                 /dicttype    { pop pop false }
                                 /booleantype { pop pop false } >>
                 /booleantype << /arraytype   { pop pop true  }
                                 /stringtype  { pop pop true  }
                                 /dicttype    { pop pop true  }
                                 /booleantype { pop pop false } >>
             >>
    /arrcomp {
        1 index xcheck {
            dup xcheck {  pop pop false  }{  pop pop false  } ifelse
        }{
            dup xcheck {  pop pop true   }{  pop pop false  } ifelse
        } ifelse
    }
>> begin
(>>) cvn [
    { counttomark 2 mod 1 eq { null } if } { } forall
    counttomark 1 add index load
] cvx def


Norah@laptop ~
$ gsnd -q pc4.ps
GS>(xxx) (x) term some exec pstack
3
(xxx)
GS<2>
Norah@laptop ~
$ 

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


#3117

Fromluser droog <luser.droog@gmail.com>
Date2017-06-13 03:48 -0700
Message-ID<6776d1fc-7baa-4684-8bfe-d497fe8379ea@googlegroups.com>
In reply to#3116
On Tuesday, June 13, 2017 at 3:53:48 AM UTC-5, luser droog wrote:
> On Tuesday, June 13, 2017 at 12:41:00 AM UTC-5, Carlos wrote:
> > [luser droog <luser.droog@gmail.com>, 2017-06-12 21:19]
> > > On Sunday, June 11, 2017 at 1:36:15 AM UTC-5, luser droog wrote:
> > > > I've got a better one now. The idea is it's a sequence. In my
> > > > builder notation,
> > > > 
> > > >   [ x ]
> > > > 
> > > > where x is whatever, the input parser to this combinator. 
> > > > This is the zero-or-more quantifier, so there may be matching
> > > > input but if not, the matcher still succeeds.
> > > > 
> > > >   << [ x ] true >>
> > > > 
> > > > Then we stitch this into a loop by inserting the whole matcher
> > > > into the inner sequence.
> > > > 
> > > >   y = <<[ x y ] true>>
> > > > 
> > > > And it works!
> > > >   
> > > 
> > > It came up in the comp.lang.c thread that this is not the usual
> > > behavior of BNF quantifiers. There's no backtracking so a greedy
> > > quantifier with this program is also "possessive". So with 
> > > something like
> > > 
> > >     (x) term some
> > >     (xy) term alt
> > > 
> > > which corresponds to the regex
> > > 
> > >     x+xy
> > > 
> > > the 'x+' consumes all 'x's that may be present, and the 'xy' part
> > > will never match.
> > > 
> > > I may not be able to fix this quickly or easily. Need to rethink
> > > the whole deal.
> > 
> > According to https://qntm.org/combinators shouldn't "x+" return a set of
> > all matches?
> > 
> 
> Thanks. That's a nice, short reference. And multiple results seems
> like the right answer. I was going mad trying to come up with a
> backtracking algorithm. My first version returned [] or [n], but
> I didn't understand the purpose or how to use it correctly.
> 

Ok. A better nucleus. None of the fancy stuff. Half-abbreviated.
Return values are arrays of matched lengths. alt applies both
alternatives and then combines the results. seq applies the
right piece to any (each) results from the left piece.

Hardest part is commenting these things. I tried giving running
stack pictures of the compile-time state and execution of that
fragment compiled so far.

Norah@laptop ~
$ cat pc5.ps
<<
    /spill   {{}forall}
    /curry   {[zxy spill]}
    /combine {2 | {spill}map}
    /map     {[zxy  forall]}
    /reduce  {y 0 get zxy 1 tail zy forall}
    /head {0 zy getinterval}
    /tail {y # y sub getinterval}
    /is  {y type eq}
    /|   {array astore}
    /#   {length}
    /y   {1 index}
    /xyz pop
    /zxy {3 1 roll}
    /yzx {3 2 roll}
     /zy {exch}

    /pass   {# 1 | zy pop}
    /fail   {pop pop { } }
    /failed {dup # 0 gt}
    /passed {failed not}

    /test { y #  y #  lt         {  fail  }{    % (input) (seek)
            2 copy # head  y  eq {  pass  }{  fail  } ifelse
            } ifelse }  % [] | [#]

    /term { /test cvx 2 | cvx }
    /alt {
        {dup} yzx combine               % p2 {dup p1}                   % (input) [?1]
        {exch} combine zy combine       % p2 {dup p1 exch p2}           % [?1] [?2]
        {combine} combine cvx }         % {dup p1 exch p2 combine}      % [?12]
    /seq {
        {dup} yzx combine                       % p2 {dup p1}                   % (input) [?1]
        {zy} combine                            % p2 {dup p1 zy}                % [?1] (input)
        { zy tail } yzx combine cvx             % {dup p1 zy} {zy tail p2}      % [?1] (input) {zy tail p2}
        {curry cvx map{spill}map} curry combine cvx } %{dup p1 zy{zy tail p2}curry map{spill}map}   % [?2]
    /ps {pstack / =} /pc {ps clear}
>> begin
%/forall { pstack/ = forall } bind def

(x) (x) term exec pc
(x) (x) term (y) term alt exec pc
(xy) (x) term (y) term seq exec pc

quit

Norah@laptop ~
$ gsnd -q pc5.ps
[1]

[1]

[1]


Norah@laptop ~
$ 

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


#3118

Fromluser droog <luser.droog@gmail.com>
Date2017-06-13 04:22 -0700
Message-ID<e2371211-86ec-4644-bb05-cf79f483cde9@googlegroups.com>
In reply to#3117
On Tuesday, June 13, 2017 at 5:48:56 AM UTC-5, luser droog wrote:
> On Tuesday, June 13, 2017 at 3:53:48 AM UTC-5, luser droog wrote:
> > On Tuesday, June 13, 2017 at 12:41:00 AM UTC-5, Carlos wrote:
> > > [luser droog <luser.droog@gmail.com>, 2017-06-12 21:19]
> > > > On Sunday, June 11, 2017 at 1:36:15 AM UTC-5, luser droog wrote:
> > > > > I've got a better one now. The idea is it's a sequence. In my
> > > > > builder notation,
> > > > > 
> > > > >   [ x ]
> > > > > 
> > > > > where x is whatever, the input parser to this combinator. 
> > > > > This is the zero-or-more quantifier, so there may be matching
> > > > > input but if not, the matcher still succeeds.
> > > > > 
> > > > >   << [ x ] true >>
> > > > > 
> > > > > Then we stitch this into a loop by inserting the whole matcher
> > > > > into the inner sequence.
> > > > > 
> > > > >   y = <<[ x y ] true>>
> > > > > 
> > > > > And it works!
> > > > >   
> > > > 
> > > > It came up in the comp.lang.c thread that this is not the usual
> > > > behavior of BNF quantifiers. There's no backtracking so a greedy
> > > > quantifier with this program is also "possessive". So with 
> > > > something like
> > > > 
> > > >     (x) term some
> > > >     (xy) term alt
> > > > 
> > > > which corresponds to the regex
> > > > 
> > > >     x+xy
> > > > 
> > > > the 'x+' consumes all 'x's that may be present, and the 'xy' part
> > > > will never match.
> > > > 
> > > > I may not be able to fix this quickly or easily. Need to rethink
> > > > the whole deal.
> > > 
> > > According to https://qntm.org/combinators shouldn't "x+" return a set of
> > > all matches?
> > > 
> > 
> > Thanks. That's a nice, short reference. And multiple results seems
> > like the right answer. I was going mad trying to come up with a
> > backtracking algorithm. My first version returned [] or [n], but
> > I didn't understand the purpose or how to use it correctly.
> > 
> 
> Ok. A better nucleus. None of the fancy stuff. Half-abbreviated.
> Return values are arrays of matched lengths. alt applies both
> alternatives and then combines the results. seq applies the
> right piece to any (each) results from the left piece.
> 
> Hardest part is commenting these things. I tried giving running
> stack pictures of the compile-time state and execution of that
> fragment compiled so far.
> 

Kleene star.
sleepy.

Norah@laptop ~
$ !c
cat pc5.ps
<<
    /spill   {{}forall}
    /curry   {[zxy spill]}
    /combine {2 | {spill}map}
    /map     {[zxy  forall]}
    /reduce  {y 0 get zxy 1 tail zy forall}
    /head {0 zy getinterval}
    /tail {y # y sub getinterval}
    /is  {y type eq}
    /|   {array astore}
    /#   {length}
     /y  {1 index}
      /z {dup}
    /xyz pop
     /zy {exch}
    /zxy {3 1 roll}
    /yzx {3 2 roll}

    /pass   {# 1 | zy pop}
    /fail   {pop pop { } }
    /failed {dup # 0 gt}
    /passed {failed not}

    /test { y #  y #  lt         {  fail  }{    % (input) (seek)
            2 copy # head  y  eq {  pass  }{  fail  } ifelse
            } ifelse }  % [] | [#]

    /term { /test cvx 2 | cvx }
    /alt {
        {dup} yzx combine               % p2 {dup p1}                   % (input) [?1]
        {exch} combine zy combine       % p2 {dup p1 exch p2}           % [?1] [?2]
        {combine} combine cvx }         % {dup p1 exch p2 combine}      % [?12]
    /seq {
        % dup p1 zy  % [?1] (input)
        % { y tail p2  % #1 [?2]
        %   zy {add} curry cvx forall
        {dup} yzx combine                       % p2 {dup p1}                   % (input) [?1]
        {zy} combine                            % p2 {dup p1 zy}                % [?1] (input)
        { y tail } yzx combine                  % {dup p1 zy} {y tail p2}       % [?1] (input) {y tail p2}
        { zy {add} curry cvx forall} combine cvx
        {curry cvx map} curry combine cvx }  %{dup p1 zy{y tail p2 ...}curry map}   % [?2]
    /many {
        {{{}exec}exec} dup 0 get zxy seq
        {()pass} alt
        2 copy 0 zy put zy pop }

    /ps {pstack / =} /pc {ps clear}
>> begin
%/forall { pstack/ = forall } bind def

(x) () term exec pc
(x) (x) term exec pc
(x) (x) term (y) term alt exec pc
(xy) (x) term (y) term seq exec pc
(xxxxy) (x) term many exec pc
(xxxxy) (x) term many (xy) term seq exec pc

quit

Norah@laptop ~
$ !g
gsnd -q pc5.ps
[0]

[1]

[1]

[2]

[4 3 2 1 0]

[5]


Norah@laptop ~
$ 

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


#3119

Fromluser droog <luser.droog@gmail.com>
Date2017-06-13 23:28 -0700
Message-ID<bd76de61-cb0b-4004-9702-ec94a5eae4d3@googlegroups.com>
In reply to#3118
On Tuesday, June 13, 2017 at 6:22:25 AM UTC-5, luser droog wrote:
> On Tuesday, June 13, 2017 at 5:48:56 AM UTC-5, luser droog wrote:
> > On Tuesday, June 13, 2017 at 3:53:48 AM UTC-5, luser droog wrote:
> > > On Tuesday, June 13, 2017 at 12:41:00 AM UTC-5, Carlos wrote:

> > > > According to https://qntm.org/combinators shouldn't "x+" return a set of
> > > > all matches?
> > > > 
> > > 
> > > Thanks. That's a nice, short reference. And multiple results seems
> > > like the right answer. I was going mad trying to come up with a
> > > backtracking algorithm. My first version returned [] or [n], but
> > > I didn't understand the purpose or how to use it correctly.
> > > 
> > 
> > Ok. A better nucleus. None of the fancy stuff. Half-abbreviated.
> > Return values are arrays of matched lengths. alt applies both
> > alternatives and then combines the results. seq applies the
> > right piece to any (each) results from the left piece.
> > 
> > Hardest part is commenting these things. I tried giving running
> > stack pictures of the compile-time state and execution of that
> > fragment compiled so far.
> > 
> 
> Kleene star.
> sleepy.
> 

Filled-out the rest of the baggage. And I think I came up with a better
way to document these dynamic procedures. By providing 3 times as much 
commentary as the code itself. The regular main-line code has stack
comments leading up the dynamic procedure body in full.

Then, accompanying the function, the dynamic procedure is exploded 
with its own running stack comments.

I'm not sure if I've mentioned this, but don't try to view the result
of the /many combinator. Its result is a procedure which recursively
contains itself. So the `==` operator will overflow the execution stack
if it attempts to print it.


Norah@laptop ~
$ cat pc5.ps
<<
    /spill   {{}forall}
    /curry   %{/exec cvx 3 |}
             {[zxy spill]}
    /combine %{2 | {/exec cvx} map}
             {2 | {spill}map}
    /map     {[zxy  forall]}
    /reduce  {y 0 get zxy zy 1 tail zy forall}
    /head {0 zy getinterval}
    /tail {y # y sub getinterval}
    /is  {y type eq}
    /|   {array astore}
    /#   {length}
    /x   {2 index}
     /y  {1 index}
      /z {dup}
    /xyz pop
     /zy {exch}
    /zxy {3 1 roll}
    /yzx {3 2 roll}
    /max {2 copy lt {exch} if pop}

    /pass   {# 1 | zy pop}
    /fail   {pop pop { } }
    /failed {z # 0 eq}
    /passed {failed not}
    /next   {y tail}
    /sum-up {zy {add} curry cvx forall}

    /test { y #  y #  lt         {  fail  }{    % (input) (seek)
            2 copy # head  y  eq {  pass  }{  fail  } ifelse
            } ifelse }  % [] | [#]
    /term { /test cvx 2 | cvx }

    /alt {
        % {             % (input)
        %     z         % (input) (input)
        %     p1 zy     % [?1] (input)
        %     p2        % [?1] [?2]
        %     combine   % [?1 ?2]
        % }
        {z} yzx combine                 % p2 [z p1]
        {zy} combine zy combine         % p2 [z p1 zy p2]
        {combine} combine cvx }         % {z p1 zy p2 combine}
    
    /seq {
        % {                                     % (input)
        %     z                                 % (input) (input)
        %     p1 zy                             % [?1] (input)
        %     {next p2 sum-up} curry cvx        % [?1] {(input) next p2 sum-up}
        %     map                               % [#1+?2]
        % }
        % {                             % #1
        %     (input) next={y tail}     % #1 (nput)
        %     p2                        % #1 [?2]
        %     sum-up={
        %         zy {add} curry cvx    % [?2] {#1 add}
        %         forall                % #1+?2*
        %     }
        % }
        {z} yzx combine                         % p2 [z p1]
        {zy} combine                            % p2 [z p1 zy]
        {next} yzx combine                      % [z p1 zy] [next p2]
        {sum-up} combine cvx                    % [z p1 zy] {next p2 sum-up}
        {curry cvx map} curry combine cvx }     % {z p1 zy{next p2 sum-up}curry cvx map}
    
    /many {     % x => y = << [ x y ] true >>
        {{{}exec}exec} z 0 get zxy seq  maybe
        2 copy 0 zy put zy pop }
    
    /some { z many seq }
    
    /maybe { {()pass} alt }

    /build-parser-action {
        % {
        %     z parser  passed {
        %         {max} reduce 2 copy head action tail
        %     }{
        %         /parser-fail = ps
        %     } ifelse
        % }
        zy build-parser {z} zy combine
        {passed} combine
        {{max} reduce 2 copy head} yzx combine
        {tail} combine cvx
        {{/parser-fail = ps}ifelse} curry combine cvx }
    /build-parser {
        /stringtype  is { term       }{
        /arraytype   is { build-seq  }{
        /dicttype    is { build-alt  }{
        /booleantype is { build-bool }{  } ifelse } ifelse } ifelse } ifelse }
    /build-seq { z xcheck {  }{  {build-parser} map  {seq} reduce  } ifelse }
    /build-alt {  {} map  {fix-up} map  bubble  {build-parser} map  {alt} reduce  }
    /build-bool {  {()pass} {()fail} ifelse  }
    /fix-up {
        /nulltype is { pop            }{
        /nametype is { z # string cvs }{  } ifelse } ifelse }
    /bubble {  { z sorted {exit} if   [ zy {2 copy comp {exch} if} reduce ] } loop  }
    /sorted { true zy  {2 copy comp {pop pop pop false 0 exit} if  exch pop} reduce  pop }
    /comp { switch?  x type get  y type get  exec }
    /switch? <<
             /arraytype   << /arraytype   { arrcomp       }
                             /stringtype  { pop pop false }
                             /dicttype    { pop pop false }
                             /booleantype { pop pop false } >>
             /stringtype  << /arraytype   { pop pop true  }
                             /stringtype  { gt            }
                             /dicttype    { pop pop false }
                             /booleantype { pop pop false } >>
             /dicttype    << /arraytype   { pop pop true  }
                             /stringtype  { pop pop true  }
                             /dicttype    { pop pop false }
                             /booleantype { pop pop false } >>
             /booleantype << /arraytype   { pop pop true  }
                             /stringtype  { pop pop true  }
                             /dicttype    { pop pop true  }
                             /booleantype { pop pop false } >>  >>
    /arrcomp {  y xcheck {    dup xcheck {  pop pop false  }{  pop pop false  } ifelse  }{
                              dup xcheck {  pop pop true   }{  pop pop false  } ifelse  } ifelse    }
    /ps {pstack/ =} /pc {ps clear} /pq {ps quit}
>> begin
(>>) [ {counttomark 2 mod 1 eq {null} if} spill  counttomark 1 add index load ] cvx def
%/forall { pstack/ = forall } bind def
%/getinterval { ps getinterval } bind def

(x) () term exec pc
(x) (x) term exec pc
(x) (x) term (y) term alt exec pc
(xy) (x) term (y) term seq exec pc
(xxxxy) (x) term many exec pc
(xxxxy) (x) term many (xy) term seq exec pc
<< (x) (y) >> build-parser pc

/xy << (x) (y) >> {
    ==
} build-parser-action ps def

(x) xy pc
(y) xy pc

pq

Norah@laptop ~
$ gsnd -q pc5.ps
[0]

[1]

[1]

[2]

[4 3 2 1 0]

[5]

{z (x) test zy (y) test combine}

{z z (x) test zy (y) test combine passed {{max} reduce 2 copy head == tail} {/parser-fail = ps} ifelse}
/xy

(x)
()

(y)
()



Norah@laptop ~
$ 

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


#3120

FromCarlos <carlos@cvkm.cz>
Date2017-06-14 21:52 +0200
Message-ID<20170614215208.2c5e105e@samara.DOMA>
In reply to#3119
[luser droog <luser.droog@gmail.com>, 2017-06-13 23:28]
[...]
> I'm not sure if I've mentioned this, but don't try to view the result
> of the /many combinator. Its result is a procedure which recursively
> contains itself. So the `==` operator will overflow the execution stack
> if it attempts to print it.

This can help, I made it when I was playing with iterators, which also
use a lot of dynamic code. It's not the epytome of elegant code, but helps...

samara:~/src/misc/ps% gsnd -q inspect.ps pc5.ps
GS>/Inspect /ProcSet findresource begin userdict begin
GS>/ppstack { inspectstack print } def
GS>
GS>(x) term many (xy) term seq   ppstack
0: {z z z #1=(x) test zy #2={next {{z z #1# test zy #2# curry cvx map zy #5=()
pass combine} exec} exec sum-up} curry cvx map zy #5# pass combine zy {next
(xy) test sum-up} curry cvx map}
GS<1>%
samara:~/src/misc/ps% 

inspect.ps:

%!PS-Adobe-3.0 Resource-ProcSet
%%Copyright: Public Domain
%%DocumentSuppliedResources: procset Inspect 1.0 1
%%+ procset _Inspect 1.0 1
%%EndComments

%%BeginProlog

%%BeginResource: procset _Inspect 1.0 1

% private functions
20 dict begin

/strbuffer 4000 string def

% obj -> pos
/register {
    registry [ 3 -1 roll false ] eappend
    registry elength 1 sub
} bind def

% obj -> pos true
% obj -> false
% also sets registered object as used
/registered {
    false
    registry elength 1 sub -1 0 {
        dup
        registry exch eget dup
        0 get 4 index eq { 1 true put exch pop true exit } if
        pop pop
    } for
    dup { 3 -1 roll  } { exch } ifelse
    pop
} bind def

% earray newlen ->
/eexpand {
    1 index 0 get length
    2 copy gt {
        {
            2 copy le { exit } if
            2 mul
        } loop
        dup 65535 gt { pop 65535 } if
        % aa rl nl
        exch pop % aa nl
        dup % aa nl nl
        2 index 0 get length ge {  % aa nl
            1 index 0 get type /stringtype eq { string } { array } ifelse %% aa na
            dup 2 index 0 get exch copy pop
            0 exch put
        }
        { pop pop } ifelse
    }
    { pop pop pop } ifelse
} bind def

% expandable-array:[arr len] elt ->
/eappend {
    exch dup aload  % st: elt earray edata elen earray
    exch 1 add eexpand pop
    aload % e edata elen earray
    4 1 roll  3 -1 roll  put
    dup 1 get 1 add 1 exch put
} bind def

% exparr arr
/econcat {
    2 copy length exch 1 get add     % aa ca ni
    2 index 2 copy exch eexpand      % aa ca ni aa
    aload pop                        % aa ca ni a i
    4 -1 roll putinterval            % aa ni
    1 exch put
} bind def

/newexparray  { [ 4 array 0 ] } bind def
/newexpstring { [ 4 string 0 ] } bind def
/edata { dup 0 get exch 1 get 0 exch getinterval } bind def

/elength { 1 get } bind def
/eget { exch 0 get exch get } bind def
/eput { 2 copy 1 sub eexpand exch 0 get exch put } bind def

/dupstr { dup length string copy } bind def

% /limit default -> n
/getlimit {
    exch dup where {
        exch get  exch pop
    } {
        pop
    } ifelse
} bind def

/inspectarray {
    dup register
    newexparray dup 3 -1 roll eappend
    dup 2 index xcheck { /xarr } { /arr } ifelse eappend
    /InspectArrayLimit 1000 getlimit
    3 -1 roll {
        exch 1 sub dup 3 1 roll 0 lt { pop 1 index (...) eappend exit } if
        inspectobject 2 index exch eappend
    } forall
    pop
    edata
} bind def

/inspectdict {
    dup register
    newexparray dup 3 -1 roll eappend
    dup /dict eappend
    /InspectDictLimit 500 getlimit
    3 -1 roll {
        3 -1 roll 1 sub dup 4 1 roll 0 lt { pop pop 1 index (...) eappend exit } if
        exch inspectobject 3 index exch eappend
        inspectobject 2 index exch eappend
    } forall
    pop
    edata
} bind def

/inspectname {
    newexpstring
    1 index xcheck not { dup 47 eappend } if
    dup 3 -1 roll strbuffer cvs econcat
    edata
} bind def

/tooctal {
    8 strbuffer cvrs
    newexpstring dup 92 eappend
    1 index length 3 exch sub { dup 48 eappend } repeat
    dup 3 -1 roll econcat
    edata
} bind def

/stringescapes <<
    40  (\\\()
    41  (\\\))
    92  (\\\\)
     8  (\\b)
     9  (\\t)
    10  (\\n)
    12  (\\f)
    13  (\\r)
>> def

/inspectstring {
    dup register
    newexparray dup 3 -1 roll eappend
    dup
    newexpstring dup 40 eappend
    /InspectStringLimit 500 getlimit
    5 -1 roll   { 
        exch 1 sub dup 3 1 roll 0 lt { pop 1 index (\\...) econcat exit } if
        2 index exch
        dup stringescapes exch known {
            stringescapes exch get econcat
        } {
            dup dup 32 lt exch 126 gt or {
                tooctal econcat
            } {
                eappend
            } ifelse
        } ifelse
    } forall
    pop
    dup 41 eappend

    edata  eappend edata
} bind def

/inspectother {
    strbuffer cvs dupstr
} bind def

/iscomposite {
    type dup dup dup /arraytype eq
    exch /packedarraytype eq or
    exch /dicttype eq or
    exch /stringtype eq or
} bind def

% obj
/inspectobject {
    dup iscomposite {
        dup rcheck not {
            pop (#<noaccess>)
        } {
            dup registered {
                exch pop
                newexpstring dup 35 eappend
                dup 3 -1 roll strbuffer cvs  econcat    
                dup 35 eappend edata dupstr            
            } {
                dup type
                dup dup /arraytype eq exch /packedarraytype eq or {
                    pop inspectarray
                } {
                    dup /dicttype eq {
                        pop inspectdict
                    } {
                        /stringtype eq {
                            inspectstring
                        } if
                    } ifelse
                } ifelse
            } ifelse
        } ifelse
    } {
        dup type /nametype eq {
            inspectname
        } {
            dup type /nulltype eq {
                pop (null)
            } {
                dup type /marktype eq {
                    pop (--mark--)
                } {
                    dup type /filetype eq {
                        pop (--file--)
                    } {
                        inspectother
                    } ifelse
                } ifelse
            } ifelse
        } ifelse
    } ifelse
} bind def

% expstr obj ->
/inspectinto {
    dup type dup /stringtype eq {
        pop econcat
    } {
        /arraytype eq {
            inspectarrayinto
        } {
            pop (**????**) econcat
        } ifelse
    } ifelse
} bind def

/inspectarrayinto {
    dup 0 get dup registry exch  eget 1 get { 
        2 index 35 eappend
        2 index exch strbuffer cvs econcat
        1 index 61 eappend
    } { pop } ifelse
    dup 1  get dup type /stringtype eq {
        exch pop econcat
    } {
        dup /dict eq {
            pop (<<) (>>)
        } {
            dup /arr eq {
                pop ([) (])
            } {
                /xarr eq {
                ({) (})
                } {
                (¿) (?)
                } ifelse
            } ifelse
        } ifelse
        % stack: espstr arr open close
        3 index 3 -1 roll econcat
        2 1 3 index length 1 sub {
            dup 2 gt { 3 index 32 eappend } if
            2 index exch get
            3 index exch  inspectinto
        } for
        3 -1 roll exch econcat
        pop
    } ifelse
} bind def

currentdict
end

/_Inspect exch /ProcSet defineresource pop

%%EndResource

%%BeginResource: procset Inspect 1.0 1

2 dict begin

% obj -> str
/inspect {
    /_Inspect /ProcSet findresource begin
    1 dict begin
    /registry newexparray def
    inspectobject
    newexpstring dup 3 -1 roll inspectinto
    edata
    end
    end
} bind def

/inspectstack {
    /_Inspect /ProcSet findresource begin
    1 dict begin
    /registry newexparray def
    count dup array
    exch 1 add 2 1 3 -1 roll {
        dup index inspectobject
        2 index  3 -1 roll 2 sub  3 -1 roll put
    } for                           
    newexpstring
    0 1 3 index length 1 sub {
        dup 3 index exch get
        exch strbuffer cvs 2 index exch econcat
        1 index (: ) econcat
        1 index exch inspectinto
        dup 10 eappend
    } for
    exch pop edata
    end
    end
} bind def

currentdict
end

/Inspect exch /ProcSet defineresource pop

%%EndResource
%%EndProlog

-- 

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


#3121

Fromluser droog <luser.droog@gmail.com>
Date2017-06-15 13:36 -0700
Message-ID<c36bd901-ee2e-442c-9a82-1663e1a9a49f@googlegroups.com>
In reply to#3120
On Wednesday, June 14, 2017 at 2:52:09 PM UTC-5, Carlos wrote:
> [luser droog <luser.droog@gmail.com>, 2017-06-13 23:28]
> [...]
> > I'm not sure if I've mentioned this, but don't try to view the result
> > of the /many combinator. Its result is a procedure which recursively
> > contains itself. So the `==` operator will overflow the execution stack
> > if it attempts to print it.
> 
> This can help, I made it when I was playing with iterators, which also
> use a lot of dynamic code. It's not the epytome of elegant code, but helps...
> 
> samara:~/src/misc/ps% gsnd -q inspect.ps pc5.ps
> GS>/Inspect /ProcSet findresource begin userdict begin
> GS>/ppstack { inspectstack print } def
> GS>
> GS>(x) term many (xy) term seq   ppstack
> 0: {z z z #1=(x) test zy #2={next {{z z #1# test zy #2# curry cvx map zy #5=()
> pass combine} exec} exec sum-up} curry cvx map zy #5# pass combine zy {next
> (xy) test sum-up} curry cvx map}
> GS<1>%
> samara:~/src/misc/ps% 
> 
> inspect.ps:
> 
<snip>

Very nice. For this I think I'd rather accept the constraint not to 
inspect them since this forces me to improve the documentation in
order to debug it. But your code looks pretty solid. I've been afraid
of dealing with resources because it all seems so complicated. So this
code nicely de-mystifies that for me.

Worked mine up a little more, up to grabbing fields from a string.

The latest bug was in the /many combinator.

/many {     % x => y = << [ x y ] true >> 
        {{{}exec}exec} z 0 get zxy seq  maybe 
        2 copy 0 zy put zy pop }

Can you see it? The problem arises when you try to make two
/many parsers at the same time. ...

... They share the same  {{ ??  exec}exec}   piece in the middle.
So that little piece needs to be assembled anew for each invocation.


Norah@laptop ~
$ cat pc5.ps
<<
    /spill   {{}forall}
    /curry   %{/exec cvx 3 |}
             {[zxy spill]}
    /combine %{2 | {/exec cvx} map}
             {2 | {spill}map}
    /map     {[zxy  forall]}
    /reduce  {y 0 get zxy zy 1 tail zy forall}
    /head {0 zy getinterval}
    /tail {y # y sub getinterval}
    /is  {y type eq}
    /|   {array astore}
    /#   {length}
    /x   {2 index}
     /y  {1 index}
      /z {dup}
    /xyz pop
     /zy {exch}
    /zxy {3 1 roll}
    /yzx {3 2 roll}
    /max {2 copy lt {exch} if pop}

    /pass   {# 1 | zy pop}
    /fail   {pop pop { } }
    /failed {z # 0 eq}
    /passed {failed not}
    /next   {y tail}
    /sum-up {zy {add} curry cvx forall}

    /test { y #  y #  lt         {  fail  }{    % (input) (seek)
            2 copy # head  y  eq {  pass  }{  fail  } ifelse
            } ifelse }  % [] | [#]
    /term { /test cvx 2 | cvx }

    /alt {
        % {             % (input)
        %     z         % (input) (input)
        %     p1 zy     % [?1] (input)
        %     p2        % [?1] [?2]
        %     combine   % [?1 ?2]
        % }
        {z} yzx combine                 % p2 [z p1]
        {zy} combine zy combine         % p2 [z p1 zy p2]
        {combine} combine cvx }         % {z p1 zy p2 combine}
    
    /seq {
        % {                                     % (input)
        %     z                                 % (input) (input)
        %     p1 zy                             % [?1] (input)
        %     {next p2 sum-up} curry cvx        % [?1] {(input) next p2 sum-up}
        %     map                               % [#1+?2]
        % }
        % {                             % #1
        %     (input) next={y tail}     % #1 (nput)
        %     p2                        % #1 [?2]
        %     sum-up={
        %         zy {add} curry cvx    % [?2] {#1 add}
        %         forall                % #1+?2*
        %     }
        % }
        {z} yzx combine                         % p2 [z p1]
        {zy} combine                            % p2 [z p1 zy]
        {next} yzx combine                      % [z p1 zy] [next p2]
        {sum-up} combine cvx                    % [z p1 zy] {next p2 sum-up}
        {curry cvx map} curry combine cvx }     % {z p1 zy{next p2 sum-up}curry cvx map}
    
    /many {     % x => y = << [ x y ] true >>
        [[[]cvx/exec cvx]cvx/exec cvx]cvx
        z 0 get zxy seq  maybe
        2 copy 0 zy put zy pop }
    
    /some { z many seq }
    
    /maybe { {()pass} alt }

    /build-parser-action {
        % {
        %     z parser  passed {
        %         {max} reduce 2 copy head action tail
        %     }{
        %         /parser-fail = ps
        %     } ifelse
        % }
        zy build-parser {z} zy combine
        {passed} combine
        {{max} reduce 2 copy head} yzx combine
        {tail} combine cvx
        {{/parser-fail = ps}ifelse} curry combine cvx }
    /build-parser {
        /stringtype  is { term       }{
        /arraytype   is { build-seq  }{
        /dicttype    is { build-alt  }{
        /booleantype is { build-bool }{  } ifelse } ifelse } ifelse } ifelse }
    /build-seq { z xcheck {  }{  {build-parser} map  {seq} reduce  } ifelse }
    /build-alt {  {} map  {fix-up} map  bubble  {build-parser} map  {alt} reduce  }
    /build-bool {  {()pass} {()fail} ifelse  }
    /fix-up {
        /nulltype is { pop            }{
        /nametype is { z # string cvs }{  } ifelse } ifelse }
    /bubble {  { z sorted {exit} if   [ zy {2 copy comp {exch} if} reduce ] } loop  }
    /sorted { true zy  {2 copy comp {pop pop pop false 0 exit} if  exch pop} reduce  pop }
    /comp { switch?  x type get  y type get  exec }
    /switch? <<
             /arraytype   << /arraytype   { arrcomp       }
                             /stringtype  { pop pop false }
                             /dicttype    { pop pop false }
                             /booleantype { pop pop false } >>
             /stringtype  << /arraytype   { pop pop true  }
                             /stringtype  { gt            }
                             /dicttype    { pop pop false }
                             /booleantype { pop pop false } >>
             /dicttype    << /arraytype   { pop pop true  }
                             /stringtype  { pop pop true  }
                             /dicttype    { pop pop false }
                             /booleantype { pop pop false } >>
             /booleantype << /arraytype   { pop pop true  }
                             /stringtype  { pop pop true  }
                             /dicttype    { pop pop true  }
                             /booleantype { pop pop false } >>  >>
    /arrcomp {  y xcheck {    dup xcheck {  pop pop false  }{  pop pop false  } ifelse  }{
                              dup xcheck {  pop pop true   }{  pop pop false  } ifelse  } ifelse    }
    /ps {pstack/ =} /pc {ps clear} /pq {ps quit}
>> begin
(>>) [ {counttomark 2 mod 1 eq {null} if} spill  counttomark 1 add index load ] cvx def
%/forall { pstack/ = forall } bind def
%/getinterval { ps getinterval } bind def
/reverse {
    [zy z # 1 sub -1 0  4 -1 roll {zy get} curry cvx for ]
} def
/func { % /name {a r g s} { body }
    {z # dict begin{zy def}forall} zy combine {end} combine
    zy reverse zy curry cvx
} def

/fortuple {arr n proc}{
    ({
        0  //n  //arr # 1 sub {
            //arr  zy  //n  getinterval
            //proc exec
        } for
    }) cvx exec exec
} func def

/char-class {
    << zy
       1 {} fortuple
    >>
} def

(x) () term exec pc
(x) (x) term exec pc
(x) (x) term (y) term alt exec pc
(xy) (x) term (y) term seq exec pc
(xxxxy) (x) term many exec pc
(xxxxy) (x) term many (xy) term seq exec pc
<< (x) (y) >> build-parser pc
/xy << (x) (y) >> {    ==    } build-parser-action ps def
(x) xy pc
(y) xy pc

/digits (012345789) char-class build-parser some
{
    %cvi ==
    cvi zxy
} build-parser-action def

/id (x) build-parser some
{
    %cvn ==
    cvn zxy
} build-parser-action def

(457xxx999) [zy   digits  id  digits   pop]  ==

pq

Norah@laptop ~
$ !g
gsnd -q pc5.ps
[0]

[1]

[1]

[2]

[4 3 2 1 0]

[5]

{z (x) test zy (y) test combine}

{z z (x) test zy (y) test combine passed {{max} reduce 2 copy head == tail} {/parser-fail = ps} ifelse}
/xy

(x)
()

(y)
()

[457 /xxx 999]


Norah@laptop ~
$ 

[toc] | [prev] | [standalone]


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


csiph-web