rA.ml

   1 (*
   2  Relational Algebra
   3 *)
   4
   5 open ListMore
   6 open Printf
   7 open Operators
   8
   9 module Type = Sql.Type
  10
  11 type attr = {name : string; domain : Type.t;}
  12   deriving (Show)
  13
  14 let attr n d = {name=n;domain=d}
  15
  16 module Scheme =
  17 struct
  18   type t = attr list
  19     deriving (Show)
  20
  21   exception Error of t * string
  22
  23   let find t name =
  24     match List.find_all (fun attr -> attr.name = name) t with
  25     | [x] -> x
  26     | [] -> raise (Error (t,"missing attribute : " ^ name))
  27     | _ -> raise (Error (t,"duplicate attribute : " ^ name))
  28
  29   let check_unique t =
  30     let t1 = List.unique ~cmp:(fun a1 a2 -> a1.name = a2.name) t in
  31     if (List.length t1 <> List.length t) then raise (Error (t,"duplicate attributes"))
  32
  33   let project names t = List.map (find t) names
  34
  35   let rename t before after =
  36     List.map (fun attr ->
  37       match attr.name with
  38       | x when x = before -> { attr with name=after }
  39       | _ -> attr ) t
  40
  41   let cross t1 t2 = t1 @ t2
  42
  43   let compound t1 t2 =
  44     if t1 <> t2 then
  45       raise (Error (t1, (Show.show<t>(t1)) ^ " not equal to " ^ (Show.show<t>(t2))))
  46     else
  47       t1
  48
  49   let to_string x = Show.show<t>(x)
  50   let print x = print_endline (to_string x)
  51
  52 (*
  53   let of_table t =
  54     List.map (fun col -> {Attr.name = None; orig = Some (col,t); domain = col.Col.sqltype}) t.Table.cols
  55 *)
  56 end
  57
  58 type table = string * Scheme.t deriving (Show)
  59
  60 let print_table t = print_endline (Show.show<table>(t))
  61
  62 (*
  63 open Scheme
  64
  65 let test = [{name="a";domain=Type.Int}; {name="b";domain=Type.Int}; {name="c";domain=Type.Text};];;
  66
  67 let () = print test
  68 let () = print (project ["b";"c";"b"] test)
  69 let () = print (project ["b";"d"] test)
  70 let () = print (rename test "a" "new_a")
  71 *)