initial regexp support in jslib

git-svn-id: http://ocamljs.googlecode.com/svn/trunk@219 27578800-e353-0410-a23a-a7c9f63c6ccd

src/jslib/Makefile

@@ -14,7 +14,7 @@ BFILES=$(addprefix _build/,$(FILES))
 all: myocamlbuild.ml
 	OCAMLFIND_IGNORE_DUPS_IN=$(LIBDIR)/site-lib \
 	OCAMLPATH=`pwd`/../../stage \
-	ocamlbuild -verbose 10 jslib.cma jslib.cmxa syntax_quotations.cmo syntax_inline.cmo syntax_lambda.cmo
+	ocamlbuild jslib.cma jslib.cmxa syntax_quotations.cmo syntax_inline.cmo syntax_lambda.cmo
 	ocamlfind remove -destdir ../../stage jslib
 	ocamlfind install -destdir ../../stage jslib META $(BFILES)
 

src/jslib/jslib_ast.incl

@@ -78,6 +78,7 @@ and exp =
     | Jnum of      loc * string
     | Jnull of     loc
     | Jbool of     loc * bool
+    | Jregexp of   loc * string * string
     | Jfun of      loc * string option * string list * stmt
     | Jfieldref of loc * exp * string
     | Junop of     loc * unop * exp

src/jslib/jslib_lexer.ml

@@ -31,6 +31,7 @@ type token =
     | FLOAT of string
     | STRING1 of string
     | STRING2 of string
+    | REGEXP of string
     | ANTIQUOT of string * string
     | EOI
 
@@ -50,6 +51,7 @@ module Token = struct
       | FLOAT s      -> sf "FLOAT %s" s
       | STRING1 s    -> sf "STRING \"%s\"" s
       | STRING2 s    -> sf "STRING \"%s\"" s
+      | REGEXP s     -> sf "REGEXP \"%s\"" s
       | ANTIQUOT (n, s) -> sf "ANTIQUOT %s: %S" n s
       | EOI          -> sf "EOI"
 
@@ -62,7 +64,7 @@ module Token = struct
 
   let extract_string =
     function
-      | KEYWORD s | IDENT s | INT s | FLOAT s | STRING1 s | STRING2 s -> s
+      | KEYWORD s | IDENT s | INT s | FLOAT s | STRING1 s | STRING2 s | REGEXP s -> s
       | tok ->
           invalid_arg ("Cannot extract a string from this token: "^
                           to_string tok)
@@ -214,35 +216,83 @@ let regexp qname = (ncname ':')? ncname
 
 let illegal c = error c "Illegal character"
 
+
+(*
+  thanks to Stephen Weeks for this idea (from javascript.lex in
+  svn://mlton.org/mltonlib/trunk/com/entain/javascript/unstable)
+*)
+let slash = ref `Reg
+
 let rec token c = lexer
   | newline -> next_line c; token c c.lexbuf
   | blank+ -> token c c.lexbuf
 
+  | "return" | "throw" | "do" | "else" | "in" | "new" | "typeof" ->
+      slash := `Reg;
+      IDENT (L.utf8_lexeme c.lexbuf)
+
   | qname ->
       let id = L.utf8_lexeme c.lexbuf in
       let id =
         let len = String.length id in
         if len > 1 && id.[0] = '$' && id.[1] = '$'
         then String.sub id 1 (len - 1)
         else id in
+      slash := `Div;
       IDENT (id)
 
   | '-'? ['0'-'9']+ '.' ['0'-'9']* ->
-      (FLOAT (L.utf8_lexeme c.lexbuf))
+      slash := `Div;
+      FLOAT (L.utf8_lexeme c.lexbuf)
 
   | '-'? ['0'-'9']+ ->
-      (INT (L.utf8_lexeme c.lexbuf))
+      slash := `Div;
+      INT (L.utf8_lexeme c.lexbuf)
+
+  | '/' ->
+      if !slash = `Reg
+      then begin
+        set_start_loc c;
+        regexp c c.lexbuf;
+        slash := `Div;
+        REGEXP (get_stored_string c)
+      end
+      else begin
+        slash := `Reg;
+        KEYWORD (L.utf8_lexeme c.lexbuf)
+      end
+
+  | "/=" ->
+      if !slash = `Reg
+      then begin
+        set_start_loc c;
+        store_ascii c '=';
+        regexp c c.lexbuf;
+        slash := `Div;
+        REGEXP (get_stored_string c)
+      end
+      else begin
+        slash := `Reg;
+        KEYWORD (L.utf8_lexeme c.lexbuf)
+      end
+
+  | "++" | "--" (* XXX `Div is wrong when these appear as prefix ops *)
+  | [ "])"] ->
+      slash := `Div;
+      KEYWORD (L.utf8_lexeme c.lexbuf)
 
-  | [ "{}()[].;,<>+-*%&|^!~?:=/" ]
+  | [ "{}([.;,<>+-*%&|^!~?:=" ]
   | "<=" | ">=" | "==" | "!=" | "===" | "!==" | "++" | "--" | "<<" | ">>" | ">>>" | "&&"
-  | "||" | "+=" | "-=" | "*=" | "%=" | "<<=" | ">>=" | ">>>=" | "&=" | "|=" | "^=" | "/=" ->
+  | "||" | "+=" | "-=" | "*=" | "%=" | "<<=" | ">>=" | ">>>=" | "&=" | "|=" | "^=" ->
+      slash := `Reg;
       KEYWORD (L.utf8_lexeme c.lexbuf)
 
   | '"' | "'" ->
       let double_quote = L.latin1_lexeme_char c.lexbuf 0 = '"' in
       set_start_loc c;
       string c double_quote c.lexbuf;
       let s = get_stored_string c in
+      slash := `Div;
       (if double_quote then STRING2 s else STRING1 s)
   | "/*" ->
       tcomment c c.lexbuf;
@@ -252,6 +302,7 @@ let rec token c = lexer
       c.enc := Ulexing.Latin1;
       let aq = antiquot c lexbuf in
       c.enc := Ulexing.Utf8;
+      slash := `Div; (* XXX ? *)
       aq
   | eof -> EOI
   | _ -> illegal c
@@ -289,6 +340,13 @@ and string c double = lexer
     store_lexeme c;
     string c double c.lexbuf
 
+and regexp c = lexer
+| '/' -> ()
+(* XXX handle escapes *)
+| _ ->
+    store_lexeme c;
+    regexp c c.lexbuf
+
 and antiquot c = lexer
 | '$' -> ANTIQUOT ("", "")
 | ('`'? (identchar* |'.'+ )) ':' ->

src/jslib/jslib_lexer.mli

@@ -29,6 +29,7 @@ type token =
   | FLOAT of string
   | STRING1 of string
   | STRING2 of string
+  | REGEXP of string
   | ANTIQUOT of string * string
   | EOI
 

src/jslib/jslib_parse.ml

@@ -207,6 +207,7 @@ expression: [
   | s = a_STRING -> Jstring (_loc, s, false)
   | s = STRING2 -> Jstring (_loc, s, true)
   | v = a_IDENT -> Jvar (_loc, v)
+  | r = REGEXP -> Jregexp (_loc, r, "")
   | "this" -> Jthis (_loc)
   | "null" -> Jnull (_loc)
   | "true" -> Jbool (_loc, true)

src/jslib/jslib_pp.ml

@@ -213,6 +213,7 @@ let prec = function
   | Jnull _ -> pPrimary
   | Jfun _ -> pPrimary
   | Jbool _ -> pPrimary
+  | Jregexp _ -> pPrimary
 
   | Jfieldref _ -> pMember
   | Jnew _ -> pMember
@@ -269,6 +270,7 @@ and exp ppf = function
   | Jnum (_, n) -> fprintf ppf "%s" n
   | Jnull _ -> fprintf ppf "null"
   | Jbool (_, b) -> fprintf ppf "%B" b
+  | Jregexp (_, r, f) -> fprintf ppf "/%s/%s" r f
   | Jfun (_, io, is, ss) ->
       fprintf ppf "@[<hv>function %a@[<hv 1>(%a)@]%a@]" (opt_nbsp id) io ids is block ss
 

test/jslib/_tags

@@ -1 +1 @@
-<*> : pkg_oUnit
+<*> : pkg_oUnit,pkg_jslib

test/jslib/main.ml

@@ -1,8 +1,7 @@
 open OUnit
 
 let tests = "Jslib" >::: [
-  "passes" >:: begin fun _ -> assert_bool "passes" true end;
-  (* "fails" >:: begin fun _ -> assert_bool "fails" false end; *)
+  Parse.tests
 ]
 
 ;;