Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

camlp4 now updated, but completely untested. I reverted camlp4 back to revision 10660 and then changed it from there 

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/gadts@10697 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Jacques Le Normand 2010-10-01 02:46:07 +00:00
parent 7fa09d99e3
commit 7af69814ac
3 changed files with 35 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
View File

@ -319,9 +319,13 @@ module Make (Ast : Sig.Camlp4Ast) = struct
| _ -> assert False (*FIXME*) ];
value mkvariant =
fun
[ <:ctyp@loc< $uid:s$ >> -> (conv_con s, [], None, mkloc loc) (* GAH : pretty sure this is wrong *)
[ <:ctyp@loc< $uid:s$ >> -> (conv_con s, [], None, mkloc loc)
| <:ctyp@loc< $uid:s$ of $t$ >> ->
(conv_con s, List.map ctyp (list_of_ctyp t []), None, mkloc loc) (* GAH: dunno what I'm doing *)
(conv_con s, List.map ctyp (list_of_ctyp t []), None, mkloc loc)
| <:ctyp@loc< $uid:s$ : $t1$ -> $t2$ >> ->
(conv_con s, List.map ctyp (list_of_ctyp t1 []), Some (ctyp t2),mkloc loc)
| <:ctyp@loc< $uid:s$ : $t$ >> ->
(conv_con s, [], Some (ctyp t), mkloc loc)
| _ -> assert False (*FIXME*) ];
value rec type_decl tl cl loc m pflag =
fun
@ -375,10 +379,11 @@ module Make (Ast : Sig.Camlp4Ast) = struct
value rec type_parameters t acc =
match t with
[ <:ctyp< $t1$ $t2$ >> -> type_parameters t1 (type_parameters t2 acc)
| <:ctyp< +'$s$ >> -> [(Some s, (True, False)) :: acc] (* GAH: so wrong *)
[ <:ctyp< $t1$ $t2$ >> -> type_parameters t1 (type_parameters t2 acc)
| <:ctyp< +'$s$ >> -> [(Some s, (True, False)) :: acc]
| <:ctyp< -'$s$ >> -> [(Some s, (False, True)) :: acc]
| <:ctyp< '$s$ >> -> [(Some s, (False, False)) :: acc]
| <:ctyp< _ >> -> [(None, (True, False)) :: acc]
| _ -> assert False ];
value rec class_parameters t acc =
@ -402,7 +407,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
let (params, variance) = List.split tpl in
let (kind, priv, ct) = opt_private_ctyp ct in
(id, pwith_type
{ptype_params = params; ptype_cstrs = []; (* GAH : fix this *)
{ptype_params = params; ptype_cstrs = [];
ptype_kind = kind;
ptype_private = priv;
ptype_manifest = Some ct;

14
camlp4/Camlp4Top/Rprint.ml
View File

@ -234,10 +234,14 @@ and print_simple_out_type ppf =
fprintf ppf "@[<1>(%a)@]" print_out_type ty ]
in
print_tkind ppf
and print_out_constr ppf (name, tyl,_) = (* GAH : so wrong *)
match tyl with
[ [] -> fprintf ppf "%s" name
| _ ->
and print_out_constr ppf (name, tyl, ret) =
match (tyl,ret) with
[ ([], None) -> fprintf ppf "%s" name
| ([], Some r) -> fprintf ppf "@[<2>%s:@ %a@]" name print_out_type r
| (_,Some r) ->
fprintf ppf "@[<2>%s:@ %a -> %a@]" name
(print_typlist print_out_type " and") tyl print_out_type r
| (_,None) ->
fprintf ppf "@[<2>%s of@ %a@]" name
(print_typlist print_out_type " and") tyl ]
and print_out_label ppf (name, mut, arg) =
@ -368,7 +372,7 @@ and print_out_sig_item ppf =
(if vir_flag then " virtual" else "") print_out_class_params params
name Toploop.print_out_class_type.val clt
| Osig_exception id tyl ->
fprintf ppf "@[<2>exception %a@]" print_out_constr (id, tyl, None)
fprintf ppf "@[<2>exception %a@]" print_out_constr (id, tyl,None)
| Osig_modtype name Omty_abstract ->
fprintf ppf "@[<2>module type %s@]" name
| Osig_modtype name mty ->

24
camlp4/boot/Camlp4.ml
View File

@ -1885,7 +1885,7 @@ module Sig =
| TySem of loc * ctyp * ctyp
| TyCom of loc * ctyp * ctyp
| TySum of loc * ctyp
| TyOf of loc * ctyp * ctyp
| TyOf of loc * ctyp * ctyp
| TyAnd of loc * ctyp * ctyp
| TyOr of loc * ctyp * ctyp
| TyPrv of loc * ctyp
@ -14520,10 +14520,17 @@ module Struct =
let mkvariant =
function
| Ast.TyId (loc, (Ast.IdUid (_, s))) ->
((conv_con s), [], None,(mkloc loc)) (* GAH: probably wrong *)
((conv_con s), [], None, (mkloc loc))
| Ast.TyOf (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), t) ->
((conv_con s), (List.map ctyp (list_of_ctyp t [])),None, (* GAH: probably wrong *)
((conv_con s), (List.map ctyp (list_of_ctyp t [])), None,
(mkloc loc))
| Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), TyArr(_,t1,t2)) ->
((conv_con s), (List.map ctyp (list_of_ctyp t1 [])),
Some (ctyp t2),(mkloc loc))
| Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), t) ->
((conv_con s), [], Some (ctyp t),
(mkloc loc))
| _ -> assert false
let rec type_decl tl cl loc m pflag =
@ -14585,9 +14592,10 @@ module Struct =
match t with
| Ast.TyApp (_, t1, t2) ->
type_parameters t1 (type_parameters t2 acc)
| Ast.TyQuP (_, s) -> (s, (true, false)) :: acc
| Ast.TyQuM (_, s) -> (s, (false, true)) :: acc
| Ast.TyQuo (_, s) -> (s, (false, false)) :: acc
| Ast.TyQuP (_, s) -> (Some s, (true, false)) :: acc
| Ast.TyQuM (_, s) -> (Some s, (false, true)) :: acc
| Ast.TyQuo (_, s) -> (Some s, (false, false)) :: acc
| Ast.TyNil _ -> (None, (true, false)) :: acc
| _ -> assert false
let rec class_parameters t acc =
@ -14614,7 +14622,7 @@ module Struct =
(id,
(pwith_type
{
ptype_params = List.map (fun x -> Some x) params; (*GAH: change this! *)
ptype_params = params;
ptype_cstrs = [];
ptype_kind = kind;
ptype_private = priv;
@ -15168,7 +15176,7 @@ module Struct =
cl
in
(c,
(type_decl (List.map (fun (x,y) -> Some x, y) (List.fold_right type_parameters tl [])) cl td)) :: (* GAH : so very wrong *)
(type_decl (List.fold_right type_parameters tl []) cl td)) ::
acc
| _ -> assert false
and module_type =