version 1.37, 2004/09/10 13:20:23 |
version 1.41, 2004/09/14 02:02:02 |
|
|
% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.36 2004/09/09 11:42:22 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.40 2004/09/14 01:57:15 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. |
|
|
Line 4202 $ [ff ff] fromVectors :: $ |
|
Line 4202 $ [ff ff] fromVectors :: $ |
|
[(cons) |
[(cons) |
[(obj list cons list) |
[(obj list cons list) |
]] putUsages |
]] 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 |
|
|
|
/makeInfix { |
|
[(or_attr) 4 4 -1 roll ] extension |
|
} def |
|
[(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 4239 $ [ff ff] fromVectors :: $ |
|
Line 4308 $ [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 4248 $ [ff ff] fromVectors :: $ |
|
Line 4320 $ [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 |
|
|
; |
; |