Commit ab98120b authored by beppe's avatar beppe
Browse files

Merge branch 'master' of https://git.cduce.org/cduce

parents 155d0e52 88d6a890
...@@ -94,6 +94,7 @@ let is_fun_decl = ...@@ -94,6 +94,7 @@ let is_fun_decl =
(fun strm -> (fun strm ->
match Stream.npeek 3 strm with match Stream.npeek 3 strm with
| [ KEYWORD "fun", _; IDENT _, _; KEYWORD "(", _ ] | [ KEYWORD "fun", _; IDENT _, _; KEYWORD "(", _ ]
| [ IDENTPAR _, _; _ ; _ ]
| [ IDENT _, _; KEYWORD "(", _; _ ] -> () | [ IDENT _, _; KEYWORD "(", _; _ ] -> ()
| _ -> raise Stream.Failure | _ -> raise Stream.Failure
) )
...@@ -140,7 +141,7 @@ EXTEND Gram ...@@ -140,7 +141,7 @@ EXTEND Gram
[ mk _loc (LetDecl (p,e)) ] [ mk _loc (LetDecl (p,e)) ]
| (_,p,e1) = let_binding; "in"; e2 = expr LEVEL "top"-> | (_,p,e1) = let_binding; "in"; e2 = expr LEVEL "top"->
[ mk _loc (EvalStatement (exp _loc (let_in e1 p e2))) ] [ mk _loc (EvalStatement (exp _loc (let_in e1 p e2))) ]
| "type"; x = PTYPE; pargs = LIST1 [ x = PVAR -> ident x ] SEP ","; ")"; "="; t = pat -> | "type"; x = IDENTPAR; pargs = LIST1 [ x = PVAR -> ident x ] SEP ","; ")"; "="; t = pat ->
[ mk _loc (TypeDecl ((lop _loc,ident x),pargs,t)) ] [ mk _loc (TypeDecl ((lop _loc,ident x),pargs,t)) ]
| "type"; x = located_ident; "="; t = pat -> | "type"; x = located_ident; "="; t = pat ->
[ mk _loc (TypeDecl (x,[],t)) ] [ mk _loc (TypeDecl (x,[],t)) ]
...@@ -490,8 +491,8 @@ EXTEND Gram ...@@ -490,8 +491,8 @@ EXTEND Gram
fun_decl: [ fun_decl: [
[ f = OPT located_ident; "("; (a,b) = fun_decl_after_lparen -> [ f = OPT located_ident; "("; (a,b) = fun_decl_after_lparen -> (f,a,b)
(f,a,b) | f = IDENTPAR; (a,b) = fun_decl_after_lparen -> (Some (lop _loc,ident f),a,b)
] ]
]; ];
...@@ -605,7 +606,7 @@ EXTEND Gram ...@@ -605,7 +606,7 @@ EXTEND Gram
mk _loc (Constant (ident a,c)) mk _loc (Constant (ident a,c))
| "!"; a = IDENT -> | "!"; a = IDENT ->
mk _loc (Internal (Types.abstract (Types.Abstracts.atom a))) mk _loc (Internal (Types.abstract (Types.Abstracts.atom a)))
| id = PTYPE; pargs = LIST1 pat SEP ","; ")" -> | id = IDENTPAR; pargs = LIST1 pat SEP ","; ")" ->
mk _loc (PatVar ([ident id],pargs)) mk _loc (PatVar ([ident id],pargs))
| ids = LIST1 ident_or_keyword SEP "." -> | ids = LIST1 ident_or_keyword SEP "." ->
mk _loc (PatVar (List.map ident ids,[])) mk _loc (PatVar (List.map ident ids,[]))
......
...@@ -52,7 +52,7 @@ type token = ...@@ -52,7 +52,7 @@ type token =
| STRING of string | STRING of string
| STRING2 of string | STRING2 of string
| PVAR of string | PVAR of string
| PTYPE of string | IDENTPAR of string
| EOI | EOI
module Token = struct module Token = struct
...@@ -73,7 +73,7 @@ module Token = struct ...@@ -73,7 +73,7 @@ module Token = struct
| STRING2 s -> sf "STRING \'%s\'" s | STRING2 s -> sf "STRING \'%s\'" s
(* here it's not %S since the string is already escaped *) (* here it's not %S since the string is already escaped *)
| PVAR s -> sf "PVAR \'%S\'" s | PVAR s -> sf "PVAR \'%S\'" s
| PTYPE s -> sf "PTYPE \'%S\'" s | IDENTPAR s -> sf "IDENTPAR \'%S\'" s
| ANY_IN_NS s -> sf "ANY_IN_NS %S" s | ANY_IN_NS s -> sf "ANY_IN_NS %S" s
| EOI -> sf "EOI" | EOI -> sf "EOI"
...@@ -86,7 +86,7 @@ module Token = struct ...@@ -86,7 +86,7 @@ module Token = struct
let extract_string = let extract_string =
function function
| PTYPE s | KEYWORD s | IDENT s | INT s | CHAR s | STRING s | STRING2 s | PVAR s | | IDENTPAR s | KEYWORD s | IDENT s | INT s | CHAR s | STRING s | STRING2 s | PVAR s |
ANY_IN_NS s -> s ANY_IN_NS s -> s
| tok -> | tok ->
invalid_arg ("Cannot extract a string from this token: "^ invalid_arg ("Cannot extract a string from this token: "^
...@@ -206,7 +206,7 @@ let rec token = lexer ...@@ -206,7 +206,7 @@ let rec token = lexer
| xml_blank+ -> token lexbuf | xml_blank+ -> token lexbuf
| qname "(" -> | qname "(" ->
let s = L.utf8_sub_lexeme lexbuf 0 (L.lexeme_length lexbuf - 1) in let s = L.utf8_sub_lexeme lexbuf 0 (L.lexeme_length lexbuf - 1) in
return lexbuf (PTYPE s) return lexbuf (IDENTPAR s)
| qname -> | qname ->
let s = L.utf8_lexeme lexbuf in let s = L.utf8_lexeme lexbuf in
return lexbuf (IDENT s) return lexbuf (IDENT s)
...@@ -263,7 +263,7 @@ and token2 = lexer ...@@ -263,7 +263,7 @@ and token2 = lexer
| xml_blank+ -> token2 lexbuf | xml_blank+ -> token2 lexbuf
| qname "(" -> | qname "(" ->
let s = L.utf8_sub_lexeme lexbuf 0 (L.lexeme_length lexbuf - 1) in let s = L.utf8_sub_lexeme lexbuf 0 (L.lexeme_length lexbuf - 1) in
return lexbuf (PTYPE s) return lexbuf (IDENTPAR s)
| qname -> | qname ->
let s = L.utf8_lexeme lexbuf in let s = L.utf8_lexeme lexbuf in
return lexbuf (IDENT s) return lexbuf (IDENT s)
...@@ -331,7 +331,7 @@ and token2toplevel = lexer ...@@ -331,7 +331,7 @@ and token2toplevel = lexer
| xml_blank+ -> token2toplevel lexbuf | xml_blank+ -> token2toplevel lexbuf
| qname "(" -> | qname "(" ->
let s = L.utf8_sub_lexeme lexbuf 0 (L.lexeme_length lexbuf - 1) in let s = L.utf8_sub_lexeme lexbuf 0 (L.lexeme_length lexbuf - 1) in
return lexbuf (PTYPE s) return lexbuf (IDENTPAR s)
| qname -> | qname ->
let s = L.utf8_lexeme lexbuf in let s = L.utf8_lexeme lexbuf in
return lexbuf (IDENT s) return lexbuf (IDENT s)
......
...@@ -9,7 +9,7 @@ type token = ...@@ -9,7 +9,7 @@ type token =
| STRING of string | STRING of string
| STRING2 of string | STRING2 of string
| PVAR of string | PVAR of string
| PTYPE of string | IDENTPAR of string
| EOI | EOI
exception Error of int * int * string exception Error of int * int * string
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment