X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fbinaries%2Ftranscript%2Fgrafite.ml;h=d44a17c5897e40df09508101d852b3025a0c060a;hb=a7237500e8a2a4237a6ae8ba4b8301f7bbcb6acb;hp=9e634d655184b43467d0ad5c2b60795cbd257b1a;hpb=a89360d64f1fcbba917ad743b97a2d973ecf6db2;p=helm.git diff --git a/helm/software/components/binaries/transcript/grafite.ml b/helm/software/components/binaries/transcript/grafite.ml index 9e634d655..d44a17c58 100644 --- a/helm/software/components/binaries/transcript/grafite.ml +++ b/helm/software/components/binaries/transcript/grafite.ml @@ -24,12 +24,14 @@ *) module T = Types +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 @@ -46,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 @@ -72,36 +75,62 @@ let command_of_obj obj = let command_of_macro macro = G.Executable (floc, G.Macro (floc, macro)) -let require value = - command_of_obj (G.Include (floc, value ^ ".ma")) +let require moo value = + command_of_obj (G.Include (floc, moo, `OldAndNew, value ^ ".ma")) let coercion value = command_of_obj (G.Coercion (floc, UM.uri_of_string value, true, 0, 0)) -let inline (kind, uri, prefix, flavour) = - let kind = match kind with - | T.Declarative -> G.Declarative - | T.Procedural -> G.Procedural None +let inline kind uri prefix flavour params = + let params = match prefix with + | "" -> params + | prefix -> G.IPPrefix prefix :: params in - command_of_macro (G.Inline (floc, kind, uri, prefix, flavour)) + let params = match flavour with + | None -> params + | Some flavour -> G.IPAs flavour :: params + in + let params = match kind with + | T.Declarative -> params + | T.Procedural -> G.IPProcedural :: params + in + command_of_macro (G.Inline (floc, uri, params)) 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 -> out_line_comment och line - | T.Include script -> out_command och (require script) - | T.Coercion specs -> out_unexported och "COERCION" (snd specs) - | T.Notation specs -> out_unexported och "NOTATION" (snd specs) (**) - | T.Inline (_, T.Var, src, _, _) -> out_alias och (UriManager.name_of_uri (UriManager.uri_of_string src)) src - | T.Inline specs -> out_command och (inline (trd_rth kind specs)) - | T.Section specs -> out_unexported och "UNEXPORTED" (trd specs) - | T.Comment comment -> out_comment och comment - | T.Unexport unexport -> out_unexported och "UNEXPORTED" unexport + | T.Heading heading -> out_preamble och heading + | T.Line line -> + if !O.comments then out_line_comment och line + | T.Include (moo, script) -> out_command och (require moo script) + | T.Coercion specs -> + if !O.comments then out_unexported och "COERCION" (snd specs) + | T.Notation specs -> + 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 objects + * let name = UriManager.name_of_uri (UriManager.uri_of_string src) in + * out_alias och name src + *) + | T.Inline (_, _, src, pre, fl, params) -> + if !O.getter then check och src; + out_command och (inline kind src pre fl params) + | T.Section specs -> + if !O.comments then out_unexported och "UNEXPORTED" (trd specs) + | T.Comment comment -> + if !O.comments then out_comment och comment + | T.Unexport unexport -> + if !O.comments then out_unexported och "UNEXPORTED" unexport | T.Verbatim verbatim -> out_verbatim och verbatim | T.Discard _ -> () in