open Printf
exception Drop
-exception IncludedFileNotCompiled of string (* file name *)
+(* mo file name, ma file name *)
+exception IncludedFileNotCompiled of string * string
exception Macro of
GrafiteAst.loc *
(Cic.context -> GrafiteTypes.status * Cic.term GrafiteAst.macro)
let moopath =
if Sys.file_exists moopath_r then moopath_r else
if Sys.file_exists moopath_rw then moopath_rw else
- raise (IncludedFileNotCompiled moopath_rw)
+ raise (IncludedFileNotCompiled (moopath_rw,baseuri))
in
let status = eval_from_moo.efm_go status moopath in
status,[]
*)
exception Drop
-exception IncludedFileNotCompiled of string
+exception IncludedFileNotCompiled of string * string
exception Macro of
GrafiteAst.loc *
(Cic.context -> GrafiteTypes.status * Cic.term GrafiteAst.macro)
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
+ uri,file
(** @raise End_of_file *)
val parse_dependencies: Ulexing.lexbuf -> dependency list
-val baseuri_of_script : include_paths:string list -> string -> string
+(* returns baseuri and the full path of the script *)
+val baseuri_of_script : include_paths:string list -> string -> string * string
fun ~include_paths status -> status,LSome (GrafiteAst.Comment (loc, com))
| (iloc,fname,mode) = include_command ; SYMBOL "." ->
fun ~include_paths status ->
- let path = DependenciesParser.baseuri_of_script ~include_paths fname in
+ let buri, fullpath =
+ DependenciesParser.baseuri_of_script ~include_paths fname
+ in
let status =
- LexiconEngine.eval_command status (LexiconAst.Include (iloc,path,mode))
+ LexiconEngine.eval_command status
+ (LexiconAst.Include (iloc,buri,mode,fullpath))
in
status,
LSome
(GrafiteAst.Executable
(loc,GrafiteAst.Command
- (loc,GrafiteAst.Include (iloc,path))))
+ (loc,GrafiteAst.Include (iloc,buri))))
| scom = lexicon_command ; SYMBOL "." ->
fun ~include_paths status ->
let status = LexiconEngine.eval_command status scom in
type inclusion_mode = WithPreferences | WithoutPreferences (* aka aliases *)
type command =
- | Include of loc * string * inclusion_mode
+ | Include of loc * string * inclusion_mode * string (* _,buri,_,path *)
| Alias of loc * alias_spec
(** parameters, name, type, fields *)
| Notation of loc * direction option * CicNotationPt.term * Gramext.g_assoc *
(pp_l2_pattern l2_pattern)
let pp_command = function
- | Include (_,path,mode) ->
+ | Include (_,_,mode,path) -> (* not precise, since path is absolute *)
if mode = WithPreferences then
"include " ^ path
else
(* $Id$ *)
-exception IncludedFileNotCompiled of string (* file name *)
+(* lexicon file name * ma file name *)
+exception IncludedFileNotCompiled of string * string
exception MetadataNotFound of string (* file name *)
type status = {
let status =
{ status with notation_ids = notation_ids' @ status.notation_ids } in
match cmd with
- | LexiconAst.Include (loc, baseuri, mode) ->
+ | LexiconAst.Include (loc, baseuri, mode, fullpath) ->
let lexiconpath_rw, lexiconpath_r =
LibraryMisc.lexicon_file_of_baseuri
~must_exist:false ~writable:true ~baseuri,
let lexiconpath =
if Sys.file_exists lexiconpath_rw then lexiconpath_rw else
if Sys.file_exists lexiconpath_r then lexiconpath_r else
- raise (IncludedFileNotCompiled lexiconpath_rw)
+ raise (IncludedFileNotCompiled (lexiconpath_rw,fullpath))
in
let lexicon = LexiconMarshal.load_lexicon lexiconpath in
let status = List.fold_left (eval_command ~mode) status lexicon in
* http://helm.cs.unibo.it/
*)
-exception IncludedFileNotCompiled of string
+exception IncludedFileNotCompiled of string * string
type status = {
aliases: DisambiguateTypes.environment; (** disambiguation aliases *)
res,parsed_text_length
let wrap_with_developments guistuff f arg =
+ let compile_needed_and_go_on lexiconfile d exc =
+ let target = Pcre.replace ~pat:"lexicon$" ~templ:"moo" lexiconfile in
+ let target = Pcre.replace ~pat:"metadata$" ~templ:"moo" target in
+ let refresh_cb () =
+ while Glib.Main.pending () do ignore(Glib.Main.iteration false); done
+ in
+ if not(MatitamakeLib.build_development_in_bg ~target refresh_cb d) then
+ raise exc
+ else
+ f arg
+ in
+ let do_nothing () = raise (ActionCancelled "Inclusion not performed") in
+ let check_if_file_is_exists f =
+ assert(Pcre.pmatch ~pat:"ma$" f);
+ let pwd = Sys.getcwd () in
+ let f_pwd = pwd ^ "/" ^ f in
+ if not (HExtlib.is_regular f_pwd) then
+ raise (ActionCancelled ("File "^f_pwd^" does not exists!"))
+ else
+ raise
+ (ActionCancelled
+ ("Internal error: "^f_pwd^" exists but I'm unable to include it!"))
+ in
+ let handle_with_devel d lexiconfile exc =
+ let name = MatitamakeLib.name_for_development d in
+ let title = "Unable to include " ^ lexiconfile in
+ let message =
+ lexiconfile ^ " is handled by development <b>" ^ name ^ "</b>.\n\n" ^
+ "<i>Should I compile it and Its dependencies?</i>"
+ in
+ (match guistuff.ask_confirmation ~title ~message with
+ | `YES -> compile_needed_and_go_on lexiconfile d exc
+ | `NO -> raise exc
+ | `CANCEL -> do_nothing ())
+ in
+ let handle_without_devel mafilename exc =
+ let title = "Unable to include " ^ mafilename in
+ let message =
+ mafilename ^ " is <b>not</b> handled by a development.\n" ^
+ "All dependencies are automatically solved for a development.\n\n" ^
+ "<i>Do you want to set up a development?</i>"
+ in
+ (match guistuff.ask_confirmation ~title ~message with
+ | `YES ->
+ guistuff.develcreator ~containing:(Some (Filename.dirname mafilename));
+ do_nothing ()
+ | `NO -> raise exc
+ | `CANCEL -> do_nothing())
+ in
try
f arg
with
- | DependenciesParser.UnableToInclude what
- | LexiconEngine.IncludedFileNotCompiled what
- | GrafiteEngine.IncludedFileNotCompiled what as exc ->
- let compile_needed_and_go_on d =
- let target = Pcre.replace ~pat:"lexicon$" ~templ:"moo" what in
- let refresh_cb () =
- while Glib.Main.pending () do ignore(Glib.Main.iteration false); done
- in
- if not(MatitamakeLib.build_development_in_bg ~target refresh_cb d) then
- raise exc
- else
- f arg
- in
- let do_nothing () = raise (ActionCancelled "Inclusion not performed") in
- let handle_with_devel d =
- let name = MatitamakeLib.name_for_development d in
- let title = "Unable to include " ^ what in
- let message =
- what ^ " is handled by development <b>" ^ name ^ "</b>.\n\n" ^
- "<i>Should I compile it and Its dependencies?</i>"
- in
- (match guistuff.ask_confirmation ~title ~message with
- | `YES -> compile_needed_and_go_on d
- | `NO -> raise exc
- | `CANCEL -> do_nothing ())
- in
- let handle_without_devel filename =
- let title = "Unable to include " ^ what in
- let message =
- what ^ " is <b>not</b> handled by a development.\n" ^
- "All dependencies are automatically solved for a development.\n\n" ^
- "<i>Do you want to set up a development?</i>"
- in
- (match guistuff.ask_confirmation ~title ~message with
- | `YES ->
- (match filename with
- | Some f ->
- guistuff.develcreator ~containing:(Some (Filename.dirname f))
- | None -> guistuff.develcreator ~containing:None);
- do_nothing ()
- | `NO -> raise exc
- | `CANCEL -> do_nothing())
- in
- match guistuff.filenamedata with
- | None,None -> handle_without_devel None
- | None,Some d -> handle_with_devel d
- | Some f,_ ->
- match MatitamakeLib.development_for_dir (Filename.dirname f) with
- | None -> handle_without_devel (Some f)
- | Some d -> handle_with_devel d
+ | DependenciesParser.UnableToInclude mafilename ->
+ assert (Pcre.pmatch ~pat:"ma$" mafilename);
+ check_if_file_is_exists mafilename
+ | LexiconEngine.IncludedFileNotCompiled (xfilename,mafilename)
+ | GrafiteEngine.IncludedFileNotCompiled (xfilename,mafilename) as exn ->
+ assert (Pcre.pmatch ~pat:"ma$" mafilename);
+ assert (Pcre.pmatch ~pat:"lexicon$" xfilename ||
+ Pcre.pmatch ~pat:"mo$" xfilename );
+ (* we know that someone was able to include the .ma, get the baseuri
+ * but was unable to get the compilation output 'xfilename' *)
+ match MatitamakeLib.development_for_dir (Filename.dirname mafilename) with
+ | None -> handle_without_devel mafilename exn
+ | Some d -> handle_with_devel d xfilename exn
;;
let eval_with_engine
end
else
begin
- let baseuri =
+ let baseuri, _fullpathforfname =
DependenciesParser.baseuri_of_script ~include_paths fname in
let moo_fname =
LibraryMisc.obj_file_of_baseuri
try
UM.buri_of_uri (UM.uri_of_string suri)
with UM.IllFormedUri _ ->
- let u =
+ let u,_ =
DependenciesParser.baseuri_of_script ~include_paths:[] suri in
if String.length u < 5 || String.sub u 0 5 <> "cic:/" then begin
HLog.error (sprintf "File %s defines a bad baseuri: %s"
Hashtbl.add baseuri_of ma_file uri
| DependenciesParser.IncludeDep path ->
try
- let baseuri =
+ let baseuri,_ =
DependenciesParser.baseuri_of_script ~include_paths path in
if not (Http_getter_storage.is_legacy baseuri) then
let moo_file = obj_file_of_baseuri false baseuri in
projects / helm.git / commitdiff