[Toss-devel-svn] SF.net SVN: toss:[1405] trunk/Toss

[<luk...@us...>]

Revision: 1405
          http://toss.svn.sourceforge.net/toss/?rev=1405&view=rev
Author:   lukaszkaiser
Date:     2011-04-05 15:57:57 +0000 (Tue, 05 Apr 2011)

Log Message:
-----------
Starting to move some python DB stuff to ocaml.

Modified Paths:
--------------
    trunk/Toss/Arena/Arena.ml
    trunk/Toss/Arena/Arena.mli
    trunk/Toss/Makefile
    trunk/Toss/README
    trunk/Toss/Server/Server.ml

Added Paths:
-----------
    trunk/Toss/Server/DB.ml
    trunk/Toss/Server/DB.mli

Modified: trunk/Toss/Arena/Arena.ml
===================================================================
--- trunk/Toss/Arena/Arena.ml	2011-03-29 17:16:10 UTC (rev 1404)
+++ trunk/Toss/Arena/Arena.ml	2011-04-05 15:57:57 UTC (rev 1405)
@@ -1010,3 +1010,54 @@
       ((g, s), "STATE SET")
     | GetModel -> ((state_game, state), Structure.sprint state.struc)
     | GetState -> ((state_game, state), state_str (state_game, state))
+
+
+let can_modify_game = function
+    AddElem _ -> true
+  | AddRel _ -> true
+  | DelElem _ -> true
+  | DelRel _ -> true
+  | GetRelSignature _ -> false
+  | GetFunSignature _ -> false
+  | GetAllTuples _ -> false
+  | GetAllElems _ -> false
+  | SetFun _ -> false      (* TODO: rethink when working on dyns *)
+  | GetFun _ -> false
+  | SetData _ -> false
+  | GetData _ -> false
+  | SetArity _ -> true
+  | GetArity _ -> false
+  | RenamePlayer _ -> false
+  | SetLoc i -> true
+  | GetLoc -> false
+  | SetLocPlayer _ -> true
+  | GetLocPlayer _ -> false
+  | SetLocPayoff _ -> true
+  | GetLocPayoff _ -> false
+  | GetCurPayoffs -> false
+  | SetLocMoves _ -> true
+  | GetLocMoves _ -> false
+  | SuggestLocMoves _ -> false
+  | EvalFormula _ -> false
+  | EvalRealExpr _ -> false
+  | SetRule _ -> true
+  | GetRule _ -> false
+  | SetRuleUpd _ -> true
+  | GetRuleUpd _ -> false
+  | SetRuleDyn _ -> true
+  | GetRuleDyn _ -> false
+  | SetRuleCond _ -> true
+  | GetRuleCond _ -> false
+  | SetRuleEmb _ -> true
+  | GetRuleEmb _ -> false
+  | SetRuleAssoc _ -> true
+  | GetRuleAssoc _ -> false
+  | GetRuleMatches _ -> false
+  | ApplyRule _ -> true
+  | ApplyRuleInt _ -> true
+  | GetRuleNames -> false
+  | SetTime _ -> false      (* TODO: rethink when working on dyns *)
+  | GetTime -> false
+  | SetState _ -> true
+  | GetModel -> false
+  | GetState -> false

Modified: trunk/Toss/Arena/Arena.mli
===================================================================
--- trunk/Toss/Arena/Arena.mli	2011-03-29 17:16:10 UTC (rev 1404)
+++ trunk/Toss/Arena/Arena.mli	2011-04-05 15:57:57 UTC (rev 1405)
@@ -212,3 +212,5 @@
 
 val handle_request : 
   game * game_state -> request -> (game * game_state) * string
+
+val can_modify_game : request -> bool

Modified: trunk/Toss/Makefile
===================================================================
--- trunk/Toss/Makefile	2011-03-29 17:16:10 UTC (rev 1404)
+++ trunk/Toss/Makefile	2011-04-05 15:57:57 UTC (rev 1405)
@@ -46,10 +46,10 @@
 # -------- MAIN OCAMLBUILD PART --------
 
 OCB_COBJ=../Formula/Sat/minisat/MiniSATWrap.o,../Formula/Sat/minisat/SatSolver.o
-OCB_LFLAG=-lflags -I,+oUnit,-cclib,-lstdc++,$(OCB_COBJ)
-OCB_LFLAGBT=-lflags -I,+oUnit,-custom,$(OCB_COBJ),"-cclib -lstdc++"
-OCB_CFLAG=-cflags -I,+oUnit,-g
-OCB_LIB=-libs str,nums,unix,oUnit 
+OCB_LFLAG=-lflags -I,+oUnit,-I,+sqlite3,-cclib,-lstdc++,$(OCB_COBJ)
+OCB_LFLAGBT=-lflags -I,+oUnit,-I,+sqlite3,-custom,$(OCB_COBJ),"-cclib -lstdc++"
+OCB_CFLAG=-cflags -I,+oUnit,-I,+sqlite3,-g
+OCB_LIB=-libs str,nums,unix,oUnit,sqlite3
 OCB_PP=-pp "camlp4o ../caml_extensions/pa_let_try.cmo ../caml_extensions/pa_backtrace.cmo"
 OCAMLBUILD=ocamlbuild -log build.log -j 8 -menhir ../menhir_conf $(OCB_PP) \
 	$(OCB_LIB) $(OCB_CFLAG) $(OCB_LFLAG)
@@ -83,7 +83,7 @@
 
 doc: Formula/Sat/minisat/SatSolver.o Formula/Sat/minisat/MiniSATWrap.o \
 	  caml_extensions/pa_let_try.cmo caml_extensions/pa_backtrace.cmo
-	$(OCAMLBUILDNOPP) -Is +oUnit,$(.INC) Toss.docdir/index.html
+	$(OCAMLBUILDNOPP) -Is +oUnit,+sqlite3,$(.INC) Toss.docdir/index.html
 	make -C www code_doc_link
 
 

Modified: trunk/Toss/README
===================================================================
--- trunk/Toss/README	2011-03-29 17:16:10 UTC (rev 1404)
+++ trunk/Toss/README	2011-04-05 15:57:57 UTC (rev 1405)
@@ -11,7 +11,7 @@
 -- Installing dependencies under Ubuntu
 
 Run the following in terminal:
-  sudo apt-get install g++ python-qt4 python-dev pyqt4-dev-tools ocaml-findlib menhir libounit-ocaml-dev 
+  sudo apt-get install g++ python-qt4 python-dev pyqt4-dev-tools ocaml-findlib menhir libounit-ocaml-dev libsqlite3-ocaml-dev
 
 Finally to compile Toss just type
   make

Added: trunk/Toss/Server/DB.ml
===================================================================
--- trunk/Toss/Server/DB.ml	                        (rev 0)
+++ trunk/Toss/Server/DB.ml	2011-04-05 15:57:57 UTC (rev 1405)
@@ -0,0 +1,22 @@
+(* Wrapper around Toss DB interface. We use sqlite for now, see below.
+   http://hg.ocaml.info/release/ocaml-sqlite3/file/0e2f7d2cbd12/sqlite3.mli 
+*)
+
+exception DBError of string
+
+let print_row r = Array.iter (fun s -> print_string (s ^ " | ")) r
+
+let print_rows rs = List.iter (fun r -> print_row r; print_endline "") rs
+
+let get_table dbfile ?(select="") tbl =
+  let (rows, wh_s) = (ref [], if select = "" then "" else " where " ^ select) in
+  let select_s = "select * from " ^ tbl ^ wh_s in
+  let db = Sqlite3.db_open dbfile in
+  let add_row r = rows := r :: !rows in
+  let res = Sqlite3.exec_not_null_no_headers db add_row select_s in
+  ignore (Sqlite3.db_close db);
+  match res with
+    | Sqlite3.Rc.OK -> List.rev !rows
+    | x -> raise (DBError (Sqlite3.Rc.to_string x))
+  
+

Added: trunk/Toss/Server/DB.mli
===================================================================
--- trunk/Toss/Server/DB.mli	                        (rev 0)
+++ trunk/Toss/Server/DB.mli	2011-04-05 15:57:57 UTC (rev 1405)
@@ -0,0 +1,7 @@
+exception DBError of string
+
+val print_row : string array -> unit
+
+val print_rows : string array list -> unit
+
+val get_table : string -> ?select : string -> string -> string array list

Modified: trunk/Toss/Server/Server.ml
===================================================================
--- trunk/Toss/Server/Server.ml	2011-03-29 17:16:10 UTC (rev 1404)
+++ trunk/Toss/Server/Server.ml	2011-04-05 15:57:57 UTC (rev 1405)
@@ -110,54 +110,8 @@
     line
 
 let possibly_modifies_game = function
-    Arena.AddElem _ -> true
-  | Arena.AddRel _ -> true
-  | Arena.DelElem _ -> true
-  | Arena.DelRel _ -> true
-  | Arena.GetRelSignature _ -> false
-  | Arena.GetFunSignature _ -> false
-  | Arena.GetAllTuples _ -> false
-  | Arena.GetAllElems _ -> false
-  | Arena.SetFun _ -> false      (* TODO: rethink when working on dyns *)
-  | Arena.GetFun _ -> false
-  | Arena.SetData _ -> false
-  | Arena.GetData _ -> false
-  | Arena.SetArity _ -> true
-  | Arena.GetArity _ -> false
-  | Arena.RenamePlayer _ -> false
   | Arena.SetLoc i -> i <> !expected_location      
-  | Arena.GetLoc -> false
-  | Arena.SetLocPlayer _ -> true
-  | Arena.GetLocPlayer _ -> false
-  | Arena.SetLocPayoff _ -> true
-  | Arena.GetLocPayoff _ -> false
-  | Arena.GetCurPayoffs -> false
-  | Arena.SetLocMoves _ -> true
-  | Arena.GetLocMoves _ -> false
-  | Arena.SuggestLocMoves _ -> false
-  | Arena.EvalFormula _ -> false
-  | Arena.EvalRealExpr _ -> false
-  | Arena.SetRule _ -> true
-  | Arena.GetRule _ -> false
-  | Arena.SetRuleUpd _ -> true
-  | Arena.GetRuleUpd _ -> false
-  | Arena.SetRuleDyn _ -> true
-  | Arena.GetRuleDyn _ -> false
-  | Arena.SetRuleCond _ -> true
-  | Arena.GetRuleCond _ -> false
-  | Arena.SetRuleEmb _ -> true
-  | Arena.GetRuleEmb _ -> false
-  | Arena.SetRuleAssoc _ -> true
-  | Arena.GetRuleAssoc _ -> false
-  | Arena.GetRuleMatches _ -> false
-  | Arena.ApplyRule _ -> true
-  | Arena.ApplyRuleInt _ -> true
-  | Arena.GetRuleNames -> false
-  | Arena.SetTime _ -> false      (* TODO: rethink when working on dyns *)
-  | Arena.GetTime -> false
-  | Arena.SetState _ -> true
-  | Arena.GetModel -> false
-  | Arena.GetState -> false
+  | r -> Arena.can_modify_game r
 
 exception Found of int
 
@@ -577,12 +531,14 @@
              Gc.major_heap_increment = 8*124*1024 (* 8*std ok *) };
   let (server, port, load_gdl) = (ref "localhost", ref 8110, ref true) in
   let (experiment, e_len, e_d1, e_d2) = (ref false, ref 1, ref 2, ref 2) in
+  let sqltest = ref "" in
   let opts = [
     ("-v", Arg.Unit (fun () -> set_debug_level 1), " make Toss server verbose");
     ("-vv", Arg.Unit (fun () -> set_debug_level 2), " make Toss server very verbose");
     ("-nogdl", Arg.Unit (fun () -> load_gdl := false), " don't load GDL");
     ("-d", Arg.Int (fun i -> set_debug_level i), " Toss server debug log level");
     ("-s", Arg.String (fun s -> (server := s)), " server (default: localhost)");
+    ("-sql", Arg.String (fun s -> (sqltest := s)), " sql testing (temporary)");
     ("-gdl", Arg.String (fun s ->
       GDL.manual_game := s; GDL.manual_translation := true),
      " GDL game for manual (i.e. hard-coded) translation (tictactoe, breakthrough, etc.)");
@@ -631,6 +587,8 @@
   );
   if !experiment then
     run_test !e_len !e_d1 !e_d2
+  else if !sqltest != "" then
+    DB.print_rows (DB.get_table "WebClient/tossdb.sqlite" !sqltest)
   else try
     start_server req_handle !port !server
   with Host_not_found -> print_endline "The host you specified was not found."


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.