X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fbinaries%2Ftranscript%2Fgrafite.ml;h=8776185b8b9451db0da72bb9ffa324b30a3187e3;hb=48794769c34c57e3ead42edc8c8eca5333e857ea;hp=f5c4a49f8ccabe1f2f95f89554904a2c9f2440be;hpb=4dc282b8b71479d45704b414d1a10a27e71752f1;p=helm.git diff --git a/helm/software/components/binaries/transcript/grafite.ml b/helm/software/components/binaries/transcript/grafite.ml index f5c4a49f8..8776185b8 100644 --- a/helm/software/components/binaries/transcript/grafite.ml +++ b/helm/software/components/binaries/transcript/grafite.ml @@ -29,8 +29,9 @@ module O = Options module UM = UriManager module NP = CicNotationPp module GP = GrafiteAstPp -module G = GrafiteAst -module H = HExtlib +module G = GrafiteAst +module H = HExtlib +module HG = Http_getter let floc = H.dummy_floc @@ -47,6 +48,7 @@ let out_unexported och head s = let out_line_comment och s = let l = 70 - String.length s in + let l = if l < 0 then 0 else l in let s = Printf.sprintf " %s %s" s (String.make l '*') in out_comment och s @@ -79,7 +81,7 @@ let require value = let coercion value = command_of_obj (G.Coercion (floc, UM.uri_of_string value, true, 0, 0)) -let inline (kind, uri, prefix, flavour) = +let inline kind uri prefix flavour = let kind = match kind with | T.Declarative -> G.Declarative | T.Procedural -> G.Procedural None @@ -89,9 +91,14 @@ let inline (kind, uri, prefix, flavour) = let out_alias och name uri = Printf.fprintf och "alias id \"%s\" = \"%s\".\n\n" name uri +let check och src = + if HG.exists ~local:false src then () else + let msg = "UNAVAILABLE OBJECT: " ^ src in + out_line_comment och msg; + prerr_endline msg + let commit kind och items = let trd (_, _, x) = x in - let trd_rth kind (_, _, x, y, z) = kind, x, y, z in let commit = function | T.Heading heading -> out_preamble och heading | T.Line line -> @@ -103,11 +110,13 @@ let commit kind och items = if !O.comments then out_unexported och "NOTATION" (snd specs) (**) | T.Inline (_, T.Var, src, _, _) -> if !O.comments then out_unexported och "UNEXPORTED" src -(* FG: we do not export variables because we cook the other object +(* FG: we do not export variables because we cook the other objects * let name = UriManager.name_of_uri (UriManager.uri_of_string src) in * out_alias och name src *) - | T.Inline specs -> out_command och (inline (trd_rth kind specs)) + | T.Inline (_, _, src, pre, fl) -> + if !O.getter then check och src; + out_command och (inline kind src pre fl) | T.Section specs -> if !O.comments then out_unexported och "UNEXPORTED" (trd specs) | T.Comment comment ->