From 32f737bea2029db1f4870ec8a3a39ba6d2e4a57d Mon Sep 17 00:00:00 2001 From: Ferruccio Guidi Date: Fri, 13 Sep 2002 11:52:42 +0000 Subject: [PATCH] parsing and pretty printing for textual notation --- helm/ocaml/mathql/.depend | 8 ++ helm/ocaml/mathql/Makefile | 13 +- helm/ocaml/mathql/mQueryTLexer.mll | 31 ++-- helm/ocaml/mathql/mQueryTParser.mly | 117 ++++++++++----- helm/ocaml/mathql/mQueryUtil.ml | 212 ++++++++++------------------ helm/ocaml/mathql/mQueryUtil.mli | 12 ++ helm/ocaml/mathql/mathQL.ml | 12 +- 7 files changed, 219 insertions(+), 186 deletions(-) diff --git a/helm/ocaml/mathql/.depend b/helm/ocaml/mathql/.depend index e69de29bb..769e30c89 100644 --- a/helm/ocaml/mathql/.depend +++ b/helm/ocaml/mathql/.depend @@ -0,0 +1,8 @@ +mQueryTParser.cmi: mathQL.cmo +mQueryUtil.cmi: mathQL.cmo +mQueryTParser.cmo: mathQL.cmo mQueryTParser.cmi +mQueryTParser.cmx: mathQL.cmx mQueryTParser.cmi +mQueryTLexer.cmo: mQueryTParser.cmi +mQueryTLexer.cmx: mQueryTParser.cmx +mQueryUtil.cmo: mQueryTLexer.cmo mQueryTParser.cmi mathQL.cmo mQueryUtil.cmi +mQueryUtil.cmx: mQueryTLexer.cmx mQueryTParser.cmx mathQL.cmx mQueryUtil.cmi diff --git a/helm/ocaml/mathql/Makefile b/helm/ocaml/mathql/Makefile index d1c97a1a1..8eb819bd3 100644 --- a/helm/ocaml/mathql/Makefile +++ b/helm/ocaml/mathql/Makefile @@ -1,13 +1,16 @@ PACKAGE = mathql -REQUIRES = helm-urimanager +# REQUIRES = helm-urimanager PREDICATES = -INTERFACE_FILES = +INTERFACE_FILES = mQueryTParser.mli mQueryUtil.mli -IMPLEMENTATION_FILES = mathQL.ml +IMPLEMENTATION_FILES = mathQL.ml mQueryTParser.ml mQueryTLexer.ml \ + mQueryUtil.ml -EXTRA_OBJECTS_TO_INSTALL = mathQL.ml mathQL.cmi +EXTRA_OBJECTS_TO_INSTALL = mathQL.ml mathQL.cmi mQueryTLexer.cmi \ + mQueryTLexer.mll mQueryTParser.mly -EXTRA_OBJECTS_TO_CLEAN = +EXTRA_OBJECTS_TO_CLEAN = mQueryTParser.ml mQueryTParser.mli \ + mQueryTLexer.ml include ../Makefile.common diff --git a/helm/ocaml/mathql/mQueryTLexer.mll b/helm/ocaml/mathql/mQueryTLexer.mll index ca24965b1..5f9b2ebac 100644 --- a/helm/ocaml/mathql/mQueryTLexer.mll +++ b/helm/ocaml/mathql/mQueryTLexer.mll @@ -41,32 +41,38 @@ let SPC = [' ' '\t' '\n']+ let ALPHA = ['A'-'Z' 'a'-'z'] let NUM = ['0'-'9'] let IDEN = ALPHA (NUM | ALPHA)* -let QSTR = [^ '"\']* - +let QSTR = [^ '"' '\\']+ rule string_token = parse | '"' { DQ } - | '\' . { STR (Lexing.lexeme lexbuf) } - | QSTR { STR (String.sub 1 1 (Lexing.lexeme lexbuf)) } + | '\\' _ { STR (String.sub (Lexing.lexeme lexbuf) 1 1) } + | QSTR { STR (Lexing.lexeme lexbuf) } | eof { EOF } -and main_token = parse - | SPC { main_token lexbuf } +and query_token = parse + | SPC { query_token lexbuf } + | '"' { STR (qstr string_token lexbuf) } | '(' { LP } | ')' { RP } + | '{' { LC } + | '}' { RC } | '@' { AT } | '%' { PC } | '$' { DL } | '.' { FS } - | '"' { STR (qstr string_token lexbuf } + | ',' { CM } | "and" { AND } | "attr" { ATTR } | "attribute" { ATTRIB } + | "be" { BE } | "diff" { DIFF } | "eq" { EQ } + | "ex" { EX } | "false" { FALSE } | "fun" { FUN } | "in" { IN } | "intersect" { INTER } + | "let" { LET } + | "meet" { MEET } | "not" { NOT } | "or" { OR } | "pattern" { PAT } @@ -81,4 +87,13 @@ and main_token = parse | "where" { WHERE } | IDEN { ID (Lexing.lexeme lexbuf) } | eof { EOF } - +and result_token = parse + | SPC { result_token lexbuf } + | '"' { STR (qstr string_token lexbuf) } + | '{' { LC } + | '}' { RC } + | ',' { CM } + | ';' { SC } + | '=' { IS } + | "attr" { ATTR } + | eof { EOF } diff --git a/helm/ocaml/mathql/mQueryTParser.mly b/helm/ocaml/mathql/mQueryTParser.mly index 7f1c6e91b..be861dc82 100644 --- a/helm/ocaml/mathql/mQueryTParser.mly +++ b/helm/ocaml/mathql/mQueryTParser.mly @@ -36,20 +36,21 @@ %{ %} %token ID STR - %token LC RC CM SC LP RP AT PC DL FS DQ EOF - %token AND ATTR ATTRIB DIFF EQ FALSE FUN IN INTER NOT OR PAT REF REFOF - %token REL SELECT SUB SUPER TRUE UNION WHERE - %left DIFF + %token 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 LET MEET NOT OR + %token PAT REF REFOF REL SELECT SUB SUPER TRUE UNION WHERE + %left DIFF WHERE REFOF %left OR UNION %left AND INTER - %nonassoc NOT - %start qstr ref query - %type qstr - %type query + %nonassoc NOT EX IN STR ATTR + %start qstr query result + %type qstr + %type query + %type result %% qstr: - | QT { "" } - | STR qstr { $1 @ $2 } + | DQ { "" } + | STR qstr { $1 ^ $2 } ; svar: | PC ID { $2 } @@ -60,32 +61,80 @@ vvar: | DL ID { $2 } ; - val: - | MCONCL { MQMConclusion } - | CONCL { MQConclusion } - | STR { MQCons $1 } - | rvar { MQStringRVar $1 } - | svar { MQStringSVar $1 } - | func rvar { MQFunc ($1, $2) } + qstr_list: + | STR CM qstr_list { $1 :: $3 } + | STR { [$1] } ; - boole: - | TRUE { MQTrue } - | FALSE { MQFalse } - | str IS str { MQIs ($1, $3) } - | NOT boole { MQNot $2 } - | boole AND boole { MQAnd ($1, $3) } - | boole OR boole { MQOr ($1, $3) } - | LPR boole RPR { $2 } + vvar_list: + | vvar CM vvar_list { $1 :: $3 } + | vvar { [$1] } + ; + ref_op: + | SUB { MathQL.SubOp } + | SUPER { MathQL.SuperOp } + | { MathQL.ExactOp } + ; + val_exp: + | STR { MathQL.Const [$1] } + | FUN STR val_exp { MathQL.Fun ($2, $3) } + | ATTRIB ref_op STR val_exp { MathQL.Attribute ($2, $3, $4) } + | rvar FS vvar { MathQL.Record ($1, $3) } + | LC qstr_list RC { MathQL.Const $2 } + | LC RC { MathQL.Const [] } + | REFOF set_exp { MathQL.RefOf $2 } + ; + boole_exp: + | TRUE { MathQL.True } + | FALSE { MathQL.False } + | LP boole_exp RP { $2 } + | NOT boole_exp { MathQL.Not $2 } + | EX boole_exp { MathQL.Ex $2 } + | val_exp SUB val_exp { MathQL.Sub ($1, $3) } + | val_exp MEET val_exp { MathQL.Meet ($1, $3) } + | val_exp EQ val_exp { MathQL.Eq ($1, $3) } + | boole_exp AND boole_exp { MathQL.And ($1, $3) } + | boole_exp OR boole_exp { MathQL.Or ($1, $3) } ; - rlist: - | PATT REF { MQPattern $2 } - | rlist UNION rlist { MQUnion ($1, $3) } - | rlist INTER rlist { MQIntersect ($1, $3) } - | USE rlist POS svar { MQUse ($2, $4) } - | USEDBY rlist POS svar { MQUsedBy ($2, $4) } - | SELECT rvar IN rlist WHERE boole { MQSelect ($2, $4, $6) } - | LPR rlist RPR { $2 } + set_exp: + | REF val_exp { MathQL.Ref $2 } + | 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 ref_op STR set_exp ATTR vvar_list { MathQL.Relation ($2, $3, $4, $6) } + | REL ref_op STR set_exp { MathQL.Relation ($2, $3, $4, []) } + | svar { MathQL.SVar $1 } + | rvar { MathQL.RVar $1 } + | set_exp UNION set_exp { MathQL.Union ($1, $3) } + | set_exp INTER set_exp { MathQL.Intersect ($1, $3) } + | set_exp DIFF set_exp { MathQL.Diff ($1, $3) } + | LET svar BE set_exp IN set_exp { MathQL.Let ($2, $4, $6) } ; query: - rlist EOF { MQList $1 } + | set_exp EOF { $1 } + ; + attribute: + | STR IS qstr_list { ($1, $3) } + | STR { ($1, []) } + ; + attr_list: + | attribute SC attr_list { $1 :: $3 } + | attribute { [$1] } ; + group: + LC attr_list RC { $2 } + ; + group_list: + | group CM group_list { $1 :: $3 } + | group { [$1] } + ; + resource: + | STR ATTR group_list { ($1, $3) } + | STR { ($1, []) } + ; + resource_list: + | resource SC resource_list { $1 :: $3 } + | resource { [$1] } + | { [] } + ; + result: + | resource_list EOF { $1 } diff --git a/helm/ocaml/mathql/mQueryUtil.ml b/helm/ocaml/mathql/mQueryUtil.ml index 8943e5675..75eb86d44 100644 --- a/helm/ocaml/mathql/mQueryUtil.ml +++ b/helm/ocaml/mathql/mQueryUtil.ml @@ -33,137 +33,81 @@ (* *) (******************************************************************************) -open MathQL -open MQueryHTML - -(* string linearization of a reference **************************************) - -let str_btoken = function - | MQBC s -> s - | MQBD -> "/" - | MQBQ -> "?" - | MQBS -> "*" - | MQBSS -> "**" - -let str_ftoken = function - | MQFC i -> string_of_int i - | MQFS -> "*" - | MQFSS -> "**" - -let str_prot = function - | Some s -> s - | None -> "*" - -let rec str_body = function - | [] -> "" - | head :: tail -> str_btoken head ^ str_body tail - -let str_frag xpointer f l = - let sfi = List.fold_left (fun l0 t0 -> l0 ^ "/" ^ f t0) "" l in - if sfi = "" then "" else - if xpointer then "#xpointer(1" ^ sfi ^ ")" else - "#1" ^ sfi - -let str_tref (p, b, i) = - str_prot p ^ ":/" ^ str_body b ^ str_frag false str_ftoken i - -let xp_str_tref (p, b, i) = - str_prot p ^ ":/" ^ str_body b ^ str_frag true str_ftoken i - -let str_uref (u, i) = - UriManager.string_of_uri u ^ str_frag false string_of_int i - -let xp_str_uref (u, i) = - UriManager.string_of_uri u ^ str_frag true string_of_int i - -(* HTML representation of a query ********************************************) - -let out_rvar s = sym s - -let out_svar s = sep "$" ^ sym s - -let out_lvar s = sep "%" ^ sym s - -let out_tref r = pat (str_tref r) - -let rec out_sequence f = function - | [] -> sep "." - | [s] -> f s - | s :: tail -> f s ^ sep ", " ^ out_sequence f tail - -let out_order = function - | MQAsc -> sub2 "asc" - | MQDesc -> sub2 "desc" - -let out_func = function - | MQName -> key "name" - | MQTheory -> key "theory" - | MQTitle -> key "title" - | MQContributor -> key "contributor" - | MQCreator -> key "creator" - | MQPublisher -> key "publisher" - | MQSubject -> key "subject" - | MQDescription -> key "description" - | MQDate -> key "date" - | MQType -> key "type" - | MQFormat -> key "format" - | MQIdentifier -> key "identifier" - | MQLanguage -> key "language" - | MQRelation -> key "relation" - | MQSource -> key "source" - | MQCoverage -> key "coverage" - | MQRights -> key "rights" - | MQInstitution -> key "institution" - | MQContact -> key "contact" - | MQFirstVersion -> key "firstversion" - | MQModified -> key "modified" - -let out_str = function - | MQCons s -> str s - | MQStringRVar s -> out_rvar s - | MQStringSVar s -> out_svar s - | MQFunc (f, r) -> out_func f ^ out_rvar r - | MQMConclusion -> key "mainconclusion" - | MQConclusion -> key "inconclusion" - -let rec out_bool = function - | MQTrue -> key "true" - | MQFalse -> key "false" - | MQIs (s, t) -> out_str s ^ sub "is" ^ out_str t - | MQNot b -> key "not" ^ out_bool b - | MQAnd (b1, b2) -> sep "(" ^ out_bool b1 ^ sub "and" ^ out_bool b2 ^ sep ")" - | MQOr (b1, b2) -> sep "(" ^ out_bool b1 ^ sub "or" ^ out_bool b2 ^ sep ")" - | MQSubset (l1, l2) -> sep "(" ^ out_list l1 ^ sub "subset" ^ out_list l2 ^ sep ")" - | MQSetEqual (l1, l2) -> sep "(" ^ out_list l1 ^ sub "setequal" ^ out_list l2 ^ sep ")" - -and out_list = function - | MQSelect (r, l, b) -> - key "select" ^ out_rvar r ^ sub "in" ^ out_list l ^ sub "where" ^ out_bool b - | MQUse (l, v) -> key "use" ^ out_list l ^ sub "position" ^ out_svar v - | MQUsedBy (l, v) -> key "usedby" ^ out_list l ^ sub "position" ^ out_svar v - | MQPattern p -> key "pattern" ^ out_tref p - | MQUnion (l1, l2) -> sep "(" ^ out_list l1 ^ sub "union" ^ out_list l2 ^ sep ")" - | MQIntersect (l1, l2) -> sep "(" ^ out_list l1 ^ sub "intersect" ^ out_list l2 ^ sep ")" - | MQDiff (l1, l2) -> sep "(" ^ out_list l1 ^ sub "diff" ^ out_list l2 ^ sep ")" - | MQListRVar v -> out_rvar v - | MQSortedBy (l, o, f) -> sep "(" ^ out_list l ^ sub "sortedby" ^ out_func f ^ out_order o ^ sep ")" - | MQListLVar v -> out_lvar v - | MQLetIn (v, l1, l2) -> key "let" ^ out_lvar v ^ sub "be" ^ out_list l1 ^ sub "in" ^ out_list l2 - | MQReference s -> key "reference" ^ out_sequence str s - -let out_query = function - | MQList l -> out_list l - -(* HTML representation of a query result ************************************) - -let rec out_res_list = function - | [] -> "" - | u :: l -> res u ^ nl () ^ out_res_list l - -let out_result qr = - par () ^ "Result:" ^ nl () ^ - match qr with - | MQRefs l -> out_res_list l + +(* text linearization and parsing *******************************************) + +let rec txt_list f s = function + | [] -> "" + | [a] -> f a + | a :: tail -> f a ^ s ^ txt_list f s tail + +let txt_qstr s = "\"" ^ s ^ "\"" + +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_ref = function + | M.ExactOp -> "" + | M.SubOp -> "sub " + | M.SuperOp -> "super " + in + let txt_vvar_list l = + txt_list txt_vvar "," l + in + let rec txt_val = function + | M.Const [s] -> txt_qstr s + | M.Const l -> "{" ^ txt_list txt_qstr "," l ^ "}" + | M.Record (rv, vv) -> txt_rvar rv ^ "." ^ txt_rvar vv + | M.Fun (s, x) -> "fun " ^ txt_qstr s ^ " " ^ txt_val x + | M.Attribute (r, s, x) -> "attribute " ^ txt_ref r ^ txt_qstr s ^ " " ^ txt_val x + | M.RefOf x -> "refof " ^ txt_set x + and txt_boole = function + | M.False -> "false" + | M.True -> "true" + | M.Ex x -> "ex " ^ txt_boole x + | M.Not x -> "not " ^ txt_boole x + | M.And (x, y) -> "(" ^ txt_boole x ^ " and " ^ txt_boole y ^ ")" + | M.Or (x, y) -> "(" ^ txt_boole x ^ " or " ^ txt_boole y ^ ")" + | M.Sub (x, y) -> "(" ^ txt_val x ^ " sub " ^ txt_val y ^ ")" + | M.Meet (x, y) -> "(" ^ txt_val x ^ " meet " ^ txt_val y ^ ")" + | M.Eq (x, y) -> "(" ^ txt_val x ^ " eq " ^ txt_val y ^ ")" + and txt_set = function + | M.SVar sv -> txt_svar sv + | M.RVar rv -> txt_rvar rv + | M.Relation (r, s, x, []) -> "relation " ^ txt_ref r ^ txt_qstr s ^ " " ^ txt_set x + | M.Relation (r, s, x, l) -> "relation " ^ txt_ref r ^ txt_qstr s ^ " " ^ txt_set x ^ " attr " ^ txt_vvar_list 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.Let (sv, x, y) -> "let " ^ txt_svar sv ^ " be " ^ txt_set x ^ " in " ^ 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 + in + txt_set x + +let text_of_result x = + let txt_attr = function + | (s, []) -> txt_qstr s + | (s, l) -> txt_qstr s ^ "=" ^ txt_list txt_qstr "," l + in + let txt_group l = "{" ^ txt_list txt_attr ";" l ^ "}" in + let txt_res = function + | (s, []) -> txt_qstr s + | (s, l) -> txt_qstr s ^ " attr " ^ txt_list txt_group "," l + in + let txt_set l = txt_list txt_res ";" l in + txt_set x + +let query_of_text lexbuf = + MQueryTParser.query MQueryTLexer.query_token lexbuf + +let result_of_text lexbuf = + MQueryTParser.result MQueryTLexer.result_token lexbuf + +(* (* Converting functions *****************************************************) @@ -171,10 +115,6 @@ let tref_uref u = let s = str_uref u in MQueryTParser.ref MQueryTLexer.rtoken (Lexing.from_string s) -let parse_text ch = - let lexbuf = Lexing.from_channel ch in - MQueryTParser.query MQueryTLexer.qtoken lexbuf - (* implementazione manuale di tref_uref da controllare let split s = @@ -203,3 +143,5 @@ let tref_uref (u, i) = (Some p, List.map encode l, i) *) + +*) diff --git a/helm/ocaml/mathql/mQueryUtil.mli b/helm/ocaml/mathql/mQueryUtil.mli index 0e62e4a13..e7ee98395 100644 --- a/helm/ocaml/mathql/mQueryUtil.mli +++ b/helm/ocaml/mathql/mQueryUtil.mli @@ -33,6 +33,16 @@ (* *) (******************************************************************************) +val text_of_query : MathQL.query -> string + +val text_of_result : MathQL.result -> string + +val query_of_text : Lexing.lexbuf -> MathQL.query + +val result_of_text : Lexing.lexbuf -> MathQL.result + +(* + val str_uref : MathQL.mquref -> string (* string linearization of a UriMan. reference *) val str_tref : MathQL.mqtref -> string (* string linearization of a tokenized reference *) @@ -48,3 +58,5 @@ val out_result : MathQL.mqresult -> string (* HTML representation of a que val tref_uref : MathQL.mquref -> MathQL.mqtref (* "tref of uref" conversion *) val parse_text : in_channel -> MathQL.mquery (* textual parsing of a query *) + +*) diff --git a/helm/ocaml/mathql/mathQL.ml b/helm/ocaml/mathql/mathQL.ml index e37b03d7c..a24dc4ed8 100644 --- a/helm/ocaml/mathql/mathQL.ml +++ b/helm/ocaml/mathql/mathQL.ml @@ -43,9 +43,9 @@ type rvar = string (* the name of a variable for a resource *) type vvar = string (* the name of a variable for an attribute value *) -type refine_op = Exact - | Sub - | Super +type refine_op = ExactOp + | SubOp + | SuperOp type attr_list = vvar list @@ -71,11 +71,13 @@ and boole_exp = False | Eq of val_exp * val_exp and val_exp = Const of string list - | Refof of set_exp + | RefOf of set_exp | Record of rvar * vvar | Fun of string * val_exp | Attribute of refine_op * string * val_exp +type query = set_exp + (* output data structures ***************************************************) @@ -90,3 +92,5 @@ type attribute_set = attribute_group list (* the attributes of an URI *) type resource = string * attribute_set (* an attributed URI *) type resource_set = resource list (* the query result *) + +type result = resource_set -- 2.39.2