{
open MQueryTParser
+
+ let debug = true
+
+ let out s = if debug then prerr_endline s
}
let SPC = [' ' '\t' '\n']+
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) }
| ',' { CM }
| ';' { SC }
| '=' { IS }
- | "attr" { ATTR }
- | eof { EOF }
+ | "attr" { ATTR }
+ | eof { EOF }
| 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 -> []
| M.Select (_, x, y) -> join (an_set x) (an_boole y)
in
an_boole x
+
+ let path_of_vvar v = (v, [])
%}
%token <string> 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
| 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 }
| 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) }
| 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 }
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 -> ""
| 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"
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 ^ ")"
| 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
| 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
| 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
| 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");
| 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 =
projects / helm.git / commitdiff