lambda.ps

/par_arr [] def
/par_names [] def

/set_par { % varname value - (vars parameter added)

  % call_fun

  %knownVar
  %{ vars exch get dup length 1 sub get } if
  %pstack (get par -------------------\n) print

  %dup type {} type eq
  %{ exec }
  %if
  %pstack (exec par -------------------\n) print

  exch dup 3 1 roll mark exch
  % check if varname already exists in context
  knownVar
  { % update context
    vars exch get aload pop
  }
  { pop }
  ifelse
  counttomark 2 add -1 roll
  ]
  vars 3 1 roll
  put
} def

% adds a parameter to the parameter array
/add_par { % value varname - varname value - par_arr parameter added
  exch

  knownVar
  { vars exch get dup length 1 sub get } if

  dup type {} type eq
  { exec }
  if

  2 array astore dup
  par_arr aload length 1 add -1 roll
  par_arr length 1 add array astore
  /par_arr exch def
  aload pop
} def

% printes the elements of a dictionary
/print_dict { % dict- 
 mark exch { } forall pstack ] pop
} def

% sets the values of a parameter
/set_pars { % value1 value2 ... [parname1, parname2, ...] - everything is saved to the vars dict
  dup length 2 add 3 -1 roll exch 1 roll

  dup dup length 2 add 1 roll
  length array astore
  dup length 1 sub array_to
  {
    dup 3 -1 roll dup 4 1 roll exch get
    exch 4 -1 roll dup 5 1 roll exch get
    add_par set_par
  } forall
  pop

  
  dup type [] type eq
  { dup length 0 eq
    { pop } if
  } if

  par_names aload length 1 add -1 roll
  par_names length 1 add array astore
  /par_names exch def
  par_names
  %count 3 ge {
    %3 -1 roll dup /call eq
    %{ 3 1 roll
    % counttomark 1 roll }
    %{ 3 1 roll exch }
    %ifelse
  %}
  %{ exch }
  %ifelse

  pop
} def

% Remove pars from par_arr after function call ends
/pop_par { % varname - varname (Parameter is removed from context)
    par_arr length 0 ne
    {
       par_arr aload exch pop
       length 1 sub array
       astore /par_arr exch def
    } if
} def

% Remove pars from vars after function call ends
/pop_var { % varname - Parameter is removed from context
    dup vars exch get
    % varname varvalue
    dup length 0 ne
    {
      aload length 1 sub exch pop array
      astore
      % varname varvalues(len-1)
      vars 3 1 roll
      put
    } if
} def

/curry_set_pars {
%  exch (aload - curry_set_pars\n) print aload pop
%  {
%    length
%    { aload pop set_par }
%    repeat
%    dup mark eq
%    { pop exit }
%    if
%  } loop
} def

% make it simple again and save all par_arrs in an own array
/curry_clearpars {
%  exch (aload - curry_clearpars\n) print aload pop
%  {
%    dup
%    { pop_par pop_var } forall
%    length
%    { pop }
%    repeat
%    dup mark eq
%    { pop exit }
%    if
%  } loop
} def

% appends the par execution array to a lambda, for currying
/append_par_arr { % { lambda } - { lambda + parameter values }
   par_arr length 0 ne {
     dup length 6 add array
     dup 0
     { null % set par in schleife
       { aload pop set_par } forall
 %      mark curry_set_pars
     } dup 0 par_arr dup length array copy put putinterval
     dup 3 4 -1 roll putinterval
     dup dup length 3 sub
     { null % clear pars in schleife
       { 0 get pop_par pop_var } forall
  %     mark curry_clearpars
     } dup 0 par_arr dup length array copy put putinterval cvx
  } if
} def

/clearpars {
  dup /call eq
  { pop }
  if

  par_names length 0 gt
  {
    par_names aload dup length 1 add 3 -1 roll exch 1 roll
    length 1 sub array
    astore /par_names exch def

    par_names pop
    { par_names pop
     pop_par pop_var } forall
  }
  if
} def

% checks if a function call mark has been set
/isCall {
  count exch dup length 2 add 3 -1 roll lt
  { 
    3 -1 roll dup /call eq
    { pop true }
    { 3 1 roll false }
    ifelse
  }
  { false }
  ifelse
} def

% (lambda (var...) exp) => [var..] { exp }
/lambda {
  12 array dup 0 % workaround
  % postscript fail --> it seems that postscript uses always the same reference here
  {
    null % function that is executed
    null % array of par_names
    isCall
    3 array dup 0
    {
      set_pars
      getVal
      clearpars
    } putinterval cvx
    {
      % Composition here
      exch lambda
      append_par_arr
    }
    ifelse
  } putinterval cvx
  dup 1 5 -1 roll put
  dup 0 4 -1 roll put
} def