is not null type re infer

lib/sql.ml

@@ -389,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
@@ -399,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

lib/sql_parser.mly

@@ -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?
@@ -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)]) }
@@ -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 { }

lib/syntax.ml

@@ -62,7 +62,10 @@ let rec is_grouping = function
 | Column _
 | SelectExpr _
 | Inparam _
-| Inserted _ -> false
+| Inserted _ 
+| Not_null _ 
+| Is_null _ 
+| Bool_binop _ -> false
 | Choices (p,l) ->
   begin match list_same @@ List.map (fun (_,expr) -> Option.map_default is_grouping false expr) l with
   | None -> failed ~at:p.pos "inconsistent grouping in choice branches"
@@ -144,6 +147,7 @@ let rec resolve_columns env expr =
     eprintf "schema: "; Sql.Schema.print (Schema.Source.from_schema env.schema);
     Tables.print stderr env.tables;
   end;
+  let poly ret args = Fun (F (Typ ret, List.map (fun _ -> Type.Var 0) args), args) in
   let rec each e =
     match e with
     | Value x -> ResValue x
@@ -155,6 +159,9 @@ let rec resolve_columns env expr =
     | Inparam x -> ResInparam x
     | InChoice (n, k, x) -> ResInChoice (n, k, each x)
     | Choices (n,l) -> ResChoices (n, List.map (fun (n,e) -> n, Option.map each e) l)
+    | Not_null expr -> each @@ poly (Type.strict Bool) [expr]
+    | Is_null expr -> each @@ poly (Type.strict Bool) [expr]
+    | Bool_binop (And, e1, e2) | Bool_binop(Or, e1, e2) | Bool_binop(Xor, e1, e2) -> each @@ Type.(Fun ((fixed Bool [Bool;Bool]),[e1;e2]))
     | Fun (r,l) ->
       ResFun (r,List.map each l)
     | SelectExpr (select, usage) ->
@@ -350,6 +357,7 @@ and ensure_res_expr = function
   | Value x -> ResValue x
   | Param x -> ResParam x
   | Inparam x -> ResInparam x
+  | Not_null _ | Is_null _ | Bool_binop _  -> failwith "FIXME?"
   | Choices (p,_) -> failed ~at:p.pos "ensure_res_expr Choices TBD"
   | InChoice (p,_,_) -> failed ~at:p.pos "ensure_res_expr InChoice TBD"
   | Column _ | Inserted _ -> failwith "Not a simple expression"
@@ -373,6 +381,21 @@ and eval_select env { columns; from; where; group; having; } =
     else if group = [] && exists_grouping columns then `One
     else `Nat
   in
+  (* a is null or b is null or c is not null *)
+  let schema = List.map (fun i -> 
+    let rec fn = function 
+     | Is_null _ -> false
+     | Not_null (Column e) -> e.cname = i.Schema.Source.Attr.attr.name
+     | Bool_binop (Or, e1, e2) -> fn e1 && fn e2
+     | Bool_binop (And, e1, e2) -> fn e1 || fn e2
+     | Fun (_, exprs) -> List.exists fn exprs
+     | _ -> false in
+    let result = where |> Option.map fn |> Option.default false in
+    if result then 
+      { i with attr = { i.Schema.Source.Attr.attr with domain = { i.Schema.Source.Attr.attr.domain with nullability = Strict;}; extra = Constraints.empty  } } 
+    else i
+  ) env.schema in
+  let env = { env with schema } in
   let final_schema = infer_schema env columns in
   let make_unique = List.unique ~cmp:(fun a1 a2 -> 
     (* let l1 = List.map (fun i -> i.tn) a1.sources in