Commit ca3688e5 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-11-27 11:38:56 by afrisch] Factorisation + broutilles

Original author: afrisch
Date: 2003-11-27 11:38:57+00:00
parent 259382bf
......@@ -128,11 +128,12 @@ OBJECTS = \
types/builtin.cmo driver/librarian.cmo driver/cduce.cmo
CQL_OBJECTS= query/query.cmo query/query_parse.cmo
CQL_OBJECTS_RUN = query/query_run.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 $(CQL_OBJECTS)
WEBIFACE = $(OBJECTS) driver/examples.cmo driver/webiface.cmo
CDUCE = $(OBJECTS) $(CQL_OBJECTS) driver/run.cmo $(CQL_OBJECTS_RUN)
WEBIFACE = $(OBJECTS) $(CQL_OBJECTS) driver/examples.cmo driver/webiface.cmo
DTD2CDUCE = tools/dtd2cduce.cmo
ALL_OBJECTS = $(OBJECTS) $(CQL_OBJECTS) \
......
......@@ -118,3 +118,10 @@ and regexp =
| SeqCapture of id * regexp
let pat_true = mknoloc (Internal Builtin_defs.true_type)
let pat_false = mknoloc (Internal Builtin_defs.false_type)
let cst_true = Const (Types.Atom Builtin_defs.true_atom)
let cst_false = Const (Types.Atom Builtin_defs.false_atom)
let cst_nil = Const Sequence.nil_cst
let pat_nil = mknoloc (Internal (Sequence.nil_type))
......@@ -14,11 +14,6 @@ let error (i,j) s = Location.raise_loc i j (Error s)
let gram = Grammar.gcreate Ulexer.lex
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)
let parse_ident = U.mk
let id_dummy = ident (U.mk "$$$")
......@@ -52,9 +47,6 @@ let tuple_queue =
let char = mknoloc (Internal (Types.char Chars.any))
let string_regexp = Star (Elem char)
let cst_nil = Const (Types.Atom (Atoms.V.mk_ascii "nil"))
let pat_nil = mknoloc (Internal (Sequence.nil_type))
let seq_of_string s =
let s = Encodings.Utf8.mk s in
let rec aux i j =
......@@ -91,15 +83,12 @@ let is_fun_decl =
| _ -> raise Stream.Failure
)
let pat_true = mknoloc (Internal true_type)
let pat_false = mknoloc (Internal false_type)
let const_true = Const (Types.Atom (true_atom))
let const_false = Const (Types.Atom (false_atom))
let logical_and e1 e2 = Match (e1, [pat_true,e2; pat_false,const_false])
let logical_or e1 e2 = Match (e1, [pat_true,const_true; pat_false,e2])
let logical_not e = Match (e, [pat_true,const_false; pat_false,const_true])
let if_then_else cond e1 e2 = Match (cond, [pat_true,e1; pat_false,e2])
let logical_and e1 e2 = if_then_else e1 e2 cst_false
let logical_or e1 e2 = if_then_else e1 cst_true e2
let logical_not e = if_then_else e cst_false cst_true
EXTEND
GLOBAL: top_phrases prog expr pat regexp keyword;
......@@ -219,9 +208,7 @@ EXTEND
| "xtransform"; e = SELF; "with"; b = branches ->
exp loc (Xtrans (e,b))
| "if"; e = SELF; "then"; e1 = SELF; "else"; e2 = SELF ->
let p1 = mk loc (Internal true_type)
and p2 = mk loc (Internal false_type) in
exp loc (Match (e, [p1,e1; p2,e2]))
exp loc (if_then_else e e1 e2)
| "transform"; e = SELF; "with"; b = branches ->
exp loc (Transform (e,b))
| "validate"; e = SELF; "with"; (kind, schema, typ) = schema_ref ->
......
......@@ -17,7 +17,10 @@ module Hook: sig
end
(* Helpers *)
(* TODO: put this in Ast *)
val logical_and: Ast.pexpr -> Ast.pexpr -> Ast.pexpr
val logical_or: Ast.pexpr -> Ast.pexpr -> Ast.pexpr
val logical_not: Ast.pexpr -> Ast.pexpr
val if_then_else: Ast.pexpr -> Ast.pexpr -> Ast.pexpr -> Ast.pexpr
......@@ -7,23 +7,11 @@ open Ident
let nooptim = ref false
let () = Run.specs :=
( "--noquery-optim", Arg.Set nooptim,
" do not optimize queries " ) :: !Run.specs
(********************************)
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)
let ou (loc,e1,e2)= exp loc (Parser.logical_or e1 e2)
let et (loc,e1,e2)= exp loc (Parser.logical_and e1 e2)
......@@ -43,8 +31,8 @@ type 'a boolFormula =
let rec ast_of_bool(c,loc)=
match (c,loc) with
|(True,loc) -> (Const (Types.Atom (true_atom)))
|(False,loc) -> (Const (Types.Atom (false_atom)))
|(True,loc) -> cst_true
|(False,loc) -> cst_false
|(Varb(e),loc) -> e
|(Not(Varb(e)),loc) -> non(loc,e)
|(OuN([varb]),loc) -> ast_of_bool(varb,loc)
......@@ -73,8 +61,8 @@ let rec string_of_ppat p =
|PatVar(id) -> U.get_str ( id)
|Cst(Atom a) -> U.get_str a
|Internal(descr) ->
if descr=true_type then "`true"
else if descr=false_type then "`false"
if descr=Builtin_defs.true_type then "`true"
else if descr=Builtin_defs.false_type then "`false"
else if Types.is_empty descr then "Empty"
else if Types.atom ( Atoms.any)=descr then "_"
else if Types.Record.any=descr then "_"
......@@ -525,8 +513,7 @@ let select2(loc,e,t) =
match c with
EtN[OuN[True]] -> e
|True -> e
|c -> exp loc(Match(ast_of_bool(c,loc),[mk loc (Internal true_type),e;
mk loc (Internal false_type),cst_nil]))
|c -> exp loc (Parser.if_then_else (ast_of_bool(c,loc)) e cst_nil)
in let rec saux loc e t =
(match t with
[] -> exp loc (Pair(cst_nil,cst_nil))
......
......@@ -10,13 +10,7 @@ open Query
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)
let cst_nil = Const Sequence.nil_cst
EXTEND
......@@ -28,20 +22,18 @@ EXTEND
"select"; e = expr;
"from";l = LIST1 [ x= pat ; "in"; e = expr -> (x,e)] SEP "," ;
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
let (condi,fin) =
match z with
Some w ->
(w, exp loc
(Parser.if_then_else (Query.ast_of_bool(w,loc))
(Pair (e,cst_nil))
cst_nil))
| None -> (True, exp loc (Pair(e,cst_nil)))
in
if !Query.nooptim
then Query.select(loc,fin,l)
else Query.selectOpt(loc,fin,l,condi)
] ];
cond:
......
let () = Run.specs :=
( "--noquery-optim", Arg.Set Query.nooptim,
" do not optimize queries " ) :: !Run.specs
let nil_atom = Atoms.V.mk_ascii "nil"
let nil_type = Types.atom (Atoms.atom nil_atom)
let nil_node = Types.cons nil_type
let nil_cst = Types.Atom nil_atom
let decompose t =
(Types.Atom.has_atom t nil_atom,
......
val nil_type: Types.t
val nil_node: Types.Node.t
val nil_atom: Atoms.V.t
val nil_cst: Types.Const.t
val any: Types.t
val seqseq: Types.t
val string: Types.t
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment