rA.ml

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