diff options
Diffstat (limited to 'src/monomorphise.ml')
| -rw-r--r-- | src/monomorphise.ml | 23 |
1 files changed, 18 insertions, 5 deletions
diff --git a/src/monomorphise.ml b/src/monomorphise.ml index 784929e1..f0472385 100644 --- a/src/monomorphise.ml +++ b/src/monomorphise.ml @@ -344,6 +344,7 @@ and inst_src_typ_arg insts (A_aux (ta,l) as tyarg) = match ta with | A_nexp _ | A_order _ + | A_bool _ -> insts, tyarg | A_typ typ -> let insts', typ' = inst_src_type insts typ in @@ -364,6 +365,7 @@ and contains_exist_arg (A_aux (arg,_)) = match arg with | A_nexp _ | A_order _ + | A_bool _ -> false | A_typ typ -> contains_exist typ @@ -2085,19 +2087,26 @@ let split_defs all_errors splits defs = | LEXP_vector_concat les -> re (LEXP_vector_concat (List.map map_lexp les)) | LEXP_field (le,id) -> re (LEXP_field (map_lexp le, id)) | LEXP_deref e -> re (LEXP_deref (map_exp e)) - in map_pexp, map_letbind - in + in map_exp, map_pexp, map_letbind + in + let map_exp r = let (f,_,_) = map_fns r in f in + let map_pexp r = let (_,f,_) = map_fns r in f in + let map_letbind r = let (_,_,f) = map_fns r in f in + let map_exp exp = + let ref_vars = referenced_vars exp in + map_exp ref_vars exp + in let map_pexp top_pexp = (* Construct the set of referenced variables so that we don't accidentally make false assumptions about them during constant propagation. Note that we assume there aren't any in the guard. *) let (_,_,body,_) = destruct_pexp top_pexp in let ref_vars = referenced_vars body in - fst (map_fns ref_vars) top_pexp + map_pexp ref_vars top_pexp in let map_letbind (LB_aux (LB_val (_,e),_) as lb) = let ref_vars = referenced_vars e in - snd (map_fns ref_vars) lb + map_letbind ref_vars lb in let map_funcl (FCL_aux (FCL_Funcl (id,pexp),annot)) = @@ -2128,6 +2137,7 @@ let split_defs all_errors splits defs = | DEF_mapdef (MD_aux (_, (l, _))) -> Reporting.unreachable l __POS__ "mappings should be gone by now" | DEF_val lb -> [DEF_val (map_letbind lb)] | DEF_scattered sd -> List.map (fun x -> DEF_scattered x) (map_scattered_def sd) + | DEF_measure (id,pat,exp) -> [DEF_measure (id,pat,map_exp exp)] in Defs (List.concat (List.map map_def defs)) in @@ -2210,6 +2220,7 @@ and sizes_of_typarg (A_aux (ta,_)) = match ta with A_nexp _ | A_order _ + | A_bool _ -> KidSet.empty | A_typ typ -> sizes_of_typ typ @@ -4380,7 +4391,9 @@ let replace_nexp_in_typ env typ orig new_nexp = | A_typ typ -> let f, typ = aux typ in f, A_aux (A_typ typ,l) - | A_order _ -> false, typ_arg + | A_order _ + | A_bool _ + -> false, typ_arg in aux typ let fresh_nexp_kid nexp = |