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.repr 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 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