From: Ferruccio Guidi Date: Tue, 26 Nov 2002 11:43:29 +0000 (+0000) Subject: MathQL.ml updated X-Git-Tag: V_0_0_6~57 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=fb7df84a9ffea7a67817b303a1d6983fb52e963d;p=helm.git MathQL.ml updated --- diff --git a/helm/ocaml/mathql/mQueryTLexer.mll b/helm/ocaml/mathql/mQueryTLexer.mll index 6f4fab954..5dbb3d1b9 100644 --- a/helm/ocaml/mathql/mQueryTLexer.mll +++ b/helm/ocaml/mathql/mQueryTLexer.mll @@ -35,6 +35,10 @@ { open MQueryTParser + + let debug = true + + let out s = if debug then prerr_endline s } let SPC = [' ' '\t' '\n']+ @@ -49,50 +53,53 @@ rule comm_token = parse and string_token = parse | '"' { DQ } | '\\' _ { STR (String.sub (Lexing.lexeme lexbuf) 1 1) } - | QSTR { STR (Lexing.lexeme lexbuf) } + | QSTR { prerr_endline "STR"; STR (Lexing.lexeme lexbuf) } | eof { EOF } and query_token = parse | "(*" { comm_token lexbuf } | SPC { query_token lexbuf } - | '"' { STR (qstr string_token lexbuf) } - | '(' { LP } - | ')' { RP } - | '{' { LC } - | '}' { RC } - | '@' { AT } - | '%' { PC } - | '$' { DL } - | '.' { FS } - | ',' { CM } - | '/' { SL } - | "and" { AND } - | "attr" { ATTR } - | "attribute" { ATTRIB } - | "be" { BE } - | "diff" { DIFF } - | "eq" { EQ } - | "ex" { EX } - | "false" { FALSE } - | "fun" { FUN } - | "in" { IN } - | "intersect" { INTER } - | "inverse" { INV } - | "let" { LET } - | "meet" { MEET } - | "not" { NOT } - | "or" { OR } - | "pattern" { PAT } - | "ref" { REF } - | "refof" { REFOF } - | "relation" { REL } - | "select" { SELECT } - | "sub" { SUB } - | "super" { SUPER } - | "true" { TRUE } - | "union" { UNION } - | "where" { WHERE } - | IDEN { ID (Lexing.lexeme lexbuf) } - | eof { EOF } + | '"' { let str = qstr string_token lexbuf in + out ("STR " ^ str); STR str } + | '(' { out "LP"; LP } + | ')' { out "RP"; RP } + | '{' { out "LC"; LC } + | '}' { out "RC"; RC } + | '@' { out "AT"; AT } + | '%' { out "PC"; PC } + | '$' { out "DL"; DL } + | '.' { out "FS"; FS } + | ',' { out "CM"; CM } + | '/' { out "SL"; SL } + | "<-" { out "GETS" ; GETS } + | "and" { out "AND" ; AND } + | "attr" { out "ATTR" ; ATTR } + | "be" { out "BE" ; BE } + | "diff" { out "DIFF" ; DIFF } + | "eq" { out "EQ" ; EQ } + | "ex" { out "EX" ; EX } + | "false" { out "FALSE" ; FALSE } + | "fun" { out "FUN" ; FUN } + | "in" { out "IN" ; IN } + | "intersect" { out "INTER" ; INTER } + | "inverse" { out "INV" ; INV } + | "let" { out "LET" ; LET } + | "meet" { out "MEET" ; MEET } + | "not" { out "NOT" ; NOT } + | "or" { out "OR" ; OR } + | "pattern" { out "PAT" ; PAT } + | "ptoperty" { out "PROP" ; PROP } + | "ref" { out "REF" ; REF } + | "refof" { out "REFOF" ; REFOF } + | "relation" { out "REL" ; REL } + | "select" { out "SELECT"; SELECT } + | "sub" { out "SUB" ; SUB } + | "super" { out "SUPER" ; SUPER } + | "true" { out "TRUE" ; TRUE } + | "union" { out "UNION" ; UNION } + | "where" { out "WHERE" ; WHERE } + | IDEN { let id = Lexing.lexeme lexbuf in + out ("ID " ^ id); ID id } + | eof { out "EOF" ; EOF } and result_token = parse | SPC { result_token lexbuf } | '"' { STR (qstr string_token lexbuf) } @@ -101,5 +108,5 @@ and result_token = parse | ',' { CM } | ';' { SC } | '=' { IS } - | "attr" { ATTR } - | eof { EOF } + | "attr" { ATTR } + | eof { EOF } diff --git a/helm/ocaml/mathql/mQueryTParser.mly b/helm/ocaml/mathql/mQueryTParser.mly index 7bc2f97bf..1ebadd29a 100644 --- a/helm/ocaml/mathql/mQueryTParser.mly +++ b/helm/ocaml/mathql/mQueryTParser.mly @@ -44,12 +44,12 @@ | s1 :: tl1, s2 :: tl2 -> s1 :: join tl1 tl2 in let rec an_val = function - | M.Const _ -> [] - | M.VVar _ -> [] - | M.Record (rv, _) -> [rv] - | M.Fun (_, x) -> an_val x - | M.Attribute (_, _, _, x) -> an_val x - | M.RefOf x -> an_set x + | M.Const _ -> [] + | M.VVar _ -> [] + | M.Record (rv, _) -> [rv] + | M.Fun (_, x) -> an_val x + | M.Property (_, _, _, x) -> an_val x + | M.RefOf x -> an_set x and an_boole = function | M.False -> [] | M.True -> [] @@ -74,15 +74,17 @@ | M.Select (_, x, y) -> join (an_set x) (an_boole y) in an_boole x + + let path_of_vvar v = (v, []) %} %token ID STR - %token SL IS LC RC CM SC LP RP AT PC DL FS DQ EOF - %token AND ATTR ATTRIB BE DIFF EQ EX FALSE FUN IN INTER INV LET MEET NOT - %token OR PAT REF REFOF REL SELECT SUB SUPER TRUE UNION WHERE + %token SL IS LC RC CM SC LP RP AT PC DL FS DQ GETS EOF + %token AND ATTR BE DIFF EQ EX FALSE FUN IN INTER INV LET MEET NOT OR PAT + %token PROP REF REFOF REL SELECT SUB SUPER TRUE UNION WHERE %left DIFF WHERE REFOF %left OR UNION %left AND INTER - %nonassoc REL + %nonassoc REL %nonassoc NOT EX IN ATTR %start qstr query result @@ -124,16 +126,23 @@ | SUPER { MathQL.RefineSuper } | { MathQL.RefineExact } ; + assign: + | vvar GETS path { (path_of_vvar $1, $3) } + ; + assigns: + | assign CM assigns { $1 :: $3 } + | assign { [$1] } + ; val_exp: - | STR { MathQL.Const [$1] } - | FUN STR val_exp { MathQL.Fun ($2, $3) } - | ATTRIB inv ref path val_exp { MathQL.Attribute ($2, $3, $4, $5) } - | rvar FS path { MathQL.Record ($1, $3) } - | vvar { MathQL.VVar $1 } - | LC strs RC { MathQL.Const $2 } - | LC RC { MathQL.Const [] } - | REFOF set_exp { MathQL.RefOf $2 } - | LP val_exp RP { $2 } + | STR { MathQL.Const [$1] } + | FUN STR val_exp { MathQL.Fun ($2, $3) } + | PROP inv ref path val_exp { MathQL.Property ($2, $3, $4, $5) } + | rvar FS vvar { MathQL.Record ($1, path_of_vvar $3) } + | vvar { MathQL.VVar $1 } + | LC strs RC { MathQL.Const $2 } + | LC RC { MathQL.Const [] } + | REFOF set_exp { MathQL.RefOf $2 } + | LP val_exp RP { $2 } ; boole_exp: | TRUE { MathQL.True } @@ -152,8 +161,8 @@ | PAT val_exp { MathQL.Pattern $2 } | LP set_exp RP { $2 } | SELECT rvar IN set_exp WHERE boole_exp { MathQL.Select ($2, $4, $6) } - | REL inv ref path set_exp ATTR strs { MathQL.Relation ($2, $3, $4, $5, $7) } - | REL inv ref path set_exp { MathQL.Relation ($2, $3, $4, $5, []) } + | REL inv ref path val_exp ATTR assigns { MathQL.Relation ($2, $3, $4, MathQL.Ref $5, $7) } + | REL inv ref path val_exp { MathQL.Relation ($2, $3, $4, MathQL.Ref $5, []) } | svar { MathQL.SVar $1 } | rvar { MathQL.RVar $1 } | set_exp UNION set_exp { MathQL.Union ($1, $3) } @@ -166,8 +175,8 @@ | set_exp EOF { $1 } ; attr: - | path IS strs { ($1, $3) } - | path { ($1, []) } + | vvar IS strs { (path_of_vvar $1, $3) } + | vvar { (path_of_vvar $1, []) } ; attrs: | attr SC attrs { $1 :: $3 } diff --git a/helm/ocaml/mathql/mQueryUtil.ml b/helm/ocaml/mathql/mQueryUtil.ml index 75e587229..98371c053 100644 --- a/helm/ocaml/mathql/mQueryUtil.ml +++ b/helm/ocaml/mathql/mQueryUtil.ml @@ -46,11 +46,14 @@ let txt_str s = "\"" ^ s ^ "\"" let txt_path (p0, p1) = txt_str p0 ^ (if p1 <> [] then "/" ^ txt_list txt_str "/" p1 else "") +let txt_svar sv = "%" ^ sv + +let txt_rvar rv = "@" ^ rv + +let txt_vvar vv = "$" ^ vv + let text_of_query x = let module M = MathQL in - let txt_svar sv = "%" ^ sv in - let txt_rvar rv = "@" ^ rv in - let txt_vvar vv = "$" ^ vv in let txt_inv i = if i then "inverse " else "" in let txt_ref = function | M.RefineExact -> "" @@ -58,14 +61,15 @@ let text_of_query x = | M.RefineSuper -> "super " in let txt_refpath i r p = txt_inv i ^ txt_ref r ^ txt_path p ^ " " in + let txt_assign (pl, pr) = txt_vvar (fst pl) ^ " <- " ^ txt_path pr in let rec txt_val = function - | M.Const [s] -> txt_str s - | M.Const l -> "{" ^ txt_list txt_str ", " l ^ "}" - | M.VVar vv -> txt_vvar vv - | M.Record (rv, p) -> txt_rvar rv ^ "." ^ txt_path p - | M.Fun (s, x) -> "fun " ^ txt_str s ^ " " ^ txt_val x - | M.Attribute (i, r, p, x) -> "attribute " ^ txt_refpath i r p ^ txt_val x - | M.RefOf x -> "refof " ^ txt_set x + | M.Const [s] -> txt_str s + | M.Const l -> "{" ^ txt_list txt_str ", " l ^ "}" + | M.VVar vv -> txt_vvar vv + | M.Record (rv, p) -> txt_rvar rv ^ "." ^ txt_vvar (fst p) + | M.Fun (s, x) -> "fun " ^ txt_str s ^ " " ^ txt_val x + | M.Property (i, r, p, x) -> "property " ^ txt_refpath i r p ^ txt_val x + | M.RefOf x -> "refof " ^ txt_set x and txt_boole = function | M.False -> "false" | M.True -> "true" @@ -80,8 +84,8 @@ let text_of_query x = and txt_set = function | M.SVar sv -> txt_svar sv | M.RVar rv -> txt_rvar rv - | M.Relation (i, r, p, x, []) -> "relation " ^ txt_refpath i r p ^ txt_set x - | M.Relation (i, r, p, x, l) -> "relation " ^ txt_refpath i r p ^ txt_set x ^ " attr " ^ txt_list txt_str ", " l + | M.Relation (i, r, p, M.Ref x, []) -> "relation " ^ txt_refpath i r p ^ txt_val x + | M.Relation (i, r, p, M.Ref x, l) -> "relation " ^ txt_refpath i r p ^ txt_val x ^ " attr " ^ txt_list txt_assign ", " l | M.Union (x, y) -> "(" ^ txt_set x ^ " union " ^ txt_set y ^ ")" | M.Intersect (x, y) -> "(" ^ txt_set x ^ " intersect " ^ txt_set y ^ ")" | M.Diff (x, y) -> "(" ^ txt_set x ^ " diff " ^ txt_set y ^ ")" @@ -90,13 +94,14 @@ let text_of_query x = | M.Select (rv, x, y) -> "select " ^ txt_rvar rv ^ " in " ^ txt_set x ^ " where " ^ txt_boole y | M.Pattern x -> "pattern " ^ txt_val x | M.Ref x -> "ref " ^ txt_val x + | _ -> assert false in txt_set x let text_of_result x sep = let txt_attr = function - | (p, []) -> txt_path p - | (p, l) -> txt_path p ^ " = " ^ txt_list txt_str ", " l + | (p, []) -> txt_vvar (fst p) + | (p, l) -> txt_vvar (fst p) ^ " = " ^ txt_list txt_str ", " l in let txt_group l = "{" ^ txt_list txt_attr "; " l ^ "}" in let txt_res = function diff --git a/helm/ocaml/mathql/mathQL.ml b/helm/ocaml/mathql/mathQL.ml index 04eb3b32d..61a7646aa 100644 --- a/helm/ocaml/mathql/mathQL.ml +++ b/helm/ocaml/mathql/mathQL.ml @@ -68,11 +68,13 @@ type refine = RefineExact | RefineSub | RefineSuper +type assign = path * path + type set_exp = SVar of svar | RVar of rvar | Ref of val_exp | Pattern of val_exp - | Relation of inverse * refine * path * set_exp * string list + | Relation of inverse * refine * path * set_exp * assign list | Select of rvar * set_exp * boole_exp | Union of set_exp * set_exp | Intersect of set_exp * set_exp @@ -94,7 +96,7 @@ and val_exp = Const of string list | RefOf of set_exp | Record of rvar * path | VVar of vvar - | Attribute of inverse * refine * path * val_exp + | Property of inverse * refine * path * val_exp | Fun of string * val_exp type query = set_exp diff --git a/helm/ocaml/mathql_interpreter/mqint.ml b/helm/ocaml/mathql_interpreter/mqint.ml index 415ee1340..e9f606b2e 100644 --- a/helm/ocaml/mathql_interpreter/mqint.ml +++ b/helm/ocaml/mathql_interpreter/mqint.ml @@ -124,14 +124,14 @@ let rec exec_set_exp c = function | MathQL.Relation (inv, rop, path, sexp, attl) -> let before = Sys.time() in if ! dbname = postgres_db then - (let res = relation_ex inv rop path (exec_set_exp c sexp) attl in + (let res = relation_ex inv rop path (exec_set_exp c sexp) [] in (* tolto attl solo pe far compilare, rimetterlo *) if ! stat then (print_string ("RELATION " ^ (fst path) ^ " = " ^ string_of_int(List.length res) ^ ": "); print_endline (string_of_float (Sys.time() -. before) ^ "s"); flush stdout); res) else - (let res = relation_galax_ex inv rop path (exec_set_exp c sexp) attl in + (let res = relation_galax_ex inv rop path (exec_set_exp c sexp) [] in (* tolto attl solo pe far compilare, rimetterlo *) if !stat then (print_string ("RELATION-GALAX " ^ (fst path) ^ " = " ^ string_of_int(List.length res) ^ ": "); print_endline (string_of_float (Sys.time() -. before) ^ "s"); @@ -207,7 +207,7 @@ and exec_val_exp c = function | MathQL.VVar s -> List.assoc s c.vvars | MathQL.RefOf sexp -> List.map (fun (s,_) -> s) (exec_set_exp c sexp) | MathQL.Fun (s, vexp) -> fun_ex s (exec_val_exp c vexp) - | MathQL.Attribute (inv, rop, path, vexp) -> attribute_ex rop path inv (exec_val_exp c vexp) + | MathQL.Property (inv, rop, path, vexp) -> attribute_ex rop path inv (exec_val_exp c vexp) (* valuta una MathQL.set_exp nel contesto vuoto e ritorna un MathQL.resource_set *) and execute x =