Commit 10678fc8 authored by Kim Nguyễn's avatar Kim Nguyễn

Remove the need for mandatory spaces around ':' in function parameters.

Now functions such as
let fun f (x:Int):Int = ...
are parsed correctly (that is, its parameter is 'x' with type Int).
parent 09feaa19
......@@ -45,6 +45,24 @@ let keyword = Gram.Entry.mk "keyword"
let lop pos = Cduce_loc.loc_of_pos (tloc pos)
let exp pos e = LocatedExpr (lop pos,e)
let split_id_list loc l =
let rec loop l acc =
match l with
[] -> acc, []
| qname :: ll ->
try
let i = String.index qname ':' in
let pre = String.sub qname 0 i in
let post = String.sub qname (i+1) (String.length qname - i - 1) in
pre :: acc, post::ll
with
Not_found -> loop ll (qname :: acc)
in
let l1, l2 = loop l [] in
if l2 == [] then raise Stream.Failure else
(mk loc (PatVar(List.rev_map ident l1, [])),
mk loc (PatVar(List.map ident l2, [])))
let rec multi_prod loc = function
| [ x ] -> x
| x :: l -> mk loc (Prod (x, multi_prod loc l))
......@@ -329,7 +347,7 @@ EXTEND Gram
let tres = targ in
let arg = mknoloc(PatVar ([x],[])) in
let abst = {fun_name = Some (lop _loc,ident "f") ; fun_iface = [(targ, tres)] ;fun_body = [(arg,xt)] } in
let body =
let body =
let_in rf (mknoloc (PatVar ([stk],[])))
(let_in ((Abstraction abst)) (mknoloc (PatVar ([ident "f"],[])))
(let_in ((Apply(Var(f) , e) ) ) (mknoloc (Internal Types.any)) (get_ref (Var stk))))
......@@ -437,6 +455,17 @@ EXTEND Gram
]
];
arg_colon_type: [
[ p1 = pat ; targ1 = OPT [ ":"; p = pat -> p ] ->
match p1.descr,targ1 with
PatVar(id1, []), None ->
split_id_list _loc (List.map Ident.U.get_str id1)
| _, Some targ1 -> p1, targ1
| _ -> raise Stream.Failure
]
];
fun_decl_after_lparen: [
(* need an hack to do this, because both productions would
match [ OPT IDENT; "("; pat ] .... *)
......@@ -444,40 +473,48 @@ EXTEND Gram
res = [ "->"; p2 = pat;
a = [ ";"; a = LIST0 arrow SEP ";" -> a | -> [] ];
")"; b = branches -> `Classic (p2,a,b)
| ":"; targ1 = pat;
args = LIST0 [ ","; arg = pat; ":"; targ = pat -> (arg,targ) ];
| targ1 = OPT [ ":"; p = pat -> p ];
args = LIST0 [ ","; arg = arg_colon_type -> arg ];
")";
others = LIST0
[ "(";
args =
LIST1
[ arg = pat; ":"; targ = pat -> (arg,targ) ]
[ arg = arg_colon_type -> arg ]
SEP ",";
")" -> args ];
":"; tres = pat ;
":" ; tres = pat ;
"="; body = expr ->
`Compact (targ1,args,others,tres,body)
] ->
match res with
| `Classic (p2,a,b) -> (p1,p2)::a,b
| `Compact (targ1,args,others,tres,body) ->
let mkfun args =
multi_prod nopos (List.map snd args),
multi_prod nopos (List.map fst args)
in
let (tres,body) =
List.fold_right
(fun args (tres,body) ->
let (targ,arg) = mkfun args in
let e = Abstraction
{ fun_name = None; fun_iface = [targ,tres];
fun_body = [arg,body] } in
let t = mknoloc (Arrow (targ,tres)) in
(t,e)
)
others (tres,body) in
let (targ,arg) = mkfun ((p1,targ1) :: args) in
[(targ,tres)],[(arg,body)]
match res with
| `Classic (p2,a,b) -> (p1,p2)::a,b
| `Compact (targ1,args,others,tres,body) ->
let mkfun args =
multi_prod nopos (List.map snd args),
multi_prod nopos (List.map fst args)
in
let (tres,body) =
List.fold_right
(fun args (tres,body) ->
let (targ,arg) = mkfun args in
let e = Abstraction
{ fun_name = None; fun_iface = [targ,tres];
fun_body = [arg,body] } in
let t = mknoloc (Arrow (targ,tres)) in
(t,e)
)
others (tres,body) in
let p1, targ1 =
match p1.descr,targ1 with
PatVar(id1, []), None ->
split_id_list _loc (List.map Ident.U.get_str id1)
| _, Some targ1 -> p1, targ1
| _ -> raise Stream.Failure
in
let (targ,arg) = mkfun ((p1,targ1) :: args) in
[(targ,tres)],[(arg,body)]
]
];
......@@ -575,7 +612,7 @@ EXTEND Gram
pat: [
[ x = pat; "where";
b = LIST1 [ x = located_ident; "="; y = pat -> (x,[],y) ] SEP "and" ->
b = LIST1 [ x = located_ident; "="; y = pat -> (x,[],y) ] SEP "and" ->
mk _loc (Recurs (x,b)) ]
| RIGHTA [ x = pat; "->"; y = pat -> mk _loc (Arrow (x,y))
| x = pat; "@"; y = pat -> mk _loc (Concat (x,y))
......@@ -583,7 +620,7 @@ EXTEND Gram
| "no_arrow" [ x = pat; "|"; y = pat -> mk _loc (Or (x,y)) ]
| "simple" [ x = pat; "&"; y = pat -> mk _loc (And (x,y))
| x = pat; "\\"; y = pat -> mk _loc (Diff (x,y)) ]
| "var" [ x = PVAR ->
| "var" [ x = PVAR ->
mk _loc (Internal (Types.var (Var.mk (ident_aux x)))) ]
|
[ "{"; r = record_spec; "}" -> r
......@@ -633,7 +670,7 @@ EXTEND Gram
mk _loc (Regexp r)
| "<"; t =
[ x = tag_type -> x
| "("; t = pat; ")" -> t ];
| "("; t = pat; ")" -> t ];
a = attrib_spec; ">"; c = pat ->
mk _loc (XmlT (t, multi_prod _loc [a;c]))
| s = STRING ->
......@@ -653,11 +690,11 @@ EXTEND Gram
or_else : [ [ OPT [ "else"; y = pat -> y ] ] ];
opt_field_pat: [
opt_field_pat: [
[ OPT [ "=";
o = [ "?" -> true | -> false];
x = pat; y = or_else -> (o,x,y) ]
]
x = pat; y = or_else -> (o,x,y) ]
]
];
record_spec: [
......@@ -688,7 +725,7 @@ EXTEND Gram
opt_field_expr: [ [ OPT [ "="; x = expr LEVEL "no_appl" -> x ] ] ];
expr_record_spec: [
expr_record_spec: [
[ r = LIST0 [ l = ident_or_keyword;
x = opt_field_expr; OPT ";" ->
let x = match x with Some x -> x | None -> Var (ident l) in
......
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