(* Lexer for GML *) { open Misc open Gml open Gmlparser exception Error of string let keywords = Hashtbl.create 27 let _ = List.iter (fun (kwd, tok) -> Hashtbl.add keywords kwd tok) ["true", BOOLEAN true; "false", BOOLEAN false; "acos", OPERATOR Op_acos; "addi", OPERATOR Op_addi; "addf", OPERATOR Op_addf; "apply", OPERATOR Op_apply; "asin", OPERATOR Op_asin; "clampf", OPERATOR Op_clampf; "cone", OPERATOR Op_cone; "cos", OPERATOR Op_cos; "cube", OPERATOR Op_cube; "cylinder", OPERATOR Op_cylinder; "difference", OPERATOR Op_difference; "divi", OPERATOR Op_divi; "divf", OPERATOR Op_divf; "eqi", OPERATOR Op_eqi; "eqf", OPERATOR Op_eqf; "floor", OPERATOR Op_floor; "frac", OPERATOR Op_frac; "get", OPERATOR Op_get; "getx", OPERATOR Op_getx; "gety", OPERATOR Op_gety; "getz", OPERATOR Op_getz; "if", OPERATOR Op_if; "intersect", OPERATOR Op_intersect; "length", OPERATOR Op_length; "lessi", OPERATOR Op_lessi; "lessf", OPERATOR Op_lessf; "light", OPERATOR Op_light; "modi", OPERATOR Op_modi; "muli", OPERATOR Op_muli; "mulf", OPERATOR Op_mulf; "negi", OPERATOR Op_negi; "negf", OPERATOR Op_negf; "plane", OPERATOR Op_plane; "point", OPERATOR Op_point; "pointlight", OPERATOR Op_pointlight; "real", OPERATOR Op_real; "render", OPERATOR Op_render; "rotatex", OPERATOR Op_rotatex; "rotatey", OPERATOR Op_rotatey; "rotatez", OPERATOR Op_rotatez; "scale", OPERATOR Op_scale; "sin", OPERATOR Op_sin; "sphere", OPERATOR Op_sphere; "spotlight", OPERATOR Op_spotlight; "sqrt", OPERATOR Op_sqrt; "subi", OPERATOR Op_subi; "subf", OPERATOR Op_subf; "translate", OPERATOR Op_translate; "union", OPERATOR Op_union; "uscale", OPERATOR Op_uscale; (* FOR TESTING -- REMOVE BEFORE SHIPPING *) (* "print", OPERATOR Op_print; *) (* "printstack", OPERATOR Op_printstack; *) ] } let whitespace = [' ' '\t' '\r' '\n' '\011' (* vertical tab *)] let identstart = ['A'-'Z' 'a'-'z'] let identbody = ['A'-'Z' 'a'-'z' '0'-'9' '-' '_'] let decimalnumber = ['0'-'9'] + let exponent = ['e' 'E'] '-'? decimalnumber let stringchar = [' '-'!' '#'-'~'] (* all printable ASCII chars except quote *) rule token = parse whitespace + { token lexbuf } | '%' [ ^ '\n'] * ('\n' | '\r' | "\r\n" | '\011' | eof) { token lexbuf } | identstart identbody * { let s = Lexing.lexeme lexbuf in try Hashtbl.find keywords s with Not_found -> IDENTIFIER (intern s) } | '/' identstart identbody * { let s1 = Lexing.lexeme lexbuf in let s2 = String.sub s1 1 (String.length s1 - 1) in try ignore(Hashtbl.find keywords s2); raise (Error ("cannot bind reserved identifier " ^ s2)) with Not_found -> BINDER (intern s2) } | '-'? decimalnumber { INTEGER (int_of_string (Lexing.lexeme lexbuf)) } | ( '-'? decimalnumber '.' decimalnumber exponent? | '-'? decimalnumber exponent ) { REAL (float_of_string (Lexing.lexeme lexbuf)) } | '"' stringchar * '"' { let s = Lexing.lexeme lexbuf in STRING(String.sub s 1 (String.length s - 2)) } | "\"" { raise (Error ("bad string literal")) } | '{' { LBRACE } | '}' { RBRACE } | '[' { LBRACKET } | ']' { RBRACKET } | eof { EOF } | _ { raise (Error ("illegal character " ^ String.escaped (Lexing.lexeme lexbuf))) }