(* Carsten Schuermann *)
(* A SQL interpreter *)
(* Fri Feb  9 23:12:11 2007 *)
  


  type Row = char list
  type Table = Row list 

  fun filter T P = foldr (fn (x, l) => if P x then x :: l else l) nil T

  fun join T1 T2 = foldr (fn (x, t1) => t1 @
			  (foldr  (fn (y, t2) => (x @ y) :: t2) nil T2)) nil T1

  fun load s = 
    let 
      val f = TextIO.openIn s
      fun load' () = 
	case (TextIO.inputLine f) 
	  of SOME s => String.explode s :: load' ()
	   | NONE => nil
      val result = load' ()
      val _ = TextIO.closeIn f
    in
      result
   end
    

  fun save s T = 
    let 
      val f = TextIO.openOut s
      fun save' nil = ()
	| save' (H :: T) = (TextIO.output (f, String.implode H); save' T)

      val result = save' T
      val _ = TextIO.closeOut f
    in
      ()
   end
    

  datatype Ctx = 
    Null
    | ConsT of Ctx * Table

  datatype 'b Exp = 
      Table of Table * 'b Exp
    | Dup of 'b Exp
    | Join of 'b Exp
    | Where of (Row -> bool) * 'b Exp
    | Return of (Row * 'b -> 'b) 
    | Select  of (Row -> Row) * 'b Exp
    | From of string * 'b Exp
    | Save of string * 'b Exp

  fun run S (Table (T, E)) = run (ConsT (S, T)) E
    | run (ConsT (S, T)) (Dup E) = run (ConsT (ConsT (S, T), T)) E
    | run (ConsT (ConsT (S, T1), T2)) (Join E) = run (ConsT (S, (join T1 T2))) E
    | run (ConsT (S, T)) (Where (P, E)) = run (ConsT (S, (filter T P))) E 
    | run (ConsT (S, T)) (Return F) = foldr F nil T
    | run (ConsT (S, T)) (Select (F, E)) = run (ConsT (S, map F T)) E
    | run S (From (s, E)) = run (ConsT (S, load s)) E
    | run (ConsT (S, T)) (Save (s, E)) = (save s; run S E)

  fun extract (N, M, nil) = extract (N, M, #" " :: nil)
    | extract (0, 0, S) = []
    | extract (0, M, H :: T) = H :: extract (0, M-1, T)
    | extract (N, M, H :: T) = extract (N-1, M-1, T)

  fun insert (0, 0, _, S) = S 
    | insert (N, M, T, nil) = insert (N, M, T, #" " :: nil)
    | insert (0, M, nil, S) = insert (0, M, #" " :: nil, S)
    | insert (0, M, H::T, _::S) = H :: insert (0, M-1, T, S)
    | insert (N, M, T, H :: S) = H :: insert (N-1, M-1, T, S)

  fun accessor (N, M) = (fn S => extract (N, M, S), 
		       fn (T:string, S:Row) => insert (N, M, String.explode T, S))
    


  val (nameE, nameI) = accessor (0, 10)
  val (sexE, sexI) = accessor (11, 20)
  val (fatherE, fatherI) = accessor (21, 41)
  val (motherE, motherI) = accessor (41, 61)



  val male = "MALE"
  val female = "FEMALE"

  val r1 = nameI ("Bob", sexI (male, fatherI ("George", motherI ("Alice", nil))))
  val r2 = nameI ("Alice", sexI (male, fatherI ("Matthew", motherI ("Hillary", nil))))

  val t : Table 
        = [r1, r2]

  val E1 = Table (t,
	  Dup (
	  Join (
	  Where (fn r => nameE r = String.explode "Bob",
	  Return (fn (r, x) => r :: x)))))

  val R1 = run Null E1


  val (date1E, date1I) = accessor (0,19)
  val (rate1E, rate1I) = accessor (20, 29)
  val (date2E, date2I) = accessor (31,50)
  val (rate2E, rate2I) = accessor (51, 60)

  val E2 = From ("dkk-dollar", 
          From ("dollar-euro",
	  Join (
	  Where (fn (r) => date1E r = date2E r, 
	  Return (fn (r, x) => (valOf (Real.fromString (String.implode (rate2E r))) / valOf (Real.fromString (String.implode (rate1E r)))) :: x)))))

  val R2 = run Null E2


  val E3 = From ("dkk-dollar", 
          From ("dollar-euro",
	  Join (
	  Where (fn (r) => date1E r = date2E r, 
	  From ("euro-dkk",
	  Join (
	  Where (fn (r) => date1E r = date2E r, 
	  Return (fn (r, x) => (valOf (Real.fromString (String.implode (rate2E r))) / valOf (Real.fromString (String.implode (rate1E r)))) :: x))))))))

  val R3 = run Null E3