X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fgrafite_parser%2FdependenciesParser.ml;h=53fb7ab6d63b8cdf5f845f9fe7c68d0d0e72532c;hb=e9b09b14538f770b9e65083c24e3e9cf487df648;hp=eb33e49b80d7b5f453dbadb433851f7de3e96556;hpb=c34321f75d5a01eb8a267916d0ece6670603dd46;p=helm.git diff --git a/helm/software/components/grafite_parser/dependenciesParser.ml b/helm/software/components/grafite_parser/dependenciesParser.ml index eb33e49b8..53fb7ab6d 100644 --- a/helm/software/components/grafite_parser/dependenciesParser.ml +++ b/helm/software/components/grafite_parser/dependenciesParser.ml @@ -25,85 +25,60 @@ (* $Id$ *) -(* FG - * From Cambridge dictionary - * Dependency: - * a country which is supported and governed by another country - * Dependence: - * when you need something or someone all the time, especially in order to - * continue existing or operating - * - * Fate vobis ... - *) - 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) + (CicNotationLexer.level2_ast_lexer ()).Token.tok_func (Obj.magic lexbuf) in let rec parse acc = - try - (parser - | [< '("QSTRING", s) >] -> - (* because of alias id qstring = qstring :-( *) - (try - parse (UriDep (UriManager.uri_of_string s) :: acc) - with - UriManager.IllFormedUri _ -> parse acc) - | [< '("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 - with - Stream.Error _ -> parse acc - | CicNotationLexer.Error _ -> parse acc + 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"); '("IDENT", "source"); '("QSTRING", fname) >] -> + true, (IncludeDep fname :: acc) + | [< '("IDENT", "include'"); '("QSTRING", fname) >] -> + true, (IncludeDep fname :: acc) + | [< '("IDENT", "inline"); '("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); - HLog.debug ("Including "^path^" with path: " ^ p); - 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); - uri,file