对应的PostScript文库

Question

作为获取级联规划的一部分，我决定在PostScript中实现常见的连接操作。下面是我用其他连接语言在单词中实现一些PostScript的尝试。任何熟悉PostScript和函数/连接编程的人会对我的代码发表评论吗？

%!PS
% conventions: parameter names with let begins with .

% basic definition, makes the definitions less verbose.
/. {bind def} bind def
/' {load} bind def
/reverse {{} exch {exch [3 1 roll aload pop]} forall}.
/let {dup length dict begin reverse {exch def} forall}.
/let* {reverse {exch def} forall}.

% some predicates.
/eq? {eq}.
/list? {dup type /arraytype eq?}.
/leaf? {list? not}.
/empty? {dup length 0 eq?}.
/zero? {dup 0 eq?}.

% stacky functions
/rup {3 1 roll}.
/rdown {3 -1 roll}.
/# {exch dup rdown .makeoperator bind def} bind def

/getname {dup 0 get exch}.
/getbody {dup length 1 sub 1 exch getinterval}.

% convenience arithmetic
/+ {add}.
/- {sub}.
/* {mul}.
/\ {div}.

% lispy functions
/first {0 get}.
/car {first}.
/!first {dup first}.
/rest {dup length 1 sub 1 exch getinterval}.
/cdr {rest}.
/!rest {dup rest}.
/head  {dup length 1 sub 0 exch getinterval}.
/!head {dup head}.
/tail  {dup length 1 sub get}.
/!tail {dup tail}.
/cons  {[rup aload pop]}.
/tadd  {[rup aload length 1 add -1 roll] }.
/uncons {getname getbody}.
/concat {exch [ rup aload pop counttomark -1 roll aload pop ] }.
% make a unit list.
/unit {1 array astore cvx}.
/succ {1 add}.
/pred {1 sub}.
/range {[rup exch aload pop rup exch rdown {} for]}.

% higher order thingies.
/map { [ rup forall ] }.
% [1 2 3 4] {1 add} map
/fold {rup exch rdown forall}.
%/reverse {{} {exch cons} fold}.
% {} [1 2 3 4 5] {exch cons} forall

% [1 2 3 4] 0 {+} fold
% name - filter is taken so we are left with..
/find {
4 dict begin
    /aif {0 /get /if}.
    /atox { [ exch cvx {cvx} forall ] cvx}.
    [ rup [ /dup rdown /exec /not [{pop}] aif ] atox forall ]
end}.

/transpose {
    [ exch {
        { {empty? exch pop} map all?} {pop exit} ift
        [ exch {} {uncons {exch cons} dip exch} fold counttomark 1 roll] uncons
    } loop ] {reverse} map
}.

/zip {[rup] transpose}.

/all? {
    {
        {empty?} ? {pop true exit} if
        uncons {?} dip exch not {pop false exit} if
    } loop
}.

/any? {
    {
        {empty?} ? {pop false exit} if
        uncons {?} dip exch {pop true exit} if
    } loop
}.
/pipe {
    {
        {empty?} ? {pop exit} if
        uncons {i} dip
    } loop
}.
%  1 {{2 *} {3 *} {5 *}} pipe
/collect {
    {
        {empty?} ? {pop exit} if
        uncons {?} dip
    } loop
}.
%  1 {{2 *} {3 *} {5 *}} collect

/? {
4 dict begin
    [/.pred] let*
    count array astore /.stack exch def
    /_restore {clear .stack aload pop}.
    .stack aload pop .pred /.top exch def
    _restore .top
end}.

% control structures
/ift {
[/.if /.then] let
    /.if ' ?  /.then ' if
end}.

/ifte {
[/.if /.then /.else] let
    /.if ' ?  /.then ' /.else ' ifelse
end}.
% switch statement.
/is? {{exit} concat cvx ift}.
/cond {{exit} concat cvx loop}.

% combinators
/dip {
[/.v /.q] let
    .q /.v '
end}.
/apply {exec}.
/i {cvx exec}.

/linrec {
[/.if /.then /.rec1 /.rec2] let
    /.if ' /.then '
        {.rec1
            {/.if ' /.then ' /.rec1 ' /.rec2 ' linrec} i
        .rec2}
    ifte
end}.

/binrec {
[/.if /.then /.rec1 /.rec2] let
    /.if ' /.then '
        { .rec1
            {/.if ' /.then ' /.rec1 ' /.rec2 ' binrec} dip
            {/.if ' /.then ' /.rec1 ' /.rec2 ' binrec} i
          .rec2 }
    ifte
end}.

/genrec {
[/.if /.then /.rec1 /.rec2] let
    /.if ' /.then '
        {.rec1
            {/.if ' /.then ' /.rec1 ' /.rec2 ' genrec}
         .rec2}
    ifte
end}.

/tailrec {{} linrec}.

/primrec {
5 dict begin
    /lzero? {
        {list?} {empty?}
                {zero?}
        ifte}.
    /lnext {
        {list?} {rest}
                {pred}
        ifte}.
[/.param /.then /.rec] let*
    {/.param ' lzero?} /.then '
        {.param
            {/.param ' lnext /.then ' /.rec ' primrec} i
        .rec}
    ifte
end}.

/treemap {
[/.tree /.rec] let
    /.tree '
    {leaf?} /.rec '
        {{empty?} {}
            {dup
                {first /.rec ' treemap} dip
                {rest /.rec ' treemap} i cons}
        ifte}
    ifte
end}.

% debug
/puts {= flush}.
/cvstr {
    4 dict begin
        /elements exch def
        /len elements length def
        /str len string def
        /i 0 def
        {
        i len ge { exit } if
        str i
        %The element of the array, as a hexadecimal string.
        %If it exceeds 16#FF, this will fail with a rangecheck.
        elements i get cvi
        put
        /i i 1 add def
    } loop
    str
end
} def


/, {(=============\n)
    print pstack
    (=============\n) print}.

localdefs.ps包括需要在本地包含的任何定义。

% set the prompt to something else so that we know initlib is loaded.
/prompt {(>| ) print flush} bind def
/:x {(localdefs.ps) run}.

下面是如何加载库并获得一个工作的REPL。

rlwrap ghostscript -q -dNOSAFER -dNODISPLAY -c '(init.ps) run' $*

Answer 1

可以对map函数进行改进。你的版本：

/. {bind def} bind def

%...

/rup {3 1 roll}.

%...

/map { [ rup forall ] }.
% [1 2 3 4] {1 add} map

这里的问题是在堆栈上构建新数组。虽然在postscript中这通常是一种完美的技术，但它对过程的行为设置了严格的限制。使用debug.ps生成一个跟踪(警告:我必须删除所有的bind调用，因为很明显，调试器有一个带有绑定的bug )，说明了执行是如何通过示例[1 2 3 4] {1 add} map进行的。(我知道你知道它是如何执行的，这是给观众的。;)

[  %|- -mark- 
1  %|- -mark- 1 
2  %|- -mark- 1 2 
3  %|- -mark- 1 2 3 
4  %|- -mark- 1 2 3 4 
]  %|- [1 2 3 4] 
{1 add}  %|- [1 2 3 4] {1 add} 
map  %|- [1 2 3 4] {1 add} 
[  %|- [1 2 3 4] {1 add} -mark- 
rup  %|- [1 2 3 4] {1 add} -mark- 
3  %|- [1 2 3 4] {1 add} -mark- 3 
1  %|- [1 2 3 4] {1 add} -mark- 3 1 
roll  %|- -mark- [1 2 3 4] {1 add} 
forall  %|- -mark- 1 
1  %|- -mark- 1 1 
add  %|- -mark- 2 
[2 3 4]  %|- -mark- 2 [2 3 4] 
{1 add}  %|- -mark- 2 [2 3 4] {1 add} 
forall  %|- -mark- 2 2 
1  %|- -mark- 2 2 1 
add  %|- -mark- 2 3 
[3 4]  %|- -mark- 2 3 [3 4] 
{1 add}  %|- -mark- 2 3 [3 4] {1 add} 
forall  %|- -mark- 2 3 3 
1  %|- -mark- 2 3 3 1 
add  %|- -mark- 2 3 4 
[4]  %|- -mark- 2 3 4 [4] 
{1 add}  %|- -mark- 2 3 4 [4] {1 add} 
forall  %|- -mark- 2 3 4 4 
1  %|- -mark- 2 3 4 4 1 
add  %|- -mark- 2 3 4 5 
[]  %|- -mark- 2 3 4 5 [] 
{1 add}  %|- -mark- 2 3 4 5 [] {1 add} 
forall  %|- -mark- 2 3 4 5

因此，每当执行过程(循环体)时，数组的其余部分都在堆栈上。

1  %|- -mark- 1 1 
add  %|- -mark- 2 
% ...
1  %|- -mark- 2 2 1 
add  %|- -mark- 2 3 
% ...
1  %|- -mark- 2 3 3 1 
add  %|- -mark- 2 3 4 
% ...
1  %|- -mark- 2 3 4 4 1 
add  %|- -mark- 2 3 4 5 

所以你不能做这样的事情来给每个元素添加一个常数。因为数组的建立阻碍了我们。

5 [1 2 3 4] {1 index add} map

消除这一困难的好尝试来自于卡洛斯线程中的comp.lang.postscript。他没有直接使用forall循环，而是使用运行在数组索引中的for循环，并按名称调用用户proc，管理循环体中数组中值的提取和重新插入。

问题在于，我们只是简单地将干扰传递到另一个堆栈上。操作数堆栈现在是清晰的和可用的，但是字典堆栈现在有我们的簿记字典在顶部(或者更糟的是:在userdict中一切都是全局的)。因此，在尝试在应用程序中使用函数时，我们很容易出现名称冲突和意外范围界定问题。

postscript语言的一些鲜为人知的特性结合起来提供了一个解决方案:动态代码生成。所以我们想要一张大致做到这一点的地图：

/map { % arr proc  map  arr'
    10 dict begin           % arr proc
    /proc exch def          % arr
    /arr exch def           % <empty>
    0 1 arr length 1 sub {  % i
        /i exch def         % <empty>
        arr i get           % arr_i
        proc                % proc(arr_i)
        arr exch i exch put % <empty>
    } for                   % <empty>
    arr                     % arr'
    end                     % arr'
} def

但是，在执行proc时，堆栈中没有这个本地字典。

要做到这一点，我们可以做的是生成一个循环体，其中的名字硬绑定到它们的值上。Postscript提供它的扫描器作为token操作符，它可以从字符串模板生成完整的过程体。

({1 1 add =} remainder) token  %  ( remainder) {1 1 add =} true
pop                            %  ( remainder) {1 1 add =}
exch                           %  {1 1 add =} ( remainder)
pop                            %  {1 1 add =}

当遇到双斜杠//时，扫描仪也将替换以双斜杠为前缀的名称。所以我们也可以这样做：

/val 5 def
({//val =}) token pop exch pop %  {5 =}

现在，不需要为执行过程定义名称。

/val 5 def
({//val =}) token pop exch pop %  {5 =}
currentdict /val undef
exec  % prints: 5

最后，我们得到了这样的东西：

/map { % arr proc  map  arr'
    10 dict begin           % arr proc
    /mydict currentdict def % arr proc
    /proc exch def          % arr
    /arr exch def           % <empty>
    0 1 arr length 1 sub    % 0 1 n-1
    ({
    {  % i
        //mydict exch /i exch put  % <empty>
        //arr                      % arr
        //mydict /i get            % arr i
        get                        % arr_i
        //mydict /proc get         % arr_i proc
        exec                       % proc(arr_i)
        //arr exch                 % arr proc(arr_i)
        //mydict /i get exch       % arr i proc(arr_i)
        put                        % <empty>
    } for                          % <empty>
    //arr                          % arr'
    }) token pop exch pop   % 0 1 n-1 {{...}for...}
    end                     %   <-- remove dictionary
    exec                    %   <-- execute dynamic proc
} def

您还可以在bind ing之前对该过程进行exec，以便为运算符提取名称查找。

此版本更改现有数组并作为结果返回该数组。卡洛斯的最后版本为结果创建一个新数组，它更接近于原始函数的行为。

这不是卡洛斯的最终版本。在我发现将bind应用到用户过程中可能出现的问题后，卡洛斯意识到，在包含一个过程(我的大花招)的字符串上调用token的整个技术天生就容易与bind混搭，于是他制作了这个最终最终版本。弦乐戏法消失了。相反，所有库函数(包括动态循环体)都在“库加载时”应用bind。因此，该行为与用户重新定义任何运算符名称无关。

字符串-令牌技巧已经被两个过程所取代，deepcopy生成循环体的可修改副本(bind使原始循环体--就像它对函数的所有子数组所做的那样)只读，因此我们需要一个副本来修补变量)，以及replaceall，它接受一个数组和一个字典，并通过字典映射数组(递归地)(它修补变量)。所以这是一个更加强大的函数。

% <array/string> <proc> map <new array/string> 
/map { 
    4 dict begin 

        /,proc exch def 
        /,arr exch def 
        /,res ,arr length 
             ,arr type /stringtype eq { string } { array } ifelse 
        def 
        /,i 1 array def 
        { 
            0 1 /,arr length 1 sub { % for 
                dup /,i 0  3 -1 roll  put 
                /,arr exch get 
                /,proc exec 
                /,res /,i 0 get  3 -1 roll  put 
            } for 
            /,res 
        } deepcopy dup currentdict replaceall 
    end exec 
} bind def 

% copies array recursively 
% <array> deepcopy <new array> 
/deepcopy { 
    dup xcheck exch 
    dup length array copy 
    dup length 1 sub 0 exch 1 exch { % for       % a i 
        2 copy 2 copy get dup type /arraytype eq % a i a i e ? 
        { % ifelse 
            deepcopy put 
        } 
        { 
            pop pop pop 
        } ifelse 
        pop 
    } for 
    exch { cvx } if 
} bind def 

% recursively replaces elements in <array> found in <dict> 
% <array> <dict> replaceall - 
/replaceall { 
    1 index length 1 sub  0 1  3 -1 roll { % for 0 1 length-1 
        3 copy  3 -1 roll  exch    % a d i d a i 
        get                        % a d i d e 
        2 copy known               % a d i d e ? 
        % ifelse 
        {                          % a d i d e 
            get                    % a d i v 
            3 index  3 1 roll      % a d a i v 
            put 
        } % else 
        {                          % a d i d e 
            dup type /arraytype eq % a d i d e ? 
            { exch replaceall } 
            { pop pop } ifelse 
            pop 
        } ifelse                   % a d 
    } for 
    pop pop 
} bind def 

Answer 2

这里有一个解决方案，它不使用PostScript的许多深层次特性，尽管它可能被认为是以自己的方式扭曲的。它将临时变量存储在堆栈的底部而不是顶部，并通过反复旋转整个堆栈来实现这一点。即便如此，它似乎已经足够有效了。

首先，修改数组的版本。

% Very general map that operates on an existing array.                                              
% Does not pollute dictionary. Allows natural access to stack.                                      
% Efficiency may vary since it rotates the entire stack a lot.                                      

/map {          % array f map --                                                                    
                                        % ... array f                                               
    count count 1 add roll              % array f ...                                               
    count 1 sub index                   % array f ... array                                         
    length 1 sub 0 exch 1 exch          % array f ... 0 1 (n-1)                                     
    {                                   % array f ... i                                             
        count count roll                % i array f ...                                             
        count 2 sub index               % i array f ... array                                       
        count 1 sub index               % i array f ... array i                                     
        get                             % i array f ... array[i]                                    
        count 3 sub index               % i array f ... array[i] f                                  
        exec                            % i array f ... f(array[i])                                 
        count 2 sub index               % i array f ... f(array[i]) array                           
        exch                            % i array f ... array f(array[i])                           
        count 1 count sub roll          % array f ... array f(array[i]) i                           
        exch put                        % array f ...                                               
    } for
    count 0 count sub roll              % ... array f                                               
    pop pop                             % ...                                                       
} bind def

第二，不修改数组并返回新数组的版本：

% Very general map that returns a new array.                                                        
% Does not pollute dictionary. Allows natural access to stack.                                      
% Efficiency may vary since it rotates the entire stack a lot.                                      

/mapc {         % array f map -- array                                                              
                                        % ... array f                                               
    exch dup length array               % ... f array newarr                                        
    count count 2 add roll              % f array newarr ...                                        
    count 2 sub index                   % f array newarr ... array                                  
    length 1 sub 0 exch 1 exch          % f array newarr ... 0 1 (n-1)                              
    {                                   % f array newarr ... i                                      
        count count roll                % i f array newarr ...                                      
        count 3 sub index               % i f array newarr ... array                                
        count 1 sub index               % i f array newarr ... array i                              
        get                             % i f array newarr ... array[i]                             
        count 2 sub index               % i f array newarr ... array[i] f                           
        exec                            % i f array newarr ... f(array[i])                          
        count 4 sub index               % i f array newarr ... f(array[i]) newarr                   
        exch                            % i f array newarr ... newarr f(array[i])                   
        count 1 count sub roll          % f array newarr ... array f(array[i]) i                    
        exch put                        % f array newarr ...                                        
    } for
    count 0 count sub roll              % newarr ... f array                                        
    pop pop                             % newarr ...                                                
    count 1 count sub roll              % ... newarr                                                
} bind def