forked from
jonmsterling.com/ocaml-forester
ocaml
cleanup environments
+17
-29
+9
-9
lib/compiler/Eval.ml
+9
-9
lib/compiler/Eval.ml
···
9
9
10
10
open struct
11
11
module T = Types
12
-
module Env = Value.Env
12
+
module String_map = Value.String_map
13
13
module Symbol_map = Value.Symbol_map
14
14
type located = Value.t Range.located
15
15
end
···
73
73
type result = {articles: T.content T.article list; jobs: Job.job Range.located list} [@@deriving show]
74
74
75
75
module Tape = Tape_effect.Make ()
76
-
module Lex_env = Algaeff.Reader.Make(struct type t = Value.t Env.t end)
76
+
module Lex_env = Algaeff.Reader.Make(struct type t = Value.t String_map.t end)
77
77
module Dyn_env = Algaeff.Reader.Make(struct type t = Value.t Symbol_map.t end)
78
78
module Config_env = Algaeff.Reader.Make(struct type t = Config.t end)
79
79
module Heap = Algaeff.State.Make(struct type t = Value.obj Symbol_map.t end)
···
399
399
let env =
400
400
match mthd.self with
401
401
| None -> mthd.env
402
-
| Some self -> Env.add self (Value.Obj sym) mthd.env
402
+
| Some self -> String_map.add self (Value.Obj sym) mthd.env
403
403
in
404
404
match proto_val with
405
405
| None -> env
406
406
| Some proto_val ->
407
407
match mthd.super with
408
408
| None -> env
409
-
| Some super -> Env.add super proto_val env
409
+
| Some super -> String_map.add super proto_val env
410
410
in
411
411
let@ () = Lex_env.run ~env in
412
412
eval_tape mthd.body
···
444
444
| None ->
445
445
Reporter.fatal
446
446
?loc: node.loc
447
-
(Unbound_fluid_symbol (k, env))
447
+
(Unbound_fluid_symbol k)
448
448
| Some v -> focus ?loc: node.loc v
449
449
end
450
450
| Verbatim str ->
···
567
567
568
568
and eval_var ~loc (x : string) =
569
569
let env = Lex_env.read () in
570
-
match Env.find_opt x env with
570
+
match String_map.find_opt x env with
571
571
| Some v -> focus ?loc v
572
572
| None ->
573
573
Reporter.fatal
574
574
?loc
575
-
(Unbound_variable (x, env))
575
+
(Unbound_variable x)
576
576
577
577
and focus ?loc = function
578
578
| Clo (rho, xs, body) ->
···
608
608
| Strict -> eval_tape arg.value
609
609
| Lazy -> Clo (Lex_env.read (), [(Strict, None)], arg.value)
610
610
in
611
-
let rhoy = match y with Some y -> Env.add y yval rho | None -> rho in
611
+
let rhoy = match y with Some y -> String_map.add y yval rho | None -> rho in
612
612
focus_clo ?loc rhoy ys body
613
613
| None ->
614
614
begin
···
670
670
let@ () = Emitted_trees.run ~init: [] in
671
671
let@ () = Jobs.run ~init: [] in
672
672
let@ () = Heap.run ~init: Symbol_map.empty in
673
-
let@ () = Lex_env.run ~env: Env.empty in
673
+
let@ () = Lex_env.run ~env: String_map.empty in
674
674
let@ () = Dyn_env.run ~env: Symbol_map.empty in
675
675
let@ () = Config_env.run ~env: config in
676
676
let main = eval_tree_inner ~uri tree in
+2
-2
lib/core/Reporter.ml
+2
-2
lib/core/Reporter.ml
···
41
41
got: Value.t option;
42
42
expected: expected_value list
43
43
}
44
-
| Unbound_fluid_symbol of (Symbol.t * Value.t Value.Symbol_map.t)
45
-
| Unbound_variable of (string * Value.t Value.Env.t)
44
+
| Unbound_fluid_symbol of Symbol.t
45
+
| Unbound_variable of string
46
46
| Unresolved_identifier of ((Sc.data, R.P.tag) Trie.t [@opaque]) * Trie.path
47
47
| Unresolved_xmlns of string
48
48
| Reference_error of URI.t
+2
-2
lib/core/Reporter.mli
+2
-2
lib/core/Reporter.mli
···
36
36
got: Value.t option;
37
37
expected: expected_value list
38
38
}
39
-
| Unbound_fluid_symbol of (Symbol.t * Value.t Value.Symbol_map.t)
40
-
| Unbound_variable of (string * Value.t Value.Env.t)
39
+
| Unbound_fluid_symbol of Symbol.t
40
+
| Unbound_variable of string
41
41
| Unresolved_identifier of ((Resolver.Scope.data, Resolver.P.tag) Trie.t) * Trie.path
42
42
| Unresolved_xmlns of string
43
43
| Reference_error of URI.t
+4
-16
lib/core/Value.ml
+4
-16
lib/core/Value.ml
···
9
9
10
10
open struct module T = Types end
11
11
12
-
module Make_env (S : sig include Map.OrderedType val pp : Format.formatter -> t -> unit end) = struct
13
-
include Map.Make(S)
14
-
let pp (pp_el : Format.formatter -> 'a -> unit) (fmt : Format.formatter) (map : 'a t) =
15
-
Format.fprintf fmt "@[<v1>{";
16
-
begin
17
-
let@ k, v = Seq.iter @~ to_seq map in
18
-
Format.fprintf fmt "@[%a ~> %a@]@;" S.pp k pp_el v
19
-
end;
20
-
Format.fprintf fmt "}@]"
21
-
end
22
-
23
-
module Env = Make_env (struct include String let pp = Format.pp_print_string end)
24
-
module Symbol_map = Make_env (Symbol)
25
-
12
+
module String_map = Map.Make(String)
13
+
module Symbol_map = Map.Make(Symbol)
26
14
27
15
type t =
28
16
| Content of T.content
29
-
| Clo of t Env.t * string option binding list * Syn.t
17
+
| Clo of (t String_map.t [@opaque]) * string option binding list * Syn.t
30
18
| Dx_prop of (string, T.content T.vertex) Datalog_expr.prop
31
19
| Dx_sequent of (string, T.content T.vertex) Datalog_expr.sequent
32
20
| Dx_query of (string, T.content T.vertex) Datalog_expr.query
···
40
28
body: Syn.t;
41
29
self: string option;
42
30
super: string option;
43
-
env: t Env.t
31
+
env: t String_map.t [@opaque]
44
32
}
45
33
[@@deriving show]
46
34