Permalink
Browse files

initial regexp support in jslib

git-svn-id: http://ocamljs.googlecode.com/svn/trunk@219 27578800-e353-0410-a23a-a7c9f63c6ccd
  • Loading branch information...
1 parent 71ff05d commit 644aad65b3a00a231edc68f39b56434ac0dbb3d4 Jake Donham committed Sep 3, 2009
View
@@ -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)
@@ -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
@@ -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* |'.'+ )) ':' ->
@@ -29,6 +29,7 @@ type token =
| FLOAT of string
| STRING1 of string
| STRING2 of string
+ | REGEXP of string
| ANTIQUOT of string * string
| EOI
@@ -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)
@@ -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
View
@@ -1 +1 @@
-<*> : pkg_oUnit
+<*> : pkg_oUnit,pkg_jslib
View
@@ -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
]
;;

0 comments on commit 644aad6

Please sign in to comment.