Commit 03cb6a6a authored by POTTIER Francois's avatar POTTIER Francois

Added a [lookup] method in every kit that needs it.

parent 29206bde
......@@ -20,5 +20,6 @@ let extend bad x env =
class ['self] map bad = object (_ : 'self)
method private extend x env = extend bad x env
method private visit_'fn env x = lookup env x
method private lookup = lookup
method private visit_'fn = lookup
end
......@@ -23,5 +23,6 @@ let extend x env =
class ['self] map = object (_ : 'self)
method private extend x env = extend x env
method private visit_'fn env x = lookup env x
method private lookup = lookup
method private visit_'fn = lookup
end
......@@ -48,5 +48,6 @@ let lookup (m1, m2, _) x1 x2 =
class ['self] iter2 = object (_ : 'self)
method private extend = extend
method private lookup = lookup
method private visit_'fn = lookup
end
......@@ -51,5 +51,6 @@ let lookup env a =
class ['self] map = object (_ : 'self)
method private extend = extend
method private lookup = lookup
method private visit_'fn = lookup
end
......@@ -28,5 +28,6 @@ let lookup (env : env) (x : string) : Atom.t =
class ['self] map = object (_ : 'self)
method private extend x env = extend x env
method private visit_'fn env x = lookup env x
method private lookup = lookup
method private visit_'fn = lookup
end
......@@ -2,7 +2,11 @@
(* At an abstraction or at a name occurrence, [Atom.show] is applied. *)
let lookup _env x =
Atom.show x
class ['self] map = object (_ : 'self)
method private extend x env = Atom.show x, env
method private visit_'fn _env x = Atom.show x
method private lookup = lookup
method private visit_'fn = lookup
end
......@@ -17,8 +17,15 @@ let extend x env =
substitution [env], unchanged, under the binder. *)
x, env
let lookup env x =
try
Atom.Map.find x env
with Not_found ->
assert false
class ['self] map = object (_ : 'self)
method private extend = extend
method private lookup = lookup
(* [visit_'fn] must be implemented. There could be several kinds of
nodes that carry variables of type ['fn], say, [FooVar] and [BarVar],
and the user may decide to substitute away [FooVar] nodes, but leave
......
......@@ -45,6 +45,7 @@ end) = struct
class ['self] map = object (_ : 'self)
method private extend = extend
method private lookup _env _x = ()
method private visit_'fn = lookup
end
......
......@@ -8,19 +8,3 @@ class ['self] iter = object (_ : 'self)
method private extend _x env = env
method private visit_'fn _env _x = ()
end
(* The following are presently unused:
class ['self] map = object (_ : 'self)
method private extend x env = x, env
method private visit_'fn _env x = x
end
class virtual ['self] reduce = object (self : 'self)
method private virtual zero: _
method private extend _x env = env
method private restrict _x z = z
method private visit_'fn _env _x = self#zero
end
*)
......@@ -24,6 +24,7 @@ module type INPUT = sig
class virtual ['self] map : object ('self)
method private virtual extend : 'bn1 -> 'env -> 'bn2 * 'env
method private virtual lookup : 'env -> 'bn1 -> 'bn2
method private virtual visit_'fn : 'env -> 'fn1 -> 'fn2
method visit_term : 'env -> ('bn1, 'fn1) term -> ('bn2, 'fn2) term
method private visit_TVar : 'env -> 'fn1 -> ('bn2, 'fn2) term
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment