diff options
| author | Brian Campbell | 2017-07-14 13:42:10 +0100 |
|---|---|---|
| committer | Brian Campbell | 2017-07-14 13:42:10 +0100 |
| commit | 9fdb8345f96c8aaf506901326757d439f17fd54a (patch) | |
| tree | 28bedb57b1875a6a9308abe205debe94e1dbf9b3 /src | |
| parent | 202e1f497fb283e51b56f8b9c3a8ca6ee6bc638c (diff) | |
Generalise matching a little in monomorphisation
Diffstat (limited to 'src')
| -rw-r--r-- | src/monomorphise.ml | 54 | ||||
| -rw-r--r-- | src/monomorphise_new.ml | 54 |
2 files changed, 50 insertions, 58 deletions
diff --git a/src/monomorphise.ml b/src/monomorphise.ml index b86f49ad..ed06c227 100644 --- a/src/monomorphise.ml +++ b/src/monomorphise.ml @@ -428,50 +428,46 @@ let split_defs splits (Type_check.Env (d_env,t_env,b_env,tp_env)) defs = (* Attempt simple pattern matches *) let can_match (E_aux (e,(l,annot)) as exp0) cases = + let rec findpat_generic check_pat description = function + | [] -> (Reporting_basic.print_err false true l "Monomorphisation" + ("Failed to find a case for " ^ description); None) + | [Pat_aux (Pat_exp (P_aux (P_wild,_),exp),_)] -> Some (exp,[]) + | (Pat_aux (Pat_exp (P_aux (P_typ (_,p),_),exp),ann))::tl -> + findpat_generic check_pat description ((Pat_aux (Pat_exp (p,exp),ann))::tl) + | (Pat_aux (Pat_exp (P_aux (P_id id',_),exp),_))::tl + when pat_id_is_variable t_env (id_to_string id') -> + Some (exp, [(id_to_string id', exp0)]) + | (Pat_aux (p,_))::tl -> + match check_pat p with + | None -> findpat_generic check_pat description tl + | result -> result + in match e with | E_id id -> let i = id_to_string id in (match Envmap.apply t_env i with | Some(Base(_,Enum _,_,_,_,_)) -> - let rec findpat cases = - match cases with - | [] -> (Reporting_basic.print_err false true l "Monomorphisation" - ("Failed to find a case for " ^ i); None) - | [Pat_aux (Pat_exp (P_aux (P_wild,_),exp),_)] -> Some (exp,[]) - | (Pat_aux (Pat_exp (P_aux (P_typ (_,p),_),exp),ann))::tl -> - findpat ((Pat_aux (Pat_exp (p,exp),ann))::tl) - | (Pat_aux (Pat_exp (P_aux (P_id id',_),exp),_))::tl - when pat_id_is_variable t_env (id_to_string id') -> - Some (exp, [(id_to_string id', exp0)]) - | (Pat_aux (Pat_exp (P_aux (P_id id',_),exp),_))::tl - | (Pat_aux (Pat_exp (P_aux (P_app (id',[]),_),exp),_))::tl -> - if i = id_to_string id' then Some (exp,[]) else findpat tl - | (Pat_aux (Pat_exp (P_aux (_,(l',_)),_),_))::_ -> + let checkpat = function + | (Pat_exp (P_aux (P_id id',_),exp)) + | (Pat_exp (P_aux (P_app (id',[]),_),exp)) -> + if i = id_to_string id' then Some (exp,[]) else None + | (Pat_exp (P_aux (_,(l',_)),_)) -> (Reporting_basic.print_err false true l' "Monomorphisation" "Unexpected kind of pattern for enumeration"; None) - in findpat cases + in findpat_generic checkpat i cases | _ -> None) (* TODO: could generalise Lit matching *) | E_lit (L_aux ((L_zero | L_one | L_true | L_false) as bit, _)) -> - let rec findpat cases = - match cases with - | [] -> (Reporting_basic.print_err false true l "Monomorphisation" - ("Failed to find a case for bit"); None) - | [Pat_aux (Pat_exp (P_aux (P_wild,_),exp),_)] -> Some (exp,[]) - | (Pat_aux (Pat_exp (P_aux (P_typ (_,p),_),exp),ann))::tl -> - findpat ((Pat_aux (Pat_exp (p,exp),ann))::tl) - | (Pat_aux (Pat_exp (P_aux (P_id id',_),exp),_))::tl - when pat_id_is_variable t_env (id_to_string id') -> - Some (exp, [(id_to_string id', exp0)]) - | (Pat_aux (Pat_exp (P_aux (P_lit (L_aux (lit, _)),_),exp),_))::tl -> + let checkpat = function + | (Pat_exp (P_aux (P_lit (L_aux (lit, _)),_),exp)) -> (match bit,lit with | (L_zero | L_false), (L_zero | L_false) -> Some (exp,[]) | (L_one | L_true ), (L_one | L_true ) -> Some (exp,[]) - | _ -> findpat tl) - | (Pat_aux (Pat_exp (P_aux (_,(l',_)),_),_))::_ -> + | _ -> None) + | (Pat_exp (P_aux (_,(l',_)),_)) -> (Reporting_basic.print_err false true l' "Monomorphisation" "Unexpected kind of pattern for bit"; None) - in findpat cases + in findpat_generic checkpat "bit" cases | _ -> None in diff --git a/src/monomorphise_new.ml b/src/monomorphise_new.ml index d945c8a0..a3ba9aa2 100644 --- a/src/monomorphise_new.ml +++ b/src/monomorphise_new.ml @@ -439,50 +439,46 @@ let split_defs splits defs = (* Attempt simple pattern matches *) let can_match (E_aux (e,(l,annot)) as exp0) cases = let (env,ty) = match annot with Some (env,ty,_) -> env,ty | None -> failwith "env" in + let rec findpat_generic check_pat description = function + | [] -> (Reporting_basic.print_err false true l "Monomorphisation" + ("Failed to find a case for " ^ description); None) + | [Pat_aux (Pat_exp (P_aux (P_wild,_),exp),_)] -> Some (exp,[]) + | (Pat_aux (Pat_exp (P_aux (P_typ (_,p),_),exp),ann))::tl -> + findpat_generic check_pat description ((Pat_aux (Pat_exp (p,exp),ann))::tl) + | (Pat_aux (Pat_exp (P_aux (P_id id',_),exp),_))::tl + when pat_id_is_variable env id' -> + Some (exp, [(id', exp0)]) + | (Pat_aux (p,_))::tl -> + match check_pat p with + | None -> findpat_generic check_pat description tl + | result -> result + in match e with | E_id id -> let i = id_to_string id in (match Env.lookup_id id env with | Enum _ -> - let rec findpat cases = - match cases with - | [] -> (Reporting_basic.print_err false true l "Monomorphisation" - ("Failed to find a case for " ^ i); None) - | [Pat_aux (Pat_exp (P_aux (P_wild,_),exp),_)] -> Some (exp,[]) - | (Pat_aux (Pat_exp (P_aux (P_typ (_,p),_),exp),ann))::tl -> - findpat ((Pat_aux (Pat_exp (p,exp),ann))::tl) - | (Pat_aux (Pat_exp (P_aux (P_id id',_),exp),_))::tl - when pat_id_is_variable env id' -> - Some (exp, [(id', exp0)]) - | (Pat_aux (Pat_exp (P_aux (P_id id',_),exp),_))::tl - | (Pat_aux (Pat_exp (P_aux (P_app (id',[]),_),exp),_))::tl -> - if i = id_to_string id' then Some (exp,[]) else findpat tl - | (Pat_aux (Pat_exp (P_aux (_,(l',_)),_),_))::_ -> + let checkpat = function + | (Pat_exp (P_aux (P_id id',_),exp)) + | (Pat_exp (P_aux (P_app (id',[]),_),exp)) -> + if i = id_to_string id' then Some (exp,[]) else None + | (Pat_exp (P_aux (_,(l',_)),_)) -> (Reporting_basic.print_err false true l' "Monomorphisation" "Unexpected kind of pattern for enumeration"; None) - in findpat cases + in findpat_generic checkpat i cases | _ -> None) (* TODO: could generalise Lit matching *) | E_lit (L_aux ((L_zero | L_one | L_true | L_false) as bit, _)) -> - let rec findpat cases = - match cases with - | [] -> (Reporting_basic.print_err false true l "Monomorphisation" - ("Failed to find a case for bit"); None) - | [Pat_aux (Pat_exp (P_aux (P_wild,_),exp),_)] -> Some (exp,[]) - | (Pat_aux (Pat_exp (P_aux (P_typ (_,p),_),exp),ann))::tl -> - findpat ((Pat_aux (Pat_exp (p,exp),ann))::tl) - | (Pat_aux (Pat_exp (P_aux (P_id id',_),exp),_))::tl - when pat_id_is_variable env id' -> - Some (exp, [(id', exp0)]) - | (Pat_aux (Pat_exp (P_aux (P_lit (L_aux (lit, _)),_),exp),_))::tl -> + let checkpat = function + | (Pat_exp (P_aux (P_lit (L_aux (lit, _)),_),exp)) -> (match bit,lit with | (L_zero | L_false), (L_zero | L_false) -> Some (exp,[]) | (L_one | L_true ), (L_one | L_true ) -> Some (exp,[]) - | _ -> findpat tl) - | (Pat_aux (Pat_exp (P_aux (_,(l',_)),_),_))::_ -> + | _ -> None) + | (Pat_exp (P_aux (_,(l',_)),_)) -> (Reporting_basic.print_err false true l' "Monomorphisation" "Unexpected kind of pattern for bit"; None) - in findpat cases + in findpat_generic checkpat "bit" cases | _ -> None in |
