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

Groups > comp.lang.postscript > #3120

Re: Parser combinators

Show all headers | View raw

[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

-- 

Back to comp.lang.postscript | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread

Thread

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

csiph-web