diff options
| author | Son Ho | 2021-12-07 16:45:13 +0100 | 
|---|---|---|
| committer | Son Ho | 2021-12-07 16:45:13 +0100 | 
| commit | 8e248d10e63c640085775c2473479a641d4daef9 (patch) | |
| tree | 304c6b6efe06dc3d14961577c58f9d118f2bf12d | |
| parent | 0cc2b46af26d371b6f2f90529d369682f91a7a2e (diff) | |
Implement map_frame_concrete
| -rw-r--r-- | src/Contexts.ml | 26 | 
1 files changed, 24 insertions, 2 deletions
diff --git a/src/Contexts.ml b/src/Contexts.ml index 9bcaaa43..295b5164 100644 --- a/src/Contexts.ml +++ b/src/Contexts.ml @@ -148,7 +148,7 @@ let ctx_push_uninitialized_vars (ctx : eval_ctx) (vars : var list) : eval_ctx =    let vars = List.map (fun v -> (v, mk_bottom v.var_ty)) vars in    ctx_push_vars ctx vars -(** Visitor to iterate over the values in a frame. *) +(** Visitor to iterate over the values in the current frame *)  class ['self] iter_frame_concrete =    object (self : 'self)      inherit [_] V.iter_typed_value @@ -163,6 +163,28 @@ class ['self] iter_frame_concrete =          | Var (vid, v) :: env ->              self#visit_env_value_Var acc vid v;              self#visit_env acc env -        | Abs _ :: _ -> raise Errors.Unimplemented (* TODO *) +        | Abs _ :: _ -> failwith "Unexpected abstraction"          | Frame :: _ -> (* We stop here *) ()    end + +(** Visitor to iterate over the values in the current frame *) +class ['self] map_frame_concrete = +  object (self : 'self) +    inherit [_] V.map_typed_value + +    method visit_env_value_Var : 'acc -> binder -> typed_value -> env_value = +      fun acc vid v -> +        let v = self#visit_typed_value acc v in +        Var (vid, v) + +    method visit_env : 'acc -> env -> env = +      fun acc env -> +        match env with +        | [] -> [] +        | Var (vid, v) :: env -> +            let v = self#visit_env_value_Var acc vid v in +            let env = self#visit_env acc env in +            v :: env +        | Abs _ :: _ -> failwith "Unexpected abstraction" +        | Frame :: env -> (* We stop here *) Frame :: env +  end  | 
