summaryrefslogtreecommitdiff
path: root/compiler/PureUtils.ml
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--compiler/PureUtils.ml58
1 files changed, 29 insertions, 29 deletions
diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml
index 49c8dd70..4cc7ef91 100644
--- a/compiler/PureUtils.ml
+++ b/compiler/PureUtils.ml
@@ -59,7 +59,7 @@ module FunLoopIdSet = Collections.MakeSet (FunLoopIdOrderedType)
let dest_arrow_ty (ty : ty) : ty * ty =
match ty with
- | Arrow (arg_ty, ret_ty) -> (arg_ty, ret_ty)
+ | TArrow (arg_ty, ret_ty) -> (arg_ty, ret_ty)
| _ -> raise (Failure "Unreachable")
let compute_literal_type (cv : literal) : literal_type =
@@ -110,7 +110,7 @@ let ty_substitute (subst : subst) (ty : ty) : ty =
let obj =
object
inherit [_] map_ty
- method! visit_TypeVar _ var_id = subst.ty_subst var_id
+ method! visit_TVar _ var_id = subst.ty_subst var_id
method! visit_CGVar _ var_id = subst.cg_subst var_id
method! visit_Clause _ id = subst.tr_subst id
method! visit_Self _ = subst.tr_self
@@ -249,12 +249,12 @@ let remove_meta (e : texpression) : texpression =
in
obj#visit_texpression () e
-let mk_arrow (ty0 : ty) (ty1 : ty) : ty = Arrow (ty0, ty1)
+let mk_arrow (ty0 : ty) (ty1 : ty) : ty = TArrow (ty0, ty1)
(** Construct a type as a list of arrows: ty1 -> ... tyn *)
let mk_arrows (inputs : ty list) (output : ty) =
let rec aux (tys : ty list) : ty =
- match tys with [] -> output | ty :: tys' -> Arrow (ty, aux tys')
+ match tys with [] -> output | ty :: tys' -> TArrow (ty, aux tys')
in
aux inputs
@@ -305,7 +305,7 @@ let destruct_apps (e : texpression) : texpression * texpression list =
(** Make an [App (app, arg)] expression *)
let mk_app (app : texpression) (arg : texpression) : texpression =
match app.ty with
- | Arrow (ty0, ty1) ->
+ | TArrow (ty0, ty1) ->
(* Sanity check *)
assert (ty0 = arg.ty);
let e = App (app, arg) in
@@ -340,7 +340,7 @@ let opt_destruct_function_call (e : texpression) :
let opt_destruct_result (ty : ty) : ty option =
match ty with
- | TAdt (TAssumed Result, generics) ->
+ | TAdt (TAssumed TResult, generics) ->
assert (generics.const_generics = []);
assert (generics.trait_refs = []);
Some (Collections.List.to_cons_nil generics.types)
@@ -350,14 +350,14 @@ let destruct_result (ty : ty) : ty = Option.get (opt_destruct_result ty)
let opt_destruct_tuple (ty : ty) : ty list option =
match ty with
- | TAdt (Tuple, generics) ->
+ | TAdt (TTuple, generics) ->
assert (generics.const_generics = []);
assert (generics.trait_refs = []);
Some generics.types
| _ -> None
let mk_abs (x : typed_pattern) (e : texpression) : texpression =
- let ty = Arrow (x.ty, e.ty) in
+ let ty = TArrow (x.ty, e.ty) in
let e = Abs (x, e) in
{ e; ty }
@@ -370,12 +370,12 @@ let rec destruct_abs_list (e : texpression) : typed_pattern list * texpression =
let destruct_arrow (ty : ty) : ty * ty =
match ty with
- | Arrow (ty0, ty1) -> (ty0, ty1)
+ | TArrow (ty0, ty1) -> (ty0, ty1)
| _ -> raise (Failure "Not an arrow type")
let rec destruct_arrows (ty : ty) : ty list * ty =
match ty with
- | Arrow (ty0, ty1) ->
+ | TArrow (ty0, ty1) ->
let tys, out_ty = destruct_arrows ty1 in
(ty0 :: tys, out_ty)
| _ -> ([], ty)
@@ -427,13 +427,13 @@ let mk_switch (scrut : texpression) (sb : switch_body) : texpression =
let mk_simpl_tuple_ty (tys : ty list) : ty =
match tys with
| [ ty ] -> ty
- | _ -> TAdt (Tuple, mk_generic_args_from_types tys)
+ | _ -> TAdt (TTuple, mk_generic_args_from_types tys)
let mk_bool_ty : ty = TLiteral TBool
-let mk_unit_ty : ty = TAdt (Tuple, empty_generic_args)
+let mk_unit_ty : ty = TAdt (TTuple, empty_generic_args)
let mk_unit_rvalue : texpression =
- let id = AdtCons { adt_id = Tuple; variant_id = None } in
+ let id = AdtCons { adt_id = TTuple; variant_id = None } in
let qualif = { id; generics = empty_generic_args } in
let e = Qualif qualif in
let ty = mk_unit_ty in
@@ -474,7 +474,7 @@ let mk_simpl_tuple_pattern (vl : typed_pattern list) : typed_pattern =
| [ v ] -> v
| _ ->
let tys = List.map (fun (v : typed_pattern) -> v.ty) vl in
- let ty = TAdt (Tuple, mk_generic_args_from_types tys) in
+ let ty = TAdt (TTuple, mk_generic_args_from_types tys) in
let value = PatAdt { variant_id = None; field_values = vl } in
{ value; ty }
@@ -485,10 +485,10 @@ let mk_simpl_tuple_texpression (vl : texpression list) : texpression =
| _ ->
(* Compute the types of the fields, and the type of the tuple constructor *)
let tys = List.map (fun (v : texpression) -> v.ty) vl in
- let ty = TAdt (Tuple, mk_generic_args_from_types tys) in
+ let ty = TAdt (TTuple, mk_generic_args_from_types tys) in
let ty = mk_arrows tys ty in
(* Construct the tuple constructor qualifier *)
- let id = AdtCons { adt_id = Tuple; variant_id = None } in
+ let id = AdtCons { adt_id = TTuple; variant_id = None } in
let qualif = { id; generics = mk_generic_args_from_types tys } in
(* Put everything together *)
let cons = { e = Qualif qualif; ty } in
@@ -507,17 +507,17 @@ let ty_as_integer (t : ty) : T.integer_type =
let ty_as_literal (t : ty) : T.literal_type =
match t with TLiteral ty -> ty | _ -> raise (Failure "Unreachable")
-let mk_state_ty : ty = TAdt (TAssumed State, empty_generic_args)
+let mk_state_ty : ty = TAdt (TAssumed TState, empty_generic_args)
let mk_result_ty (ty : ty) : ty =
- TAdt (TAssumed Result, mk_generic_args_from_types [ ty ])
+ TAdt (TAssumed TResult, mk_generic_args_from_types [ ty ])
-let mk_error_ty : ty = TAdt (TAssumed Error, empty_generic_args)
-let mk_fuel_ty : ty = TAdt (TAssumed Fuel, empty_generic_args)
+let mk_error_ty : ty = TAdt (TAssumed TError, empty_generic_args)
+let mk_fuel_ty : ty = TAdt (TAssumed TFuel, empty_generic_args)
let mk_error (error : VariantId.id) : texpression =
let ty = mk_error_ty in
- let id = AdtCons { adt_id = TAssumed Error; variant_id = Some error } in
+ let id = AdtCons { adt_id = TAssumed TError; variant_id = Some error } in
let qualif = { id; generics = empty_generic_args } in
let e = Qualif qualif in
{ e; ty }
@@ -525,16 +525,16 @@ let mk_error (error : VariantId.id) : texpression =
let unwrap_result_ty (ty : ty) : ty =
match ty with
| TAdt
- (TAssumed Result, { types = [ ty ]; const_generics = []; trait_refs = [] })
- ->
+ ( TAssumed TResult,
+ { types = [ ty ]; const_generics = []; trait_refs = [] } ) ->
ty
| _ -> raise (Failure "not a result type")
let mk_result_fail_texpression (error : texpression) (ty : ty) : texpression =
let type_args = [ ty ] in
- let ty = TAdt (TAssumed Result, mk_generic_args_from_types type_args) in
+ let ty = TAdt (TAssumed TResult, mk_generic_args_from_types type_args) in
let id =
- AdtCons { adt_id = TAssumed Result; variant_id = Some result_fail_id }
+ AdtCons { adt_id = TAssumed TResult; variant_id = Some result_fail_id }
in
let qualif = { id; generics = mk_generic_args_from_types type_args } in
let cons_e = Qualif qualif in
@@ -549,9 +549,9 @@ let mk_result_fail_texpression_with_error_id (error : VariantId.id) (ty : ty) :
let mk_result_return_texpression (v : texpression) : texpression =
let type_args = [ v.ty ] in
- let ty = TAdt (TAssumed Result, mk_generic_args_from_types type_args) in
+ let ty = TAdt (TAssumed TResult, mk_generic_args_from_types type_args) in
let id =
- AdtCons { adt_id = TAssumed Result; variant_id = Some result_return_id }
+ AdtCons { adt_id = TAssumed TResult; variant_id = Some result_return_id }
in
let qualif = { id; generics = mk_generic_args_from_types type_args } in
let cons_e = Qualif qualif in
@@ -562,7 +562,7 @@ let mk_result_return_texpression (v : texpression) : texpression =
(** Create a [Fail err] pattern which captures the error *)
let mk_result_fail_pattern (error_pat : pattern) (ty : ty) : typed_pattern =
let error_pat : typed_pattern = { value = error_pat; ty = mk_error_ty } in
- let ty = TAdt (TAssumed Result, mk_generic_args_from_types [ ty ]) in
+ let ty = TAdt (TAssumed TResult, mk_generic_args_from_types [ ty ]) in
let value =
PatAdt { variant_id = Some result_fail_id; field_values = [ error_pat ] }
in
@@ -574,7 +574,7 @@ let mk_result_fail_pattern_ignore_error (ty : ty) : typed_pattern =
mk_result_fail_pattern error_pat ty
let mk_result_return_pattern (v : typed_pattern) : typed_pattern =
- let ty = TAdt (TAssumed Result, mk_generic_args_from_types [ v.ty ]) in
+ let ty = TAdt (TAssumed TResult, mk_generic_args_from_types [ v.ty ]) in
let value =
PatAdt { variant_id = Some result_return_id; field_values = [ v ] }
in
generated by cgit v1.2.3 (git 2.25.1) at 2024-10-19 09:42:42 +0000