split meta and data providers to be able to request array template me…

…ta data

benchmark/benchmark.ml

@@ -177,7 +177,7 @@ end = struct
             let _ =
               Sys.opaque_identity
                 (Pinc.Interpreter.eval_sources
-                   ~tag_data_provider:Pinc.Interpreter.noop_data_provider
+                   ~tag_data_provider:Pinc.Helpers.noop_data_provider
                    ~root
                    [ src ])
             in

bin/print.ml

@@ -26,7 +26,7 @@ let main =
   let root = Sys.argv.(2) in
   let declarations = get_declarations_from ~directory () in
   declarations
-  |> Interpreter.eval_sources ~root ~tag_data_provider:Interpreter.noop_data_provider
+  |> Interpreter.eval_sources ~root ~tag_data_provider:Helpers.noop_data_provider
   |> fst
   |> print_endline
 ;;

bin/print_debug.ml

@@ -8,7 +8,7 @@ let main =
   let end_time_parser = Unix.gettimeofday () in
   let result =
     [ src ]
-    |> Interpreter.eval_sources ~tag_data_provider:Interpreter.noop_data_provider ~root
+    |> Interpreter.eval_sources ~tag_data_provider:Helpers.noop_data_provider ~root
   in
   let end_time = Unix.gettimeofday () in
   Printf.printf "Lexer & Parser: %fms\n" ((end_time_parser -. start_time) *. 1000.);

lib/02_parsing/Ast.ml

@@ -71,7 +71,7 @@ and expression_desc =
   | Float of float
   | Bool of bool
   | Array of expression array
-  | Record of (bool * expression) StringMap.t  (** nullable, value *)
+  | Record of ([ `Required | `Optional ] * expression) StringMap.t
   | Function of {
       parameters : string list;
       body : expression;

lib/02_parsing/Pinc_Parser.ml

@@ -183,10 +183,15 @@ module Rules = struct
     match t.token.typ with
     | Token.IDENT_LOWER key ->
         next t;
-        let nullable = optional Token.QUESTIONMARK t in
+        let requirement =
+          if optional Token.QUESTIONMARK t then
+            `Optional
+          else
+            `Required
+        in
         expect Token.COLON t;
         let value = parse_expression t in
-        value |> Option.map (fun value -> (key, (nullable, value)))
+        value |> Option.map (fun value -> (key, (requirement, value)))
     | _ -> None
 
   and parse_block t =

lib/pinc_backend/Helpers.ml

@@ -276,6 +276,7 @@ module TagMeta = struct
   let array a : meta = `Array a
   let record r : meta = `Record r
   let children () : meta = `SubTagPlaceholder
+  let template () : meta = `TemplatePlaceholder
 
   let rec merge (a : meta) (b : meta) =
     match (a, b) with
@@ -299,4 +300,26 @@ module TagMeta = struct
     | `Array a -> `Array (a |> List.map (map fn))
     | value -> fn value
   ;;
+
+  let rec filter_map : (meta -> 'a option) -> meta -> 'a option =
+   fun fn (meta : meta) ->
+    match meta with
+    | `Record a -> (
+        let result =
+          a
+          |> List.filter_map @@ fun (key, v) ->
+             filter_map fn v |> Option.map (fun v -> (key, v))
+        in
+        match result with
+        | [] -> None
+        | l -> Some (`Record l))
+    | `Array a -> (
+        match a |> List.filter_map (filter_map fn) with
+        | [] -> None
+        | l -> Some (`Array l))
+    | value -> fn value
+  ;;
 end
+
+let noop_data_provider ~tag:_ ~attributes:_ ~required:_ ~key:_ = None
+let noop_meta_provider ~tag:_ ~attributes:_ ~required:_ ~key:_ = None

lib/pinc_backend/Interpreter.ml

@@ -39,6 +39,8 @@ let rec get_uppercase_identifier_typ ~state ident =
                           (State.make
                              ~root_tag_data_provider:state.root_tag_data_provider
                              ~tag_data_provider:state.tag_data_provider
+                             ~root_tag_meta_provider:state.root_tag_meta_provider
+                             ~tag_meta_provider:state.tag_meta_provider
                              ~tag_meta:state.tag_meta
                              ~mode:state.mode
                              state.declarations)
@@ -117,16 +119,16 @@ and eval_expression ~state expression =
         map
         |> StringMap.to_seq
         |> Seq.fold_left
-             (fun (state, seq) (ident, (optional, expression)) ->
+             (fun (state, seq) (ident, (requirement, expression)) ->
                let state =
                  expression
                  |> eval_expression
-                      ~state:{ state with binding_identifier = Some (optional, ident) }
+                      ~state:{ state with binding_identifier = Some (requirement, ident) }
                in
                let output = state |> State.get_output in
                let () =
                  match output with
-                 | { value_desc = Null; value_loc } when not optional ->
+                 | { value_desc = Null; value_loc } when requirement = `Required ->
                      Pinc_Diagnostics.error
                        value_loc
                        (Printf.sprintf
@@ -962,10 +964,16 @@ and eval_lowercase_identifier ~state ~loc ident =
 
 and eval_let ~state ~ident ~is_mutable ~is_optional expression =
   let ident, ident_location = ident in
+  let requirement =
+    if is_optional then
+      `Optional
+    else
+      `Required
+  in
   let state =
     expression
     |> eval_expression
-         ~state:{ state with binding_identifier = Some (is_optional, ident) }
+         ~state:{ state with binding_identifier = Some (requirement, ident) }
   in
   let value = State.get_output state in
   match value with
@@ -1015,10 +1023,16 @@ and eval_mutation ~state ~ident expression =
   | Some { is_mutable = false; _ } ->
       Pinc_Diagnostics.error ident_location "Trying to update a non mutable variable."
   | Some { value = _; is_mutable = true; is_optional } ->
+      let requirement =
+        if is_optional then
+          `Optional
+        else
+          `Required
+      in
       let output =
         expression
         |> eval_expression
-             ~state:{ state with binding_identifier = Some (is_optional, ident) }
+             ~state:{ state with binding_identifier = Some (requirement, ident) }
       in
       let () =
         output |> State.get_output |> function
@@ -1259,38 +1273,48 @@ and eval_template ~state template =
               |> Fun.flip Option.bind (Tag.find_path (key |> List.tl))
               |> function
               | None -> state.root_tag_data_provider ~tag ~attributes ~required ~key
-              | value -> (value, None))
+              | value -> value)
           | Type_Tag.Tag_Slot _ ->
               let key = key |> List.rev |> List.hd in
-              ( component_tag_children
-                |> List.fold_left (Tag.Tag_Slot.keep_slotted ~key) []
-                |> List.rev
-                |> Helpers.Value.list
-                |> Option.some,
-                None )
+              component_tag_children
+              |> List.fold_left (Tag.Tag_Slot.keep_slotted ~key) []
+              |> List.rev
+              |> Helpers.Value.list
+              |> Option.some
           | Type_Tag.Tag_Array ->
               let key = key |> List.rev |> List.hd in
-              ( component_tag_attributes
-                |> StringMap.find_opt key
-                |> Fun.flip Option.bind (function
-                       | { value_desc = Array a; _ } ->
-                           a |> Array.length |> Helpers.Value.int |> Option.some
-                       | _ -> None),
-                None )
+              component_tag_attributes
+              |> StringMap.find_opt key
+              |> Fun.flip Option.bind (function
+                     | { value_desc = Array a; _ } ->
+                         a |> Array.length |> Helpers.Value.int |> Option.some
+                     | _ -> None)
           | _ ->
-              ( component_tag_attributes
-                |> StringMap.find_opt (key |> List.hd)
-                |> Fun.flip Option.bind (Tag.find_path (key |> List.tl)),
-                None )
+              component_tag_attributes
+              |> StringMap.find_opt (key |> List.hd)
+              |> Fun.flip Option.bind (Tag.find_path (key |> List.tl))
+        in
+        let tag_meta_provider ~tag ~attributes ~required ~key =
+          match tag with
+          | Type_Tag.Tag_Store _ -> (
+              component_tag_attributes
+              |> StringMap.find_opt (key |> List.hd)
+              |> Fun.flip Option.bind (Tag.find_path (key |> List.tl))
+              |> function
+              | None -> state.root_tag_meta_provider ~tag ~attributes ~required ~key
+              | _ -> None)
+          | _ -> None
         in
 
         let state =
           State.make
             ~context:state.context
             ~mode:state.mode
             ~tag_meta:state.tag_meta
-            ~root_tag_data_provider:state.root_tag_data_provider
             ~tag_data_provider
+            ~root_tag_data_provider:state.root_tag_data_provider
+            ~tag_meta_provider
+            ~root_tag_meta_provider:state.root_tag_meta_provider
             state.declarations
         in
         DeclarationEvaluator.eval ~eval_expression ~state component_tag_identifier
@@ -1308,8 +1332,6 @@ and eval_template ~state template =
              }
 ;;
 
-let noop_data_provider ~tag:_ ~attributes:_ ~required:_ ~key:_ = (None, None)
-
 let declarations_of_sources =
   ListLabels.fold_left ~init:[] ~f:(fun acc source ->
       let decls = Parser.parse source in
@@ -1342,8 +1364,10 @@ let eval_meta sources =
     State.make
       ~mode:`Portal_Collection
       ~tag_meta:[]
-      ~root_tag_data_provider:noop_data_provider
-      ~tag_data_provider:noop_data_provider
+      ~root_tag_data_provider:Helpers.noop_data_provider
+      ~tag_data_provider:Helpers.noop_data_provider
+      ~root_tag_meta_provider:Helpers.noop_meta_provider
+      ~tag_meta_provider:Helpers.noop_data_provider
       declarations
   in
   let eval attrs =
@@ -1380,7 +1404,11 @@ let get_stdlib () =
        StringMap.empty
 ;;
 
-let eval_declarations ~tag_data_provider ~root declarations =
+let eval_declarations
+    ?(tag_meta_provider = Helpers.noop_meta_provider)
+    ~tag_data_provider
+    ~root
+    declarations =
   Hashtbl.reset Tag.Tag_Portal.portals;
 
   let declarations =
@@ -1399,6 +1427,8 @@ let eval_declarations ~tag_data_provider ~root declarations =
     State.make
       ~root_tag_data_provider:tag_data_provider
       ~tag_data_provider
+      ~root_tag_meta_provider:tag_meta_provider
+      ~tag_meta_provider
       ~tag_meta:[]
       ~mode:`Portal_Collection
       declarations
@@ -1421,6 +1451,8 @@ let eval_declarations ~tag_data_provider ~root declarations =
   (html, meta_tree)
 ;;
 
-let eval_sources ~tag_data_provider ~root sources =
-  sources |> declarations_of_sources |> eval_declarations ~tag_data_provider ~root
+let eval_sources ?tag_meta_provider ~tag_data_provider ~root sources =
+  sources
+  |> declarations_of_sources
+  |> eval_declarations ?tag_meta_provider ~tag_data_provider ~root
 ;;

lib/pinc_backend/Interpreter.mli

@@ -2,8 +2,6 @@ module Types = Types
 module Ast = Pinc_Parser.Ast
 open Types
 
-val noop_data_provider : Type_Tag.data_provider
-
 val eval_meta :
   Pinc_Source.t list ->
   [> `Component of value StringMap.t
@@ -13,17 +11,19 @@ val eval_meta :
   ]
   StringMap.t
 
-(** [eval_sources ~tag_data_provider ~root sources] evaluates definition {!root} found in {!sources}, getting its data from the {!tag_data_provider}.
+(** [eval_sources ?tag_meta_provider ~tag_data_provider ~root sources] evaluates definition {!root} found in {!sources}, getting its data from the {!tag_data_provider}.
   @raise Invalid_argument if the given root can't be evaluated (store, library). *)
 val eval_sources :
+  ?tag_meta_provider:Types.Type_Tag.meta_provider ->
   tag_data_provider:Types.Type_Tag.data_provider ->
   root:string ->
   Pinc_Source.t list ->
   string * (string * Types.Type_Tag.meta) list
 
-(** [eval ~tag_data_provider ~root sources] evaluates definition {!root} found in {!sources}, getting its data from the {!tag_data_provider}.
+(** [eval ?tag_meta_provider ~tag_data_provider ~root sources] evaluates definition {!root} found in {!sources}, getting its data from the {!tag_data_provider}.
   @raise Invalid_argument if the given root can't be evaluated (store, library). *)
 val eval_declarations :
+  ?tag_meta_provider:Types.Type_Tag.meta_provider ->
   tag_data_provider:Types.Type_Tag.data_provider ->
   root:string ->
   (string * Pinc_Parser.Ast.declaration) list ->

lib/pinc_backend/State.ml

@@ -7,6 +7,8 @@ let make
     ~tag_meta
     ~tag_data_provider
     ~root_tag_data_provider
+    ~tag_meta_provider
+    ~root_tag_meta_provider
     ~mode
     declarations =
   {
@@ -16,6 +18,8 @@ let make
     environment = { scope = []; use_scope = StringMap.empty };
     tag_data_provider;
     root_tag_data_provider;
+    tag_meta_provider;
+    root_tag_meta_provider;
     tag_meta;
     tag_path;
     context;