home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Caml Light 0.7 / examples / asl / token.ml < prev    next >
Encoding:
Text File  |  1995-06-01  |  1.8 KB  |  71 lines  |  [TEXT/MPS ]
  1. (* $Id: token.ml,v 1.4 1995/02/08 18:57:23 xleroy Exp $ *)
  2.  
  3. let I x = x;;
  4.  
  5. let keywords =
  6.   let t = hashtbl__new 13 in
  7.   hashtbl__add t "else" ELSE;
  8.   hashtbl__add t "fi" FI;
  9.   hashtbl__add t "if" IF;
  10.   hashtbl__add t "let" LET;
  11.   hashtbl__add t "then" THEN;
  12.   t
  13. ;;
  14.  
  15. let buff = create_string 2000;;
  16.  
  17. (***
  18. let rec ident len = function
  19.   [<
  20.     '(`a`..`z` | `A` .. `Z` | `0` .. `9` | `_` | `'`) as c;
  21.     (set_nth_char buff len c; ident(succ len)) i
  22.   >] -> i
  23. | [< >] ->
  24.     let str = sub_string buff 0 len in
  25.     (try hashtbl__find keywords str with _ -> IDENT str)
  26. ;;
  27. ***)
  28.  
  29. let rec ident len = function
  30.   [< '(`a`..`z` | `A` .. `Z` | `0` .. `9` | `_` | `'`) as c; s >] ->
  31.     set_nth_char buff len c; ident (succ len) s
  32. | [< >] ->
  33.     let str = sub_string buff 0 len in
  34.     (try hashtbl__find keywords str with _ -> IDENT str)
  35. ;;
  36.  
  37. let rec number n = function
  38.   [< '`0` .. `9` as d; s >] ->
  39.     number(10*n+int_of_char d-int_of_char`0`) s
  40. | [< >] -> n
  41. ;;
  42.  
  43. let rec next_token = function
  44.   [< '(`a`..`z` | `A` .. `Z`) as c; s >] ->
  45.     set_nth_char buff 0 c; ident 1 s
  46. | [< '`0` .. `9` as d; s >] ->
  47.     INT(number (int_of_char d-int_of_char `0`) s)
  48. | [< '` ` | `\n` | `\t`; s >] -> next_token s
  49. | [< '`+` | `-` | `*` | `/` as c >] -> OP (make_string 1 c)
  50. | [< '`.` >] -> DOT
  51. | [< '`=` >] -> EQUAL
  52. | [< '`\\` >] -> BSLASH
  53. | [< '`;` >] -> SEMICOL
  54. | [< '`(` >] -> LPAREN
  55. | [< '`)` >] -> RPAREN
  56. | [< 'x >] -> failwith ("Bad char: "^make_string 1 x)
  57. ;;
  58.  
  59. let rec reset_lexer = function
  60.   [< '`\n` >] -> ()
  61. | [< '_; reset_lexer _ >] -> ()
  62. | [< >] -> ()
  63. ;;
  64.  
  65. let token_name = function
  66.   IDENT _ -> "IDENT" | INT _ -> "INT" | OP _ -> "OP"
  67. | BSLASH -> "\\" | DOT -> "." | ELSE -> "else" | EQUAL -> "="
  68. | FI -> "fi" | IF -> "if" | LET -> "let" | LPAREN -> "("
  69. | RPAREN -> ")" | SEMICOL -> ";" | THEN -> "then" 
  70. ;;
  71.