Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Parser combinators

84 views
Skip to first unread message

luser droog

unread,
May 29, 2017, 12:22:09 AM5/29/17
to
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 )

luser droog

unread,
Jun 3, 2017, 6:15:48 PM6/3/17
to
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]

luser droog

unread,
Jun 4, 2017, 2:13:16 PM6/4/17
to
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]


luser droog

unread,
Jun 4, 2017, 9:57:56 PM6/4/17
to
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


luser droog

unread,
Jun 4, 2017, 10:39:37 PM6/4/17
to
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).
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)]

luser droog

unread,
Jun 7, 2017, 2:38:14 AM6/7/17
to
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]
/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

luser droog

unread,
Jun 9, 2017, 1:18:47 AM6/9/17
to
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]

luser droog

unread,
Jun 9, 2017, 5:54:22 PM6/9/17
to
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 }{ }? }? }
( 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 )



luser droog

unread,
Jun 11, 2017, 2:36:15 AM6/11/17
to
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 }? }? }
( 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 )

luser droog

unread,
Jun 13, 2017, 12:19:58 AM6/13/17
to
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.

Carlos

unread,
Jun 13, 2017, 1:41:00 AM6/13/17
to
[luser droog <luser...@gmail.com>, 2017-06-12 21:19]
According to https://qntm.org/combinators shouldn't "x+" return a set of
all matches?

--

luser droog

unread,
Jun 13, 2017, 4:53:48 AM6/13/17
to
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 ~
$

luser droog

unread,
Jun 13, 2017, 6:48:56 AM6/13/17
to
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 ~
$

luser droog

unread,
Jun 13, 2017, 7:22:25 AM6/13/17
to
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 ~
$

luser droog

unread,
Jun 14, 2017, 2:28:07 AM6/14/17
to
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 ~
$

Carlos

unread,
Jun 14, 2017, 3:52:09 PM6/14/17
to
[luser droog <luser...@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

--

luser droog

unread,
Jun 15, 2017, 4:36:20 PM6/15/17
to
On Wednesday, June 14, 2017 at 2:52:09 PM UTC-5, Carlos wrote:
> [luser droog <luser...@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.
[[[]cvx/exec cvx]cvx/exec cvx]cvx
/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 ~
$
0 new messages