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=8776185b8b9451db0da72bb9ffa324b30a3187e3;hpb=f620bf94af6c347926ed1c2328462efab7018b21;p=helm.git diff --git a/helm/software/components/binaries/transcript/grafite.ml b/helm/software/components/binaries/transcript/grafite.ml index 8776185b8..d44a17c58 100644 --- a/helm/software/components/binaries/transcript/grafite.ml +++ b/helm/software/components/binaries/transcript/grafite.ml @@ -75,18 +75,26 @@ 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 @@ -100,23 +108,23 @@ let check och src = let commit kind och items = let trd (_, _, x) = x in let commit = function - | T.Heading heading -> out_preamble och heading - | T.Line line -> + | T.Heading heading -> out_preamble och heading + | T.Line line -> if !O.comments then out_line_comment och line - | T.Include script -> out_command och (require script) - | T.Coercion specs -> + | 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 -> + | T.Notation specs -> if !O.comments then out_unexported och "NOTATION" (snd specs) (**) - | T.Inline (_, T.Var, src, _, _) -> + | 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) -> + | T.Inline (_, _, src, pre, fl, params) -> if !O.getter then check och src; - out_command och (inline kind src pre fl) + 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 ->