languages/lisp/validate.pir

   1 # $Id$
   2
   3 =head1 NAME
   4
   5 validate.pir - lexing
   6
   7 =cut
   8
   9 .sub _VALIDATE_TOKEN
  10   .param string token
  11
  12   .local string pkgname
  13   .local string symname
  14   .local pmc package
  15   .local pmc symbol
  16   .local pmc retv
  17   .local int capture
  18   .local pmc nil
  19
  20   # VALID_IN_PARROT_0_2_0 flag = _IS_INTEGER(token)
  21   .local pmc is_integer
  22   is_integer = get_global 'is_integer'
  23   capture = is_integer(token)                                   # attempt to parse token as an integer
  24   if capture goto INTEGER
  25
  26   # VALID_IN_PARROT_0_2_0 flag = _IS_FLOAT(token)
  27   .local pmc is_float
  28   is_float = get_global 'is_float'
  29   capture = is_float(token)                                     # attempt to parse token as a float
  30   if capture goto FLOAT
  31
  32   goto QUALIFIED_SYMBOL                                         # else interpret it as a symbol
  33
  34 INTEGER:
  35   .INTEGER(retv,token)                                          # create a LispInteger object
  36   goto DONE
  37
  38 FLOAT:
  39   .FLOAT(retv,token)                                            # create a ListFloat object
  40   goto DONE
  41
  42 QUALIFIED_SYMBOL:
  43   # VALID_IN_PARROT_0_2_0 (flag,pkgname,symname) = _IS_QUALIFIED(token)
  44   .local pmc is_qualified, capture
  45   is_qualified = get_global 'is_qualified'
  46   capture = is_qualified(token)
  47   unless capture goto SYMBOL
  48
  49   pkgname = capture[0]
  50   symname = capture[1]
  51   retv = _LOOKUP_GLOBAL(pkgname, symname)
  52   if_null retv, SYMBOL_NOT_FOUND
  53   goto DONE
  54
  55 SYMBOL:
  56   symbol = _LOOKUP_GLOBAL("COMMON-LISP", "*PACKAGE*")
  57   if_null symbol, PACKAGE_NOT_FOUND
  58
  59   package = symbol._get_value()                 # Get the current package
  60   if_null package, PACKAGE_NOT_FOUND
  61
  62   pkgname = package._get_name_as_string()
  63   symname = token
  64
  65   retv = _LOOKUP_GLOBAL(pkgname, symname)
  66   if_null retv, SYMBOL_NOT_FOUND                # If not found, intern a new symbol
  67
  68   goto DONE
  69
  70 SYMBOL_NOT_FOUND:
  71   null nil                                      # Intern a new global symbol
  72   retv = _GLOBAL_SYMBOL(pkgname, symname, nil, nil)
  73
  74   goto DONE
  75
  76 PACKAGE_NOT_FOUND:
  77   .ERROR_0("internal-error", "the *PACKAGE* symbol could not be located")
  78   goto DONE
  79
  80 DONE:
  81   .return(retv)
  82 .end
  83
  84 # VALID_IN_PARROT_0_2_0 .sub _IS_INTEGER
  85 # VALID_IN_PARROT_0_2_0   .param string token
  86 # VALID_IN_PARROT_0_2_0
  87 # VALID_IN_PARROT_0_2_0   .local int retv
  88 # VALID_IN_PARROT_0_2_0   .local int ndig
  89 # VALID_IN_PARROT_0_2_0   .local int idx
  90 # VALID_IN_PARROT_0_2_0
  91 # VALID_IN_PARROT_0_2_0   ndig = 0
  92 # VALID_IN_PARROT_0_2_0   idx  = 0
  93 # VALID_IN_PARROT_0_2_0
  94 # VALID_IN_PARROT_0_2_0 SIGNS:
  95 # VALID_IN_PARROT_0_2_0   rx_oneof token, idx, '+-', DIGIT      # check for +/- signs (optional)
  96 # VALID_IN_PARROT_0_2_0   goto DIGIT
  97 # VALID_IN_PARROT_0_2_0
  98 # VALID_IN_PARROT_0_2_0 DIGIT:                                  # ensure the rest is all digits
  99 # VALID_IN_PARROT_0_2_0   rx_is_d token, idx, DECIMAL
 100 # VALID_IN_PARROT_0_2_0   ndig = ndig + 1
 101 # VALID_IN_PARROT_0_2_0   goto DIGIT
 102 # VALID_IN_PARROT_0_2_0
 103 # VALID_IN_PARROT_0_2_0 DECIMAL:
 104 # VALID_IN_PARROT_0_2_0   rx_literal token, idx, '.', EOS       # Check for an optional decimal point
 105 # VALID_IN_PARROT_0_2_0   goto EOS
 106 # VALID_IN_PARROT_0_2_0
 107 # VALID_IN_PARROT_0_2_0 EOS:                                    # check to see if we're at string end
 108 # VALID_IN_PARROT_0_2_0   rx_zwa_atend token, idx, FAIL
 109 # VALID_IN_PARROT_0_2_0   goto MATCH
 110 # VALID_IN_PARROT_0_2_0
 111 # VALID_IN_PARROT_0_2_0 MATCH:
 112 # VALID_IN_PARROT_0_2_0   if ndig == 0 goto FAIL                # ensure we had at least one digit
 113 # VALID_IN_PARROT_0_2_0   retv = 1
 114 # VALID_IN_PARROT_0_2_0   goto DONE
 115 # VALID_IN_PARROT_0_2_0
 116 # VALID_IN_PARROT_0_2_0 FAIL:
 117 # VALID_IN_PARROT_0_2_0   retv = 0
 118 # VALID_IN_PARROT_0_2_0   goto DONE
 119 # VALID_IN_PARROT_0_2_0
 120 # VALID_IN_PARROT_0_2_0 DONE:
 121 # VALID_IN_PARROT_0_2_0   .return(retv)
 122 # VALID_IN_PARROT_0_2_0 .end
 123 # VALID_IN_PARROT_0_2_0
 124 # VALID_IN_PARROT_0_2_0 .sub _IS_FLOAT
 125 # VALID_IN_PARROT_0_2_0   .param string token
 126 # VALID_IN_PARROT_0_2_0
 127 # VALID_IN_PARROT_0_2_0   .local int retv
 128 # VALID_IN_PARROT_0_2_0   .local int idx
 129 # VALID_IN_PARROT_0_2_0
 130 # VALID_IN_PARROT_0_2_0   idx  = 0
 131 # VALID_IN_PARROT_0_2_0
 132 # VALID_IN_PARROT_0_2_0 SIGNS:
 133 # VALID_IN_PARROT_0_2_0   rx_oneof token, idx, '+-', PREDIGITS  # check for +/- signs (optional)
 134 # VALID_IN_PARROT_0_2_0   goto PREDIGITS
 135 # VALID_IN_PARROT_0_2_0
 136 # VALID_IN_PARROT_0_2_0 PREDIGITS:                              # check for pre-decimal digits
 137 # VALID_IN_PARROT_0_2_0   rx_is_d token, idx, DECIMAL
 138 # VALID_IN_PARROT_0_2_0   goto PREDIGITS
 139 # VALID_IN_PARROT_0_2_0
 140 # VALID_IN_PARROT_0_2_0 DECIMAL:
 141 # VALID_IN_PARROT_0_2_0   rx_literal token, idx, '.', FAIL      # check for a decimal point
 142 # VALID_IN_PARROT_0_2_0   goto POSTDIGIT
 143 # VALID_IN_PARROT_0_2_0
 144 # VALID_IN_PARROT_0_2_0 POSTDIGIT:
 145 # VALID_IN_PARROT_0_2_0   rx_is_d token, idx, FAIL              # check for at least one required digit
 146 # VALID_IN_PARROT_0_2_0   goto POSTDIGITS
 147 # VALID_IN_PARROT_0_2_0
 148 # VALID_IN_PARROT_0_2_0 POSTDIGITS:                             # check for option post-decimal digits
 149 # VALID_IN_PARROT_0_2_0   rx_is_d token, idx, EOS
 150 # VALID_IN_PARROT_0_2_0   goto POSTDIGITS
 151 # VALID_IN_PARROT_0_2_0
 152 # VALID_IN_PARROT_0_2_0 EOS:                                    # check to see if we're at string end
 153 # VALID_IN_PARROT_0_2_0   rx_zwa_atend token, idx, FAIL
 154 # VALID_IN_PARROT_0_2_0   goto MATCH
 155 # VALID_IN_PARROT_0_2_0
 156 # VALID_IN_PARROT_0_2_0 MATCH:
 157 # VALID_IN_PARROT_0_2_0   retv = 1
 158 # VALID_IN_PARROT_0_2_0   goto DONE
 159 # VALID_IN_PARROT_0_2_0
 160 # VALID_IN_PARROT_0_2_0 FAIL:
 161 # VALID_IN_PARROT_0_2_0   retv = 0
 162 # VALID_IN_PARROT_0_2_0   goto DONE
 163 # VALID_IN_PARROT_0_2_0
 164 # VALID_IN_PARROT_0_2_0 DONE:
 165 # VALID_IN_PARROT_0_2_0   .return(retv)
 166 # VALID_IN_PARROT_0_2_0 .end
 167 # VALID_IN_PARROT_0_2_0
 168 # VALID_IN_PARROT_0_2_0 .sub _IS_QUALIFIED
 169 # VALID_IN_PARROT_0_2_0   .param string token
 170 # VALID_IN_PARROT_0_2_0
 171 # VALID_IN_PARROT_0_2_0   .local string package
 172 # VALID_IN_PARROT_0_2_0   .local string symbol
 173 # VALID_IN_PARROT_0_2_0   .local string vchar
 174 # VALID_IN_PARROT_0_2_0   .local int retv
 175 # VALID_IN_PARROT_0_2_0   .local int idx1
 176 # VALID_IN_PARROT_0_2_0   .local int idx2
 177 # VALID_IN_PARROT_0_2_0   .local int idx3
 178 # VALID_IN_PARROT_0_2_0   .local int type
 179 # VALID_IN_PARROT_0_2_0
 180 # VALID_IN_PARROT_0_2_0   vchar = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!$%&*<=>?@^_~-./+"
 181 # VALID_IN_PARROT_0_2_0   idx1   = 0
 182 # VALID_IN_PARROT_0_2_0
 183 # VALID_IN_PARROT_0_2_0 PACKAGE:
 184 # VALID_IN_PARROT_0_2_0   rx_oneof token, idx1, vchar, COLON
 185 # VALID_IN_PARROT_0_2_0   goto PACKAGE
 186 # VALID_IN_PARROT_0_2_0
 187 # VALID_IN_PARROT_0_2_0 COLON:
 188 # VALID_IN_PARROT_0_2_0   idx2 = idx1                           # Index of last valid symbol character
 189 # VALID_IN_PARROT_0_2_0
 190 # VALID_IN_PARROT_0_2_0   rx_literal token, idx1, ':', FAIL     # If we don't have this -> not qualified
 191 # VALID_IN_PARROT_0_2_0
 192 # VALID_IN_PARROT_0_2_0   idx3 = idx1                           # Start of symbol character
 193 # VALID_IN_PARROT_0_2_0   type = 0                              # External symbol
 194 # VALID_IN_PARROT_0_2_0
 195 # VALID_IN_PARROT_0_2_0   rx_literal token, idx1, ':', SYMBOL   # If we don't have this -> not external
 196 # VALID_IN_PARROT_0_2_0
 197 # VALID_IN_PARROT_0_2_0   idx3 = idx1                           # Start of symbol character
 198 # VALID_IN_PARROT_0_2_0   type = 1                              # Internal symbol
 199 # VALID_IN_PARROT_0_2_0
 200 # VALID_IN_PARROT_0_2_0   goto SYMBOL
 201 # VALID_IN_PARROT_0_2_0
 202 # VALID_IN_PARROT_0_2_0 SYMBOL:
 203 # VALID_IN_PARROT_0_2_0   rx_oneof token, idx1, vchar, EOS
 204 # VALID_IN_PARROT_0_2_0   goto SYMBOL
 205 # VALID_IN_PARROT_0_2_0
 206 # VALID_IN_PARROT_0_2_0 EOS:
 207 # VALID_IN_PARROT_0_2_0   rx_zwa_atend token, idx1, FAIL        # check to see if we're at string end
 208 # VALID_IN_PARROT_0_2_0   goto MATCH
 209 # VALID_IN_PARROT_0_2_0
 210 # VALID_IN_PARROT_0_2_0 KEYWORD:
 211 # VALID_IN_PARROT_0_2_0   package = "KEYWORD"
 212 # VALID_IN_PARROT_0_2_0   goto KEYWORD_RETURN
 213 # VALID_IN_PARROT_0_2_0
 214 # VALID_IN_PARROT_0_2_0 MATCH:
 215 # VALID_IN_PARROT_0_2_0   idx3 = idx3
 216 # VALID_IN_PARROT_0_2_0
 217 # VALID_IN_PARROT_0_2_0 KEYWORD_CHECK1:
 218 # VALID_IN_PARROT_0_2_0   if idx2 != 0 goto NOT_KEYWORD
 219 # VALID_IN_PARROT_0_2_0   if idx3 <= 2 goto KEYWORD
 220 # VALID_IN_PARROT_0_2_0   goto NOT_KEYWORD
 221 # VALID_IN_PARROT_0_2_0
 222 # VALID_IN_PARROT_0_2_0 NOT_KEYWORD:
 223 # VALID_IN_PARROT_0_2_0   substr package, token, 0, idx2
 224 # VALID_IN_PARROT_0_2_0
 225 # VALID_IN_PARROT_0_2_0 KEYWORD_RETURN:
 226 # VALID_IN_PARROT_0_2_0   substr symbol, token, idx3, idx1
 227 # VALID_IN_PARROT_0_2_0
 228 # VALID_IN_PARROT_0_2_0   retv = 1
 229 # VALID_IN_PARROT_0_2_0   goto DONE
 230 # VALID_IN_PARROT_0_2_0
 231 # VALID_IN_PARROT_0_2_0 FAIL:
 232 # VALID_IN_PARROT_0_2_0   package = ""
 233 # VALID_IN_PARROT_0_2_0   symbol = ""
 234 # VALID_IN_PARROT_0_2_0   type = 0
 235 # VALID_IN_PARROT_0_2_0   retv = 0
 236 # VALID_IN_PARROT_0_2_0   goto DONE
 237 # VALID_IN_PARROT_0_2_0
 238 # VALID_IN_PARROT_0_2_0 DONE:
 239 # VALID_IN_PARROT_0_2_0   .return(retv,package,symbol,type)
 240 # VALID_IN_PARROT_0_2_0 .end
 241
 242 # Local Variables:
 243 #   mode: pir
 244 #   fill-column: 100
 245 # End:
 246 # vim: expandtab shiftwidth=4 ft=pir: