From 4b2618e0711b0abd01766d5a2ab6fd3190753634 Mon Sep 17 00:00:00 2001 From: ygrek Date: Thu, 6 Aug 2015 22:43:59 -0700 Subject: [PATCH] fix typing of SELECT in expression --- lib/prelude.ml | 1 + lib/sql.ml | 3 ++- lib/sql_parser.mly | 31 ++++++++++++++----------------- lib/syntax.ml | 40 ++++++++++++++++++---------------------- 4 files changed, 35 insertions(+), 40 deletions(-) diff --git a/lib/prelude.ml b/lib/prelude.ml index e6cdd70..a795a92 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -6,3 +6,4 @@ let flip f x y = f y x let fail fmt = Printf.ksprintf failwith fmt let printfn fmt = Printf.ksprintf print_endline fmt +let eprintfn fmt = Printf.ksprintf prerr_endline fmt diff --git a/lib/sql.ml b/lib/sql.ml index d1b7028..c138a6e 100644 --- a/lib/sql.ml +++ b/lib/sql.ml @@ -195,7 +195,8 @@ and select_full = select * select list * expr list * limit option and expr = | Value of Type.t (** literal value *) | Param of param - | Fun of Type.func * expr list (** parameters *) * [ `Single of select_full | `Select of select_full | `None ] + | Fun of Type.func * expr list (** parameters *) + | Select of select_full * bool (* single *) | Column of (string * string option) (** name, table *) and column = | All diff --git a/lib/sql_parser.mly b/lib/sql_parser.mly index c97f4d8..4607f87 100644 --- a/lib/sql_parser.mly +++ b/lib/sql_parser.mly @@ -272,15 +272,15 @@ attr_name: name=IDENT { (name,None) } | IDENT DOT table=IDENT DOT name=IDENT { (name,Some table) } (* FIXME database identifier *) expr: - expr numeric_bin_op expr %prec PLUS { Fun ((Ret Any),[$1;$3],`None) } (* TODO default Int *) - | expr boolean_bin_op expr %prec AND { Fun ((Func (Bool,[Bool;Bool])),[$1;$3],`None) } - | e1=expr comparison_op anyall? e2=expr %prec EQUAL { Fun ((Poly Bool),[e1;e2],`None) } - | expr CONCAT_OP expr { Fun ((Func (Text,[Text;Text])),[$1;$3],`None) } + expr numeric_bin_op expr %prec PLUS { Fun ((Ret Any),[$1;$3]) } (* TODO default Int *) + | expr boolean_bin_op expr %prec AND { Fun ((Func (Bool,[Bool;Bool])),[$1;$3]) } + | e1=expr comparison_op anyall? e2=expr %prec EQUAL { Fun ((Poly Bool),[e1;e2]) } + | expr CONCAT_OP expr { Fun ((Func (Text,[Text;Text])),[$1;$3]) } | e1=expr mnot(like) e2=expr e3=escape? { match e3 with - | None -> Fun ((Func (Bool, [Text; Text])), [e1;e2], `None) - | Some e3 -> Fun ((Func (Bool, [Text; Text; Text])), [e1;e2;e3], `None) + | None -> Fun ((Func (Bool, [Text; Text])), [e1;e2]) + | Some e3 -> Fun ((Func (Bool, [Text; Text; Text])), [e1;e2;e3]) } | unary_op expr { $2 } | MINUS expr %prec UNARY_MINUS { $2 } @@ -288,25 +288,22 @@ expr: | LPAREN expr RPAREN { $2 } | attr_name { Column $1 } | v=literal_value | v=datetime_value { v } - | e1=expr mnot(IN) l=sequence(expr) { Fun ((Poly Bool),e1::l,`None) } + | e1=expr mnot(IN) l=sequence(expr) { Fun ((Poly Bool),e1::l) } | e1=expr mnot(IN) LPAREN select=select_stmt RPAREN { - Fun ((Poly Bool),[e1],`Single select) + Fun ((Poly Bool),[e1; Select (select, true)]) } | e1=expr IN table=IDENT { Tables.check table; e1 } - | LPAREN select=select_stmt RPAREN - { - Fun ((Ret Any),[],`Single select) (* FIXME typeof select *) - } + | LPAREN select=select_stmt RPAREN { Select (select, true) } | PARAM { Param ($1,Any) } - | f=FUNCTION LPAREN p=func_params RPAREN { Fun (f,p,`None) } - | expr IS NOT? NULL { Fun (Ret Bool, [$1], `None) } - | expr mnot(BETWEEN) expr AND expr { Fun ((Poly Bool),[$1;$3;$5],`None) } - | mnot(EXISTS) LPAREN select=select_stmt RPAREN { Fun ((Ret Bool),[],`Select select) } (* FIXME Poly Bool *) + | f=FUNCTION LPAREN p=func_params RPAREN { Fun (f,p) } + | expr IS NOT? NULL { Fun (Ret Bool, [$1]) } + | expr mnot(BETWEEN) expr AND expr { Fun ((Poly Bool),[$1;$3;$5]) } + | mnot(EXISTS) LPAREN select=select_stmt RPAREN { Fun ((Ret Bool),[Select (select,false)]) } (* FIXME Poly Bool *) | CASE e1=expr? branches=nonempty_list(case_branch) e2=preceded(ELSE,expr)? END (* FIXME typing *) { let l = function None -> [] | Some x -> [x] in - Fun ((Ret Any),l e1 @ List.flatten branches @ l e2, `None) + Fun ((Ret Any),l e1 @ List.flatten branches @ l e2) } case_branch: WHEN e1=expr THEN e2=expr { [e1;e2] } diff --git a/lib/syntax.ml b/lib/syntax.ml index 13a46b4..28afa85 100644 --- a/lib/syntax.ml +++ b/lib/syntax.ml @@ -35,7 +35,7 @@ let get_params_q e = let test_all_grouping columns = let test = function (* grouping function of zero or single parameter *) - | Expr (Fun (func,args,_),_) when Type.is_grouping func && List.length args <= 1 -> true + | Expr (Fun (func,args),_) when Type.is_grouping func && List.length args <= 1 -> true | _ -> false in List.for_all test columns @@ -60,7 +60,7 @@ let split_column_assignments tables l = in (* hint expression to unify with the column type *) let typ = (Schema.find schema cname).domain in - exprs := (Fun (Type.(Ret Any), [Value typ;expr], `None)) :: !exprs) l; + exprs := (Fun (Type.(Ret Any), [Value typ;expr])) :: !exprs) l; (List.rev !cols, List.rev !exprs) (** replace every Column with Value of corresponding type *) @@ -78,9 +78,15 @@ let rec resolve_columns tables joined_schema expr = let attr = Schema.find (Option.map_default schema_of_table joined_schema table) name in `Value attr.domain | Param x -> `Param x - | Fun (r,l,select) -> - let p = params_of_select {tables} select in - `Func (r,p @ List.map each l) + | Fun (r,l) -> + `Func (r,List.map each l) + | Select (select,single) -> + let as_params = List.map (fun x -> `Param x) in + let (schema,p,_) = eval_select_full {tables} select in + match schema,single with + | [ {domain;_} ], true -> `Func (Type.Ret domain, as_params p) + | s, true -> raise (Schema.Error (s, "only one column allowed for SELECT operator in this expression")) + | _ -> fail "not implemented: multi-column select in expression" in each expr @@ -133,8 +139,8 @@ and resolve_types tables joined_schema expr = assign_types expr with exn -> - printfn "resolve_types failed with %s at:" (Printexc.to_string exn); - printfn "%s" (show_expr_q expr); + eprintfn "resolve_types failed with %s at:" (Printexc.to_string exn); + eprintfn "%s" (show_expr_q expr); raise exn and infer_schema columns tables joined_schema = @@ -157,8 +163,8 @@ and infer_schema columns tables joined_schema = and test_all_const columns = let rec is_const = function - | Fun (_,args,`None) -> List.for_all is_const args - | Fun (_,_,_) -> false (* FIXME ? *) + | Fun (_,args) -> List.for_all is_const args + | Select _ -> false (* FIXME ? *) | Column _ -> false | _ -> true in @@ -224,9 +230,9 @@ and ensure_simple_expr = function | Value x -> `Value x | Param x -> `Param x | Column _ -> failwith "Not a simple expression" - | Fun (func,_,_) when Type.is_grouping func -> failwith "Grouping function not allowed in simple expression" - | Fun (x,l,`None) -> `Func (x,List.map ensure_simple_expr l) (* FIXME *) - | Fun (_,_,_) -> failwith "not implemented : ensure_simple_expr with SELECT" + | Fun (func,_) when Type.is_grouping func -> failwith "Grouping function not allowed in simple expression" + | Fun (x,l) -> `Func (x,List.map ensure_simple_expr l) (* FIXME *) + | Select _ -> failwith "not implemented : ensure_simple_expr for SELECT" and eval_select env { columns; from; where; group; having; } = let (tbls,p2,joined_schema) = @@ -272,16 +278,6 @@ and eval_select_full env (select,other,order,limit) = else cardinality in final_schema,(p1@(List.flatten p2l)@p3@p4), Stmt.Select cardinality -and params_of_select env s = - let make = List.map (fun x -> `Param x) in - match s with - | `None -> [] - | `Select s -> let (_,p,_) = eval_select_full env s in make p - | `Single select -> - match eval_select_full env select with - | [_],p,_ -> make p - | s,_,_ -> raise (Schema.Error (s,"only one column allowed for SELECT operator in this expression")) - let update_tables tables ss w = let (tables,params) = List.split tables in -- 2.11.4.GIT