(* 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 . *) module Tuple2 = Tools.Tuple2 let u = UTF8.from_utf8string type t = | Basic: 'a ScTypes.Type.t -> t (** A direct type *) | Formula: formula -> t (** A formula *) | Undefined: t (** The content is not defined *) and formula = | Expression of ScTypes.Expr.t (** 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.Ok r = ExpressionParser.content ExpressionLexer.read @@ Lexing.from_string content' in Basic r with _ -> Basic (ScTypes.Type.string (UTF8.from_utf8string content')) ) ) else ( (* If the string in empty, build an undefined value *) Undefined ) end let load_expr expr = expr module EvalExpr = ScTypes.Expr.Eval(Evaluate) (** Extract the parameters to give to a function. return an Error if one of them is an error *) let eval expr catalog mapper = begin begin try match expr with | Basic value -> ScTypes.Result.Ok value | Formula (Expression e) -> EvalExpr.eval e (catalog, mapper) | Formula (Error (i, s)) -> ScTypes.Result.Error ScTypes.Error | Undefined -> ScTypes.Result.Error Not_found with ex -> ScTypes.Result.Error ex end end module EvalSources = ScTypes.Expr.Eval(Collect_sources) let collect_sources = begin function | Formula (Expression f) -> EvalSources.eval f () Cell.Set.empty | _ -> Cell.Set.empty end module Printer = ScTypes.Expr.Eval(Show_expr.Show_Expr(Show_ref)(Show_type)) (** Inherit the default representation, but print the float with all decimals *) module LongPrinter = ScTypes.Type.Eval(struct include Show_type let num n buffer = if DataType.Num.is_integer n then DataType.Num.to_int n |> string_of_int |> UTF8.from_utf8string |> UTF8.Buffer.add_string buffer else let f = DataType.Num.to_float n and to_b = UTF8.Format.formatter_of_buffer buffer in ignore @@ UTF8.Format.fprintf to_b "%f" f; Format.pp_print_flush to_b () end) let show e = let buffer = UTF8.Buffer.create 16 in begin match e with | Formula (Expression f) -> UTF8.Buffer.add_char buffer '='; Printer.eval f () buffer | Basic b -> LongPrinter.eval b buffer | Formula (Error (i,s)) -> UTF8.Buffer.add_string buffer s | Undefined -> () end; UTF8.Buffer.contents buffer let shift vector = function | Formula (Expression f) -> Formula (Expression (ScTypes.Expr.shift_exp vector f)) | other -> other let (=) t1 t2 = match t1, t2 with | Basic b1, Basic b2 -> ScTypes.Type.(=) b1 b2 | o1, o2 -> Pervasives.(=) o1 o2