version 1.31, 2004/08/27 08:33:27 |
version 1.46, 2004/09/17 00:47:08 |
|
|
% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.30 2004/08/23 08:33:55 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.45 2004/09/17 00:10:41 takayama Exp $ |
%% dr.sm1 (Define Ring) 1994/9/25, 26 |
%% dr.sm1 (Define Ring) 1994/9/25, 26 |
%% This file is error clean. |
%% This file is error clean. |
|
|
|
|
0 1 << set0 length 1 sub >> |
0 1 << set0 length 1 sub >> |
{ |
{ |
/i set |
/i set |
<< set0 i get >> a eq |
set0 i get tag , a tag , eq { |
{ |
<< set0 i get >> a eq |
/flag 1 def |
{ |
} |
/flag 1 def exit |
{ } |
} |
ifelse |
{ } |
|
ifelse |
|
} { } ifelse |
} for |
} for |
] pop |
] pop |
/arg1 flag def |
/arg1 flag def |
|
|
[ |
[ |
/mat arg1 def |
/mat arg1 def |
/m mat length def |
/m mat length def |
|
{ |
|
m 0 eq { /ans [ ] def exit } { } ifelse |
mat 0 get isArray |
mat 0 get isArray |
{ } |
{ } |
{ (transpose: Argument must be an array of arrays.) error } |
{ (transpose: Argument must be an array of arrays.) error } |
|
|
ans [ j i ] << mat i get j get >> put |
ans [ j i ] << mat i get j get >> put |
} for |
} for |
} for |
} for |
|
exit |
|
} loop |
/arg1 ans def |
/arg1 ans def |
] pop |
] pop |
popVariables |
popVariables |
|
|
( Pointer to the ring. ) |
( Pointer to the ring. ) |
(Example: [$x,y$ ring_of_q_difference_operators $Qx,Qy$ elimination_order) |
(Example: [$x,y$ ring_of_q_difference_operators $Qx,Qy$ elimination_order) |
( 0] define_qring ) |
( 0] define_qring ) |
(cf. define_ring, set_up_ring@ <coefficient ring>, ring_def, << ,, >>) |
(cf. define_ring, set_up_ring@ <coefficient ring>, ring_def, << __ >>) |
] |
] |
] putUsages |
] putUsages |
/define_qring { |
/define_qring { |
|
|
(one may use the command ) |
(one may use the command ) |
( f (ring) data_conversion /R set) |
( f (ring) data_conversion /R set) |
(cf. define_ring, define_qring, system_variable, poly (ring) data_conversion) |
(cf. define_ring, define_qring, system_variable, poly (ring) data_conversion) |
(cf. << ,, >>) |
(cf. << __ >>) |
] |
] |
] putUsages |
] putUsages |
|
|
|
|
/univ vars 0 get reverse |
/univ vars 0 get reverse |
vars 1 get reverse join |
vars 1 get reverse join |
def |
def |
|
w-vectors to_int32 /w-vectors set |
[ |
[ |
0 1 << w-vectors length 1 sub >> |
0 1 << w-vectors length 1 sub >> |
{ |
{ |
|
|
/arg2 set /arg1 set |
/arg2 set /arg1 set |
[/univ /www /k /vname /vweight /ans] pushVariables |
[/univ /www /k /vname /vweight /ans] pushVariables |
/univ arg1 def /www arg2 def |
/univ arg1 def /www arg2 def |
[ |
[ |
|
www to_int32 /www set |
/ans << univ length >> -1 0 evecw def |
/ans << univ length >> -1 0 evecw def |
0 2 << www length 2 sub >> |
0 2 << www length 2 sub >> |
{ |
{ |
|
|
gg (0). eq |
gg (0). eq |
{ 0 } |
{ 0 } |
{ gg (ring) data_conversion /rr set |
{ gg (ring) data_conversion /rr set |
gg << var rr ,, >> degree |
gg << var rr __ >> degree |
} ifelse |
} ifelse |
} map def |
} map def |
%%degs message |
%%degs message |
|
|
[(ClassP) @.datatypeConstant.usage ] putUsages |
[(ClassP) @.datatypeConstant.usage ] putUsages |
[(DoubleP) @.datatypeConstant.usage ] putUsages |
[(DoubleP) @.datatypeConstant.usage ] putUsages |
|
|
[(,,) |
[(__) |
[( string ring ,, polynomial) |
[( string ring __ polynomial) |
(Parse the <<string>> as an element in the <<ring>> and returns) |
(Parse the <<string>> as an element in the <<ring>> and returns) |
(the polynomial.) |
(the polynomial.) |
(cf. define_ring, define_qring, ring_def) |
(cf. define_ring, define_qring, ring_def) |
(Example: [(x,y) ring_of_polynomials [[(x) 1]] weight_vector 7]define_ring) |
(Example: [(x,y) ring_of_polynomials [[(x) 1]] weight_vector 7]define_ring) |
( /myring set) |
( /myring set) |
( ((x+y)^4) myring ,, /f set) |
( ((x+y)^4) myring __ /f set) |
]] putUsages |
]] putUsages |
|
|
/,, { |
/__ { |
/arg2 set /arg1 set |
/arg2 set /arg1 set |
[/rrr] pushVariables |
[/rrr] pushVariables |
[ arg1 tag StringP eq |
[ arg1 tag StringP eq |
|
|
/arg1 arg1 expand def |
/arg1 arg1 expand def |
[(CurrentRingp) rrr] system_variable |
[(CurrentRingp) rrr] system_variable |
} |
} |
{(Argument Error for ,, ) error } |
{(Argument Error for __ ) error } |
ifelse |
ifelse |
] pop |
] pop |
popVariables |
popVariables |
|
|
[( string .. universalNumber) |
[( string .. universalNumber) |
(Parse the << string >> as a universalNumber.) |
(Parse the << string >> as a universalNumber.) |
(Example: (123431232123123).. /n set) |
(Example: (123431232123123).. /n set) |
|
({ commands }.. executes the commands. << .. >> is equivalent to exec.) |
]] putUsages |
]] putUsages |
/.. { (universalNumber) data_conversion } def |
/.. { dup tag 3 eq { exec } { (universalNumber) data_conversion} ifelse } def |
|
|
[(dc) |
[(dc) |
[(Abbreviation of data_conversion.) |
[(Abbreviation of data_conversion.) |
|
|
} def |
} def |
%%end of function |
%%end of function |
|
|
/rest { % returns remainder of a given list |
/rest { |
[ 2 1 roll aload length -1 roll pop ] |
/arg1 set [(Krest) arg1] extension |
} def |
} def |
[(rest) |
[(rest) |
[(array rest the-rest-of-the-array) |
[(array rest the-rest-of-the-array) |
|
|
error |
error |
} ifelse |
} ifelse |
/myring base 0 get (ring) dc def |
/myring base 0 get (ring) dc def |
/zero (0) myring ,, def |
/zero (0) myring __ def |
base length 1 sub /n set |
base length 1 sub /n set |
/minbase [ 0 1 n { /i set base i get } for ] def |
/minbase [ 0 1 n { /i set base i get } for ] def |
0 1 n { |
0 1 n { |
|
|
[(variableNames) M2N 0 get] system_variable |
[(variableNames) M2N 0 get] system_variable |
f toString /f2 set |
f toString /f2 set |
[(variableNames) M2N 3 get] system_variable |
[(variableNames) M2N 3 get] system_variable |
f2 M2N 2 get ,, /f2 set |
f2 M2N 2 get __ /f2 set |
} ifelse |
} ifelse |
[(CurrentRingp) cp] system_variable |
[(CurrentRingp) cp] system_variable |
/arg1 f2 def |
/arg1 f2 def |
|
|
$/R2 set$ |
$/R2 set$ |
$[[(x) (Dx)] [((t-1) Dt) (z)]] /r0 set$ |
$[[(x) (Dx)] [((t-1) Dt) (z)]] /r0 set$ |
$r0 R1 R2 makeRingMap /maptable set$ |
$r0 R1 R2 makeRingMap /maptable set$ |
$(Dx-1) R1 ,, /ff set$ |
$(Dx-1) R1 __ /ff set$ |
$ ff maptable ringmap :: $ |
$ ff maptable ringmap :: $ |
] |
] |
] putUsages |
] putUsages |
|
|
/rrr set |
/rrr set |
base { . } map /base set |
base { . } map /base set |
} ifelse |
} ifelse |
vlist { dup isPolynomial { } { rrr ,, } ifelse } map /vlist set |
vlist { dup isPolynomial { } { rrr __ } ifelse } map /vlist set |
|
|
[(hilbert) base vlist] extension /ff set |
[(hilbert) base vlist] extension /ff set |
[(CurrentRingp) rrrorg] system_variable |
[(CurrentRingp) rrrorg] system_variable |
|
|
/vv arg2 def |
/vv arg2 def |
/f hhh 1 get def |
/f hhh 1 get def |
f (0). eq { /ans [0] def /hilbReduce.label goto } { } ifelse |
f (0). eq { /ans [0] def /hilbReduce.label goto } { } ifelse |
f vv << f (ring) dc >> ,, degree /vv set |
f vv << f (ring) dc >> __ degree /vv set |
hhh 0 get /d set |
hhh 0 get /d set |
d d (integer) dc factorial /d set |
d d (integer) dc factorial /d set |
d << vv (universalNumber) dc vv factorial >> idiv /d set |
d << vv (universalNumber) dc vv factorial >> idiv /d set |
|
|
{ /fn (0). def } |
{ /fn (0). def } |
{ |
{ |
f (ring) dc /rrr set |
f (ring) dc /rrr set |
v toString (^) n toString 3 cat_n rrr ,, |
v toString (^) n toString 3 cat_n rrr __ |
f mul |
f mul |
[[v (0).] [(h) rrr ,, (1) rrr ,,]] replace /fn set |
[[v (0).] [(h) rrr __ (1) rrr __]] replace /fn set |
} ifelse |
} ifelse |
fn /arg1 set |
fn /arg1 set |
] pop |
] pop |
|
|
[ |
[ |
/fff arg1 def |
/fff arg1 def |
/www arg2 def |
/www arg2 def |
|
www to_int32 /www set |
fff (0). eq { /ddd -intInfinity def /ord_w.LLL goto} { } ifelse |
fff (0). eq { /ddd -intInfinity def /ord_w.LLL goto} { } ifelse |
fff (ring) dc /rrr set |
fff (ring) dc /rrr set |
fff init /fff set |
fff init /fff set |
/ddd 0 def |
/ddd 0 def |
0 2 www length 1 sub { |
0 2 www length 1 sub { |
/iii set |
/iii set |
fff << www iii get rrr ,, >> degree |
fff << www iii get rrr __ >> degree |
<< www iii 1 add get >> mul |
<< www iii 1 add get >> mul |
ddd add /ddd set |
ddd add /ddd set |
} for |
} for |
|
|
[ |
[ |
/fff arg1 def |
/fff arg1 def |
/www arg2 def |
/www arg2 def |
|
www to_int32 /www set |
fff (0). eq { /ddd -intInfinity def /ord_w_all.LLL goto} { } ifelse |
fff (0). eq { /ddd -intInfinity def /ord_w_all.LLL goto} { } ifelse |
/ddd -intInfinity def |
/ddd -intInfinity def |
fff (ring) dc /rrr set |
fff (ring) dc /rrr set |
/zzz (0) rrr ,, def |
/zzz (0) rrr __ def |
fff init /fff-in set |
fff init /fff-in set |
fff fff-in sub /fff set |
fff fff-in sub /fff set |
{ |
{ |
/ddd-tmp 0 def |
/ddd-tmp 0 def |
0 2 www length 1 sub { |
0 2 www length 1 sub { |
/iii set |
/iii set |
fff-in << www iii get rrr ,, >> degree |
fff-in << www iii get rrr __ >> degree |
<< www iii 1 add get >> mul |
<< www iii 1 add get >> mul |
ddd-tmp add /ddd-tmp set |
ddd-tmp add /ddd-tmp set |
} for |
} for |
|
|
/v0 vv ii get (string) dc def |
/v0 vv ii get (string) dc def |
v0 (array) dc 0 get Dascii eq %% If the first character is D? |
v0 (array) dc 0 get Dascii eq %% If the first character is D? |
{ rule %% Dx-->x |
{ rule %% Dx-->x |
[v0 rr ,, |
[v0 rr __ |
v0 (array) dc rest { (string) dc} map aload length cat_n rr ,,] |
v0 (array) dc rest { (string) dc} map aload length cat_n rr __] |
append /rule set |
append /rule set |
} |
} |
{ rule %% x --> -Dx |
{ rule %% x --> -Dx |
[v0 rr ,, |
[v0 rr __ |
(0). |
(0). |
[Dascii] v0 (array) dc join { (string) dc } map aload length |
[Dascii] v0 (array) dc join { (string) dc } map aload length |
cat_n rr ,, sub |
cat_n rr __ sub |
] |
] |
append /rule set |
append /rule set |
} ifelse |
} ifelse |
} ifelse |
} ifelse |
} for |
} for |
% rule message |
% rule message |
ff rule replace [[(h) rr ,, (1) rr ,,]] replace /ans1 set |
ff rule replace [[(h) rr __ (1) rr __]] replace /ans1 set |
} ifelse |
} ifelse |
} |
} |
{ |
{ |
|
|
{ |
{ |
/xx xx (string) dc def |
/xx xx (string) dc def |
/dxx [@@@.Dsymbol xx] cat def |
/dxx [@@@.Dsymbol xx] cat def |
/xx xx f (ring) dc ,, def |
/xx xx f (ring) dc __ def |
/dxx dxx f (ring) dc ,, def |
/dxx dxx f (ring) dc __ def |
/one (1) f (ring) dc ,, def |
/one (1) f (ring) dc __ def |
|
|
{ |
{ |
/g f init def |
/g f init def |
|
|
f (0). eq { } |
f (0). eq { } |
{ |
{ |
/rr f (ring) dc def |
/rr f (ring) dc def |
xx {toString rr ,, } map /xx set |
xx {toString rr __ } map /xx set |
dx {toString rr ,, } map /dx set |
dx {toString rr __ } map /dx set |
ss {toString rr ,, } map /ss set |
ss {toString rr __ } map /ss set |
/n xx length def |
/n xx length def |
0 1 n 1 sub { |
0 1 n 1 sub { |
/i set |
/i set |
|
|
[ |
[ |
/f arg1 def /xx arg2 def /dx arg3 def /ss arg4 def |
/f arg1 def /xx arg2 def /dx arg3 def /ss arg4 def |
f (ring) dc /rr set |
f (ring) dc /rr set |
/one (1) rr ,, def %% |
/one (1) rr __ def %% |
/ww [ xx toString -1 dx toString 1 ] weightv def |
/ww [ xx toString -1 dx toString 1 ] weightv def |
f ww init f sub (0). eq { } |
f ww init f sub (0). eq { } |
{ [(destraction2.1 : inhomogeneous with respect to ) |
{ [(destraction2.1 : inhomogeneous with respect to ) |
Line 3657 $ [ff ff] fromVectors :: $ |
|
Line 3668 $ [ff ff] fromVectors :: $ |
|
( ff to_int { tag } map :: ) |
( ff to_int { tag } map :: ) |
]] putUsages |
]] putUsages |
|
|
|
/to_int32 { |
|
/arg1 set |
|
[/to-int32 /ob /ans] pushVariables |
|
[ |
|
/ob arg1 def |
|
/ans ob def |
|
ob isArray { |
|
ob {to_int32} map /ans set |
|
/LLL.to_int32 goto |
|
} { } ifelse |
|
ob isUniversalNumber { |
|
ob (integer) dc /ans set |
|
/LLL.to_int32 goto |
|
} { } ifelse |
|
/LLL.to_int32 |
|
/arg1 ans def |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
[(to_int32) |
|
[(obj to_int32 obj2) |
|
$All universalNumber in obj are changed to integer (int32).$ |
|
(Example: /ff [1 (2).. [(hello) (0).]] def ff { tag } map ::) |
|
( ff to_int32 { tag } map :: ) |
|
(cf. to_int, to_univNum ) |
|
]] putUsages |
|
|
/define_ring_variables { |
/define_ring_variables { |
[/in-define_ring_variables /drv._v /drv._p /drv._v0] pushVariables |
[/in-define_ring_variables /drv._v /drv._p /drv._v0] pushVariables |
%% You cannot use these names for names for polynomials. |
%% You cannot use these names for names for polynomials. |
Line 3838 $ [ff ff] fromVectors :: $ |
|
Line 3877 $ [ff ff] fromVectors :: $ |
|
[(>) (stringOut://@@@stdout) (2>) (stringOut://@@@stderr)] join |
[(>) (stringOut://@@@stdout) (2>) (stringOut://@@@stderr)] join |
} def |
} def |
|
|
[(,,,) |
[(___) |
[(reparse a polynomial or polynomials)] |
[(reparse a polynomial or polynomials)] |
] putUsages |
] putUsages |
/,,, { |
/___ { |
/arg1 set |
/arg1 set |
[/in-reparse /ff] pushVariables |
[/in-reparse /ff] pushVariables |
[ |
[ |
/ff arg1 def |
/ff arg1 def |
ff tag 6 eq { |
ff tag 6 eq { |
ff { ,,, } map /arg1 set |
ff { ___ } map /arg1 set |
} { |
} { |
ff toString . /arg1 set |
ff toString . /arg1 set |
} ifelse |
} ifelse |
Line 3877 $ [ff ff] fromVectors :: $ |
|
Line 3916 $ [ff ff] fromVectors :: $ |
|
[(to_univNum) |
[(to_univNum) |
[(obj to_univNum obj2) |
[(obj to_univNum obj2) |
(Example. [ 2 (3).. ] to_univNum) |
(Example. [ 2 (3).. ] to_univNum) |
(cf. to_int) |
$cf. to_int32. (to_int)$ |
]] putUsages |
]] putUsages |
|
|
[(lcm) |
[(lcm) |
Line 4115 $ [ff ff] fromVectors :: $ |
|
Line 4154 $ [ff ff] fromVectors :: $ |
|
/getNode { |
/getNode { |
/arg2 set |
/arg2 set |
/arg1 set |
/arg1 set |
[/in-getNode /ob /key /rr /rr /ii] pushVariables |
[/in-getNode /ob /key /rr /tt /ii] pushVariables |
[ |
[ |
/ob arg1 def |
/ob arg1 def |
/key arg2 def |
/key arg2 def |
/rr null def |
/rr null def |
{ |
{ |
|
ob isArray { |
|
ob length 1 gt { |
|
ob 0 get isString { |
|
ob 0 get , key eq { |
|
/rr ob 1 get def exit |
|
} { } ifelse |
|
} { } ifelse |
|
}{ } ifelse |
|
ob { key getNode , dup tag 0 eq {pop} { } ifelse } map /tt set |
|
tt length 0 gt { /rr tt 0 get def exit } |
|
{/rr null def exit } ifelse |
|
} { } ifelse |
|
|
ob isClass { |
ob isClass { |
ob (array) dc /ob set |
ob (array) dc /ob set |
} { exit } ifelse |
} { } ifelse |
|
ob isClass , ob isArray or { } { exit } ifelse |
ob 0 get key eq { |
ob 0 get key eq { |
/rr ob def |
/rr ob def |
exit |
exit |
Line 4142 $ [ff ff] fromVectors :: $ |
|
Line 4195 $ [ff ff] fromVectors :: $ |
|
arg1 |
arg1 |
} def |
} def |
[(getNode) |
[(getNode) |
[(ob key getNode) |
[(ob key getNode node-value) |
(ob is a class object.) |
(ob is a class object or an array.) |
(The operator getNode returns the node with the key in ob.) |
(The operator getNode returns the node with the key in ob.) |
(The node is an array of the format [key attr-list node-list]) |
(When ob is a class, the node is an array of the format [key attr-list node-list]) |
|
(When ob is an array, the node is a value of key-value pairs.) |
(Example:) |
(Example:) |
( /dog [(dog) [[(legs) 4] ] [ ]] [(class) (tree)] dc def) |
( /dog [(dog) [[(legs) 4] ] [ ]] [(class) (tree)] dc def) |
( /man [(man) [[(legs) 2] ] [ ]] [(class) (tree)] dc def) |
( /man [(man) [[(legs) 2] ] [ ]] [(class) (tree)] dc def) |
( /ma [(mammal) [ ] [man dog]] [(class) (tree)] dc def) |
( /ma [(mammal) [ ] [man dog]] [(class) (tree)] dc def) |
( ma (dog) getNode ) |
( ma (dog) getNode ) |
|
(Example 2:) |
|
( [ [1 ] [2 3] [[(dog) 2]]] (dog) getNode ::) |
]] putUsages |
]] putUsages |
|
|
|
/cons { |
|
/arg2 set /arg1 set |
|
[/aa /bb] pushVariables |
|
[ |
|
/aa arg1 def /bb arg2 def |
|
[aa] (list) dc bb join /arg1 set |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
[(cons) |
|
[(obj list cons list) |
|
]] putUsages |
|
/arrayToList { |
|
/arg1 set |
|
[/a /r] pushVariables |
|
[ |
|
/a arg1 def |
|
{ |
|
a isArray { |
|
a { arrayToList } map /a set |
|
a (list) dc /r set |
|
exit |
|
} { } ifelse |
|
/r a def |
|
exit |
|
} loop |
|
/arg1 r def |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
[(arrayToList) |
|
[(a arrayToList list) |
|
]] putUsages |
|
|
|
/listToArray { |
|
/arg1 set |
|
[/a /r] pushVariables |
|
[ |
|
/a arg1 def |
|
{ |
|
a tag 12 eq { |
|
a (array) dc /a set |
|
a { listToArray } map /r set |
|
exit |
|
} { } ifelse |
|
a tag 0 eq { |
|
/r [ ] def |
|
exit |
|
} { } ifelse |
|
/r a def |
|
exit |
|
} loop |
|
/arg1 r def |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
[(listToArray) |
|
[(list listToArray a) |
|
]] putUsages |
|
|
|
% Body is moved to smacro.sm1 |
|
[(makeInfix) |
|
[(literal makeInfix) |
|
(Change literal to an infix operator.) |
|
(Example: /+ { add } def ) |
|
( /+ makeInfix) |
|
( /s 0 def 1 1 100 { /i set s + i /s set } for s message) |
|
( [ 1 2 3 ] { /i set i + 2 } map ::) |
|
]] putUsages |
|
|
/usages { |
/usages { |
/arg1 set |
/arg1 set |
[/name /flag /n /k /slist /m /i /sss] pushVariables |
[/name /flag /n /k /slist /m /i /sss /key /ukeys] pushVariables |
[ |
[ |
/name arg1 def |
/name arg1 def |
/flag true def |
/flag true def |
|
{ % begin loop |
|
|
%BUG: should use regular expression in a future. |
name isArray { |
|
/ukeys @.usages { 0 get } map shell def |
|
name { /key set [(regexec) key ukeys] extension |
|
{ 0 get } map } map /sss set |
|
exit |
|
} { } ifelse |
|
|
name tag 1 eq { |
name tag 1 eq { |
@.usages { 0 get } map shell { (, ) nl } map /sss set |
@.usages { 0 get } map shell { (, ) nl } map /sss set |
|
exit |
} { |
} { |
|
|
/sss [ ] def |
/sss [ ] def |
Line 4190 $ [ff ff] fromVectors :: $ |
|
Line 4326 $ [ff ff] fromVectors :: $ |
|
{name Usage /sss [(Usage of ) name ( could not obtained.) nl ] def} |
{name Usage /sss [(Usage of ) name ( could not obtained.) nl ] def} |
{ } |
{ } |
ifelse |
ifelse |
|
exit |
} ifelse |
} ifelse |
|
|
|
} loop |
/arg1 sss cat def |
/arg1 sss cat def |
] pop |
] pop |
popVariables |
popVariables |
Line 4199 $ [ff ff] fromVectors :: $ |
|
Line 4338 $ [ff ff] fromVectors :: $ |
|
[(usages) |
[(usages) |
[(key usages usages-as-a-string) |
[(key usages usages-as-a-string) |
(num usages list-of-key-words) |
(num usages list-of-key-words) |
|
([key1 key2 ... ] usages list-of-key-words : it accepts regular expressions.) |
]] putUsages |
]] putUsages |
|
|
|
/setMinus { |
|
/arg2 set /arg1 set |
|
[/aa /bb /i ] pushVariables |
|
[ |
|
/aa arg1 def /bb arg2 def |
|
[ |
|
0 1 aa length 1 sub { |
|
/i set |
|
aa i get bb memberQ { |
|
} { aa i get } ifelse |
|
} for |
|
] /arg1 set |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
[(setMinus) |
|
[(a b setMinus c) |
|
]] putUsages |
|
|
|
% Define some infix operators |
|
/~add~ { add } def /~add~ makeInfix |
|
/~sub~ { sub } def /~sub~ makeInfix |
|
/~mul~ { mul } def /~mul~ makeInfix |
|
/~div~ { div } def /~div~ makeInfix |
|
/~power~ { power } def /~power~ makeInfix |
|
/~put~ { |
|
dup tag 3 eq { exec } { } ifelse put |
|
} def |
|
/~put~ makeInfix |
|
|
|
|
; |
; |
|
|