=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/dr.sm1,v retrieving revision 1.1 retrieving revision 1.7 diff -u -p -r1.1 -r1.7 --- OpenXM/src/kan96xx/Kan/dr.sm1 1999/10/08 02:12:02 1.1 +++ OpenXM/src/kan96xx/Kan/dr.sm1 2000/12/29 07:19:38 1.7 @@ -1,8 +1,9 @@ +% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.6 2000/12/10 07:48:42 takayama Exp $ %% dr.sm1 (Define Ring) 1994/9/25, 26 %% This file is error clean. @@@.quiet { } -{ (macro package : dr.sm1, 9/26,1995 --- Version 9/8, 1999. ) message } ifelse +{ (macro package : dr.sm1, 9/26,1995 --- Version 12/10, 2000. ) message } ifelse /ctrlC-hook { %%% define your own routing in case of error. @@ -1473,6 +1474,13 @@ (type?) data_conversion RationalFunctionP eq } def +[(isRing) + [(obj isRing bool) ] +] putUsages +/isRing { + (type?) data_conversion RingP eq +} def + /toString.tmp { /arg1 set [/obj /fname] pushVariables @@ -1527,7 +1535,7 @@ /obj arg1 def obj isArray { - ( [ ) + [(LeftBracket)] system_variable %%( [ ) obj {toString.tmp2} map /r set /n r length 1 sub def [0 1 n { @@ -1539,7 +1547,7 @@ ifelse } for ] aload length cat_n - ( ] ) + [(RightBracket)] system_variable %%( ] ) 3 cat_n } { @@ -3027,6 +3035,50 @@ newline arg1 } def +/distraction2* { + /arg1 set + [/in-distraction2* /aa /f /vlist /xlist /dlist /slist ] pushVariables + [(CurrentRingp)] pushEnv + [ + /aa arg1 def + /f aa 0 get def + /vlist aa 1 get def + /xlist aa 2 get def + /dlist aa 3 get def + /slist aa 4 get def + vlist isArray + { + vlist { toString } map /vlist set + } + { + vlist toString to_records /vlist set + } ifelse + xlist isArray + { + xlist { toString } map /xlist set + } + { + xlist toString to_records /xlist set + } ifelse + slist isArray + { + slist { toString } map /slist set + } + { + slist toString to_records /slist set + } ifelse + [vlist from_records ring_of_differential_operators 0] define_ring pop + f toString . + xlist { . } map + dlist { toString . } map + slist { toString . } map + distraction2 /arg1 set + ] pop + popEnv + popVariables + arg1 +} def + /message-quiet { @@@.quiet { pop } { message } ifelse } def @@ -3487,6 +3539,72 @@ $ [ff ff] fromVectors :: $ [(nl) [(nl is the newline character.) $Example: [(You can break line) nl (here.)] cat message$ +]] putUsages + +/to_int { + /arg1 set + [/to-int /ob /ans] pushVariables + [ + /ob arg1 def + /ans ob def + ob isArray { + ob {to_int} map /ans set + /LLL.to_int goto + } { } ifelse + ob isInteger { + ob (universalNumber) dc /ans set + /LLL.to_int goto + } { } ifelse + /LLL.to_int + /arg1 ans def + ] pop + popVariables + arg1 +} def +[(to_int) +[(obj to_int obj2) + (All integers in obj are changed to universalNumber.) + (Example: /ff [1 2 [(hello) (0).]] def ff { tag } map ::) + ( ff to_int { tag } map :: ) +]] putUsages + +/define_ring_variables { + [/in-define_ring_variables /drv._v /drv._p /drv._v0] pushVariables +%% You cannot use these names for names for polynomials. + [ + /drv._v getVariableNames def + /drv._v0 drv._v def + drv._v { dup /drv._p set (/) 2 1 roll ( $) drv._p ($. def ) } map cat + /drv._v set +% drv._v message + [(parse) drv._v] extension + ] pop + popVariables +} def +[(define_ring_variables) +[(It binds a variable <> in the current ring to the sm1 variable <>.) + (For example, if x is a variable in the current ring, it defines the sm1) + (variable x by /x (x) def) +]] putUsages + +/boundp { + /arg1 set + [/a /ans] pushVariables + [ + /a arg1 def + [(parse) [(/) a ( load tag 0 eq { /ans 0 def } ) + ( { /ans 1 def } ifelse )] cat ] extension + /arg1 ans def + ] pop + popVariables + arg1 +} def +[(boundp) + [( a boundp b) + (string a, b is 0 or 1.) + (If the variable named << a >> is bounded to a value,) + (it returns 1 else it returns 0.) + $Example: (hoge) boundp ::$ ]] putUsages ;