diff options
Diffstat (limited to 'lib/checks/compose.ml')
| -rw-r--r-- | lib/checks/compose.ml | 130 | 
1 files changed, 0 insertions, 130 deletions
| diff --git a/lib/checks/compose.ml b/lib/checks/compose.ml deleted file mode 100644 index b29c22e..0000000 --- a/lib/checks/compose.ml +++ /dev/null @@ -1,130 +0,0 @@ -(** Build a module with the result from another one module *) - -open StdLabels -module S = Qsp_syntax.S -module T = Qsp_syntax.T - -(** Make a module lazy *) -module Lazier (E : S.Expression) : -  S.Expression with type t' = E.t' Lazy.t and type t = E.t Lazy.t = struct -  type t = E.t Lazy.t -  type t' = E.t' Lazy.t - -  let v : E.t Lazy.t -> E.t' Lazy.t = Lazy.map E.v -  let integer : S.pos -> string -> t = fun pos i -> lazy (E.integer pos i) - -  let ident : (S.pos, t) S.variable -> t = -   fun { pos; name : string; index : t option } -> -    lazy (E.ident { pos; name; index = Option.map Lazy.force index }) - -  let literal : S.pos -> t T.literal list -> t = -   fun pos litts -> -    lazy -      (let e_litts = List.map litts ~f:(T.map_litteral ~f:Lazy.force) in -       E.literal pos e_litts) - -  let function_ : S.pos -> T.function_ -> t list -> t = -   fun pos f e -> -    lazy -      (let e' = List.map ~f:Lazy.force e in -       E.function_ pos f e') - -  let uoperator : S.pos -> T.uoperator -> t -> t = -   fun pos op t -> -    let t' = lazy (E.uoperator pos op (Lazy.force t)) in -    t' - -  let boperator : S.pos -> T.boperator -> t -> t -> t = -   fun pos op t1 t2 -> -    let t' = lazy (E.boperator pos op (Lazy.force t1) (Lazy.force t2)) in -    t' -end - -(** Build an expression module with the result from another expression. The -    signature of the fuctions is a bit different, as they all receive the result -    from the previous evaluated element in argument. *) -module Expression (E : S.Expression) = struct -  module type SIG = sig -    type t -    type t' - -    (* Override the type [t] in the definition of all the functions. The -       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' 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 - -  (* Create a lazy version of the module *) -  module E = Lazier (E) - -  module Make (M : SIG) : S.Expression with type t' = M.t' = struct -    type t = E.t * M.t -    type t' = M.t' - -    let v' : E.t -> E.t' = E.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) -> (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 (v' t')) - -    let literal : S.pos -> t T.literal list -> t = -     fun pos litts -> -      let litts' = -        List.map litts ~f:(T.map_litteral ~f:(fun (e, m) -> (v' e, m))) -      in - -      let t' = -        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) -> (v' e, m)) expressions in - -      let t' = 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 (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 (v' t1, expr1) (v' t2, expr2) (v' t')) -  end -end - -module TypeBuilder = Expression (Get_type) -(** Builder adding the type for the expression *) | 
