Don't use a hash table to call components

Topologically order component bindings instead of looking them up
dynamcially with a hash table.

lib/compile.ml

@@ -164,19 +164,22 @@ end
 type 'a t = {
   name : string;
   types : Typechecker.Type.scheme;
+  components : (string * nodes) list;
+  externals : (string * Typechecker.Type.scheme * 'a) list;
   nodes : nodes;
-  components : nodes MapString.t;
-  externals : (Typechecker.Type.scheme * 'a) MapString.t;
 }
 
+module SetString = Set.Make (String)
+
 type 'a linked_components = {
-  components : nodes MapString.t;
-  externals : (Typechecker.Type.scheme * 'a) MapString.t;
+  components : (string * nodes) list;
+  externals : (string * Typechecker.Type.scheme * 'a) list;
+  set : SetString.t;
   stack : string list;
 }
 
 let empty_linked =
-  { components = MapString.empty; externals = MapString.empty; stack = [] }
+  { components = []; externals = []; set = SetString.empty; stack = [] }
 
 let make ~fname components_src nodes =
   let typed = T.make ~root:fname components_src.Components.typed nodes in
@@ -197,22 +200,30 @@ let make ~fname components_src nodes =
             Matching.Exits.nodes m.exits |> Seq.fold_left get_components linked
         | Component (name, blocks, _) -> (
             let linked = Queue.fold get_components linked blocks in
-            match MapString.find_opt name components_src.optimized with
-            | None -> raise @@ Error.missing_component linked.stack name
-            | Some (Src (_, nodes)) ->
-                let components = MapString.add name nodes linked.components in
-                get_components
-                  { linked with components; stack = name :: linked.stack }
-                  nodes
-            | Some (Fun (_, props, f)) ->
-                let externals =
-                  MapString.add name (props, f) linked.externals
-                in
-                { linked with externals }))
+            if SetString.mem name linked.set then linked
+            else if List.exists (String.equal name) linked.stack then
+              raise @@ Error.cycle (name :: linked.stack)
+            else
+              match MapString.find_opt name components_src.optimized with
+              | None -> raise @@ Error.missing_component linked.stack name
+              | Some (Src (_, nodes)) ->
+                  let { components; externals; set; _ } =
+                    get_components
+                      { linked with stack = name :: linked.stack }
+                      nodes
+                  in
+                  let set = SetString.add name set in
+                  let components = (name, nodes) :: components in
+                  { linked with components; externals; set }
+              | Some (Fun (_, props, f)) ->
+                  let set = SetString.add name linked.set in
+                  let externals = (name, props, f) :: linked.externals in
+                  { linked with externals; set }))
       linked nodes
   in
   let { components; externals; _ } = get_components empty_linked nodes in
-  { name = fname; types = typed.types; nodes; components; externals }
+  let components = List.rev components in
+  { name = fname; types = typed.types; components; externals; nodes }
 
 let make_interface ~fname src =
   parse_interface ~fname src |> T.make_interface_standalone

lib/compile.mli

@@ -72,9 +72,10 @@ end
 type 'a t = {
   name : string;
   types : Typechecker.Type.scheme;
+  components : (string * nodes) list;
+      (** Components are topologically ordered. *)
+  externals : (string * Typechecker.Type.scheme * 'a) list;
   nodes : nodes;
-  components : nodes map_string;
-  externals : (Typechecker.Type.scheme * 'a) map_string;
 }
 
 val make : fname:string -> 'a Components.t -> Ast.t -> 'a t

lib/instruct.ml

@@ -264,7 +264,7 @@ end = struct
   type 'a hashtbl = 'a Hashtbl.MakeSeeded(String).t
 
   type state = {
-    components : (Data.t hashtbl -> string promise) hashtbl exp;
+    components : (Data.t hashtbl -> string promise) exp MapString.t;
     buf : Buffer.t exp;
     escape : (Buffer.t -> string -> unit) exp;
     props : Data.t hashtbl exp;
@@ -514,7 +514,7 @@ end = struct
         let@ blocks = construct_blocks state blocks in
         buffer_add_string state.buf
           (await
-             (state.components.%{string name}
+             (MapString.find name state.components
              @@ construct_data_hashtbl blocks state dict))
 
   and construct_blocks state blocks f =
@@ -845,7 +845,7 @@ end = struct
         set (External.of_seq seq)
     | T.Record tys ->
         let$ seq =
-          ("seq", encode_record_aux (Data.to_hashtbl props) tys.contents)
+          ("seq", encode_record (Data.to_hashtbl props) tys.contents)
         in
         set (External.of_seq_assoc seq)
     | T.Dict (ty, _) ->
@@ -889,8 +889,7 @@ end = struct
             ~then_:(fun () ->
               let$ seq =
                 ( "seq",
-                  encode_record_aux ~tag:(key, to_extern tag) props tys.contents
-                )
+                  encode_record ~tag:(key, to_extern tag) props tys.contents )
               in
               set (External.of_seq_assoc seq))
             ~else_:(fun () ->
@@ -902,14 +901,14 @@ end = struct
                     | `Open -> Some (key, to_extern tag)
                   in
                   let$ seq =
-                    ("seq", encode_record_aux ?tag props MapString.empty)
+                    ("seq", encode_record ?tag props MapString.empty)
                   in
                   set (External.of_seq_assoc seq)
               | Seq.Cons (hd, seq) -> aux hd seq)
         in
         aux hd seq
 
-  and encode_record_aux ?tag props tys =
+  and encode_record ?tag props tys =
     generator (fun yield ->
         let| () = match tag with Some t -> yield (pair t) | None -> unit in
         MapString.to_seq tys
@@ -918,12 +917,38 @@ end = struct
                encode ~set:(fun v -> yield (pair (k, v))) props.%{k} ty)
         |> stmt_join)
 
+  let rec make_comps_external components components_input f =
+    match components_input with
+    | (k, tys, v) :: tl ->
+        import v (fun import ->
+            let$ comp =
+              ( k,
+                lambda (fun props ->
+                    let$ seq = ("seq", encode_record props tys) in
+                    return (import @@ External.of_seq_assoc seq)) )
+            in
+            make_comps_external (MapString.add k comp components) tl f)
+    | [] -> f components
+
+  let rec make_comps ~escape components components_input f =
+    match components_input with
+    | (k, v) :: tl ->
+        let$ comp =
+          ( k,
+            async_lambda (fun props ->
+                let@ state = state_make components ~props ~escape in
+                let| () = nodes state v in
+                return (promise (buffer_contents state.buf))) )
+        in
+        make_comps ~escape (MapString.add k comp components) tl f
+    | [] -> f components
+
   let lambdak k f = lambda (fun a -> return (k (f a)))
   let lambda2 f = lambdak lambda f
   let lambda3 f = lambdak lambda2 f
   let lambda4 f = lambdak lambda3 f
 
-  let eval compiled =
+  let eval (compiled : 'a Compile.t) =
     let$ escape =
       ( "buffer_add_escape",
         lambda2 (fun buf str ->
@@ -964,25 +989,8 @@ end = struct
             let| () = stmt (stack @@ f) (* Use FIFO evaluation. *) in
             return (f @@ x)) )
     in
-    let$ components = ("components", hashtbl_create ()) in
-    let| () =
-      Seq.append
-        (MapString.to_seq compiled.Compile.externals
-        |> Seq.map (fun (k, (tys, v)) ->
-               import v (fun import ->
-                   components.%{string k} <-
-                     lambda (fun props ->
-                         let$ seq = ("seq", encode_record_aux props tys) in
-                         return (import @@ External.of_seq_assoc seq)))))
-        (MapString.to_seq compiled.components
-        |> Seq.map (fun (k, v) ->
-               components.%{string k} <-
-                 async_lambda (fun props ->
-                     let@ state = state_make components ~props ~escape in
-                     let| () = nodes state v in
-                     return (promise (buffer_contents state.buf)))))
-      |> stmt_join
-    in
+    let@ components = make_comps_external MapString.empty compiled.externals in
+    let@ components = make_comps ~escape components compiled.components in
     export
       (async_lambda (fun input ->
            let$ errors = ("errors", buffer_create ()) in

test/parse-test.t/run.t

@@ -120,6 +120,14 @@ Print the untyped AST to make sure parsing works
      ("i_prop" (block ())))
     "Component")
    (text no_trim "\n\nComponent with implicit children\n" no_trim)
+   (component
+    "Component2"
+    (("children" (block ((text no_trim " " no_trim)))))
+    "Component2")
+   (text
+    no_trim
+    "\n\nComponents are only bound once in the instructions.\n"
+    no_trim)
    (component
     "Component2"
     (("children" (block ((text no_trim " " no_trim)))))
@@ -553,6 +561,8 @@ Print the optimized form
      ("i_prop" (block 2))))
    (text "\n\nComponent with implicit children\n")
    (component ((0 ((text " ")))) "Component2" (("children" (block 0))))
+   (text "\n\nComponents are only bound once in the instructions.\n")
+   (component ((0 ((text " ")))) "Component2" (("children" (block 0))))
    (text "\n\nPatterns\n\nTuple:\n")
    (match
     ()
@@ -943,8 +953,7 @@ Print the runtime instructions
     ((return
       (lambda arg
        ((return (lambda arg ((stmt (arg @@ arg)) (return (arg @@ arg)))))))))))
-  (let$ components = (hashtbl_create))
-  (components.%{"Component"} <-
+  (let$ Component =
    (async_lambda arg
     ((let$ buf = (buffer_create))
      (stmt ((buffer_add_escape @@ buf) @@ (Data.to_string (arg.%{"a_prop"}))))
@@ -962,7 +971,7 @@ Print the runtime instructions
      (stmt ((buffer_add_escape @@ buf) @@ (Data.to_string (arg.%{"i_prop"}))))
      (buffer_add_string buf "\n")
      (return (promise (buffer_contents buf))))))
-  (components.%{"Component2"} <-
+  (let$ Component2 =
    (async_lambda arg
     ((let$ buf = (buffer_create))
      (stmt ((buffer_add_escape @@ buf) @@ (Data.to_string (arg.%{"children"}))))
@@ -1823,7 +1832,7 @@ Print the runtime instructions
        (unit)
        (buffer_add_string buf
         (await
-         ((components.%{"Component"})
+         (Component
           @@ (hashtbl
               [("a_prop", (props.%{"b_prop"})),
                ("c_prop", (props.%{"c_prop"})),
@@ -1837,7 +1846,15 @@ Print the runtime instructions
        (buffer_add_string buf " ")
        (buffer_add_string buf
         (await
-         ((components.%{"Component2"})
+         (Component2
+          @@ (hashtbl [("children", (Data.string (buffer_contents buf)))]))))
+       (buffer_add_string buf
+        "\n\nComponents are only bound once in the instructions.\n")
+       (let$ buf = (buffer_create))
+       (buffer_add_string buf " ")
+       (buffer_add_string buf
+        (await
+         (Component2
           @@ (hashtbl [("children", (Data.string (buffer_contents buf)))]))))
        (buffer_add_string buf "\n\nPatterns\n\nTuple:\n")
        (let$ arg_match = [(props.%{"tuple"})])

test/parse-test.t/template.acutis

@@ -54,6 +54,9 @@ Component with props
 Component with implicit children
 {% Component2 %} {% /Component2 %}
 
+Components are only bound once in the instructions.
+{% Component2 %} {% /Component2 %}
+
 Patterns
 
 Tuple:

test/printjs/esm-cjs.t/run.t

@@ -51,16 +51,13 @@
         }
       );
     };
-  let components$0 = new Map();
   import {"externalFunction" as import$0} from "./jsfile.mjs";
-  components$0.set(
-    "ExternalFunction",
+  let ExternalFunction$0 =
     (arg$0) => {
       let seq$0 =
         (function* () { yield (["children", arg$0.get("children")]); })();
       return (import$0(Object.fromEntries(seq$0)));
-    }
-  );
+    };
   export default async (arg$0) => {
     let errors$0 = {contents: ""};
     let error_aux$0 =
@@ -119,10 +116,7 @@
       let buf$1 = {contents: ""};
       buf$1.contents += " text ";
       buf$0.contents +=
-        await
-          components$0.get("ExternalFunction")(
-            new Map([["children", buf$1.contents]])
-          );
+        await ExternalFunction$0(new Map([["children", buf$1.contents]]));
       buf$0.contents += "\n";
       return (Promise.resolve(buf$0.contents));
     } else {
@@ -183,16 +177,13 @@
         }
       );
     };
-  let components$0 = new Map();
   let import$0 = require("./jsfile.cjs");
-  components$0.set(
-    "ExternalFunction",
+  let ExternalFunction$0 =
     (arg$0) => {
       let seq$0 =
         (function* () { yield (["children", arg$0.get("children")]); })();
       return (import$0["externalFunction"](Object.fromEntries(seq$0)));
-    }
-  );
+    };
   module.exports =
     async (arg$0) => {
       let errors$0 = {contents: ""};
@@ -252,10 +243,7 @@
         let buf$1 = {contents: ""};
         buf$1.contents += " text ";
         buf$0.contents +=
-          await
-            components$0.get("ExternalFunction")(
-              new Map([["children", buf$1.contents]])
-            );
+          await ExternalFunction$0(new Map([["children", buf$1.contents]]));
         buf$0.contents += "\n";
         return (Promise.resolve(buf$0.contents));
       } else {

test/printjs/printjs.t/component.acutis

@@ -4,4 +4,5 @@
   list = [int]
 ~%}
 {% %i optional ? children %}
-{% map list with i ~%} {% %i i %} {%~ /map ~%}
+{% map list with i ~%} {% %i i %} {%~ /map %}
+{% NestedComponent / ~%}

test/printjs/printjs.t/nestedComponent.acutis

@@ -0,0 +1 @@
+Nested component