Jonathan Graveline pushed to branch graveline at Stefan / Typer
Commits: fc0bf4fa by Jonathan Graveline at 2018-05-10T15:15:35Z Removed 'reset_intra_ref' - - - - -
1 changed file:
- src/opslexp.ml
Changes:
===================================== src/opslexp.ml ===================================== --- a/src/opslexp.ml +++ b/src/opslexp.ml @@ -926,63 +926,13 @@ and clean_map cases =
(** Turning a set of declarations into an object. **)
-let shift n lexp = Lexp.mkSusp lexp (S.Shift (S.Identity,n)) - -(* arguments are : *) -(* len is the length of the tuple, 'n value' as in nth value of the tuple *) -let rec reset_intra_ref len n value = - - let rec reset_intra_ref' scope value = - - let reset' = reset_intra_ref' scope in - let nscope nv = reset_intra_ref' (scope + nv) in - - match value with - - (* the real thing is with Var, all other pattern are for sub expression *) - (* We want to reset variable from inside the tuple so their idx aren't modified *) - | Var (v,idx) -> if (idx <= len && idx > scope) then Var (v, (idx + n)) else Var (v,idx) - - (* now just check sub expression *) - | Susp (l,s) -> Susp (reset' l,s) - - | Let (loc,defs,l) -> - let reset'' (v,l,t) = (v,reset' l,reset' t) in - Let (loc, List.map reset'' defs, nscope (List.length defs) l) - - | Arrow (k,ov,t,loc,l) -> Arrow (k,ov,reset' t,loc,nscope 1 l) - - | Lambda (k,v,t,l) -> Lambda (k,v,reset' t,nscope 1 l) - - | Call (l,args) -> - let reset'' (k,l) = (k,reset' l) in - Call (nscope (List.length args) l, List.map reset'' args) - - | Inductive (loc,label,args,ctors) -> - let reset'' (k,vo,t) = (k,vo,reset' t) in - let ctors' = SMap.map (fun ctor -> List.map reset'' ctor) ctors in - Inductive (loc,label,List.map reset'' args,ctors') - - | Cons (l,s) -> Cons (reset' l,s) - - | Case (loc,l,t,brc,dflt) -> - let reset'' (loc2,vs,l2) = (loc2,vs,nscope 1 l2) in - let brc' = SMap.map reset'' brc in - let dflt' = match dflt with - | None -> None - | Some (vo,l) -> Some (vo,nscope 1 l) in - Case (loc,reset' l,reset' t,brc',dflt') - - | _ -> value - in reset_intra_ref' 0 value - let mktup types vals = let loc = DB.dloc in let cons_name = "cons" in let cons_label = (loc, cons_name) in let type_label = (loc, "record") in
- let reset' n (k,l) = (k,reset_intra_ref (List.length vals) n l) in + let shift n lexp = Lexp.mkSusp lexp (S.Shift (S.Identity,n)) in
Call (Cons (Inductive (loc, type_label, [], SMap.add cons_name @@ -991,8 +941,8 @@ let mktup types vals = types) SMap.empty), cons_label), - List.mapi reset' - (List.mapi (fun n v -> (P.Aimplicit, shift (- n) v)) vals)) + (* shift could be done in sform_load but it is easy to put it here *) + List.mapi (fun n v -> (P.Aimplicit, shift (- n) v)) vals)
(* does not seem to let previous global declaration be used by next global declaration *) let ctx2tup ctx nctx =
View it on GitLab: https://gitlab.com/monnier/typer/commit/fc0bf4fa5b30297aeb3f2827792bff011d72...
Afficher les réponses par date