Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

WHERE IS NOT NULL influence type #129

Draft
wants to merge 5 commits into
base: null
Choose a base branch
from
+241 −62
Draft

WHERE IS NOT NULL influence type #129

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
8713222
use inferred schema instead of table schema
Feb 4, 2024
190c57f
add test
Feb 5, 2024
f0a8877
test out
Feb 5, 2024
fd6e2a4
is not null type re infer
Mar 1, 2024
a632a58
update ensure_res_expr
Mar 4, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
78 changes: 56 additions & 22 deletions lib/sql.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -164,7 +164,35 @@ struct
type t = attr list
[@@deriving show]

exception Error of t * string
exception Error of t * string

module Source = struct
module Attr = struct
type 'a t = { attr: attr; sources: 'a list } [@@deriving show]

let by_name name sattr = sattr.attr.name = name
end

type 'a t = 'a Attr.t list

let find_by_name t name = List.find_all (Attr.by_name name) t

let find t name =
match find_by_name t name with
| [x] -> x
| [] -> raise (Error (List.map (fun i -> i.Attr.attr) t,"missing attribute : " ^ name))
| _ -> raise (Error (List.map (fun i -> i.Attr.attr) t,"duplicate attribute : " ^ name))

let mem_by_name t a =
match find_by_name t a.Attr.attr.name with
| [_] -> true
| [] -> false
| _ -> raise (Error (List.map (fun i -> i.Attr.attr) t,"duplicate attribute : " ^ a.attr.name))

let sub_by_name l del = List.filter (fun x -> not (mem_by_name del x)) l

let from_schema list = List.map (fun sattr -> sattr.Attr.attr) list
end

let raise_error t fmt = Printf.ksprintf (fun s -> raise (Error (t,s))) fmt

Expand All @@ -178,14 +206,6 @@ struct
| [] -> raise (Error (t,"missing attribute : " ^ name))
| _ -> raise (Error (t,"duplicate attribute : " ^ name))

let mem_by_name t a =
match find_by_name t a.name with
| [_] -> true
| [] -> false
| _ -> raise (Error (t,"duplicate attribute : " ^ a.name))

let sub_by_name l del = List.filter (fun x -> not (mem_by_name del x)) l

let make_unique = List.unique ~cmp:(fun a1 a2 -> a1.name = a2.name && a1.name <> "")
let is_unique t = List.length (make_unique t) = List.length t
let check_unique t = is_unique t || raise (Error (t,"duplicate attributes"))
Expand Down Expand Up @@ -222,17 +242,23 @@ struct

(* TODO check that attribute types match (ignoring nullability)? *)
let natural t1 t2 =
let (common,t1only) = List.partition (fun a -> mem_by_name t2 a) t1 in
if 0 = List.length common then raise (Error (t1,"no common attributes for natural join of " ^ (names t1) ^ " and " ^ (names t2)));
common @ t1only @ sub_by_name t2 common
let (common,t1only) = List.partition (fun a -> Source.mem_by_name t2 a) t1 in
Source.Attr.(
if 0 = List.length common then
let t1_attrs = List.map (fun i -> i.attr) t1 in
raise (Error (t1_attrs,"no common attributes for natural join of " ^
(names (t1_attrs)) ^ " and " ^ (names (List.map (fun i -> i.attr) t2))))
);
common @ t1only @ Source.sub_by_name t2 common

let using l t1 t2 =
let common = List.map (find t1) l in
List.iter (fun a -> let (_:attr) = find t2 a.name in ()) common;
common @ sub_by_name t1 common @ sub_by_name t2 common
let common = List.map (Source.find t1) l in
List.iter (fun a -> let _ = Source.find t2 a.Source.Attr.attr.name in ()) common;
common @ Source.sub_by_name t1 common @ Source.sub_by_name t2 common

let join typ cond a b =
let nullable = List.map (fun a -> { a with domain = Type.make_nullable a.domain }) in
let nullable = List.map (fun data ->
Source.Attr.{data with attr={data.attr with domain = Type.make_nullable data.attr.domain}}) in
let action = match cond with Default | On _ -> cross | Natural -> natural | Using l -> using l in
match typ with
| Inner -> action a b
Expand All @@ -245,19 +271,23 @@ struct
let cross_all l = List.fold_left Join.cross [] l

let compound t1 t2 =
if List.length t1 <> List.length t2 then raise (Error (t1, (to_string t1) ^ " differs in size to " ^ (to_string t2)));
let open Source in
let open Attr in
if List.length t1 <> List.length t2 then
raise (Error (List.map (fun i -> i.attr) t1, (to_string (List.map (fun i -> i.attr) t1))
^ " differs in size to " ^ (to_string (List.map (fun i -> i.attr) t2))));
let show_name i a =
match a.name with
| "" -> sprintf "column %d (of %d)" (i+1) (List.length t1)
| s -> s
in
List.combine t1 t2
|> List.mapi begin fun i (a1,a2) ->
match Type.supertype a1.domain a2.domain with
| Some t -> { a1 with domain=t }
| None -> raise (Error (t1, sprintf "Attributes do not match : %s of type %s and %s of type %s"
(show_name i a1) (Type.show a1.domain)
(show_name i a2) (Type.show a2.domain)))
match Type.supertype a1.attr.domain a2.attr.domain with
| Some t -> { a1 with attr = { a1.attr with domain=t } }
| None -> raise (Error (List.map (fun i -> i.attr) t1, sprintf "Attributes do not match : %s of type %s and %s of type %s"
(show_name i a1.attr) (Type.show a1.attr.domain)
(show_name i a2.attr) (Type.show a2.attr.domain)))
end

let add t col pos =
Expand Down Expand Up @@ -359,6 +389,7 @@ and select_full = {
}
and order = (expr * direction option) list
and 'expr choices = (param_id * 'expr option) list
and bool_binop = And | Or | Xor
and expr =
| Value of Type.t (** literal value *)
| Param of param
Expand All @@ -369,6 +400,9 @@ and expr =
| SelectExpr of select_full * [ `AsValue | `Exists ]
| Column of col_name
| Inserted of string (** inserted value *)
| Not_null of expr
| Is_null of expr
| Bool_binop of bool_binop * expr * expr
and column =
| All
| AllOf of table_name
Expand Down
7 changes: 4 additions & 3 deletions lib/sql_parser.mly
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -375,7 +375,7 @@ expr:
| MOD LPAREN e1=expr COMMA e2=expr RPAREN { Fun ((Ret Any),[e1;e2]) } (* mysql special *)
| e1=expr NUM_DIV_OP e2=expr %prec PLUS { Fun ((Ret Float),[e1;e2]) }
| e1=expr DIV e2=expr %prec PLUS { Fun ((Ret Int),[e1;e2]) }
| e1=expr boolean_bin_op e2=expr %prec AND { Fun ((fixed Bool [Bool;Bool]),[e1;e2]) }
| e1=expr b=boolean_bin_op e2=expr %prec AND { Bool_binop (b, e1, e2) }
| e1=expr comparison_op anyall? e2=expr %prec EQUAL { poly (depends Bool) [e1;e2] }
| e1=expr CONCAT_OP e2=expr { Fun ((fixed Text [Text;Text]),[e1;e2]) }
| e=like_expr esc=escape?
Expand Down Expand Up @@ -414,7 +414,8 @@ expr:
| CONVERT LPAREN e=expr COMMA t=sql_type RPAREN
| CAST LPAREN e=expr AS t=sql_type RPAREN { Fun (Ret t, [e]) }
| f=IDENT LPAREN p=func_params RPAREN { Fun (Function.lookup f (List.length p), p) }
| e=expr IS NOT? NULL { poly (strict Bool) [e] }
| e=expr IS NULL { Is_null e }
| e=expr IS NOT NULL { Not_null e }
| e1=expr IS NOT? distinct_from? e2=expr { poly (strict Bool) [e1;e2] }
| e=expr mnot(BETWEEN) a=expr AND b=expr { poly (depends Bool) [e;a;b] }
| mnot(EXISTS) LPAREN select=select_stmt RPAREN { Fun (F (Typ (strict Bool), [Typ (depends Any)]),[SelectExpr (select,`Exists)]) }
Expand Down Expand Up @@ -489,7 +490,7 @@ func_params: DISTINCT? l=expr_list { l }
escape: ESCAPE expr { $2 }
numeric_bin_op: PLUS | MINUS | ASTERISK | MOD | NUM_BIT_OR | NUM_BIT_AND | NUM_BIT_SHIFT { }
comparison_op: EQUAL | NUM_CMP_OP | NUM_EQ_OP | NOT_DISTINCT_OP { }
boolean_bin_op: AND | OR | XOR { }
boolean_bin_op: AND { And } | OR { Or } | XOR { Xor }

unary_op: EXCL { }
| TILDE { }
Expand Down