forked from
jonmsterling.com/ocaml-forester
ocaml
Remove Tape_effect from evaluator
+65
-106
+65
-26
lib/compiler/Eval.ml
+65
-26
lib/compiler/Eval.ml
···
89
89
}
90
90
[@@deriving show]
91
91
92
-
module Tape = Tape_effect.Make ()
93
-
94
92
type eval_env = {
95
93
mode: eval_mode;
96
94
config: Config.t;
···
99
97
jobs: Job.job Range.located Stack.t;
100
98
emitted_trees: T.content T.article Stack.t;
101
99
heap: Value.obj Symbol_table.t;
102
-
mutable frontmatter: T.content T.frontmatter;
100
+
frontmatter: T.content T.frontmatter ref;
101
+
tape: Syn.t ref;
103
102
}
104
103
104
+
let pop_node_opt ~env =
105
+
match env.tape.contents with
106
+
| node :: nodes ->
107
+
env.tape := nodes;
108
+
Some node
109
+
| [] -> None
110
+
111
+
let pop_arg_opt ~env =
112
+
match env.tape.contents with
113
+
| (Range.{value = Syn.Group (Braces, arg); _} as node) :: nodes ->
114
+
env.tape := nodes;
115
+
Some {node with value = arg}
116
+
| (Range.
117
+
{
118
+
value =
119
+
( Syn.Sym _ | Syn.Verbatim _ | Syn.Var _ | Syn.Dx_sequent _
120
+
| Syn.Dx_query _ );
121
+
_;
122
+
} as node)
123
+
:: nodes ->
124
+
env.tape := nodes;
125
+
Some {node with value = [node]}
126
+
| _ -> None
127
+
128
+
let pop_arg ~env ~loc =
129
+
match pop_arg_opt ~env with
130
+
| Some arg -> arg
131
+
| None -> Reporter.fatal ?loc (Type_error {got = None; expected = [Argument]})
132
+
105
133
let initial_eval_env config frontmatter : eval_env =
106
134
{
107
135
mode = Text_mode;
···
112
140
emitted_trees = Stack.create ();
113
141
heap = Symbol_table.create 100;
114
142
frontmatter;
143
+
tape = ref [];
115
144
}
116
145
117
146
let get_current_uri ~env ~loc =
118
-
match env.frontmatter.uri with
147
+
match env.frontmatter.contents.uri with
119
148
| Some uri -> uri
120
149
| None ->
121
150
Reporter.fatal ?loc Internal_error
···
191
220
| TeX_cs.Word x -> Format.fprintf fmt "\\%s " x
192
221
193
222
let rec process_tape ~env =
194
-
match Tape.pop_node_opt () with
223
+
match pop_node_opt ~env with
195
224
| None -> Value.Content (T.Content [])
196
225
| Some node -> eval_node ~env node
197
226
198
-
and eval_tape ~env tape = Tape.run ~tape (fun () -> process_tape ~env)
227
+
and eval_tape ~env tape = process_tape ~env:{env with tape = ref tape}
199
228
200
-
and eval_pop_arg ~env ~loc = Tape.pop_arg ~loc |> Range.map (eval_tape ~env)
229
+
and eval_pop_arg ~env ~loc = pop_arg ~env ~loc |> Range.map (eval_tape ~env)
201
230
202
231
and pop_content_arg ~env ~loc = eval_pop_arg ~env ~loc |> extract_content
203
232
···
317
346
{
318
347
subtree with
319
348
frontmatter =
320
-
{subtree.frontmatter with uri; designated_parent = frontmatter.uri};
349
+
{subtree.frontmatter with uri; designated_parent = !frontmatter.uri};
321
350
}
322
351
in
323
352
begin match uri with
···
508
537
| Verbatim str -> emit_content_node ~env ~loc @@ CDATA str
509
538
| Title ->
510
539
let title = pop_content_arg ~env ~loc in
511
-
env.frontmatter <- {env.frontmatter with title = Some title};
540
+
env.frontmatter := {env.frontmatter.contents with title = Some title};
512
541
process_tape ~env
513
542
| Parent ->
514
543
let parent_arg = eval_pop_arg ~env ~loc in
···
520
549
~extra_remarks:
521
550
[Asai.Diagnostic.loctext "Expected valid URI in parent declaration"]
522
551
in
523
-
env.frontmatter <- {env.frontmatter with designated_parent = Some parent};
552
+
env.frontmatter :=
553
+
{env.frontmatter.contents with designated_parent = Some parent};
524
554
process_tape ~env
525
555
| Meta ->
526
556
let k = pop_text_arg ~env ~loc in
527
557
let v = pop_content_arg ~env ~loc in
528
-
env.frontmatter <-
529
-
{env.frontmatter with metas = env.frontmatter.metas @ [(k, v)]};
558
+
env.frontmatter :=
559
+
{
560
+
env.frontmatter.contents with
561
+
metas = env.frontmatter.contents.metas @ [(k, v)];
562
+
};
530
563
process_tape ~env
531
564
| Attribution (role, type_) ->
532
565
let arg = eval_pop_arg ~env ~loc in
···
550
583
T.Content_vertex (extract_content arg)
551
584
in
552
585
let attribution = T.{role; vertex} in
553
-
env.frontmatter <-
586
+
env.frontmatter :=
554
587
{
555
-
env.frontmatter with
556
-
attributions = env.frontmatter.attributions @ [attribution];
588
+
env.frontmatter.contents with
589
+
attributions = env.frontmatter.contents.attributions @ [attribution];
557
590
};
558
591
process_tape ~env
559
592
| Tag type_ ->
···
573
606
];
574
607
T.Content_vertex (extract_content arg)
575
608
in
576
-
env.frontmatter <-
577
-
{env.frontmatter with tags = env.frontmatter.tags @ [vertex]};
609
+
env.frontmatter :=
610
+
{
611
+
env.frontmatter.contents with
612
+
tags = env.frontmatter.contents.tags @ [vertex];
613
+
};
578
614
process_tape ~env
579
615
| Date ->
580
616
let date_str = pop_text_arg ~env ~loc in
···
584
620
~extra_remarks:
585
621
[Asai.Diagnostic.loctextf "Invalid date string `%s`" date_str]
586
622
| Some date ->
587
-
env.frontmatter <-
588
-
{env.frontmatter with dates = env.frontmatter.dates @ [date]};
623
+
env.frontmatter :=
624
+
{
625
+
env.frontmatter.contents with
626
+
dates = env.frontmatter.contents.dates @ [date];
627
+
};
589
628
process_tape ~env
590
629
end
591
630
| Number ->
592
631
let num = pop_text_arg ~env ~loc in
593
-
env.frontmatter <- {env.frontmatter with number = Some num};
632
+
env.frontmatter := {env.frontmatter.contents with number = Some num};
594
633
process_tape ~env
595
634
| Taxon ->
596
635
let taxon = Some (pop_content_arg ~env ~loc) in
597
-
env.frontmatter <- {env.frontmatter with taxon};
636
+
env.frontmatter := {env.frontmatter.contents with taxon};
598
637
process_tape ~env
599
638
| Sym sym -> focus ~env ?loc:node.loc @@ Value.Sym sym
600
639
| Dx_prop (rel, args) ->
···
680
719
match xs with
681
720
| [] -> focus ~env ?loc @@ eval_tape ~env:{env with lex_env = rho} body
682
721
| (info, y) :: ys -> (
683
-
match Tape.pop_arg_opt () with
722
+
match pop_arg_opt ~env with
684
723
| Some arg ->
685
724
let yval =
686
725
match info with
···
714
753
let attribution_is_author attr =
715
754
match T.(attr.role) with T.Author -> true | _ -> false
716
755
in
717
-
let outer_frontmatter = env.frontmatter in
756
+
let outer_frontmatter = env.frontmatter.contents in
718
757
let attributions =
719
758
List.filter attribution_is_author outer_frontmatter.attributions
720
759
in
···
723
762
?source_path:outer_frontmatter.source_path ~dates:outer_frontmatter.dates
724
763
()
725
764
in
726
-
let env = {env with frontmatter} in
765
+
let env = {env with frontmatter = ref frontmatter} in
727
766
let mainmatter =
728
767
{value = eval_tape ~env syn; loc = None} |> extract_content
729
768
in
730
-
let frontmatter = env.frontmatter in
769
+
let frontmatter = env.frontmatter.contents in
731
770
let backmatter =
732
771
match uri with Some uri -> default_backmatter ~uri | None -> Content []
733
772
in
···
747
786
~emit:push
748
787
@@ fun () ->
749
788
let fm = T.default_frontmatter ~uri ?source_path () in
750
-
let env = initial_eval_env config fm in
789
+
let env = initial_eval_env config (ref fm) in
751
790
let main = eval_tree_inner ~env ~uri tree in
752
791
let side = env.emitted_trees |> Stack.to_seq |> List.of_seq in
753
792
let jobs = env.jobs |> Stack.to_seq |> List.of_seq in
-63
lib/compiler/Tape_effect.ml
-63
lib/compiler/Tape_effect.ml
···
1
-
(*
2
-
* SPDX-FileCopyrightText: 2024 The Forester Project Contributors
3
-
*
4
-
* SPDX-License-Identifier: GPL-3.0-or-later
5
-
*)
6
-
7
-
open Forester_core
8
-
9
-
module type S = sig
10
-
val run : tape:Syn.t -> (unit -> 'a) -> 'a
11
-
val pop_node_opt : unit -> Syn.node Range.located option
12
-
val pop_arg_opt : unit -> Syn.t Range.located option
13
-
val pop_arg : loc:Range.t option -> Syn.t Range.located
14
-
val pop_args : unit -> Syn.t Range.located list
15
-
end
16
-
17
-
module Make () = struct
18
-
open Bwd
19
-
20
-
module T = Algaeff.State.Make (struct
21
-
type t = Syn.t
22
-
end)
23
-
24
-
let pop_node_opt () =
25
-
match T.get () with
26
-
| node :: nodes ->
27
-
T.set nodes;
28
-
Some node
29
-
| [] -> None
30
-
31
-
let pop_arg_opt () =
32
-
match T.get () with
33
-
| (Range.{value = Syn.Group (Braces, arg); _} as node) :: nodes ->
34
-
T.set nodes;
35
-
Some {node with value = arg}
36
-
| (Range.
37
-
{
38
-
value =
39
-
( Syn.Sym _ | Syn.Verbatim _ | Syn.Var _ | Syn.Dx_sequent _
40
-
| Syn.Dx_query _ );
41
-
_;
42
-
} as node)
43
-
:: nodes ->
44
-
T.set nodes;
45
-
Some {node with value = [node]}
46
-
| _ -> None
47
-
48
-
let pop_arg ~loc =
49
-
match pop_arg_opt () with
50
-
| Some arg -> arg
51
-
| None ->
52
-
Reporter.fatal ?loc (Type_error {got = None; expected = [Argument]})
53
-
54
-
let pop_args () =
55
-
let rec loop acc =
56
-
match pop_arg_opt () with
57
-
| Some arg -> loop @@ Bwd.Snoc (acc, arg)
58
-
| None -> Bwd.prepend acc []
59
-
in
60
-
loop Bwd.Emp
61
-
62
-
let run ~tape = T.run ~init:tape
63
-
end
-17
lib/compiler/Tape_effect.mli
-17
lib/compiler/Tape_effect.mli
···
1
-
(*
2
-
* SPDX-FileCopyrightText: 2024 The Forester Project Contributors
3
-
*
4
-
* SPDX-License-Identifier: GPL-3.0-or-later
5
-
*)
6
-
7
-
open Forester_core
8
-
9
-
module type S = sig
10
-
val run : tape:Syn.t -> (unit -> 'a) -> 'a
11
-
val pop_node_opt : unit -> Syn.node Range.located option
12
-
val pop_arg_opt : unit -> Syn.t Range.located option
13
-
val pop_arg : loc:Range.t option -> Syn.t Range.located
14
-
val pop_args : unit -> Syn.t Range.located list
15
-
end
16
-
17
-
module Make () : S