CommonPrelude.ps

%
% Copyright (c) 2021, Masatake YAMATO
% Copyright (c) 2021, Red Hat, Inc.
%
% This source code is released for free distribution under the terms of the
% GNU General Public License version 2 or (at your option) any later version.
%

%
% The documentation table
%

% __PROCDOCS:dict<proc:name, doc:string>
/__procdocs 30 dict def

% name value __BDEF -
/__bdef { bind def }  bind def

% doc:string key:name any:val __DOCDEF -
/__bddef {
    1 index exch __bdef
    exch __procdocs 3 1 roll put
} __bdef


%
% procedures
%
(any n:int _NDUP any1 ... anyn)
/_ndup { { dup } repeat } __bddef

(x:any x:any _DEDUP x:any
 x:any y:any _DEDUP x:any y:any)
/_dedup {
    count 1 gt {
        2 copy eq {
            pop
        } if
    } if
} __bddef

(space:int space:int _DEDUP_SPACES space:int
 otherthanspace:int space:int _DEDUP_SPACES otherthanspace:int space:int)
/_dedup_spaces {
    count 0 gt {
        dup ?\_ eq {
            _dedup
        } if
    } if
} __bddef

% 32 32 _dedup_spaces pstack clear (---) ==
% 32 41 _dedup_spaces pstack clear (---) ==
% 41 32 _dedup_spaces pstack clear (---) ==
% 32 _dedup_spaces pstack clear (---) ==
% 41 _dedup_spaces pstack clear (---) ==
% quit

/__buildstring {
    {
	    counttomark dup 1 eq {
	        pop exch pop
	        exit
	    } {
	        -1 roll 1 index exch _putlast!
	    } ifelse
    } loop
} __bdef

(mark char:int|substring:string... _BUILDSTRING string)
/_buildstring {
    0 string __buildstring
} __bddef

(string char:int|string _PUTLAST! -)
/_putlast!  {
    1 index length exch
    dup type /integertype eq {
	    put
    } {
	    putinterval
    } ifelse
} __bddef

(target:string fromto:str _TR! -)
/_tr! {
    %
    % () is not allowed.
    % The reason must be be documented.
    %
    0 string
    % str [int<from> int<to>] str'
    2 index {
	% str [int<from> int<to>] str' int<chr>
	    dup 3 index 0 get
	% str [int<from> int<to>] str' int<chr> int<chr> int<from>
	    eq {% str [int<from> int<to>] str' int<chr>
	        pop
	        dup 2 index 1 get _putlast!
	    } {% str [int<from> int<to>] str' int<chr>
	        1 index exch _putlast!
	    } ifelse
    } forall
    % str [int<from> int<to>] str'
    exch pop
    0 exch putinterval
} __bddef

(string _NORMALIZE_SPACES! -)
/_normalize_spaces! {
    dup
    dup (\n ) _tr!
    dup (\t ) _tr!
    dup (\r ) _tr!
    dup (\f ) _tr!
    dup (\v ) _tr!
    mark exch { _dedup_spaces } forall _buildstring
    exch copy pop
} __bddef

(string _CHOP string)
/_chop {
    mark exch {} forall pop _buildstring
} __bddef

(string _CHOP_SPACE string)
/_chop_space {
    dup length dup 0 gt {
        % string length
        1 sub
        % string `length - 1`
        1 index exch
        % string string `length - 1`
        get (\n\t\r\f\v ) exch _amember {
            _chop
        } if
    } {
        pop                     % pop the length
    } ifelse
} __bddef

% /x mark 40 (a) 32 32 10 (b) 10 10 9 9 (xyz) 9 9 41 _buildstring def
% x _normalize_spaces! x pstack

(tag:int _SCOPEREF -)
/_scoperef {
    _scopetop not { 0 } if scope:
} __bddef

(tag:int _SCOPEPUSH -)
/_scopepush {
    dup _scoperef _scopeset
} __bddef

(string _ISSTRING string true
 any:!string _ISSTRING false)
/_isstring {
    dup type /stringtype eq {
        true
    } {
        pop false
    } ifelse
} __bddef

(array key _AMEMBER true|fales)
/_amember {
    false 3 1 roll
    % false array key
    exch {
        % false key elt
        1 index
        % false key elt key
        eq {
            % false key
            exch pop true exch
            exit
        } if
        % false key
    } forall
    pop
} __bddef

(array key _AINDEX nth:int true
 array key _AINDEX false)
/_aindex {
    0 3 1 roll
    % idx array key
    exch {
        % idx key elt
        1 index
        eq {
            % idx key
            pop true exit
        } {
            % idx key
            exch 1 add exch
        } ifelse
    } forall
    dup true ne { pop pop false } if
} __bddef

% define @1 ~ @9.
1 1 9 {
    dup
    mark (- @) 3 -1 roll ?0 add ( matchloc) _buildstring
    exch dup
    mark (@) 3 -1 roll ?0 add _buildstring cvn
    exch
    [ exch /start /_matchloc cvx ] cvx __bddef
} for

% define 1@ ~ 9@.
1 1 9 {
    dup
    mark (- ) 3 -1 roll ?0 add (@ matchloc) _buildstring
    exch dup
    mark exch ?0 add (@) _buildstring cvn
    exch
    [ exch /end /_matchloc cvx ] cvx __bddef
} for

(name:str kind:name matchloc _TAG tag
 name:str kind:name _TAG tag)
/_tag {
    dup type /nametype eq {
        % name:str kind:name
        null exch null
        % name:str null kind:name null
    } {
        % name:str kind:name matchloc
        null 3 1 roll null exch
        % name:str null kind:name matchloc null
    } ifelse
    _foreignreftag
} __bddef

(name:str kind:name role:name matchloc _REFTAG tag
 name:str kind:name role:name _REFTAG tag)
/_reftag {
    dup type /nametype eq {
        % name:str kind:name role:name
        null 3 1 roll
        % name:str null kind:name role:name
    } {
        % name:str kind:name role:name matchloc
        null 4 1 roll
        % name:str null kind:name role:name matchloc
    } ifelse
    _foreignreftag
} __bddef

(name:str language:name kind:name matchloc _FOREIGNTAG tag
 name:str lang:name kind:name _FOREIGNTAG tag)
/_foreigntag {
    null _foreignreftag
} __bddef