1 files changed, 109 insertions, 0 deletions
diff --git a/expression.ml b/expression.ml
new file mode 100755
index 0000000..f516463
--- /dev/null
+++ b/expression.ml
@@ -0,0 +1,109 @@
+module C = Catalog
+
+module Calendar = CalendarLib.Calendar.Precise
+
+let u = UTF8.from_utf8string
+
+type t =
+  | Basic of ScTypes.types            (** A direct type *)
+  | Formula of formula                (** A formula *)
+
+and formula =
+  | Expression of ScTypes.expression  (** A valid expression *)
+  | Error of int * UTF8.t             (** When the expression cannot be parsed *)
+
+
+let is_defined = function
+  | Basic ScTypes.Undefined -> false
+  | _ -> true
+
+let load content = begin
+  let content = UTF8.to_utf8string content in
+  if String.length content > 0 then (
+    if content.[0] = '=' then (
+      (* If the string start with a '=', load it as a formula *)
+      Formula (
+        try
+          Expression (
+               Lexing.from_string content
+            |> ExpressionParser.value ExpressionLexer.read)
+        with _ -> Error (1, UTF8.from_utf8string content)
+      )
+    ) else (
+      (* First try to load the data with basic types, and fallback with string *)
+      let content' =
+        try String.sub content 0 (String.index content '\000')
+        with Not_found -> content in
+      Basic (
+        (*try       ScTypes.Num (Tools.Num.of_float_string content')*)
+        try       Lexing.from_string content'
+                |> ExpressionParser.content ExpressionLexer.read
+        with _ -> ScTypes.Str (UTF8.from_utf8string content')
+      )
+    )
+  ) else (
+    (* If the string in empty, build an undefined value *)
+    Basic ScTypes.Undefined
+  )
+end
+
+let load_expr expr = expr
+
+(** Extract the parameters to give to a function.
+    return an Error if one of them is an error
+ *)
+let eval expr sources = begin
+
+  let rec eval_exp: ScTypes.expression -> ScTypes.types = function
+    | ScTypes.Value v -> v
+    | ScTypes.Call (ident, params) -> C.eval ident (List.map eval_exp params)
+    | ScTypes.Ref r -> sources r
+    | ScTypes.Expression expr -> eval_exp expr
+  in
+
+  begin try match expr with
+    | Basic value -> ScTypes.Result value
+    | Formula (Expression f) -> ScTypes.Result (eval_exp f)
+    | Formula (Error (i, s)) -> ScTypes.Error ScTypes.Error
+    with ex -> ScTypes.Error ex
+  end
+
+end
+
+let collect_sources expr = begin
+  let rec collect refs = function
+    | ScTypes.Ref r -> Cell.Set.union refs (Cell.Set.of_list @@ ScTypes.Refs.collect r)
+    | ScTypes.Call (ident, params) -> List.fold_left collect refs params
+    | ScTypes.Expression f -> collect refs f
+    | _ -> refs
+  in match expr with
+  | Formula (Expression f) -> collect Cell.Set.empty f
+  | _ -> Cell.Set.empty
+end
+
+let show e =
+  let buffer = UTF8.Buffer.create 16 in
+  begin match e with
+  | Formula (Expression f) ->
+      UTF8.Buffer.add_char buffer '=';
+      ScTypes.show_expr buffer f
+  | Basic b -> ScTypes.Type.show buffer b
+  | Formula (Error (i,s)) -> UTF8.Buffer.add_string buffer s
+  end;
+  UTF8.Buffer.contents buffer
+
+let shift vector =
+
+  let rec shift_exp: ScTypes.expression -> ScTypes.expression = function
+    | ScTypes.Value v -> ScTypes.Value v
+    | ScTypes.Call (ident, params) -> ScTypes.Call (ident, List.map shift_exp params)
+    | ScTypes.Ref r -> ScTypes.Ref (ScTypes.Refs.shift vector r)
+    | ScTypes.Expression expr -> ScTypes.Expression (shift_exp expr)
+
+  in function
+  | Formula (Expression f) -> Formula (Expression (shift_exp f))
+  | other -> other
+
+let (=) t1 t2 = match t1, t2 with
+  | Basic b1, Basic b2 -> ScTypes.Type.(=) b1 b2
+  | o1, o2 -> Pervasives.(=) o1 o2