Joby Poriyath avatar Joby Poriyath committed 24801e6

Simple db implementation; Need to make read_db tail recursive

Comments (0)

Files changed (2)

+type 'a ilist = {mutable c : 'a list}
+
+let icreate () = {c = []}
+let iempty l = (l.c = [])
+let icons x y = y.c <- x :: y.c ; y
+let ihd l = List.hd l.c
+let itl x = x.c <- List.tl x.c; x
+
+let rec imap f l = 
+  if iempty l
+  then icreate ()
+  else
+    let hd = ihd l in
+    let tl = itl l in
+    icons (f hd) (imap f tl)
+
+let example = icons "one" (icons "two" (icons "three" (icreate ())))
+
+let succ n = 
+  let rec succ_tl n aux = 
+    if n = 0 then aux else succ_tl (n - 1) (aux + 1)
+  in succ_tl n 0
+
+
+type 'a v = Imm of 'a
+            | Deferred of (unit -> 'a)
+type 'a vm = { mutable c : 'a v}
+
+let eval e = match e.c with
+  | Imm a -> a
+  | Deferred f -> let u = f () in e.c <- Imm u; u
+
+type 'a enum = {mutable i : 'a; f: 'a -> 'a}
+
+let next e = let x = e.i in e.i <- e.f e.i; x
+let nat = {i = 0; f = function n -> n + 1}
+
+let fib =
+  let fx =
+    let c = ref 0 in
+    function v -> 
+      let r = !c + v in 
+      c := v; r
+  in
+  {i = 1; f = fx}
+
+type 'a bin_tree = Empty
+                   | Node of 'a * 'a bin_tree * 'a bin_tree
+
+let height tree = 
+  let rec height_aux tree = match tree with
+    | Empty -> 0
+    | Node (_, l, r) -> 1 + max (height_aux l) (height_aux r)
+  in
+  let h = height_aux tree in
+  if (h > 0) then (h - 1) else 0
+
+let fill_array tree tab =
+  let rec fill_aux tree i =
+    match tree with
+      | Empty -> tab.(i) <- None; tab
+      | Node (a, l, r) -> tab.(i) <- Some a; ignore (fill_aux l (2 * i + 1)); fill_aux r (2 * i + 2)
+  in
+  fill_aux tree 0
+        
+type data_card = string array
+type data_base = {card_index : string -> int; data: data_card list}
+
+exception Not_found
+
+let field db n (dc : data_card) = dc.(db.card_index n)
+
+let base_ex = { data = [[| "Poriyath"; "Joby"|]; [| "Eliza"; "Dina" |]];
+                card_index = function "Lastname" -> 0 | "Firstname" -> 1 | _ -> raise Not_found }
+
+(* utility functions *)
+
+let is_whitespace = function
+  | ' ' | '\n' | '\t' | '\r' -> true
+  | _ -> false
+
+let split_on s fn =
+  let s_len = String.length s in
+  let rec sub_string lst i j =
+    if j == s_len then String.sub s i (j - i) :: lst
+    else if fn (s.[j]) then sub_string (String.sub s i (j - i) :: lst) (j + 1) (j + 1)
+    else sub_string lst i (j + 1)
+  in
+  List.rev (sub_string [] 0 0)
+
+let split s = List.filter (function s -> s <> "") (split_on s is_whitespace)
+
+let strip s =
+  let s_len = String.length s in
+  let rec index_l i =
+    if i = s_len then (i - 1) 
+    else if is_whitespace (s.[i]) then index_l (i + 1)
+    else i in
+  let rec index_r i j = 
+    if (j = i) then j
+    else if j <= 0 then 0
+    else if is_whitespace (s.[j]) then index_r i (j - 1)
+    else j + 1 in
+  let i = index_l 0 in
+  let j = index_r i (s_len - 1) in
+  if s = "" then "" else String.sub s i (j - i)
+  
+
+let rec join s = function
+  | [] -> ""
+  | (w::ws) -> (w ^ s) ^ join s ws
+
+(* end of utility functions *)
+
+let field db name =
+  let i = db.card_index name in
+  fun (card : data_card) -> card.(i)
+
+
+let mk_index list_names =
+  let rec enum i = function
+    | [] -> []
+    | (w::ws) -> (w, i) :: enum (i + 1) ws in
+  let assoc = enum 0 list_names in
+  fun name -> List.assoc name assoc 
+
+let read_db filename = 
+  let channel = open_in filename in
+  let first_line = input_line channel in
+  let index_fun = mk_index (split_on first_line (fun c -> c = '|')) in
+  let rec read_file () =
+    try
+      let data = Array.of_list (split_on (input_line channel) (fun c -> c = ':')) in
+      data :: read_file () 
+    with End_of_file -> close_in channel; [] in
+  {card_index = index_fun; data = read_file ()}
+
+
+(*
+  The Goal of database processing is to obtain a state of the database.
+  Building such a state may be decomposed into three steps.
+
+  1. Select, according to some given criteria, a set of cards.
+  2. Process each of the selected cards.
+  3. Process all the data collected from the selected cards.
+
+  List.find_all
+  List.map
+  List.fold_right, List.fold_left
+
+*)
+(* doubly linked list *)
+
+type 'a cell = { info : 'a;
+                 mutable prev : 'a dlist;
+                 mutable next : 'a dlist }
+and 'a dlist = Empty | List of 'a cell
+
+let add elt lst = match lst with
+  | Empty -> List {info = elt; prev = Empty; next = Empty}
+  | List cell -> 
+    let new_lst = List {info = elt; prev = Empty; next = List cell} in
+    begin
+      cell.prev <- new_lst; 
+      new_lst
+    end
+    
+let rec len = function 
+  | Empty -> 0
+  | List cell -> 1 + len cell.next
+
+let rec print_int_dlist = function
+  | Empty -> print_newline ()
+  | List cell -> print_int cell.info; print_string"; "; print_int_dlist cell.next
+
+let flip f x y = f y x
+
+let a = List.fold_left (flip add) Empty [1; 2; 3; 4; 5; 6]
+
+let b = List.fold_right add [1; 2; 3; 4; 5; 6] Empty
+
+let remove_cell = function
+  | Empty -> failwith "remove_cell: already empty"
+  | List cell -> 
+    match (cell.prev, cell.next) with
+      | (Empty, Empty) -> Empty
+      | (Empty, List c) -> c.prev <- Empty; cell.next
+      | (List c, Empty) -> c.next <- Empty; cell.prev
+      | (List c1, List c2) -> c1.next <- cell.next; c2.prev <- cell.prev; cell.prev
+
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.