helm/software/lambda-delta/src/complete_rg/crgOutput.ml

   1 (*
   2     ||M||  This file is part of HELM, an Hypertextual, Electronic
   3     ||A||  Library of Mathematics, developed at the Computer Science
   4     ||T||  Department, University of Bologna, Italy.
   5     ||I||
   6     ||T||  HELM is free software; you can redistribute it and/or
   7     ||A||  modify it under the terms of the GNU General Public License
   8     \   /  version 2 or (at your option) any later version.
   9      \ /   This software is distributed as is, NO WARRANTY.
  10       V_______________________________________________________________ *)
  11
  12 module P = Printf
  13 module U = NUri
  14 module C = Cps
  15 module H = Hierarchy
  16 module E = Entity
  17 module N = Level
  18 module D = Crg
  19
  20 (****************************************************************************)
  21
  22 let pp_attrs out a =
  23    let map = function
  24       | E.Name (s, true)  -> out (P.sprintf "%s;" s)
  25       | E.Name (s, false) -> out (P.sprintf "~%s;" s)
  26       | E.Apix i          -> out (P.sprintf "+%i;" i)
  27       | E.Mark i          -> out (P.sprintf "@%i;" i)
  28       | E.Meta s          -> out (P.sprintf "\"%s\";" s)
  29       | E.Priv            -> out (P.sprintf "%s;" "~")
  30    in
  31    List.iter map a
  32
  33 let rec pp_term out = function
  34    | D.TSort (a, l)    -> pp_attrs out a; out (P.sprintf "*%u" l)
  35    | D.TLRef (a, i, j) -> pp_attrs out a; out (P.sprintf "#(%u,%u)" i j)
  36    | D.TGRef (a, u)    -> pp_attrs out a; out (P.sprintf "$")
  37    | D.TCast (a, x, y) -> pp_attrs out a; out "<"; pp_term out x; out ">."; pp_term out y
  38    | D.TProj (a, x, y) -> assert false
  39    | D.TAppl (a, x, y) -> pp_attrs out a; pp_terms "(" ")" out x; pp_term out y
  40    | D.TBind (a, x, y) -> pp_attrs out a; pp_bind out x; pp_term out y
  41
  42 and pp_terms bg eg out vs =
  43    let rec aux = function
  44       | []      -> ()
  45       | [v]     -> pp_term out v
  46       | v :: vs -> pp_term out v; out ", "; aux vs
  47    in
  48    out bg; aux vs; out (eg ^ ".")
  49
  50 and pp_bind out = function
  51    | D.Abst (n, x) when N.is_infinite n -> pp_terms "[:" "]" out x
  52    | D.Abst (n, x)                      ->
  53       pp_terms "[:" (P.sprintf "]^%s" (N.to_string n)) out x
  54    | D.Abbr x                           -> pp_terms "[=" "]" out x
  55    | D.Void x                           -> out (P.sprintf "[%u]" x)
  56
  57 let rec pp_lenv out = function
  58    | D.ESort           -> ()
  59    | D.EProj (x, a, y) -> assert false
  60    | D.EBind (x, a, y) -> pp_lenv out x; pp_attrs out a; pp_bind out y
  61
  62 (****************************************************************************)