From a6b5a6bdd138a5ccc6827bcc73580df1e9218820 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Fri, 24 Nov 2017 09:22:24 +0100
Subject: Moved all the code to src directory

---
 src/expression.ml | 114 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 114 insertions(+)
 create mode 100755 src/expression.ml

(limited to 'src/expression.ml')

diff --git a/src/expression.ml b/src/expression.ml
new file mode 100755
index 0000000..20227ad
--- /dev/null
+++ b/src/expression.ml
@@ -0,0 +1,114 @@
+module Tuple2 = Tools.Tuple2
+
+let u = UTF8.from_utf8string
+
+type t =
+  | Basic: 'a ScTypes.types -> t           (** A direct type *)
+  | Formula: formula -> t               (** A formula *)
+  | Undefined: t                         (** The content is not defined *)
+
+and formula =
+  | Expression of ScTypes.expression  (** A valid expression *)
+  | Error of int * UTF8.t             (** When the expression cannot be parsed *)
+
+
+let is_defined = function
+  | 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
+        try
+          let ScTypes.Result r =
+               ExpressionParser.content ExpressionLexer.read
+            @@ Lexing.from_string content' in
+          Basic r
+        with _ -> Basic (ScTypes.string (UTF8.from_utf8string content'))
+    )
+  ) else (
+    (* If the string in empty, build an undefined value *)
+    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 eval_exp f = Evaluator.eval sources f in
+
+  begin try match expr with
+    | Basic value -> ScTypes.Result value
+    | Formula (Expression f) -> eval_exp f
+    | Formula (Error (i, s)) -> ScTypes.Error ScTypes.Error
+    | Undefined -> ScTypes.Error Not_found
+    with ex -> ScTypes.Error ex
+  end
+
+end
+
+let collect_sources expr = begin
+  let rec collect refs = function
+    | ScTypes.Ref r ->
+        begin match ScTypes.Refs.collect r with
+        | ScTypes.Refs.Single r -> Cell.Set.add r refs
+        | ScTypes.Refs.Array1 a1 ->
+            List.fold_left (fun set elt -> Cell.Set.add elt set) refs a1
+        | ScTypes.Refs.Array2 a2 ->
+            List.fold_left (List.fold_left (fun set elt -> Cell.Set.add elt set)) refs a2
+        end
+    | 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_full buffer b
+  | Formula (Error (i,s)) -> UTF8.Buffer.add_string buffer s
+  | Undefined -> ()
+  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
-- 
cgit v1.2.3