aboutsummaryrefslogtreecommitdiff
path: root/src/expressions
diff options
context:
space:
mode:
Diffstat (limited to 'src/expressions')
-rw-r--r--[-rwxr-xr-x]src/expressions/collect_sources.ml29
-rw-r--r--[-rwxr-xr-x]src/expressions/evaluate.ml80
-rw-r--r--src/expressions/id_type.ml15
-rw-r--r--src/expressions/shift_expr.ml67
-rw-r--r--[-rwxr-xr-x]src/expressions/show_expr.ml19
-rw-r--r--[-rwxr-xr-x]src/expressions/sym_expr.ml20
6 files changed, 156 insertions, 74 deletions
diff --git a/src/expressions/collect_sources.ml b/src/expressions/collect_sources.ml
index 32b40be..9698057 100755..100644
--- a/src/expressions/collect_sources.ml
+++ b/src/expressions/collect_sources.ml
@@ -29,7 +29,7 @@ module T = struct
let bool b = ()
- let observe () x = x
+ let observe : unit -> 'a -> 'a = fun () x -> x
end
@@ -39,7 +39,8 @@ module R = struct
type 'a t = 'a obs
- let cell (c:Cell.t) set = Cell.Set.add (Cell.to_pair c) set
+ let cell : Cell.t -> Cell.Set.t -> Cell.Set.t =
+ fun c set -> Cell.Set.add (Cell.to_pair c) set
let range c1 c2 set = begin
@@ -60,27 +61,25 @@ module R = struct
end
-let observe f value = f value
-
-let value v () = T.observe v
+type obs = Cell.Set.t -> Cell.Set.t
-let ref r () = R.observe r
+type t = obs
-let call0 ident () acc = acc
+let observe (f:obs) (value :Cell.Set.t) = f value
-let call1 ident p1 () acc = observe p1 acc
+let value v acc = T.observe v acc
-let call2 ident p1 p2 () acc = observe p2 (observe p1 acc)
+let ref r acc = R.observe r acc
-let call3 ident p1 p2 p3 () acc = observe p3 (observe p2 (observe p1 acc))
+let call0 ident acc = acc
-let callN ident params () acc = List.fold_left (fun acc p -> observe p acc) acc params
+let call1 ident p1 acc = observe p1 acc
-let expression e () = e
+let call2 ident p1 p2 acc = observe p2 (observe p1 acc)
-type obs = Cell.Set.t -> Cell.Set.t
+let call3 ident p1 p2 p3 acc = observe p3 (observe p2 (observe p1 acc))
-type t = unit
+let callN ident params acc = List.fold_left (fun acc p -> observe p acc) acc params
-type repr = obs
+let expression e acc = e acc
diff --git a/src/expressions/evaluate.ml b/src/expressions/evaluate.ml
index ff44097..fbf2a18 100755..100644
--- a/src/expressions/evaluate.ml
+++ b/src/expressions/evaluate.ml
@@ -26,12 +26,6 @@ type 'a value =
type existencialResult =
| Result : 'a value -> existencialResult [@@unboxed]
-type t = (Functions.C.t * (int * int -> ScTypes.Result.t option))
-
-type repr = existencialResult
-
-type obs = ScTypes.Result.t
-
module T:Sym_type.SYM_TYPE with type 'a obs = existencialResult = struct
type 'a t = 'a value
@@ -50,6 +44,12 @@ module T:Sym_type.SYM_TYPE with type 'a obs = existencialResult = struct
end
+type dic = (Functions.C.t * (int * int -> ScTypes.Result.t option))
+
+type t = dic -> existencialResult
+
+type obs = dic -> ScTypes.Result.t
+
module R = Eval_ref
(** Extract the type and the content from a value *)
@@ -97,63 +97,67 @@ let ref r (_, mapper) = begin
| R.Matrix (t, l) -> Result (Matrix(t, l))
end
+let observe repr catalog = begin
+ let Result r = repr catalog in match r with
+ | Bool b -> ScTypes.Result.Ok (ScTypes.Type.boolean b)
+ | String s -> ScTypes.Result.Ok (ScTypes.Type.string s)
+ | Num (format, n) ->
+ begin match format with
+ (* We can only match numeric formats here *)
+ | ScTypes.DataFormat.Date -> ScTypes.Result.Ok (ScTypes.Type.date n)
+ | ScTypes.DataFormat.Number -> ScTypes.Result.Ok (ScTypes.Type.number n)
+ end
+ | _ -> raise Errors.TypeError
+end
+
+let expression e = e
+
let call0 ident (catalog, _) =
let name' = UTF8.to_utf8string ident in
- let arg1 = (Functions.t_unit, ()) in
+ let (arg1:(unit Functions.C.argument * unit)) = (Functions.t_unit, ()) in
wrap_call
(Functions.C.eval1 catalog name' arg1)
(fun () -> raise Errors.TypeError)
-let call1 ident p1 (catalog, _) =
+let call1 ident p1 ((catalog, _) as c) =
let name' = UTF8.to_utf8string ident in
- let (Result r1) = p1 in
+ (* Evaluate here p1 expression *)
+ let (Result r1) = p1 c in
let arg1 = get_argument r1 in
wrap_call
(Functions.C.eval1 catalog name' arg1)
- (fun () -> build_format_list [p1])
+ (fun () -> build_format_list [Result r1])
-let call2 ident p1 p2 (catalog, _) =
+let call2 ident p1 p2 ((catalog, _) as c) =
let name' = UTF8.to_utf8string ident in
- let (Result r1) = p1 in
- let (Result r2) = p2 in
+ let (Result r1) = p1 c in
+ let (Result r2) = p2 c in
let arg1 = get_argument r1
and arg2 = get_argument r2 in
wrap_call
(Functions.C.eval2 catalog name' arg1 arg2)
- (fun () -> build_format_list [p1; p2])
+ (fun () -> build_format_list [Result r1; Result r2])
-let call3 ident p1 p2 p3 (catalog, _) =
+let call3 ident p1 p2 p3 ((catalog, _) as c) =
let name' = UTF8.to_utf8string ident in
- let (Result r1) = p1 in
- let (Result r2) = p2 in
- let (Result r3) = p3 in
+ let (Result r1) = p1 c in
+ let (Result r2) = p2 c in
+ let (Result r3) = p3 c in
let arg1 = get_argument r1
and arg2 = get_argument r2
and arg3 = get_argument r3 in
wrap_call
(Functions.C.eval3 catalog name' arg1 arg2 arg3)
- (fun () -> build_format_list [p1; p2 ; p3])
+ (fun () -> build_format_list [Result r1; Result r2; Result r3])
-let callN ident params (catalog, _) =
- let signature = List.map (fun (Result r) ->
+let callN ident params ((catalog, _) as c) =
+
+ let map_params expression = begin
+ let (Result r) = expression c in
let formatter = Format.str_formatter in
Functions.repr formatter (fst @@ get_argument r);
- Format.flush_str_formatter ()) params in
+ Format.flush_str_formatter ()
+ end in
+ let signature = List.map map_params params in
raise (Errors.Undefined (ident, signature))
-let expression e _ = e
-
-let observe repr = begin
- let Result r = repr in match r with
- | Bool b -> ScTypes.Result.Ok (ScTypes.Type.boolean b)
- | String s -> ScTypes.Result.Ok (ScTypes.Type.string s)
- | Num (format, n) ->
- begin match format with
- (* We can only match numeric formats here *)
- | ScTypes.DataFormat.Date -> ScTypes.Result.Ok (ScTypes.Type.date n)
- | ScTypes.DataFormat.Number -> ScTypes.Result.Ok (ScTypes.Type.number n)
- end
- | _ -> raise Errors.TypeError
-
-end
-
diff --git a/src/expressions/id_type.ml b/src/expressions/id_type.ml
new file mode 100644
index 0000000..d84ddfa
--- /dev/null
+++ b/src/expressions/id_type.ml
@@ -0,0 +1,15 @@
+type 'a t = 'a ScTypes.Type.t
+
+type 'a obs = 'a ScTypes.Type.t
+
+let str s = ScTypes.Type.string s
+
+let num n = ScTypes.Type.number n
+
+let date d = ScTypes.Type.date d
+
+let bool b = ScTypes.Type.boolean b
+
+let observe x = x
+
+
diff --git a/src/expressions/shift_expr.ml b/src/expressions/shift_expr.ml
new file mode 100644
index 0000000..17cce95
--- /dev/null
+++ b/src/expressions/shift_expr.ml
@@ -0,0 +1,67 @@
+(*
+This file is part of licht.
+
+licht is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
+
+licht is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with licht. If not, see <http://www.gnu.org/licenses/>.
+*)
+
+module Shift_Ref = struct
+
+ type 'a t = (int * int) -> ScTypes.Refs.t
+ type 'a obs = (int * int) -> ScTypes.Refs.t
+
+ let _shift (vector_x, vector_y) ((x, y), (fixed_x, fixed_y)) =
+ let x' = if fixed_x then x else x + vector_x
+ and y' = if fixed_y then y else y + vector_y in
+ (x', y'), (fixed_x, fixed_y)
+
+ let cell t shift =
+ ScTypes.Refs.cell (_shift shift t)
+
+
+ let range c1 c2 shift =
+ ScTypes.Refs.range (_shift shift c1) (_shift shift c2)
+
+ let observe elem shift = elem shift
+
+end
+
+module Shift_Expr = struct
+
+ type t = (int * int) -> ScTypes.Expr.t
+ type obs = (int * int) -> ScTypes.Expr.t
+
+ module R = Shift_Ref
+ module T = Id_type
+
+ let observe f x = f x
+
+ let value t vector = ScTypes.Expr.value (T.observe t)
+
+ let ref r vector = ScTypes.Expr.ref (R.observe r vector)
+
+ let call0 ident vector = ScTypes.Expr.call0 ident
+
+ let call1 ident p1 vector = ScTypes.Expr.call1 ident (observe p1 vector)
+
+ let call2 ident p1 p2 vector = ScTypes.Expr.call2 ident (observe p1 vector) (observe p2 vector)
+
+ let call3 ident p1 p2 p3 vector = ScTypes.Expr.call3 ident (observe p1 vector) (observe p2 vector) (observe p3 vector)
+
+ let expression e vector = ScTypes.Expr.expression (observe e vector)
+
+ let callN ident (params: t list) vector = ScTypes.Expr.callN ident (List.map (fun x -> observe x vector) params)
+
+end
+
+include Shift_Expr
diff --git a/src/expressions/show_expr.ml b/src/expressions/show_expr.ml
index c283162..a191d2d 100755..100644
--- a/src/expressions/show_expr.ml
+++ b/src/expressions/show_expr.ml
@@ -24,27 +24,26 @@ module Show_Expr
module T = T
module R = R
- type t = unit
- type repr = UTF8.Buffer.buffer -> unit
+ type t = UTF8.Buffer.buffer -> unit
type obs = UTF8.Buffer.buffer -> unit
let observe buffer value = buffer value
- let value v () buffer = T.observe v buffer
+ let value v buffer = T.observe v buffer
- let ref r () buffer = R.observe r buffer
+ let ref r buffer = R.observe r buffer
- let call0 ident () buffer =
+ let call0 ident buffer =
let utf8ident = UTF8.to_utf8string ident in
UTF8.Printf.bprintf buffer "%s()" utf8ident
- let call1 ident p1 () buffer =
+ let call1 ident p1 buffer =
let utf8ident = UTF8.to_utf8string ident in
UTF8.Printf.bprintf buffer "%s(%a)"
utf8ident
(fun x b -> observe b x) p1
- let call2 ident p1 p2 () buffer =
+ let call2 ident p1 p2 buffer =
let utf8ident = UTF8.to_utf8string ident in
begin match utf8ident with
| "+" | "*" | "-" | "/" | "^" | "="
@@ -60,7 +59,7 @@ module Show_Expr
(fun x b -> observe b x) p2
end
- let call3 ident p1 p2 p3 () buffer =
+ let call3 ident p1 p2 p3 buffer =
let utf8ident = UTF8.to_utf8string ident in
UTF8.Printf.bprintf buffer "%s(%a;%a;%a)"
utf8ident
@@ -68,11 +67,11 @@ module Show_Expr
(fun x b -> observe b x) p2
(fun x b -> observe b x) p3
- let callN ident (params: repr list) () buffer =
+ let callN ident (params: t list) buffer =
UTF8.Buffer.add_string buffer ident;
Tools.List.printb ~sep:(u";") (fun buffer value -> value buffer) buffer params
- let expression e () buffer =
+ let expression e buffer =
UTF8.Printf.bprintf buffer "(%a)"
(fun x b -> b x) e
diff --git a/src/expressions/sym_expr.ml b/src/expressions/sym_expr.ml
index 4f5d6a6..843b8a4 100755..100644
--- a/src/expressions/sym_expr.ml
+++ b/src/expressions/sym_expr.ml
@@ -23,26 +23,24 @@ module type SYM_EXPR = sig
type t
- type repr
-
type obs
- val value : 'a T.t -> t -> repr
+ val value : 'a T.t -> t
- val ref : 'a R.t -> t -> repr
+ val ref : 'a R.t -> t
- val call0 : UTF8.t -> t -> repr
+ val call0 : UTF8.t -> t
- val call1 : UTF8.t -> repr -> t -> repr
+ val call1 : UTF8.t -> t -> t
- val call2 : UTF8.t -> repr -> repr -> t -> repr
+ val call2 : UTF8.t -> t -> t -> t
- val call3 : UTF8.t -> repr -> repr -> repr -> t -> repr
+ val call3 : UTF8.t -> t -> t -> t -> t
- val callN: UTF8.t -> repr list -> t -> repr
+ val callN: UTF8.t -> t list -> t
- val expression : repr -> t -> repr
+ val expression : t -> t
- val observe : repr -> obs
+ val observe : t -> obs
end
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-26 08:08:25 +0000