[r2003-11-25 09:27:34 by cmiachon] nothing -

Original author: cmiachon
Date: 2003-11-25 09:27:35+00:00

Makefile.distrib

@@ -125,17 +125,17 @@ OBJECTS = \
  compile/compile.cmo \
  compile/operators.cmo \
  \
- types/builtin.cmo driver/librarian.cmo driver/cduce.cmo \
- \
-# query/query_parse.cmo
+ types/builtin.cmo driver/librarian.cmo driver/cduce.cmo
+
+CQL_OBJECTS= query/query.cmo query/query_parse.cmo 
 
 VALIDATE_OBJECTS := $(shell for o in $(OBJECTS); do echo $$o; if [ "$$o" = "schema/schema_parser.cmo" ]; then exit 0; fi; done)	# all objects until schema_parser.cmo
 
-CDUCE = $(OBJECTS) driver/run.cmo
+CDUCE = $(OBJECTS) driver/run.cmo $(CQL_OBJECTS)
 WEBIFACE  = $(OBJECTS) driver/examples.cmo driver/webiface.cmo
 DTD2CDUCE = tools/dtd2cduce.cmo
 
-ALL_OBJECTS = $(OBJECTS) \
+ALL_OBJECTS = $(OBJECTS) $(CQL_OBJECTS) \
  driver/run.cmo driver/examples.cmo driver/webiface.cmo \
  tools/dtd2cduce.cmo tools/validate.cmo
 ALL_INTERFACES = schema/schema_types.mli

depend

@@ -212,12 +212,24 @@ driver/cduce.cmx: misc/q_symbol.cmo parser/ast.cmx types/builtin.cmx compile/com
     types/patterns.cmx types/sample.cmx schema/schema_common.cmx \
     misc/state.cmx typing/typed.cmx typing/typer.cmx types/types.cmx \
     parser/ulexer.cmx runtime/value.cmx driver/cduce.cmi 
+query/query.cmo: misc/q_symbol.cmo parser/ast.cmo types/atoms.cmi types/chars.cmi \
+    types/ident.cmo types/intervals.cmi parser/location.cmi parser/parser.cmi \
+    driver/run.cmi types/types.cmi query/query.cmi 
+query/query.cmx: misc/q_symbol.cmo parser/ast.cmx types/atoms.cmx types/chars.cmx \
+    types/ident.cmx types/intervals.cmx parser/location.cmx parser/parser.cmx \
+    driver/run.cmx types/types.cmx query/query.cmi 
+query/query_parse.cmo: misc/q_symbol.cmo parser/ast.cmo types/atoms.cmi types/ident.cmo \
+    parser/location.cmi parser/parser.cmi query/query.cmi types/types.cmi 
+query/query_parse.cmx: misc/q_symbol.cmo parser/ast.cmx types/atoms.cmx types/ident.cmx \
+    parser/location.cmx parser/parser.cmx query/query.cmx types/types.cmx 
 driver/run.cmo: misc/q_symbol.cmo driver/cduce.cmi types/ident.cmo driver/librarian.cmi \
     runtime/load_xml.cmi parser/location.cmi types/sequence.cmi \
-    misc/state.cmi misc/stats.cmi parser/ulexer.cmi runtime/value.cmi 
+    misc/state.cmi misc/stats.cmi parser/ulexer.cmi runtime/value.cmi \
+    driver/run.cmi 
 driver/run.cmx: misc/q_symbol.cmo driver/cduce.cmx types/ident.cmx driver/librarian.cmx \
     runtime/load_xml.cmx parser/location.cmx types/sequence.cmx \
-    misc/state.cmx misc/stats.cmx parser/ulexer.cmx runtime/value.cmx 
+    misc/state.cmx misc/stats.cmx parser/ulexer.cmx runtime/value.cmx \
+    driver/run.cmi 
 driver/webiface.cmo: misc/q_symbol.cmo driver/cduce.cmi driver/examples.cmo parser/location.cmi \
     misc/state.cmi 
 driver/webiface.cmx: misc/q_symbol.cmo driver/cduce.cmx driver/examples.cmx parser/location.cmx \
@@ -268,5 +280,6 @@ compile/operators.cmi: misc/q_symbol.cmo misc/custom.cmo parser/location.cmi mis
 types/builtin.cmi: misc/q_symbol.cmo typing/typer.cmi 
 driver/librarian.cmi: misc/q_symbol.cmo types/types.cmi runtime/value.cmi 
 driver/cduce.cmi: misc/q_symbol.cmo types/ident.cmo types/types.cmi runtime/value.cmi 
+query/query.cmi: misc/q_symbol.cmo parser/ast.cmo 
 schema/schema_types.cmi: misc/q_symbol.cmo misc/encodings.cmi types/intervals.cmi misc/ns.cmi \
     runtime/value.cmi 

driver/cduce.ml

@@ -19,6 +19,7 @@ let prefix filename suff =
 let quiet = ref false
 let toplevel = ref false
 
+
 let typing_env = State.ref "Cduce.typing_env" Builtin.env
 let eval_env = State.ref "Cduce.eval_env" Eval.empty
 let compile_env = State.ref "Cduce.compile_env" Compile.empty

driver/cduce.mli

@@ -2,6 +2,8 @@ val quiet: bool ref
 val toplevel: bool ref
 val do_compile: bool ref
 
+
+
 val enter_global_value : Ident.id -> Value.t -> Types.descr -> unit
 val script   : Format.formatter -> Format.formatter -> char Stream.t -> bool
 val topinput : Format.formatter -> Format.formatter -> char Stream.t -> bool

driver/run.ml

@@ -27,7 +27,7 @@ been modified from the original Q Public.\n\n
 "; 
   exit 0
 
-let specs =
+let specs = ref 
   [ "--load", Arg.String (fun s -> load_dump := Some s), 
           "   load persistency file before running CDuce program";
     "--save", Arg.String (fun s -> save_dump := Some s), 
@@ -64,28 +64,29 @@ let ppf =
   else Format.std_formatter
 let ppf_err = Format.err_formatter
 
-
-let specs = 
+let () =
   if Load_xml.expat_support then
+     specs := 
     ("--expat", Arg.Unit (fun () -> Load_xml.use_parser := `Expat),
              "  use expat parser (default)") ::
     ("--pxp", Arg.Unit (fun () -> Load_xml.use_parser := `Pxp),
            "    use PXP parser") ::
-    specs
+    !specs
   else
+    specs :=
     ("--expat", Arg.Unit (fun () -> (Format.fprintf ppf  "WARNING: --expat unused option. CDuce compiled without expat support\n\n")),
              "  option not available: CDuce was compiled without expat support") ::
     ("--pxp", Arg.Unit (fun () -> (Format.fprintf ppf  "WARNING: --pxp useless option. CDuce compiled without expat support\n\n")),
            "    useless option:  CDuce was compiled without expat support") ::
-    specs
+    !specs
 
 
 let err s =
   prerr_endline s;
   exit 1
 
-let mode =
-  Arg.parse specs (fun s -> src := s :: !src) 
+let mode () =
+  Arg.parse !specs (fun s -> src := s :: !src) 
     "Usage:\ncduce [OPTIONS ...] [FILE ...] [--arg argument ...]\n\nOptions:";
   match (!compile,!out_dir,!run,!src,!args) with
     | false, _::_, _,  _, _   -> 
@@ -209,7 +210,7 @@ let save () =
     | None -> ()
 
 let main () = 
-  match mode with
+  match mode () with
     | `Toplevel args ->
 	restore (argv args);
 	toploop ();
@@ -221,8 +222,10 @@ let main () =
     | `Run (f,args) ->
 	Cduce.run f (argv args)
 	 
-let () =  
-  at_exit (fun () -> Stats.dump Format.std_formatter);
-  main ()
+let () = 
+(* Hum... *)
+  let b = ref true in
+  at_exit (fun () -> if !b then (b := false; main ()));
+  at_exit (fun () -> Stats.dump Format.std_formatter)
 
 

query/query_parse.ml

-open Parser.Hook
+open Location
+open Ast
+open Ident
+open Printf
 
+open Parser.Hook
+open Query
 #load "pa_extend.cmo";;
 
 
-EXTEND
+let exp pos e = LocatedExpr (loc_of_pos pos,e)
+
+let cst_nil =  Const (Types.Atom (Atoms.V.mk_ascii "nil"))
+
+let true_atom = Atoms.V.mk_ascii "true"
+let false_atom = Atoms.V.mk_ascii "false"
+let true_type = Types.atom (Atoms.atom true_atom)
+let false_type = Types.atom (Atoms.atom false_atom)
+
+
+ 
+EXTEND 
   GLOBAL: expr pat keyword;
 
 
@@ -11,12 +27,39 @@ EXTEND
     "top" [
      "select"; e = expr;
      "from";l = LIST1 [ x= pat ; "in"; e = expr -> (x,e)] SEP "," ;
-      z=OPT["where"  ; w = cond -> w]  -> assert false
-   ] ];
+      z=OPT["where"  ; w = cond -> w]  -> 
+     let (condi,fin) =
+      match z with
+           Some w -> let ptrue = mk loc (Internal true_type)
+                    and pfalse = mk loc (Internal false_type)
+                   in (w,exp loc (Match (Query.ast_of_bool(w,loc), [ptrue,exp loc (Pair(e,cst_nil));
+                  pfalse,cst_nil])))
+         | None -> (True,exp loc(Pair(e,cst_nil)))
+     in let s= if !Query.nooptim 
+                then Query.select(loc,fin,l)
+      		else Query.selectOpt(loc,fin,l,condi)
+	 in s		
 
+      
+      
+   ] ];
+   
   cond:
-    [
-     ["`";"true" -> assert false ] ];
+      [
+       ["`";"true" -> Query.True
+       |"`";"false" -> Query.False
+             | a = expr -> Query.Varb(a)
+       |"not"; a = cond -> Query.Not(a)
+       | a = cond ; "or" ; b = cond -> Query.Ou(a,b)
+       | a = cond ; "and" ; b = cond -> Query.Et(a,b)
+       | "(" ; a=cond ; ")" -> a
+      ]
+    ];
+
 
   keyword: [ [ a = [ "select" | "from" | "where" ] -> a ] ];
-END
\ No newline at end of file
+END
+
+
+
+