Annotation of OpenXM/src/kan96xx/Kan/smacro.sm1, Revision 1.7
1.7 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Kan/smacro.sm1,v 1.6 2004/09/10 13:20:23 takayama Exp $
1.1 maekawa 2: %%%%%% global control variables
3: %% /@@@.quiet 0 def It is defined in scanner().
4: /@@@.Dsymbol (D) def
5: /@@@.diffEsymbol (E) def
6: /@@@.Qsymbol (Q) def
7: /@@@.hsymbol (h) def
8: /@@@.esymbol (e_) def
9: /@@@.Esymbol (E) def
1.3 takayama 10: /@@@.Hsymbol (H) def
1.1 maekawa 11:
12: %%% pointer to the StandardContext.
13: /StandardContextp [(CurrentContextp)] system_variable def
14: /null 0 (null) data_conversion def
15:
1.7 ! takayama 16: /makeInfix {
! 17: [(or_attr) 4 4 -1 roll ] extension
! 18: } def
! 19:
1.1 maekawa 20: %%%%%%%%%%%%%%%%%%%%%% usages %%%%%%%%%%%%%%%%%%%%
21: /@.usages [[( ) [(gate keeper)]] ] def
22: /putUsages {
23: /arg1 set
24: /@.usages @.usages [ arg1 ] join def
25: } def
26:
27: /showKeywords {
28: @.usages { 0 get } map shell @@@.printSVector
29: ( ) message
30: } def
31:
32: /usage {
33: /arg1 set
34: [/name /flag /n /k /slist /m /i] pushVariables
35: [
36: /name arg1 def
37: /flag true def
38: @.usages length /n set
39: 0 1 << n 1 sub >>
40: {
41: /k set
42: name << @.usages k get 0 get >> eq
43: {
44: /slist @.usages k get 1 get def
45: /m slist length def
46: 0 1 << m 1 sub >> {
47: /i set
48: slist i get message
49: } for
50: /flag false def
51: }
52: { }
53: ifelse
54: } for
55:
56: flag
57: {name Usage}
58: { }
59: ifelse
60: ] pop
61: popVariables
62: } def
63:
64:
65: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
66:
67: /; %%% prompt of the sm1
68: { [ $PrintDollar$ [$PrintDollar$] system_variable %% save value
69: [$PrintDollar$ 0] system_variable pop
70: @@@.quiet 0 eq
71: {$sm1>$ print} { } ifelse
1.4 takayama 72: [(traceClearStack)] extension pop
1.1 maekawa 73: ] system_variable pop
74: } def
75:
76: /?
77: {
78: show_systemdictionary
1.7 ! takayama 79: (-- ?? : to see macro dictionary --)
! 80: (-- [(keyword in regular expression)] usages :: --)
1.1 maekawa 81: message
82: $-- (keyWord) usage to see the usages. Data type of (xxxyyy) is string.--$
83: message
84: $Main data types: 1:integer(machine integer), 2:literal, 5:string, 6:array,$
85: message
86: $ 7:poly, 13:file, 14:ring, 15:number(bignum,universalNumber), 16:rational, 17:class. $ message
87:
88: } def
89:
90: /??
91: { (------------ Macros ------------------------------------------------)
92: message
93: showKeywords
94: $------------ Use (keyWord) usage to see the usages. ---------------$
95: message
96: } def
97:
98: /::
99: {
100: print newline ;
101: } def
102:
1.7 ! takayama 103: /. { dup tag 3 eq { exec } {expand} ifelse } def
1.1 maekawa 104:
105:
106: /false 0 def
107:
108: %% You cannot use the variable arg1 in expand.
109: /expand {
110: /@@@expand.arg1 set
111: [/in-expand /f-expand /f-ans] pushVariables
112: [
113: /f-expand @@@expand.arg1 def
114: f-expand isArray {
115: f-expand { expand } map /f-ans set
116: }{
117: f-expand $poly$ data_conversion /f-ans set
118: } ifelse
119: /@@@expand.arg1 f-ans def
120: ] pop
121: popVariables
122: @@@expand.arg1
123: } def
124:
125: /<< { } def
126: />> { } def
127:
128: % v1 v2 join
129: /join {
130: /arg2 set /arg1 set
1.5 takayama 131: [(Kjoin) arg1 arg2] extension
1.1 maekawa 132: } def
133:
134: /n.map 0 def /i.map 0 def /ar.map 0 def /res.map 0 def %% declare variables
135: /map.old { %% recursive
136: /arg1.map set %% arg1.map = { }
137: /arg2.map set %% arg2.map = [ ]
138: %%%debug: /arg1.map load print arg2.map print
139: [n.map /com.map load i.map ar.map %% local variables. Don't push com!
140: %%It's better to use load for all variables.
141: /com.map /arg1.map load def
142: /ar.map arg2.map def %% set variables
143: /n.map ar.map length 1 sub def
144: [
145: 0 1 n.map {
146: /i.map set
147: << ar.map i.map get >> com.map
148: } for
149: ] /res.map set
150: /ar.map set /i.map set /com.map set /n.map set ] pop %% pop local variables
151: res.map %% push the result
152: } def
153:
154: /message {
155: [$PrintDollar$ [$PrintDollar$] system_variable
156: [$PrintDollar$ 0] system_variable pop
157: 4 -1 roll
158: print newline
159: ] system_variable pop
160: } def
161:
162: /messagen {
163: [$PrintDollar$ [$PrintDollar$] system_variable
164: [$PrintDollar$ 0] system_variable pop
165: 4 -1 roll
166: print
167: ] system_variable pop
168: } def
169:
170: /newline {
171: [$PrintDollar$ [$PrintDollar$] system_variable
172: [$PrintDollar$ 0] system_variable pop
173: 10 $string$ data_conversion print
174: ] system_variable pop
175: %% flush stdout
176: [(flush)] extension pop
177: } def
178:
179: /pushVariables {
180: { dup [ 3 1 roll load ] } map
181: } def
182:
183: /popVariables {
184: % dup print
185: { aload pop def } map pop
186: } def
187:
188:
189:
190: /timer {
191: [(TimerOn)] system_variable 1 eq
192: { [(TimerOn) 0] system_variable pop set_timer } { } ifelse
193: set_timer
194: exec
195: set_timer
196: } def
197:
198: /true 1 def
199:
200:
201:
202:
203: %%% prompter
204: ;
205:
206:
207:
208:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>