Return to smacro.sm1 CVS log

Up to [local] / OpenXM / src / kan96xx / Kan

Annotation of OpenXM/src/kan96xx/Kan/smacro.sm1, Revision 1.8

1.8     ! takayama    1: %% $OpenXM: OpenXM/src/kan96xx/Kan/smacro.sm1,v 1.7 2004/09/16 23:53:44 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.8     ! takayama  103: /. { expand } 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: