summaryrefslogtreecommitdiff
path: root/src/specialize.ml
diff options
context:
space:
mode:
authorAlasdair2020-09-29 16:23:40 +0100
committerAlasdair2020-09-29 16:32:24 +0100
commit7441db19749fb7fb9383b6361dfbd99547e53486 (patch)
tree779f90dbe139bce648540d517be84b156d92319e /src/specialize.ml
parent6dbd0facf0962d869d0c3957f668b035a4a6605c (diff)
Refactor: Change AST type from a union to a struct
Diffstat (limited to 'src/specialize.ml')
-rw-r--r--src/specialize.ml60
1 files changed, 30 insertions, 30 deletions
diff --git a/src/specialize.ml b/src/specialize.ml
index 3634b7bc..bbf74f46 100644
--- a/src/specialize.ml
+++ b/src/specialize.ml
@@ -117,15 +117,15 @@ let fix_instantiation spec instantiation =
for some set of kinded-identifiers, specified by the is_kopt
predicate. For example, polymorphic_functions is_int_kopt will
return all Int-polymorphic functions. *)
-let rec polymorphic_functions ctx (Defs defs) =
+let rec polymorphic_functions ctx defs =
match defs with
| DEF_spec (VS_aux (VS_val_spec (TypSchm_aux (TypSchm_ts (typq, typ) , _), id, externs, _), _)) :: defs ->
let is_polymorphic = List.exists ctx.is_polymorphic (quant_kopts typq) in
if is_polymorphic && not (ctx.extern_filter externs) then
- IdSet.add id (polymorphic_functions ctx (Defs defs))
+ IdSet.add id (polymorphic_functions ctx defs)
else
- polymorphic_functions ctx (Defs defs)
- | _ :: defs -> polymorphic_functions ctx (Defs defs)
+ polymorphic_functions ctx defs
+ | _ :: defs -> polymorphic_functions ctx defs
| [] -> IdSet.empty
(* When we specialize a function, we need to generate new name. To do
@@ -209,11 +209,11 @@ let id_of_instantiation id instantiation =
let str = string_of_instantiation instantiation in
prepend_id (str ^ "#") id
-let rec variant_generic_typ id (Defs defs) =
+let rec variant_generic_typ id defs =
match defs with
| DEF_type (TD_aux (TD_variant (id', typq, _, _), _)) :: _ when Id.compare id id' = 0 ->
mk_typ (Typ_app (id', List.map (fun kopt -> mk_typ_arg (A_typ (mk_typ (Typ_var (kopt_kid kopt))))) (quant_kopts typq)))
- | _ :: defs -> variant_generic_typ id (Defs defs)
+ | _ :: defs -> variant_generic_typ id defs
| [] -> failwith ("No variant with id " ^ string_of_id id)
(* Returns a list of all the instantiations of a function id in an
@@ -238,8 +238,8 @@ let rec instantiations_of spec id ast =
| Typ_aux (Typ_app (variant_id, _), _) as typ ->
let open Type_check in
let instantiation = unify (fst annot) (env_of_annot annot)
- (tyvars_of_typ (variant_generic_typ variant_id ast))
- (variant_generic_typ variant_id ast)
+ (tyvars_of_typ (variant_generic_typ variant_id ast.defs))
+ (variant_generic_typ variant_id ast.defs)
typ
in
instantiations := fix_instantiation spec instantiation :: !instantiations;
@@ -259,7 +259,7 @@ let rec instantiations_of spec id ast =
!instantiations
let rec rewrite_polymorphic_calls spec id ast =
- let vs_ids = val_spec_ids ast in
+ let vs_ids = val_spec_ids ast.defs in
let rewrite_e_aux = function
| E_aux (E_app (id', args), annot) as exp when Id.compare id id' = 0 ->
@@ -368,9 +368,9 @@ let instantiate_constraints instantiation ncs =
List.map (fun c -> List.fold_left (fun c (v, a) -> constraint_subst v a c) c (KBindings.bindings instantiation)) ncs
let specialize_id_valspec spec instantiations id ast =
- match split_ast (is_valspec id) ast with
+ match split_defs (is_valspec id) ast.defs with
| None -> Reporting.unreachable (id_loc id) __POS__ ("Valspec " ^ string_of_id id ^ " does not exist!")
- | Some (pre_ast, vs, post_ast) ->
+ | Some (pre_defs, vs, post_defs) ->
let typschm, externs, is_cast, annot = match vs with
| DEF_spec (VS_aux (VS_val_spec (typschm, _, externs, is_cast), annot)) -> typschm, externs, is_cast, annot
| _ -> Reporting.unreachable (id_loc id) __POS__ "val-spec is not actually a val-spec"
@@ -416,7 +416,7 @@ let specialize_id_valspec spec instantiations id ast =
let specializations = List.map specialize_instance instantiations |> List.concat in
- append_ast pre_ast (append_ast (Defs (vs :: specializations)) post_ast)
+ { ast with defs = pre_defs @ (vs :: specializations) @ post_defs }
(* When we specialize a function definition we also need to specialize
all the types that appear as annotations within the function
@@ -450,9 +450,9 @@ let specialize_annotations instantiation fdef =
annot)
let specialize_id_fundef instantiations id ast =
- match split_ast (is_fundef id) ast with
+ match split_defs (is_fundef id) ast.defs with
| None -> ast
- | Some (pre_ast, DEF_fundef fundef, post_ast) ->
+ | Some (pre_defs, DEF_fundef fundef, post_defs) ->
let spec_ids = ref IdSet.empty in
let specialize_fundef instantiation =
let spec_id = id_of_instantiation id instantiation in
@@ -463,10 +463,10 @@ let specialize_id_fundef instantiations id ast =
end
in
let fundefs = List.map specialize_fundef instantiations |> List.concat in
- append_ast pre_ast (append_ast (Defs (DEF_fundef fundef :: fundefs)) post_ast)
+ { ast with defs = pre_defs @ (DEF_fundef fundef :: fundefs) @ post_defs }
| Some _ -> assert false (* unreachable *)
-let specialize_id_overloads instantiations id (Defs defs) =
+let specialize_id_overloads instantiations id ast =
let ids = IdSet.of_list (List.map (id_of_instantiation id) instantiations) in
let rec rewrite_overloads defs =
@@ -478,7 +478,7 @@ let specialize_id_overloads instantiations id (Defs defs) =
| [] -> []
in
- Defs (rewrite_overloads defs)
+ { ast with defs = rewrite_overloads ast.defs }
(* Once we've specialized a definition, it's original valspec should
be unused, unless another polymorphic function called it. We
@@ -501,7 +501,7 @@ let add_initial_calls ids = initial_calls := IdSet.union ids !initial_calls
let remove_unused_valspecs env ast =
let calls = ref !initial_calls in
- let vs_ids = val_spec_ids ast in
+ let vs_ids = val_spec_ids ast.defs in
let inspect_exp = function
| E_aux (E_app (call, _), _) as exp ->
@@ -515,23 +515,23 @@ let remove_unused_valspecs env ast =
let unused = IdSet.filter (fun vs_id -> not (IdSet.mem vs_id !calls)) vs_ids in
- let rec remove_unused (Defs defs) id =
+ let rec remove_unused defs id =
match defs with
| def :: defs when is_fundef id def ->
- remove_unused (Defs defs) id
+ remove_unused defs id
| def :: defs when is_valspec id def ->
- remove_unused (Defs defs) id
+ remove_unused defs id
| DEF_overload (overload_id, overloads) :: defs ->
begin
match List.filter (fun id' -> Id.compare id id' <> 0) overloads with
- | [] -> remove_unused (Defs defs) id
- | overloads -> DEF_overload (overload_id, overloads) :: remove_unused (Defs defs) id
+ | [] -> remove_unused defs id
+ | overloads -> DEF_overload (overload_id, overloads) :: remove_unused defs id
end
- | def :: defs -> def :: remove_unused (Defs defs) id
+ | def :: defs -> def :: remove_unused defs id
| [] -> []
in
- List.fold_left (fun ast id -> Defs (remove_unused ast id)) ast (IdSet.elements unused)
+ List.fold_left (fun ast id -> { ast with defs = remove_unused ast.defs id }) ast (IdSet.elements unused)
let specialize_id spec id ast =
let instantiations = instantiations_of spec id ast in
@@ -543,7 +543,7 @@ let specialize_id spec id ast =
ensure that the types they are specialized to appear before the
function definitions in the AST. Therefore we pull all the type
definitions (and default definitions) to the start of the AST. *)
-let reorder_typedefs (Defs defs) =
+let reorder_typedefs ast =
let tdefs = ref [] in
let rec filter_typedefs = function
@@ -554,8 +554,8 @@ let reorder_typedefs (Defs defs) =
| [] -> []
in
- let others = filter_typedefs defs in
- Defs (List.rev !tdefs @ others)
+ let others = filter_typedefs ast.defs in
+ { ast with defs = List.rev !tdefs @ others }
let specialize_ids spec ids ast =
let t = Profile.start () in
@@ -571,7 +571,7 @@ let specialize_ids spec ids ast =
| Some (f, i) ->
let filename = f ^ "_spec_" ^ string_of_int i ^ ".sail" in
let out_chan = open_out filename in
- Pretty_print_sail.pp_defs out_chan ast;
+ Pretty_print_sail.pp_ast out_chan ast;
close_out out_chan;
opt_ddump_spec_ast := Some (f, i + 1)
| None -> ()
@@ -593,7 +593,7 @@ let rec specialize_passes n spec env ast =
if n = 0 then
ast, env
else
- let ids = polymorphic_functions spec ast in
+ let ids = polymorphic_functions spec ast.defs in
if IdSet.is_empty ids then
ast, env
else