removebottomコマンドの追加

bin/dune

@@ -40,3 +40,9 @@
   (modules s2e)
   (libraries birds))
 
+(executable
+  (public_name removebottom)
+  (name removebottom)
+  (modules removebottom)
+  (libraries birds))
+

bin/removebottom.ml

@@ -0,0 +1,13 @@
+open Birds
+
+let _ =
+  if Array.length Sys.argv < 2 then
+    print_endline "Invalid arguments. File name must be passed."
+  else begin
+    let filename = Sys.argv.(1) in
+    let chan = open_in filename in
+    let lexbuf = Lexing.from_channel chan in
+    let ast = Parser.main Lexer.token lexbuf in
+    let result = Remove_bottom.remove_bottom ast in
+      print_endline @@ Expr.to_string result
+  end

examples/bottom1.dl

@@ -0,0 +1,33 @@
+source brands('BRAND_ID':real, 'BRAND_NAME':string).
+source cars('CAR_ID':real, 'CAR_NAME':string, 'BRAND_ID':real).
+view all_cars('CAR_ID':real, 'CAR_NAME':string, 'BRAND_ID':real, 'BRAND_NAME':string).
+% primary key
+%PK(brands,['BRAND_ID']).
+%PK(cars, ['CAR_ID']).
+
+% fd on base relations
+% CAR_ID -> CAR_NAME, BRAND_ID on cars
+_|_ :- cars(CI, CN1, _), cars(CI, CN2, _), CN1 <> CN2.
+_|_ :- cars(CI, _, BI1), cars(CI, _, BI2), BI1 <> BI2.
+% BRAND_ID -> BRAND_NAME on brands
+_|_ :- brands(BI, BN1), brands(BI, BN2), BN1 <> BN2.
+
+%% fd on views
+% BRAND_ID -> BRAND_NAME on all_cars
+_|_ :- all_cars(_,_,BI,BN1), all_cars(_,_,BI,BN2), BN1 <> BN2.
+% CAR_ID -> CAR_NAME, BRAND_ID on all_cars
+_|_ :- all_cars(CI, CN1, _, _), all_cars(CI, CN2, _, _), CN1 <>CN2.
+_|_ :- all_cars(CI, _, BI1, _), all_cars(CI, _, BI2, _), BI1 <> BI2.
+
+% foreign key
+_|_ :- cars(_, _, BI), not brands(BI, _).
+
+% view definition
+all_cars(CI, CN, BI, BN) :- cars(CI, CN, BI), brands(BI, BN).
+
+% update strategy
+
+-cars(CI, CN, BI) :- cars(CI, CN, BI), not all_cars(CI, CN, BI, _).
+-brands(BI, BN) :- brands(BI, BN), all_cars(_, _, BI, _), not all_cars(_, _, BI, BN).
++cars(CI, CN, BI) :- all_cars(CI, CN, BI, _), not cars(CI, CN, BI).
++brands(BI, BN) :- all_cars(_, _, BI, BN), not brands(BI, BN).

src/remove_bottom.ml

@@ -0,0 +1,21 @@
+
+open Expr
+
+(** The prefix used for generated predicates. *)
+let constraint_predicate_prefix = "__constraint__"
+
+let remove_bottom (ast: expr): expr =
+
+  let preds =
+    Seq.iterate (fun i -> i + 1) 0 |>
+    Seq.take (List.length ast.constraints) |>
+    List.of_seq |>
+    List.map (fun i -> Pred (constraint_predicate_prefix ^ Int.to_string i, []))
+   in
+
+  let crules =
+    (Pred (constraint_predicate_prefix, []), List.map (fun p -> Not p) preds) ::
+    List.map2 (fun c pred -> match c with (_, body) -> (pred, body)) ast.constraints preds
+  in
+
+  { ast with rules = List.append ast.rules crules; constraints = [] }

src/remove_bottom.mli

@@ -0,0 +1,4 @@
+
+open Expr
+
+val remove_bottom : expr -> expr