aboutsummaryrefslogtreecommitdiff
path: root/lib/syntax/compose.ml
diff options
context:
space:
mode:
authorChimrod <>2024-12-02 09:05:18 +0100
committerChimrod <>2024-12-02 09:05:18 +0100
commit53c02501935b3cb2db78e79deb4d38c997505a95 (patch)
tree88a75e012ee186ffb6c6e3e0c53ba80610ec3b0b /lib/syntax/compose.ml
parent9e7b9de243e488e15d2c7528ce64e569eba8add2 (diff)
Moved the checks in a dedicated library
Diffstat (limited to 'lib/syntax/compose.ml')
-rw-r--r--lib/syntax/compose.ml125
1 files changed, 0 insertions, 125 deletions
diff --git a/lib/syntax/compose.ml b/lib/syntax/compose.ml
deleted file mode 100644
index 8c92ed0..0000000
--- a/lib/syntax/compose.ml
+++ /dev/null
@@ -1,125 +0,0 @@
-(** Build a module with the result from another one module *)
-
-open StdLabels
-
-(** 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