在PostScript中定义函数的增强语法

Question

这个文件通过一些新的语法细节来增强PostScript，用于定义带有命名参数的函数，甚至类型检查。

块

增强的第一部分包括一个称为“块”的新控制结构。块是成对的列表，它将作为键/值对收集到字典中，然后调用特殊的键main。这使得我们可以删除所有函数和数据的“def”，以及所有函数名上的/装饰。

{
    main { f g h }
    f { }
    g { }
    h { }
} block

这段代码定义了一个main函数和3个main调用的函数。当block执行时，所有4个函数都定义在字典中，然后调用main。

重要的是，它允许您将main放在顶部，以帮助进行自顶向下的编码。或者，还有一个函数pairs-begin，它可以与这个相同的对数组一起使用，作为对传统<< ... >> begin结构的升级。

func

另一个增强是func语法。可以通过使用参数名称数组和函数主体的数组调用func来创建函数以接受命名的参数。要在block构造中执行此操作，通常不会执行块的内容，而只是收集内容，您可以通过将@符号前缀为func强制执行。任何名称都可以在编译时使用这个@前缀执行，但只能在顶层执行。

使用func，您可以将函数的参数以大括号括在函数主体之前，从而为它们命名：

{
    main{
        3 f
        4 5 g
    }
    f {x}{ 1 x div sin } @func
    g {x y}{ x log y log mul } @func
} block

此代码创建一个函数f (一个参数x )和一个函数g (由两个参数x和y组成)。函数体增加了代码，代码将这两个对象从堆栈中提取出来，并在新创建的本地字典中定义它们，并为函数的调用进行begin编辑，最后加上一个end。

对于一些用例，比如实现控制结构，更有策略地放置end是很有用的。fortuple函数通过使用@func-begin来说明这一点，D31在末尾不添加end。然后，在调用回p参数之前，将end放在前面。

函数还可以声明其参数必须具有的类型，方法是将它们括在括号中，并使用可执行名称作为参数名和类型的字面名称：

{
    main {
        3 4 p
    }
    p (x/integer y/integer){ x y add } @func
} block

这将使用代码来增强函数体，这些代码检查堆栈上确实有足够的对象，否则会触发stackunderflow错误。然后检查所有参数是否都具有预期的类型，否则会触发typecheck错误。这里的类型是在没有后面的字母type的情况下写的；它们是自动添加的。

您可以省略带括号的语法的类型名称，它将允许该参数的任何类型。如果省略所有类型名称，仍然会得到stackunderflow检查。对于这些错误中的任何一个，用户函数的名称都会在错误消息中报告，以便于调试。

Implementation

就实现而言，基础是pairs构造，它是一个用forall遍历的数组。任何以@开头的名称都会去掉@，其余的将被执行。结果包含在<<和>>中，以创建字典。

第一个字典定义了与pairs相关的一切，包括pairs-def，它将键/值对添加到当前字典中，而不是开始一个新字典。接下来的两个部分将它们的函数添加到同一个字典中。

这(在某种程度上)证明了拥抱式支撑的合理性。整个实现被分成3层，但结果是命令栈上只有一个字典，其中包含了所有这些函数。

中间部分定义了block和func以及定义函数的simple-func样式的所有功能。第三部分实现了两种使用simple-func风格的循环控制结构。然后，更复杂的typed-func样式使用这些循环函数。

用于实现所有这些的许多函数本身都很有用，因此它们也提供给用户，比如curry compose reduce。

在由/debug where保护的底部有一些简单的测试代码。因此，如果这个文件只是来自另一个文件的run，它将跳过测试代码。但是，如果键debug是在命令堆栈的某个位置定义的，那么测试代码将执行。因此，使用鬼脚本，可以使用gs -ddebug struct2.ps调用测试。

测试代码本身说明了func添加的代码的开销。对于类型检查，它添加了相当数量的代码。

%!
% struct2.ps   An enhanced PostScript syntax for defining functions with named,
% type-checked arguments. Using @func within a block or other construct that uses
% 'pairs' accomplishes a sort of compile-time macro expansion of the shorthand function description.
<<
    /pairs-begin { pairs begin        }
    /pairs-def   { pairs {def} forall }
    /pairs       { << exch explode >> }
    /explode     { { @exec } forall   }
    /@exec       { dup type /nametype eq { exec-if-@ } if }
    /exec-if-@   { dup dup length string cvs dup first (@) first eq { exec@ }{ pop } ifelse }
    /first       { 0 get }            /exec@ {  exch pop rest cvn cvx exec  }
    /rest        { 1 1 index length 1 sub getinterval }
>> begin {
    block { pairs-begin main end }
    func  { 1 index type /stringtype eq { typed-func }{ simple-func } ifelse }
    simple-func { func-begin { end } compose }
    typed-func  { exch args-and-types reverse { make-type-name } map check-stack 3 1 roll
                  exch simple-func   compose }
    func-begin  { exch reverse /args-begin load curry exch compose }
    args-begin  { dup length dict begin { exch def } forall }
    args-and-types { /was_x false def [ exch { each-specifier } fortokens fix-last ] dup args exch types  }
    each-specifier { dup xcheck /is_x exch def  is_x was_x and { null exch } if  /was_x is_x def }
    fix-last       { counttomark 2 mod 1 eq { null } if }
    check-stack    { {pop} 4 index cvlit { cvx /stackunderflow signalerror } curry compose
                     /if cvx 2 array astore cvx {check-count} exch compose curry
                     3 index cvlit { cvx /typecheck signalerror } curry
                     /if cvx 2 array astore cvx {check-types} exch compose compose }
    check-count { dup length count 2 sub gt }
    check-types { dup length 1 add copy true exch { check-type and } forall exch pop not }
    check-type  { dup null eq { 3 -1 roll pop pop true }{ 3 -1 roll type eq } ifelse }
    make-type-name { dup type /nametype eq { dup length 4 add string dup dup 4 2 roll cvs
                     2 copy 0 exch putinterval length (type) putinterval cvn } if }
    args    { [ exch 2 { 0 get } fortuple ] }
    types   { [ exch 2 { 1 get } fortuple ] }
    map     { 1 index xcheck 3 1 roll  [ 3 1 roll forall ]  exch {cvx} if }
    reduce  { exch dup first exch rest 3 -1 roll forall }
    rreduce { exch aload length 1 sub dup 3 add -1 roll repeat }
    curry   { [ 3 1 roll {} forall ] cvx } @pop
            { dup length 1 add array dup 0 5 -1 roll put dup 1 4 -1 roll putinterval cvx }
    compose { 2 array astore cvx { {} forall } map } @pop
            { 1 index length 1 index length add array  dup 0 4 index putinterval
              dup 4 -1 roll length 4 -1 roll putinterval cvx }
    reverse { [ exch dup length 1 sub -1 0 { 2 copy get 3 1 roll pop } for pop ] }
} pairs-def {
    fortokens {src proc}{ { src token {exch /src exch store}{exit}ifelse  proc } loop } @func
    fortuple {a n p}{ 0 n /a load length 1 sub
        { /a exch /n getinterval /p exec } {load-if-literal-name} map end for
    } @func-begin
    load-if-literal-name { dup type /nametype eq 1 index xcheck not and { load } if }
} pairs-def

/debug where{pop}{currentfile flushfile}ifelse
{
    - sub + add * mul    %:= {exch def}    += {dup load 3 -1 roll + store}

    var 2 3 @add

    
    f  {x y z}{ x  y z +  *      } @func

    f' {x y z}{ x  y z +  *  end } @func-begin

    f'' { {z y x}args-begin  x y z + *  end }

    
    g(x/integer y/integer z/real){ x y z + * } @func

    g' {
        [/realtype/integertype/integertype]
        check-count { pop /g cvx /stackunderflow signalerror } if
        check-types { /g cvx /typecheck signalerror } if

        {z y x}args-begin  x y z + *  end
    }

    
    h(x y z){ x y z + * } @func %@dup @==

    h' {
        [null null null]
        check-count { pop /h cvx /stackunderflow signalerror } if
        check-types { /h cvx /typecheck signalerror } if

        {z y x}args-begin  x y z + *  end
    }

    
    main {
        var ==
        [ 1 2 3 4 5 ] { - } rreduce ==
        / =
        3 4 5 f ==
        3 4 5 f' ==
        3 4 5 f'' ==
        / =
        3 4 5.0 g =
        3 4 5.0 g' =
        { 3 4 5 g = } stopped { $error /errorname get =only ( in ) print $error /command get = } if
        / =
        clear
        { 3 4 h  = } stopped { $error /errorname get =only ( in ) print $error /command get = } if
        clear
        3 4 5 h =
        { 3.0 4.0 5.0 h = } stopped { $error /errorname get =only ( in ) print $error /command get = } if
        { 3.0 4.0 5.0 h' = } stopped { $error /errorname get =only ( in ) print $error /command get = } if
        quit
    }

} block

测试代码的输出：

$ gsnd -q -ddebug struct2.ps
5
3

27
27
27

27.0
27.0
typecheck in g

stackunderflow in h
27
27.0
27.0

对实现或行为是否有改进？目前，simple-func样式并不检查是否有足够的参数，而只是在假设它们存在的情况下尝试定义它们。添加此检查更好，还是使用此低开销版本而不添加(可能是浪费)检查更好？

Answer 1

这一功能

check-stack    { {pop} 4 index cvlit { cvx /stackunderflow signalerror } curry compose
                 /if cvx 2 array astore cvx {check-count} exch compose curry
                 3 index cvlit { cvx /typecheck signalerror } curry
                 /if cvx 2 array astore cvx {check-types} exch compose compose }

一塌糊涂。最好是以模板实例化的方式编写。

check-stack  { % types -> stack-checker-proc-for-types
  {_types _args _body _name} args-begin
  /_name load /_name 1 index cvlit def
  /_body load /_args load
  ({
    //_types
    check-count { pop //_name cvx /stackunderflow signalerror } if
    check-types { //_name cvx /typecheck signalerror } if
  }) cvx exec
  end
}