Made the compose evaluation lazy

3 files changed, 85 insertions, 50 deletions

diff --git a/lib/syntax/compose.ml b/lib/syntax/compose.ml
index dcc1a86..670249a 100644
--- a/lib/syntax/compose.ml
+++ b/lib/syntax/compose.ml
@@ -14,60 +14,79 @@ module Expression (E : S.Expression) = struct
        signatures differs a bit from the standard signature as they get the
        result from E.t in last argument *)
 
-    val ident : (S.pos, E.t' * t) S.variable -> E.t' -> t
-    val integer : S.pos -> string -> E.t' -> t
-    val literal : S.pos -> (E.t' * t) T.literal list -> E.t' -> t
-    val function_ : S.pos -> T.function_ -> (E.t' * t) list -> E.t' -> t
-    val uoperator : S.pos -> T.uoperator -> E.t' * t -> E.t' -> t
-    val boperator : S.pos -> T.boperator -> E.t' * t -> E.t' * t -> E.t' -> t
-
-    val v : E.t' * t -> t'
+    val ident : (S.pos, E.t' Lazy.t * t) S.variable -> E.t' Lazy.t -> t
+    val integer : S.pos -> string -> E.t' Lazy.t -> t
+    val literal : S.pos -> (E.t' Lazy.t * t) T.literal list -> E.t' Lazy.t -> t
+
+    val function_ :
+      S.pos -> T.function_ -> (E.t' Lazy.t * t) list -> E.t' Lazy.t -> t
+
+    val uoperator : S.pos -> T.uoperator -> E.t' Lazy.t * t -> E.t' Lazy.t -> t
+
+    val boperator :
+      S.pos ->
+      T.boperator ->
+      E.t' Lazy.t * t ->
+      E.t' Lazy.t * t ->
+      E.t' Lazy.t ->
+      t
+
+    val v : E.t' Lazy.t * t -> t'
     (** Convert from the internal representation to the external one. *)
   end
 
   module Make (M : SIG) : S.Expression with type t' = M.t' = struct
-    type t = E.t * M.t
+    type t = E.t Lazy.t * M.t
     type t' = M.t'
 
-    let v : t -> t' = fun (type_of, v) -> M.v (E.v type_of, v)
+    let v' : E.t Lazy.t -> E.t' Lazy.t = Lazy.map E.v
+    let fst' : 'a Lazy.t * _ -> 'a = fun v -> Lazy.force (fst v)
+    let v : t -> t' = fun (type_of, v) -> M.v (v' type_of, v)
 
     let ident : (S.pos, t) S.variable -> t =
      fun { pos; name : string; index : t option } ->
-      let t' = E.ident { pos; name; index = Option.map fst index } in
-      let index' = Option.map (fun (e, m) -> (E.v e, m)) index in
-      (t', M.ident { pos; name; index = index' } (E.v @@ t'))
+      let t' = lazy (E.ident { pos; name; index = Option.map fst' index }) in
+      let index' = Option.map (fun (e, m) -> (v' e, m)) index in
+      (t', M.ident { pos; name; index = index' } (v' t'))
 
     let integer : S.pos -> string -> t =
      fun pos i ->
-      let t' = E.integer pos i in
-      (t', M.integer pos i (E.v t'))
+      let t' = lazy (E.integer pos i) in
+      (t', M.integer pos i (v' t'))
 
     let literal : S.pos -> t T.literal list -> t =
      fun pos litts ->
-      let e_litts = List.map litts ~f:(T.map_litteral ~f:fst) in
       let litts' =
-        List.map litts ~f:(T.map_litteral ~f:(fun (e, m) -> (E.v e, m)))
+        List.map litts ~f:(T.map_litteral ~f:(fun (e, m) -> (v' e, m)))
       in
 
-      let t' = E.literal pos e_litts in
-      (t', M.literal pos litts' (E.v t'))
+      let t' =
+        lazy
+          (let e_litts = List.map litts ~f:(T.map_litteral ~f:fst') in
+           E.literal pos e_litts)
+      in
+      (t', M.literal pos litts' (v' t'))
 
     let function_ : S.pos -> T.function_ -> t list -> t =
      fun pos f expressions ->
       let e = List.map ~f:fst expressions
-      and expressions' = List.map ~f:(fun (e, m) -> (E.v e, m)) expressions in
+      and expressions' = List.map ~f:(fun (e, m) -> (v' e, m)) expressions in
 
-      let t' = E.function_ pos f e in
-      (t', M.function_ pos f expressions' (E.v t'))
+      let t' =
+        lazy
+          (let e' = List.map ~f:Lazy.force e in
+           E.function_ pos f e')
+      in
+      (t', M.function_ pos f expressions' (v' t'))
 
     let uoperator : S.pos -> T.uoperator -> t -> t =
      fun pos op (t, expr) ->
-      let t' = E.uoperator pos op t in
-      (t', M.uoperator pos op (E.v t, expr) (E.v t'))
+      let t' = lazy (E.uoperator pos op (Lazy.force t)) in
+      (t', M.uoperator pos op (v' t, expr) (v' t'))
 
     let boperator : S.pos -> T.boperator -> t -> t -> t =
      fun pos op (t1, expr1) (t2, expr2) ->
-      let t' = E.boperator pos op t1 t2 in
-      (t', M.boperator pos op (E.v t1, expr1) (E.v t2, expr2) (E.v t'))
+      let t' = lazy (E.boperator pos op (Lazy.force t1) (Lazy.force t2)) in
+      (t', M.boperator pos op (v' t1, expr1) (v' t2, expr2) (v' t'))
   end
 end
diff --git a/lib/syntax/nested_strings.ml b/lib/syntax/nested_strings.ml
index fcd0b91..7e49ace 100644
--- a/lib/syntax/nested_strings.ml
+++ b/lib/syntax/nested_strings.ml
@@ -10,35 +10,42 @@ module Expression = TypeBuilder.Make (struct
   type t = Report.t list
   type t' = Report.t list
 
-  let v : Get_type.t * t -> t' = snd
+  let v : Get_type.t Lazy.t * t -> t' = snd
 
   (** Identify the expressions reprented as string. That’s here that the report
       are added. 
 
       All the rest of the module only push thoses warning to the top level. *)
-  let literal : S.pos -> (Get_type.t * t) T.literal list -> Get_type.t -> t =
+  let literal :
+      S.pos -> (Get_type.t Lazy.t * t) T.literal list -> Get_type.t Lazy.t -> t
+      =
    fun pos content _type_of ->
     match content with
     | [ T.Expression [ (t', _) ]; T.Text "" ] -> (
-        match Get_type.get_type t' with
+        match Get_type.get_type (Lazy.force t') with
         | Get_type.Integer -> []
         | _ ->
             let msg = Report.debug pos "This expression can be simplified" in
             [ msg ])
     | _ -> []
 
-  let ident : (S.pos, Get_type.t * t) S.variable -> Get_type.t -> t =
+  let ident :
+      (S.pos, Get_type.t Lazy.t * t) S.variable -> Get_type.t Lazy.t -> t =
    fun variable _type_of ->
     match variable.index with None -> [] | Some (_, t) -> t
 
-  let integer : S.pos -> string -> Get_type.t -> t =
+  let integer : S.pos -> string -> Get_type.t Lazy.t -> t =
    fun pos t _type_of ->
     ignore pos;
     ignore t;
     []
 
   let function_ :
-      S.pos -> T.function_ -> (Get_type.t * t) list -> Get_type.t -> t =
+      S.pos ->
+      T.function_ ->
+      (Get_type.t Lazy.t * t) list ->
+      Get_type.t Lazy.t ->
+      t =
    fun pos f expressions _type_of ->
     ignore pos;
     ignore f;
@@ -48,7 +55,8 @@ module Expression = TypeBuilder.Make (struct
     in
     exprs
 
-  let uoperator : S.pos -> T.uoperator -> Get_type.t * t -> Get_type.t -> t =
+  let uoperator :
+      S.pos -> T.uoperator -> Get_type.t Lazy.t * t -> Get_type.t Lazy.t -> t =
    fun pos op r _type_of ->
     ignore op;
     ignore pos;
@@ -57,9 +65,9 @@ module Expression = TypeBuilder.Make (struct
   let boperator :
       S.pos ->
       T.boperator ->
-      Get_type.t * t ->
-      Get_type.t * t ->
-      Get_type.t ->
+      Get_type.t Lazy.t * t ->
+      Get_type.t Lazy.t * t ->
+      Get_type.t Lazy.t ->
       t =
    fun pos op (_, r1) (_, r2) _type_of ->
     ignore pos;
diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml
index 7b9a67e..c532a96 100644
--- a/lib/syntax/type_of.ml
+++ b/lib/syntax/type_of.ml
@@ -137,22 +137,23 @@ end
 
 module TypeBuilder = Compose.Expression (Get_type)
 
-type t' = { result : Get_type.t; pos : S.pos; empty : bool }
+type t' = { result : Get_type.t Lazy.t; pos : S.pos; empty : bool }
 
-let arg_of_repr : Get_type.t -> S.pos -> Helper.argument_repr =
- fun type_of pos -> { pos; t = type_of }
+let arg_of_repr : Get_type.t Lazy.t -> S.pos -> Helper.argument_repr =
+ fun type_of pos -> { pos; t = Lazy.force type_of }
 
 module TypedExpression = struct
   type nonrec t' = t' * Report.t list
   type state = { pos : S.pos; empty : bool }
   type t = state * Report.t list
 
-  let v : Get_type.t * t -> t' =
+  let v : Get_type.t Lazy.t * t -> t' =
    fun (type_of, (t, r)) ->
     ({ result = type_of; pos = t.pos; empty = t.empty }, r)
 
   (** The variable has type string when starting with a '$' *)
-  let ident : (S.pos, Get_type.t * t) S.variable -> Get_type.t -> t =
+  let ident :
+      (S.pos, Get_type.t Lazy.t * t) S.variable -> Get_type.t Lazy.t -> t =
    fun var _type_of ->
     let empty = false in
 
@@ -166,7 +167,7 @@ module TypedExpression = struct
     in
     ({ pos = var.pos; empty }, report)
 
-  let integer : S.pos -> string -> Get_type.t -> t =
+  let integer : S.pos -> string -> Get_type.t Lazy.t -> t =
    fun pos value _type_of ->
     let int_value = int_of_string_opt value in
 
@@ -179,7 +180,9 @@ module TypedExpression = struct
 
     ({ pos; empty }, report)
 
-  let literal : S.pos -> (Get_type.t * t) T.literal list -> Get_type.t -> t =
+  let literal :
+      S.pos -> (Get_type.t Lazy.t * t) T.literal list -> Get_type.t Lazy.t -> t
+      =
    fun pos values type_of ->
     ignore type_of;
     let init = ({ pos; empty = true }, []) in
@@ -188,7 +191,7 @@ module TypedExpression = struct
         | T.Text t ->
             let empty = String.equal t String.empty in
             ({ pos; empty }, report)
-        | T.Expression (t : (Get_type.t * t) list) ->
+        | T.Expression (t : (Get_type.t Lazy.t * t) list) ->
             (* Report the warning bottom top *)
             let result, r =
               List.fold_left t ~init:(None, [])
@@ -207,7 +210,11 @@ module TypedExpression = struct
     result
 
   let function_ :
-      S.pos -> T.function_ -> (Get_type.t * t) list -> Get_type.t -> t =
+      S.pos ->
+      T.function_ ->
+      (Get_type.t Lazy.t * t) list ->
+      Get_type.t Lazy.t ->
+      t =
    fun pos function_ params _type_of ->
     (* Accumulate the expressions and get the results, the report is given in
        the differents arguments, and we build a list with the type of the
@@ -297,7 +304,8 @@ module TypedExpression = struct
         (default, report)
 
   (** Unary operator like [-123] or [+'Text']*)
-  let uoperator : S.pos -> T.uoperator -> Get_type.t * t -> Get_type.t -> t =
+  let uoperator :
+      S.pos -> T.uoperator -> Get_type.t Lazy.t * t -> Get_type.t Lazy.t -> t =
    fun pos operator t1 type_of ->
     ignore type_of;
     let type_of, (t, report) = t1 in
@@ -312,9 +320,9 @@ module TypedExpression = struct
   let boperator :
       S.pos ->
       T.boperator ->
-      Get_type.t * t ->
-      Get_type.t * t ->
-      Get_type.t ->
+      Get_type.t Lazy.t * t ->
+      Get_type.t Lazy.t * t ->
+      Get_type.t Lazy.t ->
       t =
    fun pos operator (type_1, t1) (type_2, t2) type_of ->
     ignore type_of;
@@ -457,7 +465,7 @@ module Instruction = struct
     match right_expression.empty with
     | true -> report
     | false -> (
-        let var_type = Get_type.ident variable in
+        let var_type = Lazy.from_val (Get_type.ident variable) in
         let op1 = arg_of_repr var_type variable.pos in
         let op2 = arg_of_repr right_expression.result right_expression.pos in