X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fgrafite_parser%2FdependenciesParser.ml;h=b44ad499484f2f5919d9bf258dde20d4b358de6b;hb=7e79f902b0fea9afb02576b653b384bc512b2264;hp=dee9511182333c36d1ff7412f3c6498103e1b475;hpb=b95be966e385957a25f26a41f45e0116955264ae;p=helm.git diff --git a/helm/software/components/grafite_parser/dependenciesParser.ml b/helm/software/components/grafite_parser/dependenciesParser.ml index dee951118..b44ad4994 100644 --- a/helm/software/components/grafite_parser/dependenciesParser.ml +++ b/helm/software/components/grafite_parser/dependenciesParser.ml @@ -30,63 +30,53 @@ exception UnableToInclude of string (* statements meaningful for matitadep *) type dependency = | IncludeDep of string - | BaseuriDep of string | UriDep of UriManager.uri - + | InlineDep of string + let pp_dependency = function | IncludeDep str -> "include \"" ^ str ^ "\"" - | BaseuriDep str -> "set \"baseuri\" \"" ^ str ^ "\"" | UriDep uri -> "uri \"" ^ UriManager.string_of_uri uri ^ "\"" + | InlineDep str -> "inline \"" ^ str ^ "\"" let parse_dependencies lexbuf = let tok_stream,_ = CicNotationLexer.level2_ast_lexer.Token.tok_func (Obj.magic lexbuf) in let rec parse acc = - (parser - | [< '("URI", u) >] -> - parse (UriDep (UriManager.uri_of_string u) :: acc) - | [< '("IDENT", "include"); '("QSTRING", fname) >] -> - parse (IncludeDep fname :: acc) - | [< '("IDENT", "set"); '("QSTRING", "baseuri"); '("QSTRING", baseuri) >] -> - parse (BaseuriDep baseuri :: acc) - | [< '("EOI", _) >] -> acc - | [< 'tok >] -> parse acc - | [< >] -> acc) tok_stream + let continue, acc = + try + (parser + | [< '("QSTRING", s) >] -> + (* because of alias id qstring = qstring :-( *) + (try + true, (UriDep (UriManager.uri_of_string s) :: acc) + with + UriManager.IllFormedUri _ -> true, acc) + | [< '("URI", u) >] -> + true, (UriDep (UriManager.uri_of_string u) :: acc) + | [< '("IDENT", "include"); '("QSTRING", fname) >] -> + true, (IncludeDep fname :: acc) + | [< '("IDENT", "include'"); '("QSTRING", fname) >] -> + true, (IncludeDep fname :: acc) + | [< '("IDENT", "inline"); '("IDENT", "procedural"); '("QSTRING", fname) >] -> + true, (InlineDep fname :: acc) + | [< '("EOI", _) >] -> false, acc + | [< 'tok >] -> true, acc + | [< >] -> false, acc) tok_stream + with + Stream.Error _ -> false, acc + | CicNotationLexer.Error _ -> true, acc + in + if continue then parse acc else acc in List.rev (parse []) -let make_absolute paths path = - let rec aux = function - | [] -> ignore (Unix.stat path); path - | p :: tl -> - let path = p ^ "/" ^ path in - try - ignore (Unix.stat path); path - with Unix.Unix_error _ -> aux tl - in - try - aux paths - with Unix.Unix_error _ -> raise (UnableToInclude path) +let deps_of_file ma_file = + try + let ic = open_in ma_file in + let istream = Ulexing.from_utf8_channel ic in + let dependencies = parse_dependencies istream in + close_in ic; + dependencies + with End_of_file -> [] ;; - -let baseuri_of_script ~include_paths file = - let file = make_absolute include_paths file in - let ic = open_in file in - let istream = Ulexing.from_utf8_channel ic in - let rec find_baseuri = - function - [] -> failwith ("No baseuri defined in " ^ file) - | BaseuriDep s::_ -> s - | _::tl -> find_baseuri tl in - let buri = find_baseuri (parse_dependencies istream) in - let uri = Http_getter_misc.strip_trailing_slash buri in - if String.length uri < 5 || String.sub uri 0 5 <> "cic:/" then - HLog.error (file ^ " sets an incorrect baseuri: " ^ buri); - (try - ignore(Http_getter.resolve ~writable:false uri) - with - | Http_getter_types.Unresolvable_URI _ -> - HLog.error (file ^ " sets an unresolvable baseuri: " ^ buri) - | Http_getter_types.Key_not_found _ -> ()); - uri