add index support into the sql, with syntax:

with orm( unique: x<foo,bar>,y<foo2,bar2>; index: x<bar>; )
where x and y are tables and foo,bar are fields.
The index keyword makes lookup indices, while unique enforces that constraint in the index

NEWS

@@ -1,4 +1,5 @@
 0.3:
+* Add support for index (both lookup and unique) [2 Oct 2009]
 * Rewrite to a camlp4 (3.11+) code base and remove old extension [26 Sep 2009]
 
 0.2:

TODO

@@ -1,4 +1,3 @@
-- create indexes
 - foreign keys (Frefs)
 - no fold
 - let type t work via type alias (clashes with Functor atm)

lib/pa_orm.ml

@@ -701,7 +701,15 @@ module Init = struct
         }
         >>
     ) (sql_tables env)) in
-    <:expr< do { $create_exs$; $trigger_exs$; $cache_trigger_exs$ } >>
+
+    let create_indices = Ast.exSem_of_list (List.map (fun (unique,t,fs) ->
+      let s = sprintf "CREATE %sINDEX IF NOT EXISTS idx_%s_%s ON %s (%s);"
+       (match unique with true -> "UNIQUE " |false -> "")
+       t (String.concat "_" fs) t (String.concat "," fs) in
+      <:expr< OS.db_must_ok db (fun () -> Sqlite3.exec db.OS.db $str:s$) >>
+    ) env.e_indices) in
+
+    <:expr< do { $create_exs$; $trigger_exs$; $cache_trigger_exs$; $create_indices$ } >>
 
   (* construct custom trigger function to delete ids/values from the weak hash
      after a delete has gone through *)
@@ -769,13 +777,14 @@ end
 module Syntax = struct
   (* Extend grammar with options for SQL tables *)
   type p_keys =
-    | Unique of string list
+    | Unique of (bool * string * string list) list (* unique, table, fields *)
     | Debug of string list
     | Dot of string
     | Name of string
 
   let string_of_p_keys = function
-    | Unique sl ->  "unique: " ^ ( String.concat "," sl )
+    | Unique sl ->  "unique: " ^ ( String.concat "," 
+       (List.map (fun (u,x,y) -> sprintf "%s(%s:%b)" x (String.concat "," y) u) sl ))
     | Debug d -> "debug: " ^ (String.concat "," d)
     | Dot f -> "dot: " ^ f
     | Name n -> "name: " ^ n
@@ -785,12 +794,15 @@ module Syntax = struct
 
   GLOBAL: orm_parms;
 
-  orm_svars: [
-    [ l = LIST0 [ `LIDENT(x) -> x ] SEP "," -> l ]
-    ];
+  orm_svars: [[ l = LIST1 [ `LIDENT(x) -> x ] SEP "," -> l ]];
+
+  orm_table: [[ x = LIDENT; "<"; y = orm_svars; ">" -> (x, y) ]];
+
+  orm_tables: [[ l = LIST1 [ orm_table ] SEP "," -> l ]];
 
   orm_param: [[ 
-       "unique"; ":" ; x = orm_svars -> Unique x 
+       "unique"; ":" ; x = orm_tables -> Unique (List.map (fun (x,y) -> (true,x,y)) x)
+     | "index"; ":" ; x = orm_tables -> Unique (List.map (fun (x,y) -> (false,x,y)) x)
      | "debug";  ":" ; x = orm_svars -> Debug x 
      | "dot";    ":" ; x = STRING -> Dot x 
      | "modname";":" ; x = STRING -> Name x
@@ -804,7 +816,7 @@ module Syntax = struct
 
   let parse_keys =
     List.fold_left (fun env -> function
-      |Unique fl -> { env with e_unique = fl :: env.e_unique }
+      |Unique fl -> { env with e_indices = fl @ env.e_indices }
       |Name n -> { env with e_name=n }
       |Debug modes -> List.fold_left (fun env -> function
         |"sql" -> { env with debug_sql=true } 

lib/sql_types.ml

@@ -52,7 +52,7 @@ type field_info =
 and env = {
   e_tables: table list;
   e_types: (string * ctyp) list;
-  e_unique: string list list;
+  e_indices: (bool * string * string list) list;
   e_name: string;
   debug_sql: bool;
   debug_binds: bool;
@@ -134,7 +134,7 @@ let dot_of_env e =
 
 (* --- Helper functions to manipulate environment *)
 
-let empty_env () = { e_tables = []; e_types=[]; e_unique=[]; e_name="orm";
+let empty_env () = { e_tables = []; e_types=[]; e_indices=[]; e_name="orm";
   debug_sql=false; debug_binds=false; debug_cache=false; debug_dot=None }
 
 let find_table env name =

lib_test/foreign.ml

@@ -13,7 +13,9 @@ and x = {
   third: int;
 }
 with orm (
- debug:sql
+ debug:sql;
+ unique: s<xyz>, s<bar>;
+ index: x<first,second>
 )
 
 let name = "foreign.db"

lib_test/simple.ml

@@ -8,6 +8,7 @@ type x = {
   bar: string
 } with
 orm(
+ unique: x<foo,bar>, x<bar>;
  debug: all;
  dot: "simple.dot";
  modname: "My_simple"