From e82962fe44c35b5ae6e6a68e8719e5d77aaf9e55 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Mon, 6 Nov 2017 17:39:53 +0100 Subject: Simplify type deduction --- evaluator.ml | 110 ++++++++++++++++------------------------------------------- 1 file changed, 29 insertions(+), 81 deletions(-) (limited to 'evaluator.ml') diff --git a/evaluator.ml b/evaluator.ml index 8862b3a..a5f3380 100755 --- a/evaluator.ml +++ b/evaluator.ml @@ -50,24 +50,12 @@ fun printer typ -> match typ with type 'a returnType = 'a ScTypes.returnType -let specialize_result: type a. a ScTypes.returnType -> a ScTypes.dataFormat -> a ScTypes.returnType = - begin fun a b -> match a, b with - | ScTypes.Num (Some ScTypes.Date) as _1, _ -> _1 - | _, ScTypes.Date -> ScTypes.Num (Some ScTypes.Date) - | x, y -> x -end - -let typ_of_result: type a. a ScTypes.returnType -> a typ = function - | ScTypes.Num _ -> Num - | ScTypes.Bool -> Bool - | ScTypes.Str -> String - (*** Values definitions *) type 'a value = | Bool: D.Bool.t -> D.Bool.t value | Num: D.Num.t ScTypes.dataFormat * D.Num.t -> D.Num.t value - | String: UTF8.t -> UTF8.t value + | String: UTF8.t -> UTF8.t value | List: 'a ScTypes.dataFormat * 'a list -> 'a list value | Matrix: 'a ScTypes.dataFormat * 'a list list -> 'a list list value @@ -87,45 +75,6 @@ let type_of_value: type a. a value -> a typ = function | List (t, l) -> List (typ_of_format t) | Matrix (t, l) -> List (List (typ_of_format t)) -let inject': - type a. a ScTypes.returnType -> (unit -> a ScTypes.dataFormat) -> a -> a value = - fun resultFormat f res -> begin match resultFormat, res with - | ScTypes.Bool, x -> Bool x - | ScTypes.Str, s -> String s - | ScTypes.Num None, x -> Num (f (), x) - | ScTypes.Num (Some v), x -> Num(v, x) - end - -let compare_format: type a b. a typ -> a ScTypes.returnType -> b value -> a ScTypes.returnType = begin -fun init_typ currentResult value -> - - (* If the argument as the same type as the result format, just select the most specialized *) - match compare_typ init_typ (type_of_value value) with - | T.Eq -> begin match value with - | Bool b -> ScTypes.Bool - | String s -> ScTypes.Str - | Num (f, v) -> specialize_result currentResult f - (* There is no possibility to get init_typ as List typ *) - | List (f, v) -> raise Errors.TypeError - | Matrix (f, v) -> raise Errors.TypeError - end - (* The types differ, handle the special cases for Lists *) - | _ -> - begin match value with - | List (f, v) -> - begin match compare_typ init_typ (typ_of_format f) with - | T.Eq -> specialize_result currentResult f - | _ -> currentResult - end - | Matrix (f, v) -> - begin match compare_typ init_typ (typ_of_format f) with - | T.Eq -> specialize_result currentResult f - | _ -> currentResult - end - | _ -> currentResult - end - end - end module C = Catalog.Make(Data) @@ -142,34 +91,29 @@ let repr = C.repr type existencialResult = | Result : 'a Data.value -> existencialResult [@@unboxed] -(** Guess the format to use for the result function from the arguments given. - The most specialized format take over the others. -*) -let guess_format_result: -type a. a ScTypes.returnType -> existencialResult list -> unit -> a Data.dataFormat = -begin fun init_value values () -> - - let init_typ:a Data.typ = Data.typ_of_result init_value in - - (* fold over the arguments, and check if they have the same format *) - let compare_format: a ScTypes.returnType -> existencialResult -> a ScTypes.returnType = - fun currentResult (Result value) -> - Data.compare_format init_typ currentResult value in - - begin match List.fold_left compare_format init_value values with - | ScTypes.Str -> ScTypes.String - | ScTypes.Bool -> ScTypes.Bool - | ScTypes.Num None-> ScTypes.Number - | ScTypes.Num (Some x)-> x +let inject: +type a. a Data.dataFormat -> a -> existencialResult = fun resultFormat res -> + begin match resultFormat with + | ScTypes.Bool -> Result (Data.Bool res) + | ScTypes.String -> Result (Data.String res) + | ScTypes.Number -> Result (Data.Num (resultFormat, res)) + | ScTypes.Date -> Result (Data.Num (resultFormat, res)) end -end -let inject: -type a. a Data.returnType -> (unit -> a Data.dataFormat) -> a -> existencialResult = -fun resultFormat f res -> - let (x:a Data.value) = Data.inject' resultFormat f res in - Result x +(** Extract the format from a list of results *) +let build_format_list ll () = + + List.map (fun (Result x) -> + begin match x with + | Data.Bool _ -> ScTypes.DataFormat.F (ScTypes.Bool) + | Data.Num (x, _) -> ScTypes.DataFormat.F x + | Data.String _ -> ScTypes.DataFormat.F (ScTypes.String) + | Data.List (f, _) -> ScTypes.DataFormat.F f + | Data.Matrix (f, _) -> ScTypes.DataFormat.F f + end + ) ll + let register0 name returnType f = catalog := C.register !catalog name (C.T1(Data.Unit)) (C.Fn1 (returnType, f)) @@ -188,22 +132,26 @@ let call name args = begin begin try match args with | [] -> let C.Fn1(ret, f) = C.find_function !catalog name' (C.T1 Data.Unit) in - inject ret (fun () -> raise Errors.TypeError) (f ()) + let returnType = ScTypes.DataFormat.guess_format_result ret (fun () -> raise Errors.TypeError) in + inject returnType (f ()) | (Result p1)::[] -> let C.Fn1(ret, f) = C.find_function !catalog name' (C.T1 (Data.type_of_value p1)) in - inject ret (guess_format_result ret args) (f (Data.get_value_content p1)) + let returnType = ScTypes.DataFormat.guess_format_result ret (build_format_list args) in + inject returnType (f (Data.get_value_content p1)) | (Result p1)::(Result p2)::[] -> let C.Fn2(ret, f) = C.find_function !catalog name' (C.T2 (Data.type_of_value p1, Data.type_of_value p2)) in - inject ret (guess_format_result ret args) (f (Data.get_value_content p1) (Data.get_value_content p2)) + let returnType = ScTypes.DataFormat.guess_format_result ret (build_format_list args) in + inject returnType (f (Data.get_value_content p1) (Data.get_value_content p2)) | (Result p1)::(Result p2)::(Result p3)::[] -> let C.Fn3(ret, f) = C.find_function !catalog name' (C.T3 (Data.type_of_value p1, Data.type_of_value p2, Data.type_of_value p3)) in - inject ret (guess_format_result ret args) (f (Data.get_value_content p1) (Data.get_value_content p2) (Data.get_value_content p3)) + let returnType = ScTypes.DataFormat.guess_format_result ret (build_format_list args) in + inject returnType (f (Data.get_value_content p1) (Data.get_value_content p2) (Data.get_value_content p3)) | _ -> raise Not_found with Not_found -> -- cgit v1.2.3