languages/forth/tokenstream.pir

   1
   2 .HLL 'Forth', ''
   3 .namespace ['TokenStream']
   4
   5 .sub init :anon :load
   6     .local pmc class
   7     class = newclass 'TokenStream'
   8
   9     addattribute class, '$code'
  10     addattribute class, '$pos'
  11 .end
  12
  13
  14 .sub '__new_from_string'
  15     .param pmc class
  16     .param pmc str
  17     .param int flags
  18
  19     .local pmc self
  20     $I0  = typeof class
  21     self = new $I0
  22
  23     .local pmc pos
  24     pos = new 'Integer'
  25     pos = 0
  26
  27     setattribute self, '$code', str
  28     setattribute self, '$pos',  pos
  29
  30     .return(self)
  31 .end
  32
  33
  34 .sub 'get_bool' :vtable :method
  35     .local string code
  36     .local pmc pos
  37     pos  = getattribute self, '$pos'
  38     $P0  = getattribute self, '$code'
  39     code = $P0
  40
  41     .local int len
  42     len = length code
  43
  44     .include 'cclass.pasm'
  45     $I0 = pos
  46     $I0 = find_not_cclass .CCLASS_WHITESPACE, code, $I0, len
  47     if $I0 == len goto false
  48
  49     pos = $I0
  50     .return(1)
  51
  52 false:
  53     .return(0)
  54 .end
  55
  56 .sub 'shift_pmc' :vtable :method
  57     .local pmc token, pos
  58     .local string code, str
  59     null token
  60     pos  = getattribute self, '$pos'
  61     $P0  = getattribute self, '$code'
  62     code = $P0
  63
  64     .local int len
  65     len = length code
  66
  67     .include 'cclass.pasm'
  68     $I0 = pos
  69     $I0 = find_not_cclass .CCLASS_WHITESPACE, code, $I0, len
  70     $I1 = find_cclass     .CCLASS_WHITESPACE, code, $I0, len
  71     if $I0 == len goto return
  72
  73     $I2 = $I1 - $I0
  74     str = substr code, $I0, $I2
  75     str = downcase str
  76     pos = $I1
  77
  78     $I0 = length str
  79     $I1 = find_not_cclass .CCLASS_NUMERIC, str, 0, $I0
  80     if $I1 == $I0 goto numeric
  81
  82     token = new .String
  83     token = str
  84     goto return
  85
  86 numeric:
  87     $I0 = str
  88     token = new 'Integer'
  89     token = $I0
  90
  91 return:
  92     .return(token)
  93 .end
  94
  95
  96 .sub remove_upto :method
  97     .param string str
  98
  99     .local pmc code, pos
 100     code = getattribute self, '$code'
 101     pos  = getattribute self, '$pos'
 102
 103     $S0 = code
 104     $I0 = pos
 105     inc $I0 # skip a space
 106     $I1 = index $S0, str, $I0
 107
 108     $I2 = $I1 - $I0
 109     $S1 = substr $S0, $I0, $I2
 110
 111     inc $I1
 112     pos = $I1
 113
 114     .return($S1)
 115 .end
 116
 117 # Local Variables:
 118 #   mode: pir
 119 #   fill-column: 100
 120 # End:
 121 # vim: expandtab shiftwidth=4 ft=pir: