diff options
Diffstat (limited to 'src/monomorphise.ml')
| -rw-r--r-- | src/monomorphise.ml | 20 |
1 files changed, 14 insertions, 6 deletions
diff --git a/src/monomorphise.ml b/src/monomorphise.ml index 0585d9fa..3af0b480 100644 --- a/src/monomorphise.ml +++ b/src/monomorphise.ml @@ -2241,13 +2241,16 @@ let rewrite_size_parameters env (Defs defs) = let open Rewriter in let open Util in - let sizes_funcl fsizes (FCL_aux (FCL_Funcl (id,pexp),(l,_))) = + let sizes_funcl fsizes (FCL_aux (FCL_Funcl (id,pexp),(l,ann))) = let pat,guard,exp,pannot = destruct_pexp pexp in - let parameters = match pat with - | P_aux (P_tup ps,_) -> ps - | _ -> [pat] + let env = env_of_annot (l,ann) in + let _, typ = Env.get_val_spec_orig id env in + let types = + match pat, Env.expand_synonyms env typ with + | P_aux (P_tup ps,_), Typ_aux (Typ_tup ts,_) -> ts + | _, _ -> [typ] in - let add_parameter (i,nmap) (P_aux (_,(_,Some (env,typ,_)))) = + let add_parameter (i,nmap) typ = let nmap = match Env.base_typ_of env typ with Typ_aux (Typ_app(Id_aux (Id "range",_), @@ -2262,8 +2265,13 @@ let rewrite_size_parameters env (Defs defs) = | _ -> nmap in (i+1,nmap) in - let (_,nexp_map) = List.fold_left add_parameter (0,NexpMap.empty) parameters in + let (_,nexp_map) = List.fold_left add_parameter (0,NexpMap.empty) types in let nexp_list = NexpMap.bindings nexp_map in +(* let () = + print_endline ("Type of pattern for " ^ string_of_id id ^": " ^string_of_typ (pat_typ_of pat)); + print_endline ("Nexp map for " ^ string_of_id id); + List.iter (fun (nexp, i) -> print_endline (" " ^ string_of_nexp nexp ^ " -> " ^ string_of_int i)) nexp_list +in *) let parameters_for = function | Some (env,typ,_) -> begin match Env.base_typ_of env typ with |