Commit ee8e9fa5 authored by Andrei Paskevich's avatar Andrei Paskevich

swap arguments of Ptree.PPTtyapp

parent fe725f26
......@@ -560,12 +560,12 @@ indcase:
primitive_type:
| primitive_type_arg { $1 }
| lqualid primitive_type_args { PPTtyapp ($2, $1) }
| lqualid primitive_type_args { PPTtyapp ($1, $2) }
;
primitive_type_non_lident:
| primitive_type_arg_non_lident { $1 }
| uqualid DOT lident primitive_type_args { PPTtyapp ($4, Qdot ($1, $3)) }
| uqualid DOT lident primitive_type_args { PPTtyapp (Qdot ($1, $3), $4) }
;
primitive_type_args:
......@@ -574,13 +574,13 @@ primitive_type_args:
;
primitive_type_arg:
| lident { PPTtyapp ([], Qident $1) }
| lident { PPTtyapp (Qident $1, []) }
| primitive_type_arg_non_lident { $1 }
;
primitive_type_arg_non_lident:
| uqualid DOT lident
{ PPTtyapp ([], Qdot ($1, $3)) }
{ PPTtyapp (Qdot ($1, $3), []) }
| type_var
{ PPTtyvar $1 }
| LEFTPAR primitive_type COMMA list1_primitive_type_sep_comma RIGHTPAR
......@@ -815,15 +815,15 @@ param:
| type_var
{ [None, PPTtyvar $1] }
| lqualid
{ [None, PPTtyapp ([], $1)] }
{ [None, PPTtyapp ($1, [])] }
;
param_type:
| lident param_type_cont
{ PPTtyapp ($2, Qident $1) }
{ PPTtyapp (Qident $1, $2) }
| lident list1_lident param_type_cont
{ let id2ty i = PPTtyapp ([], Qident i) in
PPTtyapp (List.map id2ty $2 @ $3, Qident $1) }
{ let id2ty i = PPTtyapp (Qident i, []) in
PPTtyapp (Qident $1, List.map id2ty $2 @ $3) }
| primitive_type_non_lident
{ $1 }
;
......
......@@ -40,7 +40,7 @@ type qualid =
type pty =
| PPTtyvar of ident
| PPTtyapp of pty list * qualid
| PPTtyapp of qualid * pty list
| PPTtuple of pty list
type param = ident option * pty
......
......@@ -188,7 +188,7 @@ let find_namespace q uc = find_namespace_ns q (get_namespace uc)
let rec dty uc = function
| PPTtyvar {id=x} ->
create_user_type_var x
| PPTtyapp (p, x) ->
| PPTtyapp (x, p) ->
let ts = find_tysymbol x uc in
let tyl = List.map (dty uc) p in
Loc.try2 (qloc x) tyapp ts tyl
......@@ -199,7 +199,7 @@ let rec dty uc = function
let rec ty_of_pty uc = function
| PPTtyvar {id=x} ->
ty_var (create_user_tv x)
| PPTtyapp (p, x) ->
| PPTtyapp (x, p) ->
let ts = find_tysymbol x uc in
let tyl = List.map (ty_of_pty uc) p in
Loc.try2 (qloc x) ty_app ts tyl
......@@ -821,7 +821,7 @@ let add_types dl th =
try ty_var (Hstr.find vars v.id)
with Not_found -> error ~loc:v.id_loc (UnboundTypeVar v.id)
end
| PPTtyapp (tyl, q) ->
| PPTtyapp (q, tyl) ->
let ts = match q with
| Qident x when Mstr.mem x.id def ->
visit x.id
......@@ -1136,7 +1136,7 @@ let type_inst th t s =
let ns1 = Opt.fold find t.th_export p in
let ns2 = Opt.fold find (get_namespace th) q in
clone_ns loc t.th_local ns2 ns1 s
| CStsym (loc,p,[],PPTtyapp ([],q)) ->
| CStsym (loc,p,[],PPTtyapp (q,[])) ->
let ts1 = find_tysymbol_ns p t.th_export in
let ts2 = find_tysymbol q th in
if Mts.mem ts1 s.inst_ts
......
......@@ -167,7 +167,7 @@ let uc_find_ps uc p =
let rec dity_of_pty denv = function
| Ptree.PPTtyvar id ->
create_user_type_variable id
| Ptree.PPTtyapp (pl, p) ->
| Ptree.PPTtyapp (p, pl) ->
let dl = List.map (dity_of_pty denv) pl in
begin match uc_find_ts denv.uc p with
| PT ts -> its_app ts dl
......@@ -1508,7 +1508,7 @@ let add_types ~wp uc tdl =
| _ -> seen in
let rec check seen = function
| PPTtyvar _ -> seen
| PPTtyapp (tyl,q) -> List.fold_left check (ts_seen seen q) tyl
| PPTtyapp (q,tyl) -> List.fold_left check (ts_seen seen q) tyl
| PPTtuple tyl -> List.fold_left check seen tyl in
let seen = match d.td_def with
| TDabstract | TDalgebraic _ | TDrecord _ -> seen
......@@ -1531,7 +1531,7 @@ let add_types ~wp uc tdl =
in
let rec check = function
| PPTtyvar _ -> false
| PPTtyapp (tyl,q) -> ts_imp q || List.exists check tyl
| PPTtyapp (q,tyl) -> ts_imp q || List.exists check tyl
| PPTtuple tyl -> List.exists check tyl in
Hstr.replace impures x false;
let imp =
......@@ -1567,7 +1567,7 @@ let add_types ~wp uc tdl =
in
let rec check = function
| PPTtyvar _ -> false
| PPTtyapp (tyl,q) -> ts_mut q || List.exists check tyl
| PPTtyapp (q,tyl) -> ts_mut q || List.exists check tyl
| PPTtuple tyl -> List.exists check tyl in
Hstr.replace mutables x false;
let mut =
......@@ -1619,7 +1619,7 @@ let add_types ~wp uc tdl =
| PPTtyvar { id = v ; id_loc = loc } ->
let e = Loc.Located (loc, UnboundTypeVar v) in
ity_var (Mstr.find_exn e v vars)
| PPTtyapp (tyl,q) ->
| PPTtyapp (q,tyl) ->
let tyl = List.map parse tyl in
begin match get_ts q with
| TS ts -> Loc.try2 (qloc q) ity_pur ts tyl
......@@ -1718,7 +1718,7 @@ let add_types ~wp uc tdl =
| PPTtyvar { id = v ; id_loc = loc } ->
let e = Loc.Located (loc, UnboundTypeVar v) in
ity_var (Mstr.find_exn e v vars)
| PPTtyapp (tyl,q) ->
| PPTtyapp (q,tyl) ->
let tyl = List.map parse tyl in
begin match get_ts q with
| TS ts -> Loc.try2 (qloc q) ity_pur ts tyl
......
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