]> matita.cs.unibo.it Git - helm.git/commitdiff
the refactoring continues ....
authorFerruccio Guidi <ferruccio.guidi@unibo.it>
Fri, 6 Aug 2010 11:29:40 +0000 (11:29 +0000)
committerFerruccio Guidi <ferruccio.guidi@unibo.it>
Fri, 6 Aug 2010 11:29:40 +0000 (11:29 +0000)
176 files changed:
helm/software/lambda-delta/components/Make [deleted file]
helm/software/lambda-delta/components/automath/Make [deleted file]
helm/software/lambda-delta/components/automath/Omega.aut [deleted file]
helm/software/lambda-delta/components/automath/aut.ml [deleted file]
helm/software/lambda-delta/components/automath/autLexer.mll [deleted file]
helm/software/lambda-delta/components/automath/autOutput.ml [deleted file]
helm/software/lambda-delta/components/automath/autOutput.mli [deleted file]
helm/software/lambda-delta/components/automath/autParser.mly [deleted file]
helm/software/lambda-delta/components/automath/autProcess.ml [deleted file]
helm/software/lambda-delta/components/automath/autProcess.mli [deleted file]
helm/software/lambda-delta/components/basic_ag/Make [deleted file]
helm/software/lambda-delta/components/basic_ag/bag.ml [deleted file]
helm/software/lambda-delta/components/basic_ag/bagEnvironment.ml [deleted file]
helm/software/lambda-delta/components/basic_ag/bagEnvironment.mli [deleted file]
helm/software/lambda-delta/components/basic_ag/bagOutput.ml [deleted file]
helm/software/lambda-delta/components/basic_ag/bagOutput.mli [deleted file]
helm/software/lambda-delta/components/basic_ag/bagReduction.ml [deleted file]
helm/software/lambda-delta/components/basic_ag/bagReduction.mli [deleted file]
helm/software/lambda-delta/components/basic_ag/bagSubstitution.ml [deleted file]
helm/software/lambda-delta/components/basic_ag/bagSubstitution.mli [deleted file]
helm/software/lambda-delta/components/basic_ag/bagType.ml [deleted file]
helm/software/lambda-delta/components/basic_ag/bagType.mli [deleted file]
helm/software/lambda-delta/components/basic_ag/bagUntrusted.ml [deleted file]
helm/software/lambda-delta/components/basic_ag/bagUntrusted.mli [deleted file]
helm/software/lambda-delta/components/basic_rg/Make [deleted file]
helm/software/lambda-delta/components/basic_rg/brg.ml [deleted file]
helm/software/lambda-delta/components/basic_rg/brgEnvironment.ml [deleted file]
helm/software/lambda-delta/components/basic_rg/brgEnvironment.mli [deleted file]
helm/software/lambda-delta/components/basic_rg/brgOutput.ml [deleted file]
helm/software/lambda-delta/components/basic_rg/brgOutput.mli [deleted file]
helm/software/lambda-delta/components/basic_rg/brgReduction.ml [deleted file]
helm/software/lambda-delta/components/basic_rg/brgReduction.mli [deleted file]
helm/software/lambda-delta/components/basic_rg/brgSubstitution.ml [deleted file]
helm/software/lambda-delta/components/basic_rg/brgSubstitution.mli [deleted file]
helm/software/lambda-delta/components/basic_rg/brgType.ml [deleted file]
helm/software/lambda-delta/components/basic_rg/brgType.mli [deleted file]
helm/software/lambda-delta/components/basic_rg/brgUntrusted.ml [deleted file]
helm/software/lambda-delta/components/basic_rg/brgUntrusted.mli [deleted file]
helm/software/lambda-delta/components/common/Make [deleted file]
helm/software/lambda-delta/components/common/alpha.ml [deleted file]
helm/software/lambda-delta/components/common/alpha.mli [deleted file]
helm/software/lambda-delta/components/common/entity.ml [deleted file]
helm/software/lambda-delta/components/common/hierarchy.ml [deleted file]
helm/software/lambda-delta/components/common/hierarchy.mli [deleted file]
helm/software/lambda-delta/components/common/library.ml [deleted file]
helm/software/lambda-delta/components/common/library.mli [deleted file]
helm/software/lambda-delta/components/common/marks.ml [deleted file]
helm/software/lambda-delta/components/common/options.ml [deleted file]
helm/software/lambda-delta/components/common/output.ml [deleted file]
helm/software/lambda-delta/components/common/output.mli [deleted file]
helm/software/lambda-delta/components/complete_rg/Make [deleted file]
helm/software/lambda-delta/components/complete_rg/crg.ml [deleted file]
helm/software/lambda-delta/components/complete_rg/crgAut.ml [deleted file]
helm/software/lambda-delta/components/complete_rg/crgAut.mli [deleted file]
helm/software/lambda-delta/components/complete_rg/crgBrg.ml [deleted file]
helm/software/lambda-delta/components/complete_rg/crgBrg.mli [deleted file]
helm/software/lambda-delta/components/complete_rg/crgOutput.ml [deleted file]
helm/software/lambda-delta/components/complete_rg/crgOutput.mli [deleted file]
helm/software/lambda-delta/components/complete_rg/crgTxt.ml [deleted file]
helm/software/lambda-delta/components/complete_rg/crgTxt.mli [deleted file]
helm/software/lambda-delta/components/complete_rg/crgXml.ml [deleted file]
helm/software/lambda-delta/components/complete_rg/crgXml.mli [deleted file]
helm/software/lambda-delta/components/lib/Make [deleted file]
helm/software/lambda-delta/components/lib/cps.ml [deleted file]
helm/software/lambda-delta/components/lib/log.ml [deleted file]
helm/software/lambda-delta/components/lib/log.mli [deleted file]
helm/software/lambda-delta/components/lib/share.ml [deleted file]
helm/software/lambda-delta/components/lib/time.ml [deleted file]
helm/software/lambda-delta/components/text/Make [deleted file]
helm/software/lambda-delta/components/text/prova.hln [deleted file]
helm/software/lambda-delta/components/text/txt.ml [deleted file]
helm/software/lambda-delta/components/text/txtLexer.mll [deleted file]
helm/software/lambda-delta/components/text/txtParser.mly [deleted file]
helm/software/lambda-delta/components/text/txtTxt.ml [deleted file]
helm/software/lambda-delta/components/text/txtTxt.mli [deleted file]
helm/software/lambda-delta/components/toplevel/Make [deleted file]
helm/software/lambda-delta/components/toplevel/meta.ml [deleted file]
helm/software/lambda-delta/components/toplevel/metaAut.ml [deleted file]
helm/software/lambda-delta/components/toplevel/metaAut.mli [deleted file]
helm/software/lambda-delta/components/toplevel/metaBag.ml [deleted file]
helm/software/lambda-delta/components/toplevel/metaBag.mli [deleted file]
helm/software/lambda-delta/components/toplevel/metaBrg.ml [deleted file]
helm/software/lambda-delta/components/toplevel/metaBrg.mli [deleted file]
helm/software/lambda-delta/components/toplevel/metaLibrary.ml [deleted file]
helm/software/lambda-delta/components/toplevel/metaLibrary.mli [deleted file]
helm/software/lambda-delta/components/toplevel/metaOutput.ml [deleted file]
helm/software/lambda-delta/components/toplevel/metaOutput.mli [deleted file]
helm/software/lambda-delta/components/toplevel/top.ml [deleted file]
helm/software/lambda-delta/src/Make [new file with mode: 0644]
helm/software/lambda-delta/src/automath/Make [new file with mode: 0644]
helm/software/lambda-delta/src/automath/Omega.aut [new file with mode: 0644]
helm/software/lambda-delta/src/automath/aut.ml [new file with mode: 0644]
helm/software/lambda-delta/src/automath/autLexer.mll [new file with mode: 0644]
helm/software/lambda-delta/src/automath/autOutput.ml [new file with mode: 0644]
helm/software/lambda-delta/src/automath/autOutput.mli [new file with mode: 0644]
helm/software/lambda-delta/src/automath/autParser.mly [new file with mode: 0644]
helm/software/lambda-delta/src/automath/autProcess.ml [new file with mode: 0644]
helm/software/lambda-delta/src/automath/autProcess.mli [new file with mode: 0644]
helm/software/lambda-delta/src/basic_ag/Make [new file with mode: 0644]
helm/software/lambda-delta/src/basic_ag/bag.ml [new file with mode: 0644]
helm/software/lambda-delta/src/basic_ag/bagEnvironment.ml [new file with mode: 0644]
helm/software/lambda-delta/src/basic_ag/bagEnvironment.mli [new file with mode: 0644]
helm/software/lambda-delta/src/basic_ag/bagOutput.ml [new file with mode: 0644]
helm/software/lambda-delta/src/basic_ag/bagOutput.mli [new file with mode: 0644]
helm/software/lambda-delta/src/basic_ag/bagReduction.ml [new file with mode: 0644]
helm/software/lambda-delta/src/basic_ag/bagReduction.mli [new file with mode: 0644]
helm/software/lambda-delta/src/basic_ag/bagSubstitution.ml [new file with mode: 0644]
helm/software/lambda-delta/src/basic_ag/bagSubstitution.mli [new file with mode: 0644]
helm/software/lambda-delta/src/basic_ag/bagType.ml [new file with mode: 0644]
helm/software/lambda-delta/src/basic_ag/bagType.mli [new file with mode: 0644]
helm/software/lambda-delta/src/basic_ag/bagUntrusted.ml [new file with mode: 0644]
helm/software/lambda-delta/src/basic_ag/bagUntrusted.mli [new file with mode: 0644]
helm/software/lambda-delta/src/basic_rg/Make [new file with mode: 0644]
helm/software/lambda-delta/src/basic_rg/brg.ml [new file with mode: 0644]
helm/software/lambda-delta/src/basic_rg/brgEnvironment.ml [new file with mode: 0644]
helm/software/lambda-delta/src/basic_rg/brgEnvironment.mli [new file with mode: 0644]
helm/software/lambda-delta/src/basic_rg/brgOutput.ml [new file with mode: 0644]
helm/software/lambda-delta/src/basic_rg/brgOutput.mli [new file with mode: 0644]
helm/software/lambda-delta/src/basic_rg/brgReduction.ml [new file with mode: 0644]
helm/software/lambda-delta/src/basic_rg/brgReduction.mli [new file with mode: 0644]
helm/software/lambda-delta/src/basic_rg/brgSubstitution.ml [new file with mode: 0644]
helm/software/lambda-delta/src/basic_rg/brgSubstitution.mli [new file with mode: 0644]
helm/software/lambda-delta/src/basic_rg/brgType.ml [new file with mode: 0644]
helm/software/lambda-delta/src/basic_rg/brgType.mli [new file with mode: 0644]
helm/software/lambda-delta/src/basic_rg/brgUntrusted.ml [new file with mode: 0644]
helm/software/lambda-delta/src/basic_rg/brgUntrusted.mli [new file with mode: 0644]
helm/software/lambda-delta/src/common/Make [new file with mode: 0644]
helm/software/lambda-delta/src/common/alpha.ml [new file with mode: 0644]
helm/software/lambda-delta/src/common/alpha.mli [new file with mode: 0644]
helm/software/lambda-delta/src/common/entity.ml [new file with mode: 0644]
helm/software/lambda-delta/src/common/hierarchy.ml [new file with mode: 0644]
helm/software/lambda-delta/src/common/hierarchy.mli [new file with mode: 0644]
helm/software/lambda-delta/src/common/library.ml [new file with mode: 0644]
helm/software/lambda-delta/src/common/library.mli [new file with mode: 0644]
helm/software/lambda-delta/src/common/marks.ml [new file with mode: 0644]
helm/software/lambda-delta/src/common/options.ml [new file with mode: 0644]
helm/software/lambda-delta/src/common/output.ml [new file with mode: 0644]
helm/software/lambda-delta/src/common/output.mli [new file with mode: 0644]
helm/software/lambda-delta/src/complete_rg/Make [new file with mode: 0644]
helm/software/lambda-delta/src/complete_rg/crg.ml [new file with mode: 0644]
helm/software/lambda-delta/src/complete_rg/crgAut.ml [new file with mode: 0644]
helm/software/lambda-delta/src/complete_rg/crgAut.mli [new file with mode: 0644]
helm/software/lambda-delta/src/complete_rg/crgBrg.ml [new file with mode: 0644]
helm/software/lambda-delta/src/complete_rg/crgBrg.mli [new file with mode: 0644]
helm/software/lambda-delta/src/complete_rg/crgOutput.ml [new file with mode: 0644]
helm/software/lambda-delta/src/complete_rg/crgOutput.mli [new file with mode: 0644]
helm/software/lambda-delta/src/complete_rg/crgTxt.ml [new file with mode: 0644]
helm/software/lambda-delta/src/complete_rg/crgTxt.mli [new file with mode: 0644]
helm/software/lambda-delta/src/complete_rg/crgXml.ml [new file with mode: 0644]
helm/software/lambda-delta/src/complete_rg/crgXml.mli [new file with mode: 0644]
helm/software/lambda-delta/src/lib/Make [new file with mode: 0644]
helm/software/lambda-delta/src/lib/cps.ml [new file with mode: 0644]
helm/software/lambda-delta/src/lib/log.ml [new file with mode: 0644]
helm/software/lambda-delta/src/lib/log.mli [new file with mode: 0644]
helm/software/lambda-delta/src/lib/share.ml [new file with mode: 0644]
helm/software/lambda-delta/src/lib/time.ml [new file with mode: 0644]
helm/software/lambda-delta/src/text/Make [new file with mode: 0644]
helm/software/lambda-delta/src/text/prova.hln [new file with mode: 0644]
helm/software/lambda-delta/src/text/txt.ml [new file with mode: 0644]
helm/software/lambda-delta/src/text/txtLexer.mll [new file with mode: 0644]
helm/software/lambda-delta/src/text/txtParser.mly [new file with mode: 0644]
helm/software/lambda-delta/src/text/txtTxt.ml [new file with mode: 0644]
helm/software/lambda-delta/src/text/txtTxt.mli [new file with mode: 0644]
helm/software/lambda-delta/src/toplevel/Make [new file with mode: 0644]
helm/software/lambda-delta/src/toplevel/meta.ml [new file with mode: 0644]
helm/software/lambda-delta/src/toplevel/metaAut.ml [new file with mode: 0644]
helm/software/lambda-delta/src/toplevel/metaAut.mli [new file with mode: 0644]
helm/software/lambda-delta/src/toplevel/metaBag.ml [new file with mode: 0644]
helm/software/lambda-delta/src/toplevel/metaBag.mli [new file with mode: 0644]
helm/software/lambda-delta/src/toplevel/metaBrg.ml [new file with mode: 0644]
helm/software/lambda-delta/src/toplevel/metaBrg.mli [new file with mode: 0644]
helm/software/lambda-delta/src/toplevel/metaLibrary.ml [new file with mode: 0644]
helm/software/lambda-delta/src/toplevel/metaLibrary.mli [new file with mode: 0644]
helm/software/lambda-delta/src/toplevel/metaOutput.ml [new file with mode: 0644]
helm/software/lambda-delta/src/toplevel/metaOutput.mli [new file with mode: 0644]
helm/software/lambda-delta/src/toplevel/top.ml [new file with mode: 0644]

diff --git a/helm/software/lambda-delta/components/Make b/helm/software/lambda-delta/components/Make
deleted file mode 100644 (file)
index 8e332c3..0000000
+++ /dev/null
@@ -1 +0,0 @@
-lib common text automath basic_ag basic_rg complete_rg toplevel
diff --git a/helm/software/lambda-delta/components/automath/Make b/helm/software/lambda-delta/components/automath/Make
deleted file mode 100644 (file)
index 29d2378..0000000
+++ /dev/null
@@ -1 +0,0 @@
-aut autProcess autOutput autParser autLexer
diff --git a/helm/software/lambda-delta/components/automath/Omega.aut b/helm/software/lambda-delta/components/automath/Omega.aut
deleted file mode 100644 (file)
index 2466a60..0000000
+++ /dev/null
@@ -1,10 +0,0 @@
-# The lambda-term \Omega
-# This book is not accepted in AUT-QE because [y:'type'] is not allowed
-# This book is accepted in lambda-delta with sort inclusion but Omega is not
-#    valid if sort inclusion is allowed on the term backbone only
-# This book is valid in lambda-delta with unrestricted sort inclusion 
-
-+l 
-@ Delta := [x:[y:'type']'type']<x>x : [x:[y:'type']'type']'type'
-  Omega := <Delta>Delta             : 'type'
--l
diff --git a/helm/software/lambda-delta/components/automath/aut.ml b/helm/software/lambda-delta/components/automath/aut.ml
deleted file mode 100644 (file)
index 00213b4..0000000
+++ /dev/null
@@ -1,25 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type id = string (* identifier *)
-
-type qid = id * bool * id list (* qualified identifier: name, local?, path *)
-
-type term = Sort of bool              (* sorts: true = TYPE, false = PROP *)
-         | GRef of qid * term list   (* reference: name, arguments *)
-         | Appl of term * term       (* application: argument, function *)
-         | Abst of id * term * term  (* abstraction: name, domain, scope *)
-         
-type command = Section of (bool * id) option  (* section: Some true = open, Some false = reopen, None = close last *)
-            | Context of qid option          (* context: Some = last node, None = root *)
-            | Block of id * term             (* block opener: name, domain *)
-            | Decl of id * term              (* declaration: name, domain *)
-            | Def of id * term * bool * term (* definition: name, domain, transparent?, body *)
diff --git a/helm/software/lambda-delta/components/automath/autLexer.mll b/helm/software/lambda-delta/components/automath/autLexer.mll
deleted file mode 100644 (file)
index cb33d0c..0000000
+++ /dev/null
@@ -1,90 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-{ 
-   module L = Log
-   module O = Options
-   module P = AutParser
-   
-   let out s = if !O.debug_lexer then L.warn s else ()
-
-(* This turns an Automath identifier into an XML nmtoken *)
-   let quote id =
-      let l = String.length id in
-      let rec aux i =
-         if i < l then begin
-            if id.[i] = '\'' || id.[i] = '`' then id.[i] <- '_';
-           aux (succ i)
-         end else
-           id
-      in
-      aux 0
-}
-
-let LC  = ['#' '%']
-let OC  = "{"
-let CC  = "}"
-let SPC = [' ' '\t' '\n']+
-let NL  = "\n"
-let ID  = ['0'-'9' 'A'-'Z' 'a'-'z' '_' '\'' '`']+
-
-rule line_comment = parse
-   | NL  { () }
-   | OC  { block_comment lexbuf; line_comment lexbuf }
-   | _   { line_comment lexbuf }
-   | eof { () } 
-and block_comment = parse
-   | CC  { () }
-   | OC  { block_comment lexbuf; block_comment lexbuf }
-   | LC  { line_comment lexbuf; block_comment lexbuf  }
-   | _   { block_comment lexbuf }
-and token = parse
-   | SPC      { token lexbuf } 
-   | LC       { line_comment lexbuf; token lexbuf  }
-   | OC       { block_comment lexbuf; token lexbuf }
-   | "_E"     { out "E"; P.E         }
-   | "'_E'"   { out "E"; P.E         }
-   | "---"    { out "EB"; P.EB       }
-   | "'eb'"   { out "EB"; P.EB       }
-   | "EB"     { out "EB"; P.EB       }
-   | "--"     { out "EXIT"; P.EXIT   }
-   | "PN"     { out "PN"; P.PN       }
-   | "'pn'"   { out "PN"; P.PN       }
-   | "PRIM"   { out "PN"; P.PN       }
-   | "'prim'" { out "PN"; P.PN       }
-   | "???"    { out "PN"; P.PN       }
-   | "PROP"   { out "PROP"; P.PROP   }
-   | "'prop'" { out "PROP"; P.PROP   }
-   | "TYPE"   { out "TYPE"; P.TYPE   }
-   | "'type'" { out "TYPE"; P.TYPE   }
-   | ID       { out "ID"; 
-                   let s = Lexing.lexeme lexbuf in
-                   if !O.unquote then P.IDENT s else P.IDENT (quote s)
-              }
-   | ":="     { out "DEF"; P.DEF     }
-   | "("      { out "OP"; P.OP       }
-   | ")"      { out "CP"; P.CP       }
-   | "["      { out "OB"; P.OB       }
-   | "]"      { out "CB"; P.CB       }
-   | "<"      { out "OA"; P.OA       }
-   | ">"      { out "CA"; P.CA       }
-   | "@"      { out "AT"; P.AT       }
-   | "~"      { out "TD"; P.TD       }
-   | "\""     { out "QT"; P.QT       }
-   | ":"      { out "CN"; P.CN       }   
-   | ","      { out "CM"; P.CM       }
-   | ";"      { out "SC"; P.SC       }
-   | "."      { out "FS"; P.FS       }   
-   | "+"      { out "PLUS"; P.PLUS   }
-   | "-"      { out "MINUS"; P.MINUS }
-   | "*"      { out "TIMES"; P.TIMES }
-   | "="      { out "DEF"; P.DEF     }
-   | eof      { out "EOF"; P.EOF     }
diff --git a/helm/software/lambda-delta/components/automath/autOutput.ml b/helm/software/lambda-delta/components/automath/autOutput.ml
deleted file mode 100644 (file)
index d692005..0000000
+++ /dev/null
@@ -1,100 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module P = Printf
-module C = Cps
-module L = Log
-module A = Aut
-module R = AutProcess
-
-type counters = {
-   sections: int;
-   contexts: int;
-   blocks:   int;
-   decls:    int;
-   defs:     int;
-   sorts:    int;
-   grefs:    int;
-   appls:    int;
-   absts:    int;
-   pars:     int;
-   xnodes:   int
-}
-
-let initial_counters = {
-   sections = 0; contexts = 0; blocks = 0; decls = 0; defs = 0;
-   sorts = 0; grefs = 0; appls = 0; absts = 0; pars = 0; xnodes = 0
-}
-
-let rec count_term f c = function
-   | A.Sort _         -> 
-      f {c with sorts = succ c.sorts; xnodes = succ c.xnodes}
-   | A.GRef (_, ts)   -> 
-      let c = {c with grefs = succ c.grefs} in
-      let c = {c with pars = c.pars + List.length ts} in
-      let c = {c with xnodes = succ c.xnodes + List.length ts} in
-      C.list_fold_left f count_term c ts
-   | A.Appl (v, t)    -> 
-      let c = {c with appls = succ c.appls; xnodes = succ c.xnodes} in
-      let f c = count_term f c t in
-      count_term f c v
-   | A.Abst (_, w, t) -> 
-      let c = {c with absts = succ c.absts; xnodes = succ c.xnodes} in
-      let f c = count_term f c t in
-      count_term f c w
-
-let count_command f c = function
-   | A.Section _        ->
-      f {c with sections = succ c.sections}
-   | A.Context _        ->
-      f {c with contexts = succ c.contexts}
-   | A.Block (_, w)     -> 
-      let c = {c with blocks = succ c.blocks; xnodes = succ c.xnodes} in
-      count_term f c w
-   | A.Decl (_, w)      -> 
-      let c = {c with decls = succ c.decls; xnodes = succ c.xnodes} in
-      count_term f c w
-   | A.Def (_, w, _, t) -> 
-      let c = {c with defs = succ c.defs; xnodes = succ c.xnodes} in
-      let f c = count_term f c t in
-      count_term f c w
-
-let print_counters f c =
-   let terms = c.sorts + c.grefs + c.appls + c.absts in
-   let entities = c.sections + c.contexts + c.blocks + c.decls + c.defs in
-   L.warn (P.sprintf "  Automath representation summary");
-   L.warn (P.sprintf "    Total book entities:      %7u" entities);
-   L.warn (P.sprintf "      Section entities:       %7u" c.sections);
-   L.warn (P.sprintf "      Context entities:       %7u" c.contexts);
-   L.warn (P.sprintf "      Block entities:         %7u" c.blocks);
-   L.warn (P.sprintf "      Declaration entities:   %7u" c.decls);
-   L.warn (P.sprintf "      Definition entities:    %7u" c.defs);
-   L.warn (P.sprintf "    Total Parameter items:    %7u" c.pars);
-   L.warn (P.sprintf "      Application items:      %7u" c.pars);
-   L.warn (P.sprintf "    Total term items:         %7u" terms);
-   L.warn (P.sprintf "      Sort items:             %7u" c.sorts);
-   L.warn (P.sprintf "      Reference items:        %7u" c.grefs);
-   L.warn (P.sprintf "      Application items:      %7u" c.appls);
-   L.warn (P.sprintf "      Abstraction items:      %7u" c.absts);
-   L.warn (P.sprintf "    Global Int. Complexity:   unknown");
-   L.warn (P.sprintf "      + Abbreviation nodes:   %7u" c.xnodes);
-   f ()
-
-let print_process_counters f c =
-   let f iao iar iac iag =
-      L.warn (P.sprintf "  Automath process summary");
-      L.warn (P.sprintf "    Implicit after opening:   %7u" iao);
-      L.warn (P.sprintf "    Implicit after reopening: %7u" iar);
-      L.warn (P.sprintf "    Implicit after closing:   %7u" iac);
-      L.warn (P.sprintf "    Implicit after global:    %7u" iag);
-      f ()
-   in
-   R.get_counters f c
diff --git a/helm/software/lambda-delta/components/automath/autOutput.mli b/helm/software/lambda-delta/components/automath/autOutput.mli
deleted file mode 100644 (file)
index 1a5f561..0000000
+++ /dev/null
@@ -1,20 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type counters
-
-val initial_counters: counters
-
-val count_command: (counters -> 'a) -> counters -> Aut.command -> 'a
-
-val print_counters: (unit -> 'a) -> counters -> 'a
-
-val print_process_counters: (unit -> 'a) -> AutProcess.status -> 'a
diff --git a/helm/software/lambda-delta/components/automath/autParser.mly b/helm/software/lambda-delta/components/automath/autParser.mly
deleted file mode 100644 (file)
index e90ba3b..0000000
+++ /dev/null
@@ -1,100 +0,0 @@
-/* Copyright (C) 2000, HELM Team.
- * 
- * This file is part of HELM, an Hypertextual, Electronic
- * Library of Mathematics, developed at the Computer Science
- * Department, University of Bologna, Italy.
- * 
- * HELM is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- * 
- * HELM is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with HELM; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- * MA  02111-1307, USA.
- * 
- * For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
- */
-
-%{
-   module O = Options
-   module A = Aut
-
-   let _ = Parsing.set_trace !O.debug_parser
-%}
-   %token <int> NUM
-   %token <string> IDENT
-   %token EOF MINUS PLUS TIMES AT FS CN CM SC QT TD OP CP OB CB OA CA
-   %token TYPE PROP DEF EB E PN EXIT
-    
-   %start entry
-   %type <Aut.command option> entry   
-%%
-   path: MINUS {} | FS {} ;
-   oftype: CN {} | CM {} ;
-   star: TIMES {} | AT {} ;
-   sc: E {} | SC {} | CN {} ;
-   eof: SC {} | EOF {} ;
-
-   expand:
-      |    { true  }
-      | TD { false }
-   ;
-   local:
-      |      { false }
-      | path { true  }
-   ;
-
-   idents:
-      | IDENT             { [$1]     }
-      | IDENT path idents { $1 :: $3 }
-   ;
-   qid:
-      | IDENT                    { ($1, true, [])  }
-      | IDENT QT QT              { ($1, true, [])  }
-      | IDENT QT local idents QT { ($1, $3, $4)    }
-   ;
-   term:
-      | TYPE                         { A.Sort true         }
-      | PROP                         { A.Sort false        }
-      | qid                          { A.GRef ($1, [])     }
-      | qid OP CP                    { A.GRef ($1, [])     }
-      | qid OP terms CP              { A.GRef ($1, $3)     } 
-      | OA term CA term              { A.Appl ($2, $4)     }
-      | OB IDENT oftype term CB term { A.Abst ($2, $4, $6) } 
-   ;
-   terms:
-      | term          { [$1]     }
-      | term CM terms { $1 :: $3 }
-   ;
-   
-   start:
-      | PLUS {} | MINUS {} | EXIT {} | eof {}
-      | star {} | IDENT {} | OB {} 
-   ; 
-   entity:
-      | PLUS IDENT                    { A.Section (Some (true, $2))  }
-      | PLUS TIMES IDENT              { A.Section (Some (false, $3)) }
-      | MINUS IDENT                   { A.Section None               }
-      | EXIT                          { A.Section None               }
-      | star                          { A.Context None               }
-      | qid star                      { A.Context (Some $1)          }
-      | IDENT DEF EB sc term          { A.Block ($1, $5)             }
-      | IDENT sc term DEF EB          { A.Block ($1, $3)             }
-      | OB IDENT oftype term CB       { A.Block ($2, $4)             }
-      | IDENT DEF PN sc term          { A.Decl ($1, $5)              }
-      | IDENT sc term DEF PN          { A.Decl ($1, $3)              }
-      | IDENT DEF expand term sc term { A.Def ($1, $6, $3, $4)       }
-      | IDENT sc term DEF expand term { A.Def ($1, $3, $5, $6)       }
-   ;
-   entry:
-      | entity start { Some $1 }
-      | eof          { None    }
-   ;
diff --git a/helm/software/lambda-delta/components/automath/autProcess.ml b/helm/software/lambda-delta/components/automath/autProcess.ml
deleted file mode 100644 (file)
index 405952f..0000000
+++ /dev/null
@@ -1,77 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module A = Aut
-
-type status = {
-   opening  : bool; (* just opened section *)
-   reopening: bool; (* just reopened section *)
-   closing  : bool; (* just closed section *)
-   explicit : bool; (* just found explicit context *)
-   block    : bool; (* just found block opener *)
-   iao      : int;  (* implicit context after opening section *)
-   iar      : int;  (* implicit context after reopening section *)
-   iac      : int;  (* implicit context after closing section *)
-   iag      : int   (* implicit context after global statement *)
-}
-
-(* internal functions *******************************************************)
-
-let orc_reset f st =
-   f {st with opening = false; reopening = false; closing = false}
-
-let orc_count f st =
-   let st = if st.opening then {st with iao = succ st.iao} else st in
-   let st = if st.reopening then {st with iar = succ st.iar} else st in
-   let st = if st.closing then {st with iac = succ st.iac} else st in
-   f st
-
-let exp_count f st =
-   let st = 
-      if st.explicit || st.block then st else {st with iag = succ st.iag} 
-   in
-   f st
-
-let proc_section f st = function
-   | Some (true, _)  -> f {st with opening = true} 
-   | Some (false, _) -> f {st with reopening = true} 
-   | None            -> f {st with closing = true}
-
-let proc_context f st =
-   orc_reset f {st with explicit = true}
-
-let proc_block f st =
-   orc_count (orc_reset f) {st with explicit = false; block = true}
-
-let proc_global f st =
-   let f st = 
-      orc_count (orc_reset f) {st with explicit = false; block = false}
-   in
-   exp_count f st
-
-let proc_command f st command = match command with
-   | A.Section section -> proc_section f st section command
-   | A.Context _       -> proc_context f st command  
-   | A.Block _         -> proc_block f st command
-   | A.Decl _          -> proc_global f st command
-   | A.Def _           -> proc_global f st command
-   
-(* interface functions ******************************************************)
-
-let initial_status () = {
-   opening = false; reopening = false; closing = false; 
-   explicit = false; block = false;
-   iao = 0; iar = 0; iac = 0; iag = 0
-}
-
-let process_command = proc_command
-
-let get_counters f st = f st.iao st.iar st.iac st.iag
diff --git a/helm/software/lambda-delta/components/automath/autProcess.mli b/helm/software/lambda-delta/components/automath/autProcess.mli
deleted file mode 100644 (file)
index 4145ff9..0000000
+++ /dev/null
@@ -1,19 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type status
-
-val initial_status: unit -> status
-
-val process_command: 
-   (status -> Aut.command -> 'a) -> status -> Aut.command -> 'a
-
-val get_counters: (int -> int -> int -> int -> 'a) -> status -> 'a
diff --git a/helm/software/lambda-delta/components/basic_ag/Make b/helm/software/lambda-delta/components/basic_ag/Make
deleted file mode 100644 (file)
index 1d2286b..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-bag bagOutput 
-bagEnvironment bagSubstitution bagReduction bagType bagUntrusted
diff --git a/helm/software/lambda-delta/components/basic_ag/bag.ml b/helm/software/lambda-delta/components/basic_ag/bag.ml
deleted file mode 100644 (file)
index 1aa9b62..0000000
+++ /dev/null
@@ -1,93 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-(* kernel version: basic, absolute, global *)
-(* note          : experimental *) 
-
-type uri = Entity.uri
-type id = Entity.id
-
-type bind = Void         (* exclusion *)
-          | Abst of term (* abstraction *)
-          | Abbr of term (* abbreviation *)
-
-and term = Sort of int                    (* hierarchy index *)
-         | LRef of int                    (* location *)
-         | GRef of uri                    (* reference *)
-         | Cast of term * term            (* domain, element *)
-         | Appl of term * term            (* argument, function *)
-         | Bind of int * id * bind * term (* location, name, binder, scope *)
-
-type entity = term Entity.entity (* attrs, uri, binder *)
-
-type lenv = (int * id * bind) list (* location, name, binder *) 
-
-type message = (lenv, term) Log.item list
-
-(* helpers ******************************************************************)
-
-let mk_uri si root s =
-   let kernel = if si then "bag-si" else "bag" in
-   String.concat "/" ["ld:"; kernel; root; s ^ ".ld"]
-
-(* Currified constructors ***************************************************)
-
-let abst w = Abst w
-
-let abbr v = Abbr v
-
-let lref i = LRef i
-
-let cast u t = Cast (u, t)
-
-let appl u t = Appl (u, t)
-
-let bind l id b t = Bind (l, id, b, t)
-
-let bind_abst l id u t = Bind (l, id, Abst u, t)
-
-let bind_abbr l id v t = Bind (l, id, Abbr v, t)
-
-(* location handling functions **********************************************)
-
-let location = ref 0
-
-let new_location () = let loc = !location in incr location; loc
-
-let locations () = !location
-
-(* local environment handling functions *************************************)
-
-let empty_lenv = []
-
-let push msg f es l id b =
-   let rec does_not_occur loc = function
-      | []                          -> true
-      | (l, _, _) :: _ when l = loc -> false
-      | _ :: es                     -> does_not_occur l es
-   in
-   if not (does_not_occur l es) then failwith msg else
-   let c = (l, id, b) :: es in f c
-
-let append f es1 es2 = 
-   f (List.append es2 es1)
-
-let map f map es =
-   Cps.list_map f map es
-
-let contents f es = f es
-
-let get f es i =
-   let rec aux = function
-      | []               -> f None
-      | (l, id, b) :: tl -> if l = i then f (Some (id, b)) else aux tl
-   in
-   aux es
diff --git a/helm/software/lambda-delta/components/basic_ag/bagEnvironment.ml b/helm/software/lambda-delta/components/basic_ag/bagEnvironment.ml
deleted file mode 100644 (file)
index 04681cf..0000000
+++ /dev/null
@@ -1,39 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module U = NUri
-module L = Log
-module H = U.UriHash
-module Y = Entity
-module B = Bag
-
-exception ObjectNotFound of B.message
-
-let hsize = 7000 
-let env = H.create hsize
-
-(* Internal functions *******************************************************)
-
-let get_age = 
-   let age = ref 0 in
-   fun () -> incr age; !age
-
-let error uri = raise (ObjectNotFound (L.items1 (U.string_of_uri uri)))
-
-(* Interface functions ******************************************************)
-
-let set_entity f (a, uri, b) =
-   let age = get_age () in
-   let entry = (Y.Apix age :: a), uri, b in
-   H.add env uri entry; f entry
-
-let get_entity f uri =
-   try f (H.find env uri) with Not_found -> error uri
diff --git a/helm/software/lambda-delta/components/basic_ag/bagEnvironment.mli b/helm/software/lambda-delta/components/basic_ag/bagEnvironment.mli
deleted file mode 100644 (file)
index 4a44c05..0000000
+++ /dev/null
@@ -1,16 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-exception ObjectNotFound of Bag.message
-
-val set_entity: (Bag.entity -> 'a) -> Bag.entity -> 'a
-
-val get_entity: (Bag.entity -> 'a) -> Bag.uri -> 'a
diff --git a/helm/software/lambda-delta/components/basic_ag/bagOutput.ml b/helm/software/lambda-delta/components/basic_ag/bagOutput.ml
deleted file mode 100644 (file)
index 0bfc13e..0000000
+++ /dev/null
@@ -1,145 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module P = Printf
-module F = Format
-module U = NUri
-module L = Log
-module O = Options
-module Y = Entity
-module H = Hierarchy
-module B = Bag
-
-type counters = {
-   eabsts: int;
-   eabbrs: int;
-   tsorts: int;
-   tlrefs: int;
-   tgrefs: int;
-   tcasts: int;
-   tappls: int;
-   tabsts: int;
-   tabbrs: int
-}
-
-let initial_counters = {
-   eabsts = 0; eabbrs = 0; tsorts = 0; tlrefs = 0; tgrefs = 0;
-   tcasts = 0; tappls = 0; tabsts = 0; tabbrs = 0
-}
-
-let rec count_term_binder f c = function
-   | B.Abst w ->
-      let c = {c with tabsts = succ c.tabsts} in
-      count_term f c w
-   | B.Abbr v -> 
-      let c = {c with tabbrs = succ c.tabbrs} in
-      count_term f c v
-   | B.Void   -> f c
-
-and count_term f c = function
-   | B.Sort _            -> 
-      f {c with tsorts = succ c.tsorts}
-   | B.LRef _            -> 
-      f {c with tlrefs = succ c.tlrefs}
-   | B.GRef _            -> 
-      f {c with tgrefs = succ c.tgrefs}
-   | B.Cast (v, t)       -> 
-      let c = {c with tcasts = succ c.tcasts} in
-      let f c = count_term f c t in
-      count_term f c v
-   | B.Appl (v, t)       -> 
-      let c = {c with tappls = succ c.tappls} in
-      let f c = count_term f c t in
-      count_term f c v
-   | B.Bind (_, _, b, t) -> 
-      let f c = count_term_binder f c b in
-      count_term f c t
-
-let count_entity f c = function
-   | _, _, Y.Abst w -> 
-      let c = {c with eabsts = succ c.eabsts} in
-      count_term f c w
-   | _, _, Y.Abbr v -> 
-      let c = {c with eabbrs = succ c.eabbrs} in
-      count_term f c v
-   | _, _, Y.Void   -> assert false
-
-let print_counters f c =
-   let terms =
-      c.tsorts + c.tgrefs + c.tgrefs + c.tcasts + c.tappls + c.tabsts +
-      c.tabbrs
-   in
-   let items = c.eabsts + c.eabbrs in
-   let locations = B.locations () in
-   L.warn (P.sprintf "  Kernel representation summary (basic_ag)");
-   L.warn (P.sprintf "    Total entry items:        %7u" items);
-   L.warn (P.sprintf "      Declaration items:      %7u" c.eabsts);
-   L.warn (P.sprintf "      Definition items:       %7u" c.eabbrs);
-   L.warn (P.sprintf "    Total term items:         %7u" terms);
-   L.warn (P.sprintf "      Sort items:             %7u" c.tsorts);
-   L.warn (P.sprintf "      Local reference items:  %7u" c.tlrefs);
-   L.warn (P.sprintf "      Global reference items: %7u" c.tgrefs);
-   L.warn (P.sprintf "      Explicit Cast items:    %7u" c.tcasts);
-   L.warn (P.sprintf "      Application items:      %7u" c.tappls);
-   L.warn (P.sprintf "      Abstraction items:      %7u" c.tabsts);
-   L.warn (P.sprintf "      Abbreviation items:     %7u" c.tabbrs);
-   L.warn (P.sprintf "    Total binder locations:   %7u" locations);   
-   f ()
-
-let res l id =
-   if !O.indexes then P.sprintf "#%u" l else id
-
-let rec pp_term c frm = function
-   | B.Sort h                 -> 
-      let err () = F.fprintf frm "@[*%u@]" h in
-      let f s = F.fprintf frm "@[%s@]" s in
-      H.string_of_sort err f h 
-   | B.LRef i                 -> 
-      let f = function
-         | Some (id, _) -> F.fprintf frm "@[%s@]" id
-         | None         -> F.fprintf frm "@[#%u@]" i
-      in
-      if !O.indexes then f None else B.get f c i
-   | B.GRef s                    -> F.fprintf frm "@[$%s@]" (U.string_of_uri s)
-   | B.Cast (u, t)               ->
-      F.fprintf frm "@[{%a}.%a@]" (pp_term c) u (pp_term c) t
-   | B.Appl (v, t)               ->
-      F.fprintf frm "@[(%a).%a@]" (pp_term c) v (pp_term c) t
-   | B.Bind (l, id, B.Abst w, t) ->
-      let f cc =
-         F.fprintf frm "@[[%s:%a].%a@]" (res l id) (pp_term c) w (pp_term cc) t
-      in
-      B.push "output abst" f c l id (B.Abst w)
-   | B.Bind (l, id, B.Abbr v, t) ->
-      let f cc = 
-         F.fprintf frm "@[[%s=%a].%a@]" (res l id) (pp_term c) v (pp_term cc) t
-      in
-      B.push "output abbr" f c l id (B.Abbr v)
-   | B.Bind (l, id, B.Void, t)   ->
-      let f cc = F.fprintf frm "@[[%s].%a@]" (res l id) (pp_term cc) t in
-      B.push "output void" f c l id B.Void
-
-let pp_lenv frm c =
-   let pp_entry frm = function
-      | l, id, B.Abst w -> 
-         F.fprintf frm "@,@[%s : %a@]" (res l id) (pp_term c) w
-      | l, id, B.Abbr v -> 
-         F.fprintf frm "@,@[%s = %a@]" (res l id) (pp_term c) v
-      | l, id, B.Void   -> 
-         F.fprintf frm "@,%s" (res l id)
-   in
-   let iter map frm l = List.iter (map frm) l in
-   let f es = F.fprintf frm "%a" (iter pp_entry) (List.rev es) in
-   B.contents f c
-
-let specs = {
-   L.pp_term = pp_term; L.pp_lenv = pp_lenv
-}
diff --git a/helm/software/lambda-delta/components/basic_ag/bagOutput.mli b/helm/software/lambda-delta/components/basic_ag/bagOutput.mli
deleted file mode 100644 (file)
index daa07a6..0000000
+++ /dev/null
@@ -1,20 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type counters
-
-val initial_counters: counters
-
-val count_entity: (counters -> 'a) -> counters -> Bag.entity -> 'a
-
-val print_counters: (unit -> 'a) -> counters -> 'a
-
-val specs: (Bag.lenv, Bag.term) Log.specs
diff --git a/helm/software/lambda-delta/components/basic_ag/bagReduction.ml b/helm/software/lambda-delta/components/basic_ag/bagReduction.ml
deleted file mode 100644 (file)
index b7eb88f..0000000
+++ /dev/null
@@ -1,196 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module U = NUri
-module C = Cps
-module L = Log
-module Y = Entity
-module B = Bag
-module O = BagOutput
-module E = BagEnvironment
-module S = BagSubstitution
-
-type machine = {
-   i: int;
-   c: B.lenv;
-   s: B.term list
-}
-
-type whd_result =
-   | Sort_ of int
-   | LRef_ of int * B.term option
-   | GRef_ of B.entity
-   | Bind_ of int * B.id * B.term * B.term
-
-type ho_whd_result =
-   | Sort of int
-   | Abst of B.term
-
-(* Internal functions *******************************************************)
-
-let term_of_whdr = function
-   | Sort_ h             -> B.Sort h
-   | LRef_ (i, _)        -> B.LRef i
-   | GRef_ (_, uri, _)   -> B.GRef uri
-   | Bind_ (l, id, w, t) -> B.bind_abst l id w t
-
-let level = 5
-
-let log1 s c t =
-   let sc, st = s ^ " in the environment", "the term" in
-   L.log O.specs level (L.et_items1 sc c st t)
-
-let log2 s cu u ct t =
-   let s1, s2, s3 = s ^ " in the environment", "the term", "and in the environment" in
-   L.log O.specs level (L.et_items2 s1 cu s2 u ~sc2:s3 ~c2:ct s2 t)
-
-let empty_machine = {i = 0; c = B.empty_lenv; s = []}
-
-let inc m = {m with i = succ m.i}
-
-let unwind_to_term f m t =
-   let map f t (l, id, b) = f (B.Bind (l, id, b, t)) in
-   let f mc = C.list_fold_left f map t mc in
-   B.contents f m.c
-
-let unwind_stack f m =
-   let map f v = unwind_to_term f m v in
-   C.list_map f map m.s
-
-let get f c m i =
-   let f = function
-      | Some (_, b) -> f b
-      | None        -> assert false
-   in
-   let f c = B.get f c i in
-   B.append f c m.c
-
-let push msg f c m l id w = 
-   assert (m.s = []);
-   let f w = B.push msg f c l id (B.Abst w) in
-   unwind_to_term f m w
-
-(* to share *)
-let rec whd f c m x = 
-(*   L.warn "entering R.whd"; *)
-   match x with
-   | B.Sort h                    -> f m (Sort_ h)
-   | B.GRef uri                  ->
-      let f entry = f m (GRef_ entry) in
-      E.get_entity f uri
-   | B.LRef i                    ->
-      let f = function
-         | B.Void   -> f m (LRef_ (i, None))
-        | B.Abst t -> f m (LRef_ (i, Some t))
-        | B.Abbr t -> whd f c m t
-      in
-      get f c m i
-   | B.Cast (_, t)               -> whd f c m t
-   | B.Appl (v, t)               -> whd f c {m with s = v :: m.s} t   
-   | B.Bind (l, id, B.Abst w, t) -> 
-      begin match m.s with
-         | []      -> f m (Bind_ (l, id, w, t))
-        | v :: tl -> 
-            let nl = B.new_location () in
-           let f mc = S.subst (whd f c {m with c = mc; s = tl}) nl l t in
-           B.push "!" f m.c nl id (B.Abbr (B.Cast (w, v)))
-      end
-   | B.Bind (l, id, b, t)         -> 
-      let nl = B.new_location () in
-      let f mc = S.subst (whd f c {m with c = mc}) nl l t in
-      B.push "!" f m.c nl id b
-
-(* Interface functions ******************************************************)
-
-let rec ho_whd f c m x =
-(*   L.warn "entering R.ho_whd"; *)
-   let aux m = function
-      | Sort_ h                -> f (Sort h)
-      | Bind_ (_, _, w, _)     -> 
-         let f w = f (Abst w) in unwind_to_term f m w
-      | LRef_ (_, Some w)      -> ho_whd f c m w
-      | GRef_ (_, _, Y.Abst w) -> ho_whd f c m w  
-      | GRef_ (_, _, Y.Abbr v) -> ho_whd f c m v
-      | LRef_ (_, None)        -> assert false
-      | GRef_ (_, _, Y.Void)   -> assert false
-   in
-   whd aux c m x
-   
-let ho_whd f c t =
-   let f r = L.unbox level; f r in
-   L.box level; log1 "Now scanning" c t;
-   ho_whd f c empty_machine t
-
-let rec are_convertible f ~si a c m1 t1 m2 t2 =
-(*   L.warn "entering R.are_convertible"; *)
-   let rec aux m1 r1 m2 r2 =
-(*   L.warn "entering R.are_convertible_aux"; *)
-   let u, t = term_of_whdr r1, term_of_whdr r2 in
-   log2 "Now really converting" c u c t;   
-   match r1, r2 with
-      | Sort_ h1, Sort_ h2                                 ->
-         if h1 = h2 then f a else f false 
-      | LRef_ (i1, _), LRef_ (i2, _)                       ->
-         if i1 = i2 then are_convertible_stacks f ~si a c m1 m2 else f false
-      | GRef_ ((Y.Apix a1 :: _), _, Y.Abst _), 
-        GRef_ ((Y.Apix a2 :: _), _, Y.Abst _)              ->
-         if a1 = a2 then are_convertible_stacks f ~si a c m1 m2 else f false
-      | GRef_ ((Y.Apix a1 :: _), _, Y.Abbr v1), 
-        GRef_ ((Y.Apix a2 :: _), _, Y.Abbr v2)             ->
-         if a1 = a2 then
-           let f a = 
-              if a then f a else are_convertible f ~si true c m1 v1 m2 v2
-           in
-           are_convertible_stacks f ~si a c m1 m2
-        else
-        if a1 < a2 then whd (aux m1 r1) c m2 v2 else
-        whd (aux_rev m2 r2) c m1 v1
-      | _, GRef_ (_, _, Y.Abbr v2)                         ->
-         whd (aux m1 r1) c m2 v2
-      | GRef_ (_, _, Y.Abbr v1), _                         ->
-        whd (aux_rev m2 r2) c m1 v1      
-      | Bind_ (l1, id1, w1, t1), Bind_ (l2, id2, w2, t2)   ->
-          let l = B.new_location () in
-          let h c =
-             let m1, m2 = inc m1, inc m2 in
-             let f t1 = S.subst (are_convertible f ~si a c m1 t1 m2) l l2 t2 in
-             S.subst f l l1 t1
-        in
-         let f r = if r then push "!" h c m1 l id1 w1 else f false in
-        are_convertible f ~si a c m1 w1 m2 w2
-(* we detect the AUT-QE reduction rule for type/prop inclusion *)      
-      | Sort_ _, Bind_ (l2, id2, w2, t2) when si           ->
-        let m1, m2 = inc m1, inc m2 in
-        let f c = are_convertible f ~si a c m1 (term_of_whdr r1) m2 t2 in
-        push "nsi" f c m2 l2 id2 w2
-      | _                                                  -> f false
-   and aux_rev m2 r2 m1 r1 = aux m1 r1 m2 r2 in
-   let g m1 r1 = whd (aux m1 r1) c m2 t2 in 
-   if a = false then f false else whd g c m1 t1
-
-and are_convertible_stacks f ~si a c m1 m2 =
-(*   L.warn "entering R.are_convertible_stacks"; *)
-   let mm1, mm2 = {m1 with s = []}, {m2 with s = []} in
-   let map f a v1 v2 = are_convertible f ~si a c mm1 v1 mm2 v2 in
-   if List.length m1.s <> List.length m2.s then 
-      begin 
-(*         L.warn (Printf.sprintf "Different lengths: %u %u"
-           (List.length m1.s) (List.length m2.s) 
-        ); *)
-        f false
-      end
-   else
-      C.list_fold_left2 f map a m1.s m2.s
-
-let are_convertible f ?(si=false) c u t = 
-   let f b = L.unbox level; f b in
-   L.box level; log2 "Now converting" c u c t;
-   are_convertible f ~si true c empty_machine u empty_machine t
diff --git a/helm/software/lambda-delta/components/basic_ag/bagReduction.mli b/helm/software/lambda-delta/components/basic_ag/bagReduction.mli
deleted file mode 100644 (file)
index 8f32faa..0000000
+++ /dev/null
@@ -1,20 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type ho_whd_result =
-   | Sort of int
-   | Abst of Bag.term
-
-val ho_whd: 
-   (ho_whd_result -> 'a) -> Bag.lenv -> Bag.term -> 'a
-
-val are_convertible:
-   (bool -> 'a) -> ?si:bool -> Bag.lenv -> Bag.term -> Bag.term -> 'a
diff --git a/helm/software/lambda-delta/components/basic_ag/bagSubstitution.ml b/helm/software/lambda-delta/components/basic_ag/bagSubstitution.ml
deleted file mode 100644 (file)
index ad75d63..0000000
+++ /dev/null
@@ -1,48 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module S = Share
-module B = Bag
-
-(* Internal functions *******************************************************)
-
-let rec lref_map_bind f map b = match b with
-   | B.Abbr v ->
-      let f v' = f (S.sh1 v v' b B.abbr) in
-      lref_map f map v      
-   | B.Abst w ->
-      let f w' = f (S.sh1 w w' b B.abst) in
-      lref_map f map w
-   | B.Void   -> f b
-
-and lref_map f map t = match t with
-   | B.LRef i            -> 
-      let ii = map i in f (S.sh1 i ii t B.lref)
-   | B.GRef _            -> f t
-   | B.Sort _            -> f t
-   | B.Cast (w, u)       ->
-      let f w' u' = f (S.sh2 w w' u u' t B.cast) in
-      let f w' = lref_map (f w') map u in 
-      lref_map f map w
-   | B.Appl (w, u)       ->
-      let f w' u' = f (S.sh2 w w' u u' t B.appl) in
-      let f w' = lref_map (f w') map u in 
-      lref_map f map w
-   | B.Bind (l, id, b, u) ->
-      let f b' u' = f (S.sh2 b b' u u' t (B.bind l id)) in
-      let f b' = lref_map (f b') map u in 
-      lref_map_bind f map b
-
-(* Interface functions ******************************************************)
-
-let subst f new_l old_l t =
-   let map i = if i = old_l then new_l else i in
-   if new_l = old_l then f t else lref_map f map t
diff --git a/helm/software/lambda-delta/components/basic_ag/bagSubstitution.mli b/helm/software/lambda-delta/components/basic_ag/bagSubstitution.mli
deleted file mode 100644 (file)
index b48c056..0000000
+++ /dev/null
@@ -1,12 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-val subst: (Bag.term -> 'a) -> int -> int -> Bag.term -> 'a
diff --git a/helm/software/lambda-delta/components/basic_ag/bagType.ml b/helm/software/lambda-delta/components/basic_ag/bagType.ml
deleted file mode 100644 (file)
index bb4ee83..0000000
+++ /dev/null
@@ -1,127 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module U = NUri
-module C = Cps
-module S = Share
-module L = Log
-module Y = Entity
-module H = Hierarchy
-module B = Bag
-module O = BagOutput
-module E = BagEnvironment
-module R = BagReduction
-
-exception TypeError of B.message
-
-(* Internal functions *******************************************************)
-
-let level = 4
-
-let log1 s c t =
-   let sc, st = s ^ " in the envireonment", "the term" in
-   L.log O.specs level (L.et_items1 sc c st t)
-
-let error1 st c t =
-   let sc = "In the envireonment" in
-   raise (TypeError (L.et_items1 sc c st t))
-
-let error3 c t1 t2 t3 =
-   let sc, st1, st2, st3 = 
-      "In the envireonment", "the term", "is of type", "but must be of type"
-   in
-   raise (TypeError (L.et_items3 sc c st1 t1 st2 t2 st3 t3))
-
-let mk_gref u l =
-   let map t v = B.Appl (v, t) in
-   List.fold_left map (B.GRef u) l
-
-(* Interface functions ******************************************************)
-
-let rec b_type_of f st c x = 
-(*   L.warn "Entering T.b_type_of"; *)
-   log1 "Now checking" c x;
-   match x with
-   | B.Sort h                    ->
-      let h = H.apply h in f x (B.Sort h) 
-   | B.LRef i                    ->
-      let f = function
-         | Some (_, B.Abst w)               -> f x w
-        | Some (_, B.Abbr (B.Cast (w, v))) -> f x w
-        | Some (_, B.Abbr _)               -> assert false
-        | Some (_, B.Void)                 -> 
-           error1 "reference to excluded variable" c x
-         | None                             ->
-           error1 "variable not found" c x      
-      in
-      B.get f c i
-   | B.GRef uri                  ->
-      let f = function
-         | _, _, Y.Abst w               -> f x w
-        | _, _, Y.Abbr (B.Cast (w, v)) -> f x w
-        | _, _, Y.Abbr _               -> assert false
-        | _, _, Y.Void                 -> assert false
-      in
-      E.get_entity f uri   
-   | B.Bind (l, id, B.Abbr v, t) ->
-      let f xv xt tt =
-         f (S.sh2 v xv t xt x (B.bind_abbr l id)) (B.bind_abbr l id xv tt)
-      in
-      let f xv cc = b_type_of (f xv) st cc t in
-      let f xv = B.push "type abbr" (f xv) c l id (B.Abbr xv) in
-      let f xv vv = match xv with 
-        | B.Cast _ -> f xv
-         | _        -> f (B.Cast (vv, xv))
-      in
-      type_of f st c v
-   | B.Bind (l, id, B.Abst u, t) ->
-      let f xu xt tt =
-        f (S.sh2 u xu t xt x (B.bind_abst l id)) (B.bind_abst l id xu tt)
-      in
-      let f xu cc = b_type_of (f xu) st cc t in
-      let f xu _ = B.push "type abst" (f xu) c l id (B.Abst xu) in
-      type_of f st c u
-   | B.Bind (l, id, B.Void, t)   ->
-      let f xt tt = 
-         f (S.sh1 t xt x (B.bind l id B.Void)) (B.bind l id B.Void tt)
-      in
-      let f cc = b_type_of f st cc t in
-      B.push "type void" f c l id B.Void   
-   | B.Appl (v, t)            ->
-      let f xv vv xt tt = function
-        | R.Abst w                             -> 
-            L.box (succ level);
-           L.log O.specs (succ level) (L.t_items1 "Just scanned" c w);
-           L.unbox (succ level);
-           let f a =                
-(*            L.warn (Printf.sprintf "Convertible: %b" a); *)
-              if a then f (S.sh2 v xv t xt x B.appl) (B.appl xv tt)
-              else error3 c xv vv w
-           in
-           R.are_convertible f ~si:st.Y.si c w vv
-        | _                                    -> 
-           error1 "not a function" c xt
-      in
-      let f xv vv xt tt = R.ho_whd (f xv vv xt tt) c tt in
-      let f xv vv = b_type_of (f xv vv) st c t in
-      type_of f st c v
-   | B.Cast (u, t)            ->
-      let f xu xt tt a =  
-         (* L.warn (Printf.sprintf "Convertible: %b" a); *)
-        if a then f (S.sh2 u xu t xt x B.cast) xu else error3 c xt tt xu
-      in
-      let f xu xt tt = R.are_convertible (f xu xt tt) ~si:st.Y.si c xu tt in
-      let f xu _ = b_type_of (f xu) st c t in
-      type_of f st c u
-
-and type_of f st c x =
-   let f t u = L.unbox level; f t u in
-   L.box level; b_type_of f st c x
diff --git a/helm/software/lambda-delta/components/basic_ag/bagType.mli b/helm/software/lambda-delta/components/basic_ag/bagType.mli
deleted file mode 100644 (file)
index 31a421b..0000000
+++ /dev/null
@@ -1,16 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-exception TypeError of Bag.message
-
-val type_of: 
-   (Bag.term -> Bag.term -> 'a) ->
-   Entity.status -> Bag.lenv -> Bag.term -> 'a
diff --git a/helm/software/lambda-delta/components/basic_ag/bagUntrusted.ml b/helm/software/lambda-delta/components/basic_ag/bagUntrusted.ml
deleted file mode 100644 (file)
index 33d6a5f..0000000
+++ /dev/null
@@ -1,29 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module U = NUri
-module L = Log
-module Y = Entity
-module B = Bag
-module E = BagEnvironment
-module T = BagType
-
-(* Interface functions ******************************************************)
-
-(* to share *)
-let type_check f st = function
-   | a, uri, Y.Abst t ->
-      let f xt tt = E.set_entity (f tt) (a, uri, Y.Abst xt) in
-      L.loc := U.string_of_uri uri; T.type_of f st B.empty_lenv t
-   | a, uri, Y.Abbr t ->
-      let f xt tt = E.set_entity (f tt) (a, uri, Y.Abbr xt) in
-      L.loc := U.string_of_uri uri; T.type_of f st B.empty_lenv t
-   | _, _, Y.Void     -> assert false
diff --git a/helm/software/lambda-delta/components/basic_ag/bagUntrusted.mli b/helm/software/lambda-delta/components/basic_ag/bagUntrusted.mli
deleted file mode 100644 (file)
index af96740..0000000
+++ /dev/null
@@ -1,13 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-val type_check:
-   (Bag.term -> Bag.entity -> 'a) -> Entity.status -> Bag.entity -> 'a
diff --git a/helm/software/lambda-delta/components/basic_rg/Make b/helm/software/lambda-delta/components/basic_rg/Make
deleted file mode 100644 (file)
index ee53ca2..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-brg brgOutput
-brgEnvironment brgSubstitution brgReduction brgType brgUntrusted
diff --git a/helm/software/lambda-delta/components/basic_rg/brg.ml b/helm/software/lambda-delta/components/basic_rg/brg.ml
deleted file mode 100644 (file)
index efc5d75..0000000
+++ /dev/null
@@ -1,83 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-(* kernel version: basic, relative, global *)
-(* note          : ufficial basic lambda-delta *) 
-
-type uri = Entity.uri
-type id = Entity.id
-type attrs = Entity.attrs
-
-type bind = Void         (*      *)
-          | Abst of term (* type *)
-          | Abbr of term (* body *)
-
-and term = Sort of attrs * int         (* attrs, hierarchy index *)
-         | LRef of attrs * int         (* attrs, position index *)
-         | GRef of attrs * uri         (* attrs, reference *)
-         | Cast of attrs * term * term (* attrs, type, term *)
-         | Appl of attrs * term * term (* attrs, argument, function *)
-         | Bind of attrs * bind * term (* attrs, binder, scope *)
-
-type entity = term Entity.entity (* attrs, uri, binder *)
-
-type lenv = Null
-(* Cons: tail, relative local environment, attrs, binder *) 
-          | Cons of lenv * lenv * attrs * bind 
-
-(* helpers ******************************************************************)
-
-let mk_uri si root s =
-   let kernel = if si then "brg-si" else "brg" in
-   String.concat "/" ["ld:"; kernel; root; s ^ ".ld"]
-
-(* Currified constructors ***************************************************)
-
-let abst w = Abst w
-
-let abbr v = Abbr v
-
-let lref a i = LRef (a, i)
-
-let cast a u t = Cast (a, u, t)
-
-let appl a u t = Appl (a, u, t)
-
-let bind a b t = Bind (a, b, t)
-
-let bind_abst a u t = Bind (a, Abst u, t)
-
-let bind_abbr a v t = Bind (a, Abbr v, t)
-
-let bind_void a t = Bind (a, Void, t)
-
-(* local environment handling functions *************************************)
-
-let empty = Null
-
-let push e c a b = Cons (e, c, a, b)
-
-let rec get i = function
-   | Null                         -> Null, Null, [], Void
-   | Cons (e, c, a, b) when i = 0 -> e, c, a, b
-   | Cons (e, _, _, _)            -> get (pred i) e
-
-let get e i = get i e
-
-(* used in BrgOutput.pp_lenv *)
-let rec fold_right f map e x = match e with   
-   | Null              -> f x
-   | Cons (e, c, a, b) -> fold_right (map f e c a b) map e x
-
-(* used in MetaBrg.unwind_to_xlate_term *)
-let rec fold_left map x = function
-   | Null              -> x
-   | Cons (e, _, a, b) -> fold_left map (map x a b) e
diff --git a/helm/software/lambda-delta/components/basic_rg/brgEnvironment.ml b/helm/software/lambda-delta/components/basic_rg/brgEnvironment.ml
deleted file mode 100644 (file)
index 121da88..0000000
+++ /dev/null
@@ -1,35 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module U = NUri
-module H = U.UriHash
-module Y = Entity
-module B = Brg
-
-let hsize = 7000 
-let env = H.create hsize
-
-(* Internal functions *******************************************************)
-
-let get_age = 
-   let age = ref 0 in
-   fun () -> incr age; !age
-
-(* Interface functions ******************************************************)
-
-(* decps *)
-let set_entity (a, uri, b) =
-   let age = get_age () in
-   let entity = (Y.Apix age :: a), uri, b in
-   H.add env uri entity; entity
-
-let get_entity uri =
-   try H.find env uri with Not_found -> [], uri, Y.Void
diff --git a/helm/software/lambda-delta/components/basic_rg/brgEnvironment.mli b/helm/software/lambda-delta/components/basic_rg/brgEnvironment.mli
deleted file mode 100644 (file)
index 1f51f1e..0000000
+++ /dev/null
@@ -1,14 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-val set_entity: Brg.entity -> Brg.entity
-
-val get_entity: Brg.uri -> Brg.entity
diff --git a/helm/software/lambda-delta/components/basic_rg/brgOutput.ml b/helm/software/lambda-delta/components/basic_rg/brgOutput.ml
deleted file mode 100644 (file)
index 186349a..0000000
+++ /dev/null
@@ -1,258 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module P = Printf
-module F = Format
-module C = Cps
-module U = NUri
-module L = Log
-module O = Options
-module Y = Entity
-module X = Library
-module H = Hierarchy
-module B = Brg
-
-(* nodes count **************************************************************)
-
-type counters = {
-   eabsts: int;
-   eabbrs: int;
-   evoids: int;
-   tsorts: int;
-   tlrefs: int;
-   tgrefs: int;
-   tcasts: int;
-   tappls: int;
-   tabsts: int;
-   tabbrs: int;
-   tvoids: int;
-   uris  : B.uri list;
-   nodes : int;
-   xnodes: int
-}
-
-let initial_counters = {
-   eabsts = 0; eabbrs = 0; evoids = 0; 
-   tsorts = 0; tlrefs = 0; tgrefs = 0; tcasts = 0; tappls = 0;
-   tabsts = 0; tabbrs = 0; tvoids = 0;
-   uris = []; nodes = 0; xnodes = 0
-}
-
-let rec count_term_binder f c e = function
-   | B.Abst w ->
-      let c = {c with tabsts = succ c.tabsts; nodes = succ c.nodes} in
-      count_term f c e w
-   | B.Abbr v -> 
-      let c = {c with tabbrs = succ c.tabbrs; xnodes = succ c.xnodes} in
-      count_term f c e v
-   | B.Void   ->
-      let c = {c with tvoids = succ c.tvoids; xnodes = succ c.xnodes} in   
-      f c
-
-and count_term f c e = function
-   | B.Sort _         -> 
-      f {c with tsorts = succ c.tsorts; nodes = succ c.nodes}
-   | B.LRef (_, i)    -> 
-      begin match B.get e i with
-        | _, _, _, B.Abst _
-        | _, _, _, B.Void   ->
-           f {c with tlrefs = succ c.tlrefs; nodes = succ c.nodes}
-        | _, _, _, B.Abbr _ ->
-           f {c with tlrefs = succ c.tlrefs; xnodes = succ c.xnodes}
-      end      
-   | B.GRef (_, u)    -> 
-      let c =    
-        if Cps.list_mem ~eq:U.eq u c.uris
-        then {c with nodes = succ c.nodes}
-        else {c with xnodes = succ c.xnodes}
-      in
-      f {c with tgrefs = succ c.tgrefs}
-   | B.Cast (_, v, t) -> 
-      let c = {c with tcasts = succ c.tcasts} in
-      let f c = count_term f c e t in
-      count_term f c e v
-   | B.Appl (_, v, t) -> 
-      let c = {c with tappls = succ c.tappls; nodes = succ c.nodes} in
-      let f c = count_term f c e t in
-      count_term f c e v
-   | B.Bind (a, b, t) -> 
-      let f c = count_term f c (B.push e B.empty a b) t in
-      count_term_binder f c e b
-
-let count_entity f c = function
-   | _, u, Y.Abst w -> 
-      let c = {c with
-         eabsts = succ c.eabsts; nodes = succ c.nodes; uris = u :: c.uris
-      } in
-      count_term f c B.empty w
-   | _, _, Y.Abbr v ->  
-      let c = {c with eabbrs = succ c.eabbrs; xnodes = succ c.xnodes} in
-      count_term f c B.empty v
-   | _, _, Y.Void   -> assert false
-
-let print_counters f c =
-   let terms =
-      c.tsorts + c.tgrefs + c.tgrefs + c.tcasts + c.tappls + c.tabsts +
-      c.tabbrs
-   in
-   let items = c.eabsts + c.eabbrs in
-   let nodes = c.nodes + c.xnodes in
-   L.warn (P.sprintf "  Kernel representation summary (basic_rg)");
-   L.warn (P.sprintf "    Total entry items:        %7u" items);
-   L.warn (P.sprintf "      Declaration items:      %7u" c.eabsts);
-   L.warn (P.sprintf "      Definition items:       %7u" c.eabbrs);
-   L.warn (P.sprintf "    Total term items:         %7u" terms);
-   L.warn (P.sprintf "      Sort items:             %7u" c.tsorts);
-   L.warn (P.sprintf "      Local reference items:  %7u" c.tlrefs);
-   L.warn (P.sprintf "      Global reference items: %7u" c.tgrefs);
-   L.warn (P.sprintf "      Explicit Cast items:    %7u" c.tcasts);
-   L.warn (P.sprintf "      Application items:      %7u" c.tappls);
-   L.warn (P.sprintf "      Abstraction items:      %7u" c.tabsts);
-   L.warn (P.sprintf "      Abbreviation items:     %7u" c.tabbrs);
-   L.warn (P.sprintf "    Global Int. Complexity:   %7u" c.nodes);
-   L.warn (P.sprintf "      + Abbreviation nodes:   %7u" nodes);
-   f ()
-
-(* supplementary annotation *************************************************)
-
-let rec does_not_occur f n r = function
-   | B.Null              -> f true
-   | B.Cons (e, _, a, _) ->
-      let f n1 r1 =
-         if n1 = n && r1 = r then f false else does_not_occur f n r e
-      in
-      Y.name C.err f a 
-
-let rename f e a =
-   let rec aux f e n r =
-      let f = function
-         | true  -> f n r
-        | false -> aux f e (n ^ "_") r
-      in
-      does_not_occur f n r e
-   in
-   let f n0 r0 =
-      let f n r = if n = n0 && r = r0 then f a else f (Y.Name (n, r) :: a) in
-      aux f e n0 r0 
-   in
-   Y.name C.err f a
-
-(* lenv/term pretty printing ************************************************)
-
-let name err frm a =
-   let f n = function 
-      | true  -> F.fprintf frm "%s" n
-      | false -> F.fprintf frm "^%s" n
-   in      
-   Y.name err f a
-
-let rec pp_term e frm = function
-   | B.Sort (_, h)           -> 
-      let err _ = F.fprintf frm "@[*%u@]" h in
-      let f s = F.fprintf frm "@[%s@]" s in
-      H.string_of_sort err f h 
-   | B.LRef (_, i)           -> 
-      let err _ = F.fprintf frm "@[#%u@]" i in
-      if !O.indexes then err () else      
-      let _, _, a, b = B.get e i in
-      F.fprintf frm "@[%a@]" (name err) a
-   | B.GRef (_, s)           ->
-      F.fprintf frm "@[$%s@]" (U.string_of_uri s)
-   | B.Cast (_, u, t)        ->
-      F.fprintf frm "@[{%a}.%a@]" (pp_term e) u (pp_term e) t
-   | B.Appl (_, v, t)        ->
-      F.fprintf frm "@[(%a).%a@]" (pp_term e) v (pp_term e) t
-   | B.Bind (a, B.Abst w, t) ->
-      let f a =
-         let ee = B.push e B.empty a (B.abst w) in
-        F.fprintf frm "@[[%a:%a].%a@]" (name C.err) a (pp_term e) w (pp_term ee) t
-      in
-      rename f e a
-   | B.Bind (a, B.Abbr v, t) ->
-      let f a = 
-         let ee = B.push e B.empty a (B.abbr v) in
-        F.fprintf frm "@[[%a=%a].%a@]" (name C.err) a (pp_term e) v (pp_term ee) t
-      in
-      rename f e a
-   | B.Bind (a, B.Void, t)   ->
-      let f a = 
-         let ee = B.push e B.empty a B.Void in
-         F.fprintf frm "@[[%a].%a@]" (name C.err) a (pp_term ee) t
-      in
-      rename f e a
-
-let pp_lenv frm e =
-   let pp_entry f e c a b x = f x (*match b with
-      | B.Abst (a, w) -> 
-         let f a = F.fprintf frm "@,@[%a : %a@]" (name C.err) a (pp_term e) w; f a in
-         rename f x a
-      | B.Abbr (a, v) -> 
-         let f a = F.fprintf frm "@,@[%a = %a@]" (name C.err) a (pp_term e) v; f a in
-        rename f c a
-      | B.Void a      -> 
-         let f a = F.fprintf frm "@,%a" (name C.err) a; f a in
-        rename f c a
-*)   in
-   B.fold_right ignore pp_entry e B.empty
-
-let specs = {
-   L.pp_term = pp_term; L.pp_lenv = pp_lenv
-}
-
-(* term xml printing ********************************************************)
-
-let rec exp_term e t out tab = match t with
-   | B.Sort (a, l)    ->
-      let a =
-         let err _ = a in
-         let f s = Y.Name (s, true) :: a in
-        H.string_of_sort err f l
-      in
-      let attrs = [X.position l; X.name a] in
-      X.tag X.sort attrs out tab
-   | B.LRef (a, i)    ->
-      let a = 
-        let err _ = a in
-        let f n r = Y.Name (n, r) :: a in
-         let _, _, a, b = B.get e i in
-        Y.name err f a
-      in
-      let attrs = [X.position i; X.name a] in
-      X.tag X.lref attrs out tab
-   | B.GRef (a, n)    ->
-      let a = Y.Name (U.name_of_uri n, true) :: a in
-      let attrs = [X.uri n; X.name a] in
-      X.tag X.gref attrs out tab
-   | B.Cast (a, u, t) ->
-      let attrs = [] in
-      X.tag X.cast attrs ~contents:(exp_term e u) out tab;
-      exp_term e t out tab
-   | B.Appl (a, v, t) ->
-      let attrs = [] in
-      X.tag X.appl attrs ~contents:(exp_term e v) out tab;
-      exp_term e t out tab
-   | B.Bind (a, b, t)    ->
-      let a = rename C.start e a in
-      exp_bind e a b out tab; 
-      exp_term (B.push e B.empty a b) t out tab 
-
-and exp_bind e a b out tab = match b with
-   | B.Abst w ->
-      let attrs = [X.name a; X.mark a] in
-      X.tag X.abst attrs ~contents:(exp_term e w) out tab
-   | B.Abbr v ->
-      let attrs = [X.name a; X.mark a] in
-      X.tag X.abbr attrs ~contents:(exp_term e v) out tab
-   | B.Void   ->
-      let attrs = [X.name a; X.mark a] in
-      X.tag X.void attrs out tab
-
-let export_term = exp_term B.empty
diff --git a/helm/software/lambda-delta/components/basic_rg/brgOutput.mli b/helm/software/lambda-delta/components/basic_rg/brgOutput.mli
deleted file mode 100644 (file)
index 772f43c..0000000
+++ /dev/null
@@ -1,25 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type counters
-
-val initial_counters: counters
-
-val count_entity: (counters -> 'a) -> counters -> Brg.entity -> 'a
-
-val print_counters: (unit -> 'a) -> counters -> 'a
-
-val specs: (Brg.lenv, Brg.term) Log.specs
-
-val export_term: Brg.term -> Library.pp
-(*
-val export_term: Format.formatter -> Brg.term -> unit
-*)
diff --git a/helm/software/lambda-delta/components/basic_rg/brgReduction.ml b/helm/software/lambda-delta/components/basic_rg/brgReduction.ml
deleted file mode 100644 (file)
index 03ed05b..0000000
+++ /dev/null
@@ -1,210 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module U = NUri
-module C = Cps
-module S = Share
-module L = Log
-module Y = Entity
-module P = Output
-module B = Brg
-module O = BrgOutput
-module E = BrgEnvironment
-
-type kam = {
-   e: B.lenv;                 (* environment *)
-   s: (B.lenv * B.term) list; (* stack       *)
-   d: int                     (* depth       *)
-}
-
-(* Internal functions *******************************************************)
-
-let level = 5
-
-let log1 s c t =
-   let sc, st = s ^ " in the environment", "the term" in
-   L.log O.specs level (L.et_items1 sc c st t)
-
-let log2 s cu u ct t =
-   let s1, s2, s3 = s ^ " in the environment", "the term", "and in the environment" in
-   L.log O.specs level (L.et_items2 s1 cu s2 u ~sc2:s3 ~c2:ct s2 t)
-
-let rec list_and map = function
-   | hd1 :: tl1, hd2 :: tl2 ->
-      if map hd1 hd2 then list_and map (tl1, tl2) else false
-   | l1, l2                 -> l1 = l2
-
-(* check closure *)
-let are_alpha_convertible err f t1 t2 =
-   let rec aux f = function
-      | B.Sort (_, p1), B.Sort (_, p2)
-      | B.LRef (_, p1), B.LRef (_, p2)         ->
-         if p1 = p2 then f () else err ()
-      | B.GRef (_, u1), B.GRef (_, u2)         ->
-         if U.eq u1 u2 then f () else err ()
-      | B.Cast (_, v1, t1), B.Cast (_, v2, t2)         
-      | B.Appl (_, v1, t1), B.Appl (_, v2, t2) ->
-         let f _ = aux f (t1, t2) in
-        aux f (v1, v2)
-      | B.Bind (_, b1, t1), B.Bind (_, b2, t2) ->
-         let f _ = aux f (t1, t2) in
-        aux_bind f (b1, b2)
-      | _                                      -> err ()
-   and aux_bind f = function
-      | B.Abbr v1, B.Abbr v2
-      | B.Abst v1, B.Abst v2                   -> aux f (v1, v2)
-      | B.Void, B.Void                         -> f ()
-      | _                                      -> err ()
-   in
-   if S.eq t1 t2 then f () else aux f (t1, t2)
-
-let get m i =
-   let _, c, a, b = B.get m.e i in c, a, b
-
-(* to share *)
-let rec step st m x = 
-(*   L.warn "entering R.step"; *)
-   match x with
-   | B.Sort _                -> m, None, x
-   | B.GRef (_, uri)         ->
-      begin match E.get_entity uri with
-         | _, _, Y.Abbr v when st.Y.delta ->
-           P.add ~gdelta:1 (); step st m v
-         | _, _, Y.Abst w when st.Y.rt    ->
-            P.add ~grt:1 (); step st m w        
-        | a, _, Y.Abbr v                 ->
-           let e = Y.apix C.err C.start a in
-           m, Some (e, a, B.Abbr v), x   
-        | a, _, Y.Abst w                 ->
-           let e = Y.apix C.err C.start a in
-           m, Some (e, a, B.Abst w), x
-        | _, _, Y.Void                   -> assert false
-      end
-   | B.LRef (_, i)           ->
-      begin match get m i with
-        | c, _, B.Abbr v              ->
-           P.add ~ldelta:1 ();
-           step st {m with e = c} v
-        | c, _, B.Abst w when st.Y.rt ->
-            P.add ~lrt:1 ();
-            step st {m with e = c} w
-        | c, _, B.Void                ->
-           assert false
-        | c, a, (B.Abst _ as b)       ->
-           let e = Y.apix C.err C.start a in
-           {m with e = c}, Some (e, a, b), x
-      end
-   | B.Cast (_, _, t)        ->
-      P.add ~tau:1 ();
-      step st m t
-   | B.Appl (_, v, t)        ->
-      step st {m with s = (m.e, v) :: m.s} t   
-   | B.Bind (a, B.Abst w, t) ->
-      begin match m.s with
-         | []          -> m, None, x
-        | (c, v) :: s ->
-            P.add ~beta:1 ~upsilon:(List.length s) ();
-           let e = B.push m.e c a (B.abbr v) (* (B.Cast ([], w, v)) *) in 
-           step st {m with e = e; s = s} t
-      end
-   | B.Bind (a, b, t)        ->
-      P.add ~upsilon:(List.length m.s) ();
-      let e = B.push m.e m.e a b in 
-      step st {m with e = e} t
-
-let push m a b = 
-   assert (m.s = []);
-   let a, d = match b with
-      | B.Abst _ -> Y.Apix m.d :: a, succ m.d
-      | b        -> a, m.d
-   in
-   let e = B.push m.e m.e a b in
-   {m with e = e; d = d}
-
-let rec ac_nfs st (m1, r1, u) (m2, r2, t) =
-   log2 "Now converting nfs" m1.e u m2.e t;
-   match r1, u, r2, t with
-      | _, B.Sort (_, h1), _, B.Sort (_, h2)                   ->
-         h1 = h2  
-      | Some (e1, _, B.Abst _), _, Some (e2, _, B.Abst _), _   ->
-        if e1 = e2 then ac_stacks st m1 m2 else false
-      | Some (e1, _, B.Abbr v1), _, Some (e2, _, B.Abbr v2), _ ->
-         if e1 = e2 then
-           if ac_stacks st m1 m2 then true else begin
-              P.add ~gdelta:2 (); ac st m1 v1 m2 v2
-           end
-        else if e1 < e2 then begin 
-            P.add ~gdelta:1 ();
-           ac_nfs st (m1, r1, u) (step st m2 v2)
-        end else begin
-           P.add ~gdelta:1 ();
-           ac_nfs st (step st m1 v1) (m2, r2, t) 
-         end
-      | _, _, Some (_, _, B.Abbr v2), _                        ->
-         P.add ~gdelta:1 ();
-        ac_nfs st (m1, r1, u) (step st m2 v2)      
-      | Some (_, _, B.Abbr v1), _, _, _                        ->
-         P.add ~gdelta:1 ();
-        ac_nfs st (step st m1 v1) (m2, r2, t)             
-      | _, B.Bind (a1, (B.Abst w1 as b1), t1), 
-        _, B.Bind (a2, (B.Abst w2 as b2), t2)                  ->
-        if ac {st with Y.si = false} m1 w1 m2 w2 then
-           ac st (push m1 a1 b1) t1 (push m2 a2 b2) t2
-        else false
-      | _, B.Sort _, _, B.Bind (a, b, t) when st.Y.si          ->
-        P.add ~si:1 ();
-        ac st (push m1 a b) u (push m2 a b) t
-      | _                                                      -> false
-
-and ac st m1 t1 m2 t2 =
-(*   L.warn "entering R.are_convertible"; *)
-   ac_nfs st (step st m1 t1) (step st m2 t2)
-
-and ac_stacks st m1 m2 =
-(*   L.warn "entering R.are_convertible_stacks"; *)
-   if List.length m1.s <> List.length m2.s then false else
-   let map (c1, v1) (c2, v2) =
-      let m1, m2 = {m1 with e = c1; s = []}, {m2 with e = c2; s = []} in
-      ac {st with Y.si = false} m1 v1 m2 v2
-   in
-   list_and map (m1.s, m2.s)
-
-(* Interface functions ******************************************************)
-
-let empty_kam = { 
-   e = B.empty; s = []; d = 0
-}
-
-let get m i =
-   assert (m.s = []);
-   let _, _, _, b = B.get m.e i in b
-
-let xwhd st m t =
-   L.box level; log1 "Now scanning" m.e t;   
-   let m, _, t = step {st with Y.delta = true; Y.rt = true} m t in
-   L.unbox level; m, t
-
-let are_convertible st mu u mw w = 
-   L.box level; log2 "Now converting" mu.e u mw.e w;
-   let r = ac {st with Y.delta = st.Y.expand; Y.rt = false} mu u mw w in   
-   L.unbox level; r
-(*    let err _ = in 
-      if S.eq mu mw then are_alpha_convertible err f u w else err () *)
-
-(* error reporting **********************************************************)
-
-let pp_term m frm t = O.specs.L.pp_term m.e frm t
-
-let pp_lenv frm m = O.specs.L.pp_lenv frm m.e
-
-let specs = {
-   L.pp_term = pp_term; L.pp_lenv = pp_lenv
-}
diff --git a/helm/software/lambda-delta/components/basic_rg/brgReduction.mli b/helm/software/lambda-delta/components/basic_rg/brgReduction.mli
deleted file mode 100644 (file)
index eebb157..0000000
+++ /dev/null
@@ -1,26 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type kam
-
-val empty_kam: kam
-
-val get: kam -> int -> Brg.bind
-
-val push: kam -> Entity.attrs -> Brg.bind -> kam
-
-val xwhd: Entity.status -> kam -> Brg.term -> kam * Brg.term 
-
-(* arguments: expected type, inferred type *) 
-val are_convertible: 
-   Entity.status -> kam -> Brg.term -> kam -> Brg.term -> bool
-
-val specs: (kam, Brg.term) Log.specs
diff --git a/helm/software/lambda-delta/components/basic_rg/brgSubstitution.ml b/helm/software/lambda-delta/components/basic_rg/brgSubstitution.ml
deleted file mode 100644 (file)
index 5c9d91a..0000000
+++ /dev/null
@@ -1,46 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module B = Brg
-(* module O = Output *)
-
-let rec icm a = function
-   | B.Sort _
-   | B.LRef _
-   | B.GRef _                -> succ a
-   | B.Bind (_, B.Void, t)   -> icm (succ a) t
-   | B.Cast (_, u, t)        -> icm (icm a u) t
-   | B.Appl (_, u, t)
-   | B.Bind (_, B.Abst u, t)
-   | B.Bind (_, B.Abbr u, t) -> icm (icm (succ a) u) t
-
-let iter map d =
-   let rec iter_bind d = function
-      | B.Void   -> B.Void
-      | B.Abst w -> B.Abst (iter_term d w)
-      | B.Abbr v -> B.Abbr (iter_term d v)
-   and iter_term d = function
-      | B.Sort _ as t      -> t
-      | B.GRef _ as t      -> t
-      | B.LRef (a, i) as t -> if i < d then t else map d a i
-      | B.Cast (a, w, v)   -> B.Cast (a, iter_term d w, iter_term d v)
-      | B.Appl (a, w, u)   -> B.Appl (a, iter_term d w, iter_term d u)
-      | B.Bind (a, b, u)   -> B.Bind (a, iter_bind d b, iter_term (succ d) u)
-   in
-   iter_term d
-
-let lift_map h _ a i =
-   if i + h >= 0 then B.LRef (a, i + h) else assert false
-
-let lift h d t =
-   if h = 0 then t else begin
-(*      O.icm := succ (* icm *) !O.icm (*t*); *) iter (lift_map h) d t
-   end
diff --git a/helm/software/lambda-delta/components/basic_rg/brgSubstitution.mli b/helm/software/lambda-delta/components/basic_rg/brgSubstitution.mli
deleted file mode 100644 (file)
index a171766..0000000
+++ /dev/null
@@ -1,15 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-val lift: int -> int -> Brg.term -> Brg.term
-(*
-val lift_bind: (Brg.bind -> 'a) -> int -> int -> Brg.bind -> 'a
-*)
diff --git a/helm/software/lambda-delta/components/basic_rg/brgType.ml b/helm/software/lambda-delta/components/basic_rg/brgType.ml
deleted file mode 100644 (file)
index 8b119e5..0000000
+++ /dev/null
@@ -1,131 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module U = NUri
-module C = Cps
-module A = Share
-module L = Log
-module H = Hierarchy
-module Y = Entity
-module B = Brg
-module O = BrgOutput
-module E = BrgEnvironment
-module S = BrgSubstitution
-module R = BrgReduction
-
-type message = (R.kam, B.term) Log.message
-
-(* Internal functions *******************************************************)
-
-let level = 4
-
-let message1 st1 m t1 =
-   L.et_items1 "In the environment" m st1 t1
-
-let log1 s m t =
-   let s =  s ^ " the term" in
-   L.log R.specs level (message1 s m t) 
-
-let error1 err s m t =
-   err (message1 s m t)
-
-let message3 m t1 t2 ?mu t3 =    
-   let sm, st1, st2 = "In the environment", "the term", "is of type" in
-   match mu with
-      | Some mu ->
-         let smu, st3 = "but in the environment", "it must be of type" in
-         L.et_items3 sm m st1 t1 st2 t2 ~sc3:smu ~c3:mu st3 t3
-      | None    ->
-         let st3 = "but it must be of type" in
-         L.et_items3 sm m st1 t1 st2 t2 st3 t3
-   
-let error3 err m t1 t2 ?mu t3 =
-   err (message3 m t1 t2 ?mu t3)
-
-let assert_convertibility err f st m u w v =
-   if R.are_convertible st m u m w then f () else
-   error3 err m v w u
-
-let assert_applicability err f st m u w v =
-   match R.xwhd st m u with 
-      | _, B.Sort _                 -> error1 err "not a function type" m u
-      | mu, B.Bind (_, B.Abst u, _) -> 
-         if R.are_convertible st mu u m w then f () else
-        error3 err m v w ~mu u
-      | _                         -> assert false (**)
-
-let rec b_type_of err f st m x =
-   log1 "Now checking" m x;
-   match x with
-   | B.Sort (a, h)           ->
-      let h = H.apply h in f x (B.Sort (a, h)) 
-   | B.LRef (_, i)           ->
-      begin match R.get m i with
-         | B.Abst w                  ->
-           f x (S.lift (succ i) (0) w)
-        | B.Abbr (B.Cast (_, w, _)) -> 
-           f x (S.lift (succ i) (0) w)
-        | B.Abbr _                  -> assert false
-        | B.Void                    -> 
-           error1 err "reference to excluded variable" m x
-      end
-   | B.GRef (_, uri)         ->
-      begin match E.get_entity uri with
-         | _, _, Y.Abst w                  -> f x w
-        | _, _, Y.Abbr (B.Cast (_, w, _)) -> f x w
-        | _, _, Y.Abbr _                  -> assert false
-        | _, _, Y.Void                    ->
-            error1 err "reference to unknown entry" m x
-      end
-   | B.Bind (a, B.Abbr v, t) ->
-      let f xv xt tt =
-         f (A.sh2 v xv t xt x (B.bind_abbr a)) (B.bind_abbr a xv tt)
-      in
-      let f xv m = b_type_of err (f xv) st m t in
-      let f xv = f xv (R.push m a (B.abbr xv)) in
-      let f xv vv = match xv with 
-        | B.Cast _ -> f xv
-         | _        -> f (B.Cast ([], vv, xv))
-      in
-      type_of err f st m v
-   | B.Bind (a, B.Abst u, t) ->
-      let f xu xt tt =
-        f (A.sh2 u xu t xt x (B.bind_abst a)) (B.bind_abst a xu tt)
-      in
-      let f xu m = b_type_of err (f xu) st m t in
-      let f xu _ = f xu (R.push m a (B.abst xu)) in
-      type_of err f st m u
-   | B.Bind (a, B.Void, t)   ->
-      let f xt tt = 
-         f (A.sh1 t xt x (B.bind_void a)) (B.bind_void a tt)
-      in
-      b_type_of err f st (R.push m a B.Void) t
-         
-   | B.Appl (a, v, t)        ->
-      let f xv vv xt tt = 
-         let f _ = f (A.sh2 v xv t xt x (B.appl a)) (B.appl a xv tt) in
-         assert_applicability err f st m tt vv xv
-      in
-      let f xv vv = b_type_of err (f xv vv) st m t in
-      type_of err f st m v
-   | B.Cast (a, u, t)        ->
-      let f xu xt tt =  
-        let f _ = f (A.sh2 u xu t xt x (B.cast a)) xu in
-         assert_convertibility err f st m xu tt xt
-      in
-      let f xu _ = b_type_of err (f xu) st m t in
-      type_of err f st m u
-
-(* Interface functions ******************************************************)
-
-and type_of err f st m x =
-   let f t u = L.unbox level; f t u in
-   L.box level; b_type_of err f st m x
diff --git a/helm/software/lambda-delta/components/basic_rg/brgType.mli b/helm/software/lambda-delta/components/basic_rg/brgType.mli
deleted file mode 100644 (file)
index 5d9350b..0000000
+++ /dev/null
@@ -1,16 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type message = (BrgReduction.kam, Brg.term) Log.message
-
-val type_of: 
-   (message -> 'a) -> (Brg.term -> Brg.term -> 'a) -> 
-   Entity.status -> BrgReduction.kam -> Brg.term -> 'a
diff --git a/helm/software/lambda-delta/components/basic_rg/brgUntrusted.ml b/helm/software/lambda-delta/components/basic_rg/brgUntrusted.ml
deleted file mode 100644 (file)
index 4c1ae61..0000000
+++ /dev/null
@@ -1,38 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module U = NUri
-module L = Log
-module Y = Entity
-module B = Brg
-module E = BrgEnvironment
-module R = BrgReduction
-module T = BrgType
-
-(* Interface functions ******************************************************)
-
-(* to share *)
-let type_check err f st = function
-   | a, uri, Y.Abst t ->
-      let f xt tt = 
-         let e = E.set_entity (a, uri, Y.Abst xt) in f tt e
-      in
-      L.loc := U.string_of_uri uri; T.type_of err f st R.empty_kam t
-   | a, uri, Y.Abbr t ->
-      let f xt tt = 
-         let xt = match xt with
-           | B.Cast _ -> xt
-           | _        -> B.Cast ([], tt, xt)
-        in
-         let e = E.set_entity (a, uri, Y.Abbr xt) in f tt e
-      in
-      L.loc := U.string_of_uri uri; T.type_of err f st R.empty_kam t
-   | _, _, Y.Void     -> assert false
diff --git a/helm/software/lambda-delta/components/basic_rg/brgUntrusted.mli b/helm/software/lambda-delta/components/basic_rg/brgUntrusted.mli
deleted file mode 100644 (file)
index d395eb5..0000000
+++ /dev/null
@@ -1,14 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-val type_check:
-   (BrgType.message -> 'a) -> (Brg.term -> Brg.entity -> 'a) -> 
-   Entity.status -> Brg.entity -> 'a
diff --git a/helm/software/lambda-delta/components/common/Make b/helm/software/lambda-delta/components/common/Make
deleted file mode 100644 (file)
index de13dd4..0000000
+++ /dev/null
@@ -1 +0,0 @@
-options hierarchy output entity marks alpha library
diff --git a/helm/software/lambda-delta/components/common/alpha.ml b/helm/software/lambda-delta/components/common/alpha.ml
deleted file mode 100644 (file)
index 01c2aaf..0000000
+++ /dev/null
@@ -1,39 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module Y = Entity
-
-(* internal functions *******************************************************)
-
-let rec rename ns n =
-   let token, mode = n in
-   let n = token ^ "_", mode in
-   if List.mem n ns then rename ns n else n
-
-let alpha_name acc attr =
-   let ns, a = acc in
-   match attr with
-      | Y.Name n ->
-        if List.mem n ns then
-            let n = rename ns n in
-           n :: ns, Y.Name n :: a
-        else 
-           n :: ns, attr :: a
-      | _        -> assert false 
-
-(* interface functions ******************************************************)
-
-let alpha ns a =
-   let f a names =
-      let _, names = List.fold_left alpha_name (ns, []) (List.rev names) in
-      List.rev_append a names
-   in
-   Y.get_names f a
diff --git a/helm/software/lambda-delta/components/common/alpha.mli b/helm/software/lambda-delta/components/common/alpha.mli
deleted file mode 100644 (file)
index a08e98e..0000000
+++ /dev/null
@@ -1,12 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-val alpha: Entity.names -> Entity.attrs -> Entity.attrs
diff --git a/helm/software/lambda-delta/components/common/entity.ml b/helm/software/lambda-delta/components/common/entity.ml
deleted file mode 100644 (file)
index e32b347..0000000
+++ /dev/null
@@ -1,127 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module O = Options
-
-type uri = NUri.uri
-type id = Aut.id
-type name = id * bool (* token, real? *)
-
-type names = name list
-
-type attr = Name of name      (* name *)
-          | Apix of int       (* additional position index *)
-         | Mark of int       (* node marker *)
-         | Meta of string    (* metaliguistic annotation *)
-         | Priv              (* private global definition *)
-
-type attrs = attr list (* attributes *)
-
-type 'term bind = Abst of 'term (* declaration: domain *)
-                | Abbr of 'term (* definition: body *)
-               | Void          (* exclusion *)
-
-type 'term entity = attrs * uri * 'term bind (* attrs, name, binder *)
-
-type status = {
-   delta: bool;        (* global delta-expansion *)
-   rt: bool;           (* reference typing *)
-   si: bool;           (* sort inclusion *)
-   expand: bool        (* always expand global definitions *)
-}
-
-(* helpers ******************************************************************)
-
-let common f (a, u, _) = f a u
-
-let rec name err f = function
-   | Name (n, r) :: _ -> f n r
-   | _ :: tl          -> name err f tl
-   | []               -> err ()
-
-let names f map l a =
-   let rec aux f i a = function   
-      | []                -> f a
-      | Name (n, r) :: tl -> aux (map f i n r) false a tl
-      | _ :: tl           -> aux f i a tl
-   in
-   aux f true a l
-
-let rec get_name err f j = function
-   | []                          -> err ()
-   | Name (n, r) :: _ when j = 0 -> f n r
-   | Name _ :: tl                -> get_name err f (pred j) tl
-   | _ :: tl                     -> get_name err f j tl
-
-let rec get_names f = function
-   | []                -> f [] []
-   | Name _ as n :: tl ->
-      let f a ns = f a (n :: ns) in get_names f tl
-   | e :: tl           ->
-      let f a = f (e :: a) in get_names f tl
-
-let count_names a =
-   let rec aux k = function
-      | []           -> k
-      | Name _ :: tl -> aux (succ k) tl
-      | _ :: tl      -> aux k tl
-   in
-   aux 0 a
-
-let rec apix err f = function
-   | Apix i :: _ -> f i
-   | _ :: tl     -> apix err f tl
-   | []          -> err ()
-
-let rec mark err f = function
-   | Mark i :: _ -> f i
-   | _ :: tl     -> mark err f tl
-   | []          -> err ()
-
-let rec priv err f = function
-   | Priv :: _ -> f ()
-   | _ :: tl   -> priv err f tl
-   | []        -> err ()
-
-let rec meta err f = function
-   | Meta s :: _ -> f s
-   | _ :: tl     -> meta err f tl
-   | []          -> err ()
-
-let resolve err f name a =
-   let rec aux i = function
-      | Name (n, true) :: _ when n = name -> f i
-      | _ :: tl                           -> aux (succ i) tl
-      | []                                -> err i
-   in
-   aux 0 a
-
-let rec rev_append_names ns = function
-   | []           -> ns
-   | Name n :: tl -> rev_append_names (n :: ns) tl
-   | _ :: tl      -> rev_append_names ns tl
-
-let xlate f xlate_term = function
-   | a, uri, Abst t ->
-      let f t = f (a, uri, Abst t) in xlate_term f t
-   | a, uri, Abbr t ->
-      let f t = f (a, uri, Abbr t) in xlate_term f t
-   | _, _, Void   ->
-      assert false
-
-let initial_status () = {
-   delta = false; rt = false; si = !O.si; expand = !O.expand
-}
-
-let refresh_status st = {st with
-   si = !O.si; expand = !O.expand
-}
-
diff --git a/helm/software/lambda-delta/components/common/hierarchy.ml b/helm/software/lambda-delta/components/common/hierarchy.ml
deleted file mode 100644 (file)
index b7d4283..0000000
+++ /dev/null
@@ -1,64 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module H = Hashtbl
-module S = Scanf
-module C = Cps
-
-type graph = string * (int -> int)
-
-let sorts = 3
-let sort = H.create sorts
-
-let default_graph = "Z1"
-
-(* Internal functions *******************************************************)
-
-let set_sort h s =
-   H.add sort h s; succ h
-
-let graph_of_string err f s =
-   try 
-      let x = S.sscanf s "Z%u" C.start in 
-      if x > 0 then f (s, fun h -> x + h) else err ()
-   with
-      S.Scan_failure _ | Failure _ | End_of_file -> err ()
-
-let graph = ref (graph_of_string C.err C.start default_graph)
-
-(* Interface functions ******************************************************)
-
-let set_sorts i ss =   
-   List.fold_left set_sort i ss
-
-let string_of_sort err f h =
-   try f (H.find sort h) with Not_found -> err ()
-
-let sort_of_string err f s =
-   let map h n = function
-      | None when n = s -> Some h
-      | xh              -> xh
-   in
-   match H.fold map sort None with
-      | None   -> err ()
-      | Some h -> f h
-
-let string_of_graph () = fst !graph
-
-let apply h = snd !graph h
-
-let set_graph s =
-   let err () = false in
-   let f g = graph := g; true in
-   graph_of_string err f s
-
-let clear () =
-   H.clear sort; graph := graph_of_string C.err C.start default_graph
diff --git a/helm/software/lambda-delta/components/common/hierarchy.mli b/helm/software/lambda-delta/components/common/hierarchy.mli
deleted file mode 100644 (file)
index 04feaf9..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-val set_sorts: int -> string list -> int
-
-val string_of_sort: (unit -> 'a) -> (string -> 'a) -> int -> 'a
-
-val sort_of_string: (unit -> 'a) -> (int -> 'a) -> string -> 'a
-
-val set_graph: string -> bool
-
-val string_of_graph: unit -> string
-
-val apply: int -> int
-
-val clear: unit -> unit
diff --git a/helm/software/lambda-delta/components/common/library.ml b/helm/software/lambda-delta/components/common/library.ml
deleted file mode 100644 (file)
index 8a68011..0000000
+++ /dev/null
@@ -1,132 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module F = Filename
-module U = NUri
-module C = Cps
-module H = Hierarchy
-module Y = Entity
-
-(* internal functions *******************************************************)
-
-let base = "xml"
-
-let obj_ext = ".xml"
-
-let root = "ENTITY"
-
-let system = "http://helm.cs.unibo.it/lambda-delta/" ^ base ^ "/ld.dtd"
-
-let path_of_uri xdir uri =
-   let base = F.concat xdir base in 
-   F.concat base (Str.string_after (U.string_of_uri uri) 3)
-
-(* interface functions ******************************************************)
-
-type och = string -> unit
-
-type attr = string * string
-
-type pp = och -> int -> unit
-
-let attribute out (name, contents) =
-   if contents <> "" then begin
-      out " "; out name; out "=\""; out contents; out "\""
-   end
-
-let xml out version encoding =
-   out "<?xml";
-      attribute out ("version", version);
-      attribute out ("encoding", encoding);
-   out "?>\n\n"
-
-let doctype out root system =
-   out "<!DOCTYPE "; out root; out " SYSTEM \""; out system; out "\">\n\n"
-
-let tag tag attrs ?contents out indent =
-   let spc = String.make indent ' ' in
-   out spc; out "<"; out tag; List.iter (attribute out) attrs;
-   match contents with
-      | None      -> out "/>\n"
-      | Some cont -> 
-         out ">\n"; cont out (indent + 3); out spc; 
-        out "</"; out tag; out ">\n"
-
-let sort = "Sort"
-
-let lref = "LRef"
-
-let gref = "GRef"
-
-let cast = "Cast"
-
-let appl = "Appl"
-
-let proj = "Proj"
-
-let abst = "Abst"
-
-let abbr = "Abbr"
-
-let void = "Void"
-
-let position i =
-   "position", string_of_int i
-
-let offset j = 
-   let contents = if j > 0 then string_of_int j else "" in
-   "offset", contents
-
-let uri u =
-   "uri", U.string_of_uri u
-
-let arity n =
-   let contents = if n > 1 then string_of_int n else "" in
-   "arity", contents
-
-let name a =
-   let map f i n r s =
-      let n = if r then n else "^" ^ n in 
-      let spc = if i then "" else " " in
-      f (s ^ n ^ spc)
-   in
-   let f s = "name", s in
-   Y.names f map a ""
-
-let mark a =
-   let err () = "mark", "" in
-   let f i = "mark", string_of_int i in
-   Y.mark err f a
-
-(* TODO: the string s must be quoted *)
-let meta a =
-   let err () = "meta", "" in
-   let f s = "meta", s in
-   Y.meta err f a
-
-let export_entity pp_term si xdir (a, u, b) =
-   let path = path_of_uri xdir u in
-   let _ = Sys.command (Printf.sprintf "mkdir -p %s" (F.dirname path)) in
-   let och = open_out (path ^ obj_ext) in
-   let out = output_string och in
-   xml out "1.0" "UTF-8"; doctype out root system;
-   let a = Y.Name (U.name_of_uri u, true) :: a in
-   let attrs = [uri u; name a; mark a; meta a] in 
-   let contents = match b with
-      | Y.Abst w -> tag "ABST" attrs ~contents:(pp_term w) 
-      | Y.Abbr v -> tag "ABBR" attrs ~contents:(pp_term v)
-      | Y.Void   -> assert false
-   in
-   let opts = if si then "si" else "" in
-   let shp = H.string_of_graph () in
-   let attrs = ["hierarchy", shp; "options", opts] in
-   tag root attrs ~contents out 0;
-   close_out och
diff --git a/helm/software/lambda-delta/components/common/library.mli b/helm/software/lambda-delta/components/common/library.mli
deleted file mode 100644 (file)
index ed3f7bb..0000000
+++ /dev/null
@@ -1,53 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type och = string -> unit
-
-type attr = string * string
-
-type pp = och -> int -> unit
-
-val export_entity:
-   ('term -> pp) -> bool -> string -> 'term Entity.entity -> unit
-
-val tag: string -> attr list -> ?contents:pp -> pp 
-
-val sort: string
-
-val lref: string
-
-val gref: string
-
-val cast: string
-
-val appl: string
-
-val proj: string
-
-val abst: string
-
-val abbr: string
-
-val void: string
-
-val position: int -> attr
-
-val offset: int -> attr
-
-val uri: Entity.uri -> attr
-
-val arity: int -> attr
-
-val name: Entity.attrs -> attr
-
-val mark: Entity.attrs -> attr
-
-val meta: Entity.attrs -> attr
diff --git a/helm/software/lambda-delta/components/common/marks.ml b/helm/software/lambda-delta/components/common/marks.ml
deleted file mode 100644 (file)
index 026414e..0000000
+++ /dev/null
@@ -1,21 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module Y = Entity
-
-(* interface functions ******************************************************)
-
-let new_location =
-   let location = ref 0 in
-   fun () -> incr location; !location
-
-let new_mark () =
-   Y.Mark (new_location ())
diff --git a/helm/software/lambda-delta/components/common/options.ml b/helm/software/lambda-delta/components/common/options.ml
deleted file mode 100644 (file)
index d9783c7..0000000
+++ /dev/null
@@ -1,42 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module C = Cps
-
-type uri_generator = string -> string
-
-(* interface functions ******************************************************)
-
-let indexes = ref false      (* show de Bruijn indexes *)
-
-let expand = ref false       (* always expand global definitions *)
-
-let si = ref false           (* use sort inclusion *)
-
-let unquote = ref false      (* do not quote identifiers when lexing *)
-
-let icm = ref 0              (* complexity measure of relocated terms *)
-
-let cover = ref ""           (* initial uri segment *)
-
-let debug_parser = ref false (* output parser debug information *)
-
-let debug_lexer = ref false  (* output lexer debug information *)
-
-let mk_uri = ref (fun _ _ -> C.err : bool -> string -> uri_generator) 
-
-let get_mk_uri () =
-   !mk_uri !si !cover
-
-let clear () =
-   expand := false; si := false; cover := ""; indexes := false; icm := 0;
-   debug_parser := false; debug_lexer := false;
-   mk_uri := fun _ _ -> C.err 
diff --git a/helm/software/lambda-delta/components/common/output.ml b/helm/software/lambda-delta/components/common/output.ml
deleted file mode 100644 (file)
index 8270c5d..0000000
+++ /dev/null
@@ -1,72 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module P = Printf
-module L = Log
-module O = Options
-
-type reductions = {
-   beta   : int;
-   zeta   : int;
-   upsilon: int;
-   tau    : int;
-   ldelta : int;
-   gdelta : int;
-   si     : int;
-   lrt    : int;
-   grt    : int
-}
-
-let initial_reductions = {
-   beta = 0; upsilon = 0; tau = 0; zeta = 0; ldelta = 0; gdelta = 0;
-   si = 0; lrt = 0; grt = 0
-}
-
-let reductions = ref initial_reductions
-
-let clear_reductions () = reductions := initial_reductions
-
-let add 
-   ?(beta=0) ?(upsilon=0) ?(tau=0) ?(ldelta=0) ?(gdelta=0) ?(zeta=0) 
-   ?(si=0) ?(lrt=0) ?(grt=0) ()
-= reductions := {
-   beta = !reductions.beta + beta;
-   zeta = !reductions.zeta + zeta;
-   upsilon = !reductions.upsilon + upsilon;
-   tau = !reductions.tau + tau;
-   ldelta = !reductions.ldelta + ldelta;
-   gdelta = !reductions.gdelta + gdelta;
-   si = !reductions.si + si;
-   lrt = !reductions.lrt + lrt;
-   grt = !reductions.grt + grt
-}
-
-let print_reductions () =
-   let r = !reductions in
-   let rs = r.beta + r.ldelta + r.zeta + r.upsilon + r.tau + r.gdelta in
-   let prs = r.si + r.lrt + r.grt in
-   let delta = r.ldelta + r.gdelta in
-   let rt = r.lrt + r.grt in   
-   L.warn (P.sprintf "  Reductions summary");
-   L.warn (P.sprintf "    Proper reductions:        %7u" rs);
-   L.warn (P.sprintf "      Beta:                   %7u" r.beta);
-   L.warn (P.sprintf "      Delta:                  %7u" delta);
-   L.warn (P.sprintf "        Local:                %7u" r.ldelta);
-   L.warn (P.sprintf "        Global:               %7u" r.gdelta);
-   L.warn (P.sprintf "      Zeta:                   %7u" r.zeta);
-   L.warn (P.sprintf "      Upsilon:                %7u" r.upsilon);
-   L.warn (P.sprintf "      Tau:                    %7u" r.tau);
-   L.warn (P.sprintf "    Pseudo reductions:        %7u" prs);
-   L.warn (P.sprintf "      Reference typing:       %7u" rt);
-   L.warn (P.sprintf "        Local:                %7u" r.lrt);
-   L.warn (P.sprintf "        Global:               %7u" r.grt);
-   L.warn (P.sprintf "      Sort inclusion:         %7u" r.si);
-   L.warn (P.sprintf "  Relocated nodes (icm):      %7u" !O.icm)
diff --git a/helm/software/lambda-delta/components/common/output.mli b/helm/software/lambda-delta/components/common/output.mli
deleted file mode 100644 (file)
index 20b83f0..0000000
+++ /dev/null
@@ -1,19 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-val clear_reductions: unit -> unit
-
-val add: 
-   ?beta:int -> ?upsilon:int -> ?tau:int -> ?ldelta:int -> ?gdelta:int ->
-   ?zeta:int -> ?si:int -> ?lrt:int -> ?grt:int ->
-   unit -> unit
-
-val print_reductions: unit -> unit
diff --git a/helm/software/lambda-delta/components/complete_rg/Make b/helm/software/lambda-delta/components/complete_rg/Make
deleted file mode 100644 (file)
index d7a45f9..0000000
+++ /dev/null
@@ -1 +0,0 @@
-crg crgOutput crgXml crgTxt crgAut crgBrg
diff --git a/helm/software/lambda-delta/components/complete_rg/crg.ml b/helm/software/lambda-delta/components/complete_rg/crg.ml
deleted file mode 100644 (file)
index 07a4cb3..0000000
+++ /dev/null
@@ -1,94 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-(* kernel version: complete, relative, global *)
-(* note          : fragment of complete lambda-delta serving as abstract layer *) 
-
-module Y = Entity
-
-type uri = Y.uri
-type id = Y.id
-type attrs = Y.attrs
-
-type bind = Abst of term list (* domains *)
-          | Abbr of term list (* bodies  *)
-          | Void of int       (* number of exclusions *)
-
-and term = TSort of attrs * int              (* attrs, hierarchy index *)
-         | TLRef of attrs * int * int        (* attrs, position indexes *)
-         | TGRef of attrs * uri              (* attrs, reference *)
-         | TCast of attrs * term * term      (* attrs, domain, element *)
-         | TAppl of attrs * term list * term (* attrs, arguments, function *)
-        | TProj of attrs * lenv * term      (* attrs, closure, member *)
-        | TBind of attrs * bind * term      (* attrs, binder, scope *)
-
-and lenv = ESort                        (* top *)
-         | EProj of lenv * attrs * lenv (* environment, attrs, closure *) 
-         | EBind of lenv * attrs * bind (* environment, attrs, binder *)
-
-type entity = term Y.entity
-
-(* helpers ******************************************************************)
-
-let mk_uri si root s =
-   let kernel = if si then "crg-si" else "crg" in
-   String.concat "/" ["ld:"; kernel; root; s ^ ".ld"]
-
-let empty_lenv = ESort
-
-let push_bind f lenv a b = f (EBind (lenv, a, b))
-
-let push_proj f lenv a e = f (EProj (lenv, a, e))
-
-let push2 err f lenv attr ?t () = match lenv, t with
-   | EBind (e, a, Abst ws), Some t -> f (EBind (e, (attr :: a), Abst (t :: ws)))
-   | EBind (e, a, Abbr vs), Some t -> f (EBind (e, (attr :: a), Abbr (t :: vs)))
-   | EBind (e, a, Void n), None    -> f (EBind (e, (attr :: a), Void (succ n)))
-   | _                             -> err ()
-
-(* this id not tail recursive *)
-let resolve_lref err f id lenv =
-   let rec aux f i k = function
-     | ESort                  -> err ()
-     | EBind (tl, a, _)       ->
-        let err kk = aux f (succ i) (k + kk) tl in
-       let f j = f i j (k + j) in
-       Y.resolve err f id a
-     | EProj _                -> assert false (* TODO *)
-   in
-   aux f 0 0 lenv
-
-let rec get_name err f i j = function
-   | ESort                      -> err i
-   | EBind (_, a, _) when i = 0 -> 
-      let err () = err i in
-      Y.get_name err f j a
-   | EBind (tl, _, _)           -> 
-      get_name err f (pred i) j tl
-   | EProj (tl, _, e)           ->
-      let err i = get_name err f i j tl in 
-      get_name err f i j e
-
-let get_index err f i j lenv =
-   let rec aux f i k = function
-      | ESort                      -> err i
-      | EBind (_, a, _) when i = 0 ->
-        if Y.count_names a > j then f (k + j) else err i
-      | EBind (tl, a, _)           -> 
-         aux f (pred i) (k + Y.count_names a) tl
-      | EProj _                    -> assert false (* TODO *)
-   in
-   aux f i 0 lenv
-
-let rec names_of_lenv ns = function
-   | ESort            -> ns
-   | EBind (tl, a, _) -> names_of_lenv (Y.rev_append_names ns a) tl
-   | EProj (tl, _, e) -> names_of_lenv (names_of_lenv ns e) tl
diff --git a/helm/software/lambda-delta/components/complete_rg/crgAut.ml b/helm/software/lambda-delta/components/complete_rg/crgAut.ml
deleted file mode 100644 (file)
index 0b95adf..0000000
+++ /dev/null
@@ -1,224 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module U = NUri
-module H = U.UriHash
-module C = Cps
-module O = Options
-module Y = Entity
-module A = Aut
-module D = Crg
-
-(* qualified identifier: uri, name, qualifiers *)
-type qid = D.uri * D.id * D.id list
-
-type context = Y.attrs * D.term list
-
-type context_node = qid option (* context node: None = root *)
-
-type status = {
-   path: D.id list;          (* current section path *) 
-   node: context_node;       (* current context node *)
-   nodes: context_node list; (* context node list *)
-   line: int;                (* line number *)
-   mk_uri:O.uri_generator    (* uri generator *) 
-}
-
-type resolver = Local of int
-              | Global of context
-
-let henv_size, hcnt_size = 7000, 4300 (* hash tables initial sizes *)
-
-let henv = H.create henv_size (* optimized global environment *)
-
-let hcnt = H.create hcnt_size (* optimized context *)
-
-(* Internal functions *******************************************************)
-
-let empty_cnt = [], []
-
-let add_abst (a, ws) id w = 
-   Y.Name (id, true) :: a, w :: ws 
-
-let lenv_of_cnt (a, ws) = 
-   D.push_bind C.start D.empty_lenv a (D.Abst ws)
-
-let mk_lref f i j k = f (D.TLRef ([Y.Apix k], i, j))
-
-let id_of_name (id, _, _) = id
-
-let mk_qid f st id path =
-   let str = String.concat "/" path in
-   let str = Filename.concat str id in 
-   let str = st.mk_uri str in
-   f (U.uri_of_string str, id, path)
-
-let uri_of_qid (uri, _, _) = uri
-
-let complete_qid f st (id, is_local, qs) =
-   let f path = C.list_rev_append (mk_qid f st id) path ~tail:qs in
-   let rec skip f = function
-      | phd :: ptl, qshd :: _ when phd = qshd -> f ptl
-      | _ :: ptl, _ :: _                      -> skip f (ptl, qs)
-      | _                                     -> f []
-   in
-   if is_local then f st.path else skip f (st.path, qs)
-
-let relax_qid f st (_, id, path) =
-   let f = function
-      | _ :: tl -> C.list_rev (mk_qid f st id) tl
-      | []      -> assert false
-   in
-   C.list_rev f path
-
-let relax_opt_qid f st = function
-   | None     -> f None
-   | Some qid -> let f qid = f (Some qid) in relax_qid f st qid
-
-let resolve_gref err f st qid =
-   try let cnt = H.find henv (uri_of_qid qid) in f qid cnt
-   with Not_found -> err qid 
-
-let resolve_gref_relaxed f st qid =
-(* this is not tail recursive *)   
-   let rec err qid = relax_qid (resolve_gref err f st) st qid in
-   resolve_gref err f st qid
-
-let get_cnt err f st = function
-   | None              -> f empty_cnt
-   | Some qid as node ->
-      try let cnt = H.find hcnt (uri_of_qid qid) in f cnt
-      with Not_found -> err node
-
-let get_cnt_relaxed f st =
-(* this is not tail recursive *)   
-   let rec err node = relax_opt_qid (get_cnt err f st) st node in
-   get_cnt err f st st.node
-
-(* this is not tail recursive in the GRef branch *)
-let rec xlate_term f st lenv = function
-   | A.Sort s            -> 
-      let f h = f (D.TSort ([], h)) in
-      if s then f 0 else f 1
-   | A.Appl (v, t)       ->
-      let f vv tt = f (D.TAppl ([], [vv], tt)) in
-      let f vv = xlate_term (f vv) st lenv t in
-      xlate_term f st lenv v
-   | A.Abst (name, w, t) ->
-      let f ww = 
-         let a, b = [Y.Name (name, true)], (D.Abst [ww]) in
-        let f tt = f (D.TBind (a, b, tt)) in
-         let f lenv = xlate_term f st lenv t in
-        D.push_bind f lenv a b
-      in
-      xlate_term f st lenv w
-   | A.GRef (name, args) ->
-      let map1 f = function
-           | Y.Name (id, _) -> f (A.GRef ((id, true, []), []))
-           | _              -> C.err ()
-      in
-      let map2 f = xlate_term f st lenv in
-      let g qid (a, _) =
-         let gref = D.TGRef ([], uri_of_qid qid) in
-        match args, a with
-           | [], [] -> f gref
-           | _      -> 
-              let f args = f (D.TAppl ([], args, gref)) in
-              let f args = f (List.rev_map (map2 C.start) args) in
-              let f a = C.list_rev_map_append f map1 a ~tail:args in
-              C.list_sub_strict f a args
-      in
-      let g qid = resolve_gref_relaxed g st qid in
-      let err () = complete_qid g st name in
-      D.resolve_lref err (mk_lref f) (id_of_name name) lenv
-
-let xlate_entity err f st = function
-   | A.Section (Some (_, name))     ->
-      err {st with path = name :: st.path; nodes = st.node :: st.nodes}
-   | A.Section None            ->
-      begin match st.path, st.nodes with
-        | _ :: ptl, nhd :: ntl -> 
-           err {st with path = ptl; node = nhd; nodes = ntl}
-         | _                    -> assert false
-      end
-   | A.Context None            ->
-      err {st with node = None}
-   | A.Context (Some name)     ->
-      let f name = err {st with node = Some name} in
-      complete_qid f st name 
-   | A.Block (name, w)         ->
-      let f qid = 
-         let f cnt =
-           let lenv = lenv_of_cnt cnt in
-           let ww = xlate_term C.start st lenv w in
-           H.add hcnt (uri_of_qid qid) (add_abst cnt name ww);
-           err {st with node = Some qid}
-        in
-         get_cnt_relaxed f st
-      in
-      complete_qid f st (name, true, [])
-   | A.Decl (name, w)          ->
-      let f cnt =
-         let a, ws = cnt in
-         let lenv = lenv_of_cnt cnt in
-        let f qid = 
-            let ww = xlate_term C.start st lenv w in
-           H.add henv (uri_of_qid qid) cnt;
-           let t = match ws with
-              | [] -> ww
-              | _  -> D.TBind (a, D.Abst ws, ww)
-           in
-(*
-           print_newline (); CrgOutput.pp_term print_string t;
-*)
-           let b = Y.Abst t in
-           let entity = [Y.Mark st.line], uri_of_qid qid, b in
-           f {st with line = succ st.line} entity
-        in
-         complete_qid f st (name, true, [])
-      in
-      get_cnt_relaxed f st
-   | A.Def (name, w, trans, v) ->
-      let f cnt = 
-        let a, ws = cnt in
-        let lenv = lenv_of_cnt cnt in
-         let f qid = 
-            let ww = xlate_term C.start st lenv w in
-           let vv = xlate_term C.start st lenv v in
-           H.add henv (uri_of_qid qid) cnt;
-            let t = match ws with
-              | [] -> D.TCast ([], ww, vv)
-              | _  -> D.TBind (a, D.Abst ws, D.TCast ([], ww, vv))
-           in
-(*
-           print_newline (); CrgOutput.pp_term print_string t;
-*)
-           let b = Y.Abbr t in
-           let a = Y.Mark st.line :: if trans then [] else [Y.Priv] in
-           let entity = a, uri_of_qid qid, b in
-           f {st with line = succ st.line} entity
-        in
-         complete_qid f st (name, true, [])
-      in
-      get_cnt_relaxed f st
-
-(* Interface functions ******************************************************)
-
-let initial_status () =
-   H.clear henv; H.clear hcnt; {
-   path = []; node = None; nodes = []; line = 1; mk_uri = O.get_mk_uri ()
-}
-
-let refresh_status st = {st with
-   mk_uri = O.get_mk_uri ()
-}
-
-let crg_of_aut = xlate_entity
diff --git a/helm/software/lambda-delta/components/complete_rg/crgAut.mli b/helm/software/lambda-delta/components/complete_rg/crgAut.mli
deleted file mode 100644 (file)
index c7d93d3..0000000
+++ /dev/null
@@ -1,19 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type status
-
-val initial_status: unit -> status 
-
-val refresh_status: status -> status
-
-val crg_of_aut: (status -> 'a) -> (status -> Crg.entity -> 'a) -> 
-                status -> Aut.command -> 'a
diff --git a/helm/software/lambda-delta/components/complete_rg/crgBrg.ml b/helm/software/lambda-delta/components/complete_rg/crgBrg.ml
deleted file mode 100644 (file)
index 2b31293..0000000
+++ /dev/null
@@ -1,101 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module C = Cps
-module Y = Entity
-module M = Marks
-module D = Crg
-module B = Brg
-
-(* internal functions: crg to brg term **************************************)
-
-let rec lenv_fold_left map1 map2 x = function
-   | D.ESort            -> x
-   | D.EBind (tl, a, b) -> lenv_fold_left map1 map2 (map1 x a b) tl
-   | D.EProj (tl, a, e) -> lenv_fold_left map1 map2 (map2 x a e) tl
-
-let rec xlate_term f = function
-   | D.TSort (a, l)     -> f (B.Sort (a, l))
-   | D.TGRef (a, n)     -> f (B.GRef (a, n))
-   | D.TLRef (a, _, _)  -> let f i = f (B.LRef (a, i)) in Y.apix C.err f a
-   | D.TCast (a, u, t)  ->
-      let f uu tt = f (B.Cast (a, uu, tt)) in
-      let f uu = xlate_term (f uu) t in
-      xlate_term f u 
-   | D.TAppl (a, vs, t) ->
-      let map f v tt = let f vv = f (B.Appl (a, vv, tt)) in xlate_term f v in
-      let f tt = C.list_fold_right f map vs tt in
-      xlate_term f t
-   | D.TProj (a, e, t)  ->
-      let f tt = f (lenv_fold_left xlate_bind xlate_proj tt e) in
-      xlate_term f t
-   | D.TBind (ab, D.Abst ws, D.TCast (ac, u, t)) ->
-      xlate_term f (D.TCast (ac, D.TBind (ab, D.Abst ws, u), D.TBind (ab, D.Abst ws, t)))
-   | D.TBind (a, b, t)  ->
-      let f tt = f (xlate_bind tt a b) in xlate_term f t
-
-and xlate_bind x a b =
-   let f a ns = a, ns in
-   let a, ns = Y.get_names f a in 
-   match b with
-      | D.Abst ws ->
-         let map x n w = 
-           let f ww = B.Bind (n :: M.new_mark () :: a, B.Abst ww, x) in 
-           xlate_term f w
-        in
-        List.fold_left2 map x ns ws 
-      | D.Abbr vs ->
-         let map x n v = 
-           let f vv = B.Bind (n :: a, B.Abbr vv, x) in 
-           xlate_term f v
-        in
-        List.fold_left2 map x ns vs
-      | D.Void _  ->
-         let map x n = B.Bind (n :: a, B.Void, x) in
-        List.fold_left map x ns
-
-and xlate_proj x _ e =
-   lenv_fold_left xlate_bind xlate_proj x e
-
-(* internal functions: brg to crg term **************************************)
-
-let rec xlate_bk_term f = function
-   | B.Sort (a, l)     -> f (D.TSort (a, l))
-   | B.GRef (a, n)     -> f (D.TGRef (a, n))
-   | B.LRef (a, i)     -> f (D.TLRef (a, i, 0))
-   | B.Cast (a, u, t)  ->
-      let f uu tt = f (D.TCast (a, uu, tt)) in
-      let f uu = xlate_bk_term (f uu) t in
-      xlate_bk_term f u 
-   | B.Appl (a, u, t)  ->
-      let f uu tt = f (D.TAppl (a, [uu], tt)) in
-      let f uu = xlate_bk_term (f uu) t in
-      xlate_bk_term f u 
-   | B.Bind (a, b, t)  ->
-      let f bb tt = f (D.TBind (a, bb, tt)) in
-      let f bb = xlate_bk_term (f bb) t in
-      xlate_bk_bind f b
-
-and xlate_bk_bind f = function
-   | B.Abst t ->
-      let f tt = f (D.Abst [tt]) in
-      xlate_bk_term f t
-   | B.Abbr t ->
-      let f tt = f (D.Abbr [tt]) in
-      xlate_bk_term f t
-   | B.Void   -> f (D.Void 1)
-   
-(* interface functions ******************************************************)
-
-let brg_of_crg f t =
-   f (xlate_term C.start t)
-
-let crg_of_brg = xlate_bk_term
diff --git a/helm/software/lambda-delta/components/complete_rg/crgBrg.mli b/helm/software/lambda-delta/components/complete_rg/crgBrg.mli
deleted file mode 100644 (file)
index 84c7f23..0000000
+++ /dev/null
@@ -1,14 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-val brg_of_crg: (Brg.term -> 'a) -> Crg.term -> 'a
-
-val crg_of_brg: (Crg.term -> 'a) -> Brg.term -> 'a
diff --git a/helm/software/lambda-delta/components/complete_rg/crgOutput.ml b/helm/software/lambda-delta/components/complete_rg/crgOutput.ml
deleted file mode 100644 (file)
index 6da54cb..0000000
+++ /dev/null
@@ -1,59 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module P = Printf
-module U = NUri
-module C = Cps
-module H = Hierarchy
-module Y = Entity
-module D = Crg
-
-(****************************************************************************)
-
-let pp_attrs out a =
-   let map = function
-      | Y.Name (s, true)  -> out (P.sprintf "%s;" s)
-      | Y.Name (s, false) -> out (P.sprintf "~%s;" s)
-      | Y.Apix i          -> out (P.sprintf "+%i;" i)
-      | Y.Mark i          -> out (P.sprintf "@%i;" i)
-      | Y.Meta s          -> out (P.sprintf "\"%s\";" s)
-      | Y.Priv            -> out (P.sprintf "%s;" "~")
-   in
-   List.iter map a
-
-let rec pp_term out = function
-   | D.TSort (a, l)    -> pp_attrs out a; out (P.sprintf "*%u" l)
-   | D.TLRef (a, i, j) -> pp_attrs out a; out (P.sprintf "#(%u,%u)" i j)
-   | D.TGRef (a, u)    -> pp_attrs out a; out (P.sprintf "$")
-   | D.TCast (a, x, y) -> pp_attrs out a; out "<"; pp_term out x; out ">."; pp_term out y
-   | D.TProj (a, x, y) -> assert false
-   | D.TAppl (a, x, y) -> pp_attrs out a; pp_terms "(" ")" out x; pp_term out y
-   | D.TBind (a, x, y) -> pp_attrs out a; pp_bind out x; pp_term out y
-
-and pp_terms bg eg out vs =
-   let rec aux = function
-      | []      -> ()
-      | [v]     -> pp_term out v
-      | v :: vs -> pp_term out v; out ", "; aux vs
-   in
-   out bg; aux vs; out (eg ^ ".")
-
-and pp_bind out = function
-   | D.Abst x -> pp_terms "[:" "]" out x
-   | D.Abbr x -> pp_terms "[=" "]" out x
-   | D.Void x -> out (P.sprintf "[%u]" x)
-
-let rec pp_lenv out = function
-   | D.ESort           -> ()
-   | D.EProj (x, a, y) -> assert false
-   | D.EBind (x, a, y) -> pp_lenv out x; pp_attrs out a; pp_bind out y
-
-(****************************************************************************)
diff --git a/helm/software/lambda-delta/components/complete_rg/crgOutput.mli b/helm/software/lambda-delta/components/complete_rg/crgOutput.mli
deleted file mode 100644 (file)
index d804937..0000000
+++ /dev/null
@@ -1,12 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-val pp_term: (string -> unit) -> Crg.term -> unit
diff --git a/helm/software/lambda-delta/components/complete_rg/crgTxt.ml b/helm/software/lambda-delta/components/complete_rg/crgTxt.ml
deleted file mode 100644 (file)
index 34727af..0000000
+++ /dev/null
@@ -1,160 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module U  = NUri
-module H  = Hierarchy
-module C  = Cps
-module O  = Options
-module Y  = Entity
-module T  = Txt
-module TT = TxtTxt
-module D  = Crg
-
-type status = {
-   path  : T.id list;      (* current section path *)
-   line  : int;            (* line number *)
-   sort  : int;            (* first default sort index *)
-   mk_uri: O.uri_generator (* uri generator *) 
-}
-
-let henv_size = 7000 (* hash tables initial size *)
-
-let henv = Hashtbl.create henv_size (* optimized global environment *)
-
-(* Internal functions *******************************************************)
-
-let name_of_id ?(r=true) id = Y.Name (id, r)
-
-let mk_lref f i j k = f (D.TLRef ([Y.Apix k], i, j))
-
-let mk_gref f uri = f (D.TGRef ([], uri))
-
-let uri_of_id st id path =
-   let str = String.concat "/" path in
-   let str = Filename.concat str id in 
-   let str = st.mk_uri str in
-   U.uri_of_string str
-
-let resolve_gref err f st id =
-   try f (Hashtbl.find henv id)
-   with Not_found -> err ()
-
-let rec xlate_term f st lenv = function
-   | T.Inst _
-   | T.Impl _       -> assert false
-   | T.Sort h       -> 
-      f (D.TSort ([], h))
-   | T.NSrt id      -> 
-      let f h = f (D.TSort ([], h)) in
-      H.sort_of_string C.err f id
-   | T.LRef (i, j)  ->    
-      D.get_index C.err (mk_lref f i j) i j lenv
-   | T.NRef id      ->
-      let err () = resolve_gref C.err (mk_gref f) st id in
-      D.resolve_lref err (mk_lref f) id lenv
-   | T.Cast (u, t)  ->
-      let f uu tt = f (D.TCast ([], uu, tt)) in
-      let f uu = xlate_term (f uu) st lenv t in
-      xlate_term f st lenv u
-   | T.Appl (vs, t) ->
-      let map f = xlate_term f st lenv in
-      let f vvs tt = f (D.TAppl ([], vvs, tt)) in
-      let f vvs = xlate_term (f vvs) st lenv t in
-      C.list_map f map vs
-   | T.Bind (b, t)  ->
-      let abst_map (lenv, a, wws) (id, r, w) = 
-         let attr = name_of_id ~r id in
-        let ww = xlate_term C.start st lenv w in
-        D.push2 C.err C.start lenv attr ~t:ww (), attr :: a, ww :: wws
-      in
-      let abbr_map (lenv, a, wws) (id, w) = 
-         let attr = name_of_id id in
-        let ww = xlate_term C.start st lenv w in
-        D.push2 C.err C.start lenv attr ~t:ww (), attr :: a, ww :: wws
-      in
-      let void_map (lenv, a, n) id = 
-        let attr = name_of_id id in
-        D.push2 C.err C.start lenv attr (), attr :: a, succ n
-      in
-      let lenv, aa, bb = match b with
-         | T.Abst xws ->
-           let lenv = D.push_bind C.start lenv [] (D.Abst []) in
-           let lenv, aa, wws = List.fold_left abst_map (lenv, [], []) xws in
-           lenv, aa, D.Abst wws
-         | T.Abbr xvs ->
-           let lenv = D.push_bind C.start lenv [] (D.Abbr []) in
-           let lenv, aa, vvs = List.fold_left abbr_map (lenv, [], []) xvs in
-           lenv, aa, D.Abbr vvs
-         | T.Void ids ->
-           let lenv = D.push_bind C.start lenv [] (D.Void 0) in
-           let lenv, aa, n = List.fold_left void_map (lenv, [], 0) ids in
-           lenv, aa, D.Void n
-      in
-      let f tt = f (D.TBind (aa, bb, tt)) in
-      xlate_term f st lenv t
-
-let xlate_term f st lenv t =
-   TT.contract (xlate_term f st lenv) t
-
-let mk_contents tt = function
-   | T.Decl -> [], Y.Abst tt
-   | T.Ax   -> [], Y.Abst tt
-   | T.Def  -> [], Y.Abbr tt
-   | T.Th   -> [], Y.Abbr tt
-
-let xlate_entity err f gen st = function
-   | T.Require _                  ->
-      err st
-   | T.Section (Some name)        ->
-      err {st with path = name :: st.path}
-   | T.Section None               ->
-      begin match st.path with
-        | _ :: ptl -> 
-           err {st with path = ptl}
-         | _        -> assert false
-      end
-   | T.Sorts sorts                ->
-      let map st (xix, s) =
-         let ix = match xix with 
-           | None    -> st.sort
-           | Some ix -> ix
-        in
-         {st with sort = H.set_sorts ix [s]}
-      in
-      err (List.fold_left map st sorts)
-   | T.Graph id                   ->
-      assert (H.set_graph id); err st
-   | T.Entity (kind, id, meta, t) ->
-      let uri = uri_of_id st id st.path in
-      Hashtbl.add henv id uri;
-      let tt = xlate_term C.start st D.empty_lenv t in
-(*
-      print_newline (); CrgOutput.pp_term print_string tt;
-*)
-      let a, b = mk_contents tt kind in 
-      let a = if meta <> "" then Y.Meta meta :: a else a in
-      let entity = Y.Mark st.line :: a, uri, b in
-      f {st with line = succ st.line} entity
-   | T.Generate _                 ->
-      err st
-
-(* Interface functions ******************************************************)
-
-let initial_status () =
-   Hashtbl.clear henv; {
-   path = []; line = 1; sort = 0; mk_uri = O.get_mk_uri ()
-}
-
-let refresh_status st = {st with
-   mk_uri = O.get_mk_uri ()
-}
-
-let crg_of_txt = xlate_entity
diff --git a/helm/software/lambda-delta/components/complete_rg/crgTxt.mli b/helm/software/lambda-delta/components/complete_rg/crgTxt.mli
deleted file mode 100644 (file)
index 150268a..0000000
+++ /dev/null
@@ -1,19 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type status
-
-val initial_status: unit -> status 
-
-val refresh_status: status -> status
-
-val crg_of_txt: (status -> 'a) -> (status -> Crg.entity -> 'a) ->
-                (Txt.command -> unit) -> status -> Txt.command -> 'a
diff --git a/helm/software/lambda-delta/components/complete_rg/crgXml.ml b/helm/software/lambda-delta/components/complete_rg/crgXml.ml
deleted file mode 100644 (file)
index 111cfed..0000000
+++ /dev/null
@@ -1,114 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module U = NUri
-module C = Cps
-module H = Hierarchy
-module Y = Entity
-module A = Alpha
-module X = Library
-module D = Crg
-
-(* internal functions *******************************************************)
-
-let rec list_iter map l out tab = match l with
-   | []       -> ()
-   | hd :: tl -> map hd out tab; list_iter map tl out tab
-
-let list_rev_iter map e ns l out tab =
-   let rec aux err f e = function
-      | [], []            -> f e
-      | n :: ns, hd :: tl -> 
-        let f e =
-(*     
-           pp_lenv print_string e; print_string " |- "; 
-          pp_term print_string hd; print_newline ();
-*)
-          map e hd out tab; f (D.push2 C.err C.start e n ~t:hd ())
-       in
-       aux err f e (ns, tl) 
-      | _                 -> err ()
-   in
-   ignore (aux C.err C.start e (ns, l))
-
-let lenv_iter map1 map2 l out tab = 
-   let rec aux f = function
-      | D.ESort              -> f ()
-      | D.EBind (lenv, a, b) -> aux (fun () -> map1 a b out tab; f ()) lenv
-      | D.EProj (lenv, a, e) -> aux (fun () -> map2 a e out tab; f ()) lenv
-   in 
-   aux C.start l
-
-let rec exp_term e t out tab = match t with
-   | D.TSort (a, l)       ->
-      let a =
-         let err _ = a in
-         let f s = Y.Name (s, true) :: a in
-        H.string_of_sort err f l
-      in
-      let attrs = [X.position l; X.name a] in
-      X.tag X.sort attrs out tab
-   | D.TLRef (a, i, j)    ->
-      let a = 
-         let err _ = a in
-        let f n r = Y.Name (n, r) :: a in
-         D.get_name err f i j e
-      in
-      let attrs = [X.position i; X.offset j; X.name a] in
-      X.tag X.lref attrs out tab
-   | D.TGRef (a, n)       ->
-      let a = Y.Name (U.name_of_uri n, true) :: a in
-      let attrs = [X.uri n; X.name a] in
-      X.tag X.gref attrs out tab
-   | D.TCast (a, u, t)    ->
-      let attrs = [] in
-      X.tag X.cast attrs ~contents:(exp_term e u) out tab;
-      exp_term e t out tab
-   | D.TAppl (a, vs, t)   ->
-      let attrs = [X.arity (List.length vs)] in
-      X.tag X.appl attrs ~contents:(list_iter (exp_term e) vs) out tab;
-      exp_term e t out tab
-   | D.TProj (a, lenv, t) ->
-      let attrs = [] in
-      X.tag X.proj attrs ~contents:(lenv_iter (exp_bind e) (exp_eproj e) lenv) out tab;
-      exp_term (D.push_proj C.start e a lenv) t out tab
-   | D.TBind (a, b, t) ->
-(* NOTE: the inner binders are alpha-converted first *)
-(*       so undesirable renamings might occur        *)
-(* EX:   we rename [x][x]x to [x][x_]x_              *)
-(*       whereas [x_][x]x would be more desirable    *)
-      let a = A.alpha (D.names_of_lenv [] e) a in
-      exp_bind e a b out tab; 
-      exp_term (D.push_bind C.start e a b) t out tab 
-
-and exp_bind e a b out tab = 
-   let f a ns = a, ns in
-   let a, ns = Y.get_names f a in 
-   match b with
-      | D.Abst ws ->
-        let e = D.push_bind C.start e a (D.Abst []) in
-        let attrs = [X.name ns; X.mark a; X.arity (List.length ws)] in
-         X.tag X.abst attrs ~contents:(list_rev_iter exp_term e ns ws) out tab
-      | D.Abbr vs ->
-         let e = D.push_bind C.start e a (D.Abbr []) in
-         let attrs = [X.name ns; X.mark a; X.arity (List.length vs)] in
-         X.tag X.abbr attrs ~contents:(list_rev_iter exp_term e ns vs) out tab
-      | D.Void n ->
-         let attrs = [X.name a; X.mark a; X.arity n] in
-         X.tag X.void attrs out tab
-
-and exp_eproj e a lenv out tab =
-   let attrs = [] in
-   X.tag X.proj attrs ~contents:(lenv_iter (exp_bind e) (exp_eproj e) lenv) out tab
-
-(* interface functions ******************************************************)
-
-let export_term = exp_term D.empty_lenv
diff --git a/helm/software/lambda-delta/components/complete_rg/crgXml.mli b/helm/software/lambda-delta/components/complete_rg/crgXml.mli
deleted file mode 100644 (file)
index c326a98..0000000
+++ /dev/null
@@ -1,12 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-val export_term: Crg.term -> Library.pp
diff --git a/helm/software/lambda-delta/components/lib/Make b/helm/software/lambda-delta/components/lib/Make
deleted file mode 100644 (file)
index 45d5eac..0000000
+++ /dev/null
@@ -1 +0,0 @@
-cps share log time
diff --git a/helm/software/lambda-delta/components/lib/cps.ml b/helm/software/lambda-delta/components/lib/cps.ml
deleted file mode 100644 (file)
index 10ec623..0000000
+++ /dev/null
@@ -1,83 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-let err _ = assert false
-
-let start x = x
-
-let id f x = f x
-
-let rec list_sub_strict f l1 l2 = match l1, l2 with
-   | _, []              -> f l1
-   | _ :: tl1, _ :: tl2 -> list_sub_strict f tl1 tl2
-   | _                  -> assert false
-
-(* this is not tail recursive *)
-let rec list_fold_left f map a = function
-   | []       -> f a
-   | hd :: tl -> 
-      let f a = list_fold_left f map a tl in
-      map f a hd
-
-(* this is not tail recursive *)
-let rec list_rev_map_append f map ~tail = function
-      | []       -> f tail        
-      | hd :: tl ->
-         let f hd = list_rev_map_append f map ~tail:(hd :: tail) tl in
-         map f hd
-
-(* this is not tail recursive *)
-let rec list_forall2 f map l1 l2 = match l1, l2 with
-   | [], []                 -> f true
-   | hd1 :: tl1, hd2 :: tl2 ->
-      let f b = if b then list_forall2 f map tl1 tl2 else f false in
-      map f hd1 hd2
-   | _                      -> f false
-
-let list_rev_append f =
-   list_rev_map_append f (fun f t -> f t)
-
-let list_rev_map =
-   list_rev_map_append ~tail:[]
-
-let list_rev =
-   list_rev_append ~tail:[]
-
-let list_iter f map l =
-   let map f () x = map f x in
-   list_fold_left f map () l
-
-(* this is not tail recursive *)
-let rec list_fold_left2 f map a l1 l2 = match l1, l2 with
-   | [], []                 -> f a
-   | hd1 :: tl1, hd2 :: tl2 -> 
-      let f a = list_fold_left2 f map a tl1 tl2 in
-      map f a hd1 hd2
-   | _                      -> assert false
-
-let list_iter2 f map l1 l2 =
-   let map f () x1 x2 = map f x1 x2 in
-   list_fold_left2 f map () l1 l2
-
-let rec list_fold_right f map l a = match l with
-   | []       -> f a
-   | hd :: tl -> list_fold_right (map f hd) map tl a
-
-let list_map f map l =
-   let map f hd a = 
-      let f hd = f (hd :: a) in map f hd
-   in
-   list_fold_right f map l []
-
-let rec list_mem ?(eq=(=)) a = function
-   | []                   -> false
-   | hd :: _ when eq a hd -> true
-   | _ :: tl              -> list_mem ~eq a tl
diff --git a/helm/software/lambda-delta/components/lib/log.ml b/helm/software/lambda-delta/components/lib/log.ml
deleted file mode 100644 (file)
index 03e7b5b..0000000
+++ /dev/null
@@ -1,95 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module P = Printf
-module F = Format
-module C = Cps
-
-type ('a, 'b) item = Term of 'a * 'b
-                   | LEnv of 'a
-                   | Warn of string
-                  | String of string
-                   | Loc
-
-type ('a, 'b) message = ('a, 'b) item list
-
-type ('a, 'b) specs = {
-   pp_term: 'a -> F.formatter -> 'b -> unit;
-   pp_lenv: F.formatter -> 'a -> unit
-}
-
-let level = ref 0
-
-let loc = ref "unknown location"
-
-(* Internal functions *******************************************************)
-
-let clear () = 
-   level := 0; loc := "unknown location"
-
-let std = F.std_formatter
-
-let err = F.err_formatter
-
-let pp_items frm st l items =   
-   let pp_item frm = function
-      | Term (c, t) -> F.fprintf frm "@,%a" (st.pp_term c) t
-      | LEnv c      -> F.fprintf frm "%a" st.pp_lenv c
-      | Warn s      -> F.fprintf frm "@,%s" s
-      | String s    -> F.fprintf frm "%s " s
-      | Loc         -> F.fprintf frm " <%s>" !loc 
-   in
-   let iter map frm l = List.iter (map frm) l in
-   if !level >= l then F.fprintf frm "%a" (iter pp_item) items
-
-(* Interface functions ******************************************************)
-
-let box l = 
-   if !level >= l then
-   begin F.fprintf std "@,@[<v 2>%s" "  "; F.pp_print_if_newline std () end
-
-let unbox l = if !level >= l then F.fprintf std "@]"
-
-let flush l = if !level >= l then F.fprintf std "@]@."
-
-let box_err () = F.fprintf err "@[<v>"
-
-let flush_err () = F.fprintf err "@]@."
-
-let log st l items = pp_items std st l items
-
-let error st items = pp_items err st 0 items
-
-let items1 s = [Warn s]
-
-let t_items1 st c t =
-   [Warn st; Term (c, t)]
-
-let et_items1 sc c st t =
-   [Warn sc; LEnv c; Warn st; Term (c, t)]
-
-let et_items2 sc1 c1 st1 t1 ?sc2 ?c2 st2 t2 =
-   let tl = match sc2, c2 with
-      | Some sc2, Some c2 -> et_items1 sc2 c2 st2 t2
-      | None, None        -> t_items1 st2 c1 t2
-      | _                 -> assert false
-   in
-   et_items1 sc1 c1 st1 t1 @ tl  
-
-let et_items3 sc1 c1 st1 t1 ?sc2 ?c2 st2 t2 ?sc3 ?c3 st3 t3 =
-   let tl = match sc3, c3 with
-      | Some sc3, Some c3 -> et_items1 sc3 c3 st3 t3
-      | None, None        -> t_items1 st3 c1 t3 
-      | _                 -> assert false
-   in   
-   et_items2 sc1 c1 st1 t1 ?sc2 ?c2 st2 t2 @ tl 
-
-let warn msg = F.fprintf std "@,%s" msg
diff --git a/helm/software/lambda-delta/components/lib/log.mli b/helm/software/lambda-delta/components/lib/log.mli
deleted file mode 100644 (file)
index 9e0f054..0000000
+++ /dev/null
@@ -1,63 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type ('a, 'b) item = Term of 'a * 'b
-                   | LEnv of 'a
-                   | Warn of string
-                  | String of string
-                  | Loc
-
-type ('a, 'b) message = ('a, 'b) item list
-
-type ('a, 'b) specs = {
-   pp_term: 'a -> Format.formatter -> 'b -> unit;
-   pp_lenv: Format.formatter -> 'a -> unit
-}
-
-val loc: string ref
-
-val level: int ref
-
-val clear: unit -> unit
-
-val warn: string -> unit
-
-val box: int -> unit
-
-val unbox: int -> unit
-
-val flush: int -> unit
-
-val box_err: unit -> unit
-
-val flush_err: unit -> unit
-
-val log: ('a, 'b) specs -> int -> ('a, 'b) message -> unit
-
-val error: ('a, 'b) specs -> ('a, 'b) message -> unit
-
-val items1: string -> ('a, 'b) message
-
-val t_items1: string -> 'a -> 'b -> ('a, 'b) message
-
-val et_items1:
-   string -> 'a -> string -> 'b -> ('a, 'b) message
-
-val et_items2:
-   string -> 'a -> string -> 'b -> 
-   ?sc2:string -> ?c2:'a -> string -> 'b -> 
-   ('a, 'b) message
-
-val et_items3:
-   string -> 'a -> string -> 'b -> 
-   ?sc2:string -> ?c2:'a -> string -> 'b -> 
-   ?sc3:string -> ?c3:'a -> string -> 'b ->
-   ('a, 'b) message
diff --git a/helm/software/lambda-delta/components/lib/share.ml b/helm/software/lambda-delta/components/lib/share.ml
deleted file mode 100644 (file)
index 600ae9d..0000000
+++ /dev/null
@@ -1,21 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-let sh a b =
-   if a == b then a else b
-
-let sh1 a1 a2 b1 b2 =
-   if a1 == a2 then b1 else b2 (sh a1 a2)
-
-let sh2 a1 a2 b1 b2 c1 c2 =
-   if a1 == a2 && b1 == b2 then c1 else c2 (sh a1 a2) (sh b1 b2)
-
-let eq a b = (a == b) || (a = b)
diff --git a/helm/software/lambda-delta/components/lib/time.ml b/helm/software/lambda-delta/components/lib/time.ml
deleted file mode 100644 (file)
index 42d7d39..0000000
+++ /dev/null
@@ -1,34 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module P = Printf
-module L = Log
-
-let utime_stamp =
-   let old = ref 0.0 in
-   fun msg -> 
-      let times = Unix.times () in
-      let stamp = times.Unix.tms_utime in
-      let lap = stamp -. !old in
-      L.warn (P.sprintf "USR TIME STAMP (%s): %f (%f)" msg stamp lap);
-      old := stamp
-
-let gmtime msg =
-   let gmt = Unix.gmtime (Unix.time ()) in
-   let yy = gmt.Unix.tm_year + 1900 in
-   let mm = gmt.Unix.tm_mon + 1 in
-   let dd = gmt.Unix.tm_mday in
-   let h = gmt.Unix.tm_hour in
-   let m = gmt.Unix.tm_min in
-   let s = gmt.Unix.tm_sec in
-   L.warn (
-      P.sprintf "UTC TIME STAMP (%s): %u/%u/%u %u:%u:%u" msg yy mm dd h m s
-   )
diff --git a/helm/software/lambda-delta/components/text/Make b/helm/software/lambda-delta/components/text/Make
deleted file mode 100644 (file)
index f1c0ffe..0000000
+++ /dev/null
@@ -1 +0,0 @@
-txt txtParser txtLexer txtTxt
diff --git a/helm/software/lambda-delta/components/text/prova.hln b/helm/software/lambda-delta/components/text/prova.hln
deleted file mode 100644 (file)
index a782fda..0000000
+++ /dev/null
@@ -1,11 +0,0 @@
-\open pippo
-
-\global a : *Set
-
-\global b : *Prop
-
-\global f = [x:*Set].[y:*Prop].x
-
-\global "commento\"" c = f(a,b) : *Set
-
-\close
diff --git a/helm/software/lambda-delta/components/text/txt.ml b/helm/software/lambda-delta/components/text/txt.ml
deleted file mode 100644 (file)
index dbcc067..0000000
+++ /dev/null
@@ -1,43 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type ix = int (* index *)
-
-type id = string (* identifier *)
-
-type desc = string (* description *)
-
-type kind = Decl (* generic declaration *) 
-          | Ax   (* axiom               *)
-         | Def  (* generic definition  *)
-         | Th   (* theorem             *)
-
-type bind = Abst of (id * bool * term) list (* name, real?, domain *)
-          | Abbr of (id * term) list        (* name, bodies        *)
-          | Void of id list                 (* names               *)
-
-and term = Sort of ix                      (* level                          *)
-         | NSrt of id                      (* named level                    *)
-        | LRef of ix * ix                 (* index, offset                  *)
-        | NRef of id                      (* name                           *)
-        | Cast of term * term             (* domain, element                *)
-        | Appl of term list * term        (* arguments, function            *)
-        | Bind of bind * term             (* binder, scope                  *)
-        | Inst of term * term list        (* function, arguments            *)
-        | Impl of bool * id * term * term (* strong?, label, source, target *)
-
-type command = Require of id list                (* required files: names *)
-             | Graph of id                       (* hierarchy graph: name *) 
-             | Sorts of (int option * id) list   (* sorts: index, name *)
-            | Section of id option              (* section: Some id = open, None = close last *)
-            | Entity of kind * id * desc * term (* entity: class, name, description, contents *) 
-             | Generate of term list             (* predefined generated entity: arguments *)
-            
diff --git a/helm/software/lambda-delta/components/text/txtLexer.mll b/helm/software/lambda-delta/components/text/txtLexer.mll
deleted file mode 100644 (file)
index dc293bd..0000000
+++ /dev/null
@@ -1,72 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-{ 
-   module L = Log
-   module O = Options
-   module P = TxtParser
-   
-   let out s = if !O.debug_lexer then L.warn s else ()
-}
-
-let BS    = "\\"
-let SPC   = [' ' '\t' '\n']+
-let OC    = "\\*"
-let CC    = "*\\"
-let FIG   = ['0'-'9']
-let ALPHA = ['A'-'Z' 'a'-'z' '_']
-let QT    = '"'
-let ID    = ALPHA+ (ALPHA | FIG)*
-let IX    = FIG+
-
-rule block_comment = parse
-   | CC  { () }
-   | OC  { block_comment lexbuf; block_comment lexbuf }
-   | _   { block_comment lexbuf }
-and qstring = parse
-   | QT    { ""                                }
-   | SPC   { " " ^ qstring lexbuf              }  
-   | BS BS { "\\" ^ qstring lexbuf             } 
-   | BS QT { "\"" ^ qstring lexbuf             }  
-   | _ as c { String.make 1 c ^ qstring lexbuf }
-and token = parse
-   | SPC          { token lexbuf                                        } 
-   | OC           { block_comment lexbuf; token lexbuf                  }
-   | ID as id     { out ("ID " ^ id); P.ID id                           }
-   | IX as ix     { out ("IX " ^ ix); P.IX (int_of_string ix)           }
-   | QT           { let s = qstring lexbuf in out ("STR " ^ s); P.STR s }
-   | "\\graph"    { out "GRAPH"; P.GRAPH }
-   | "\\decl"     { out "DECL"; P.DECL   }
-   | "\\ax"       { out "AX"; P.AX       }
-   | "\\def"      { out "DEF"; P.DEF     }
-   | "\\th"       { out "TH"; P.TH       }
-   | "\\generate" { out "GEN"; P.GEN     }
-   | "\\require"  { out "REQ"; P.REQ     }
-   | "\\open"     { out "OPEN"; P.OPEN   } 
-   | "\\close"    { out "CLOSE"; P.CLOSE }
-   | "\\sorts"    { out "SORTS"; P.SORTS }
-   | "("          { out "OP"; P.OP       }
-   | ")"          { out "CP"; P.CP       }
-   | "["          { out "OB"; P.OB       }
-   | "]"          { out "CB"; P.CB       }
-   | "<"          { out "OA"; P.OA       }
-   | ">"          { out "CA"; P.CA       }
-   | "."          { out "FS"; P.FS       }   
-   | ":"          { out "CN"; P.CN       }   
-   | ","          { out "CM"; P.CM       }
-   | "="          { out "EQ"; P.EQ       }
-   | "*"          { out "STAR"; P.STAR   }
-   | "#"          { out "HASH"; P.HASH   }
-   | "+"          { out "PLUS"; P.PLUS   }
-   | "~"          { out "TE"; P.TE       }
-   | "->"         { out "WTO"; P.WTO     }
-   | "=>"         { out "STO"; P.STO     }
-   | eof          { out "EOF"; P.EOF     }
diff --git a/helm/software/lambda-delta/components/text/txtParser.mly b/helm/software/lambda-delta/components/text/txtParser.mly
deleted file mode 100644 (file)
index 694e308..0000000
+++ /dev/null
@@ -1,153 +0,0 @@
-/* Copyright (C) 2000, HELM Team.
- * 
- * This file is part of HELM, an Hypertextual, Electronic
- * Library of Mathematics, developed at the Computer Science
- * Department, University of Bologna, Italy.
- * 
- * HELM is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- * 
- * HELM is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with HELM; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- * MA  02111-1307, USA.
- * 
- * For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
- */
-
-%{
-   module O = Options
-   module T = Txt
-   
-   let _ = Parsing.set_trace !O.debug_parser
-%}
-   %token <int> IX
-   %token <string> ID STR
-   %token OP CP OB CB OA CA FS CN CM EQ STAR HASH PLUS TE WTO STO 
-   %token GRAPH DECL AX DEF TH GEN REQ OPEN CLOSE SORTS EOF
-
-   %start entry
-   %type <Txt.command option> entry
-
-   %nonassoc CP CB CA
-   %right WTO STO
-%%
-   hash:
-      |      {}
-      | HASH {}
-   ;
-   fs:
-      |    {}
-      | FS {}
-   ;
-   comment:
-      |     { "" }
-      | STR { $1 }
-   ;
-   ids:
-      | ID        { [$1]     }
-      | ID CM ids { $1 :: $3 }
-   ;
-   sort:
-      | ID    { None, $1    }
-      | IX ID { Some $1, $2 }
-   ;
-   sorts:
-      | sort          { [$1]     }
-      | sort CM sorts { $1 :: $3 }
-   ;
-
-   abst:
-      | ID CN term { $1, true, $3  }
-      | TE term    { "", false, $2 }
-      | ID TE term { $1, false, $3 }
-   ;
-   abbr:
-      | ID EQ term { $1, $3 }
-   ;
-   absts:
-      | abst          { [$1]     }
-      | abst CM absts { $1 :: $3 }
-   ;
-   abbrs:
-      | abbr          { [$1]     }
-      | abbr CM abbrs { $1 :: $3 }
-   ;   
-   binder: 
-      | absts { T.Abst $1 }
-      | abbrs { T.Abbr $1 }
-      | ids   { T.Void $1 }
-   ;      
-   atom:
-      | STAR IX          { T.Sort $2         }
-      | STAR ID          { T.NSrt $2         }
-      | hash IX          { T.LRef ($2, 0)    }
-      | hash IX PLUS IX  { T.LRef ($2, $4)   }
-      | ID               { T.NRef $1         }
-      | HASH ID          { T.NRef $2         }
-      | atom OP term CP  { T.Inst ($1, [$3]) }
-      | atom OP terms CP { T.Inst ($1, $3)   }
-   ;
-   term:
-      | atom                 { $1                         }
-      | OA term CA fs term   { T.Cast ($2, $5)            }
-      | OP term CP fs term   { T.Appl ([$2], $5)          }
-      | OP terms CP fs term  { T.Appl ($2, $5)            }
-      | OB binder CB fs term { T.Bind ($2, $5)            }
-      | term WTO term        { T.Impl (false, "", $1, $3) }
-      | ID TE term WTO term  { T.Impl (false, $1, $3, $5) }
-      | term STO term        { T.Impl (true, "", $1, $3)  }
-      | ID TE term STO term  { T.Impl (true, $1, $3, $5)  }
-      | OP term CP           { $2                         }
-   ;
-   terms:
-      | term CM term  { [$1; $3] }
-      | term CM terms { $1 :: $3 }
-   ;
-   
-   decl:
-      | DECL { T.Decl }
-      | AX   { T.Ax   }
-   ;
-   def:   
-      | DEF  { T.Def } 
-      | TH   { T.Th  }
-   ;
-   xentity:
-      | GRAPH ID
-         { T.Graph $2                             }
-      | decl comment ID CN term
-         { T.Entity ($1, $3, $2, $5)              }
-      | def comment ID EQ term
-         { T.Entity ($1, $3, $2, $5)              }
-      | def comment ID EQ term CN term
-         { T.Entity ($1, $3, $2, T.Cast ($7, $5)) }
-      | GEN term
-         { T.Generate [$2]                        }
-      | GEN terms
-         { T.Generate $2                          }      
-      | REQ ids
-         { T.Require $2                           }
-      | OPEN ID                           
-         { T.Section (Some $2)                    }
-      | CLOSE                             
-         { T.Section None                         }
-      | SORTS sorts
-         { T.Sorts $2                             }
-   ;
-   start: 
-      | GRAPH {} | decl {} | def {} | GEN {} |
-      | REQ {} | OPEN {} | CLOSE {} | SORTS {} | EOF {}
-   ;
-   entry:
-      | xentity start { Some $1 }
-      | EOF           { None    }
-   ;
diff --git a/helm/software/lambda-delta/components/text/txtTxt.ml b/helm/software/lambda-delta/components/text/txtTxt.ml
deleted file mode 100644 (file)
index 1d501fe..0000000
+++ /dev/null
@@ -1,62 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module C = Cps
-module T = Txt
-
-(* Interface functions ******************************************************)
-
-let rec contract f = function
-   | T.Inst (t, vs)           ->
-      let tt = T.Appl (List.rev vs, t) in 
-      contract f tt
-   | T.Impl (false, id, w, t) ->
-      let tt = T.Bind (T.Abst [id, false, w], t) in 
-      contract f tt      
-   | T.Impl (true, id, w, t)  -> 
-      let f = function
-         | T.Bind (T.Abst [xw], T.Bind (T.Abst xws, tt)) ->
-            f (T.Bind (T.Abst (xw :: xws), tt))
-        | tt                                            -> f tt
-      in
-      let tt = T.Impl (false, id, w, t) in
-      contract f tt
-   | T.Sort _ 
-   | T.NSrt _     
-   | T.LRef _
-   | T.NRef _ as t            -> f t
-   | T.Cast (u, t)            ->
-      let f tt uu = f (T.Cast (uu, tt)) in
-      let f tt = contract (f tt) u in
-      contract f t
-    | T.Appl (vs, t)          ->
-      let f tt vvs = f (T.Appl (vvs, tt)) in
-      let f tt = C.list_map (f tt) contract vs in
-      contract f t      
-   | T.Bind (b, t)            ->
-      let f tt bb = f (T.Bind (bb, tt)) in
-      let f tt = contract_binder (f tt) b in
-      contract f t
-
-and contract_binder f = function
-   | T.Void n as b -> f b
-   | T.Abbr xvs    ->
-      let map f (id, v) = 
-         let f vv = f (id, vv) in contract f v
-      in
-      let f xvvs = f (T.Abbr xvvs) in
-      C.list_map f map xvs
-   | T.Abst xws    ->
-      let map f (id, real, w) = 
-         let f ww = f (id, real, ww) in contract f w
-      in
-      let f xwws = f (T.Abst xwws) in
-      C.list_map f map xws
diff --git a/helm/software/lambda-delta/components/text/txtTxt.mli b/helm/software/lambda-delta/components/text/txtTxt.mli
deleted file mode 100644 (file)
index 3574876..0000000
+++ /dev/null
@@ -1,12 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-val contract: (Txt.term -> 'a) -> Txt.term -> 'a
diff --git a/helm/software/lambda-delta/components/toplevel/Make b/helm/software/lambda-delta/components/toplevel/Make
deleted file mode 100644 (file)
index a8a72e1..0000000
+++ /dev/null
@@ -1 +0,0 @@
-meta metaOutput metaLibrary metaAut metaBag metaBrg top
diff --git a/helm/software/lambda-delta/components/toplevel/meta.ml b/helm/software/lambda-delta/components/toplevel/meta.ml
deleted file mode 100644 (file)
index 5539772..0000000
+++ /dev/null
@@ -1,25 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type uri = Entity.uri
-type id = Entity.id
-
-type term = Sort of bool                  (* sorts: true = TYPE, false = PROP *)
-         | LRef of int * int             (* local reference: local environment length, de bruijn index *)
-         | GRef of int * uri * term list (* global reference: local environment length, name, arguments *)
-         | Appl of term * term           (* application: argument, function *)
-         | Abst of id * term * term      (* abstraction: name, domain, scope *)
-
-type pars = (id * term) list (* parameter declarations: name, type *)
-
-type entry = pars * term * term option (* parameters, domain, body *)
-
-type entity = entry Entity.entity
diff --git a/helm/software/lambda-delta/components/toplevel/metaAut.ml b/helm/software/lambda-delta/components/toplevel/metaAut.ml
deleted file mode 100644 (file)
index dd6c4a6..0000000
+++ /dev/null
@@ -1,218 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module U = NUri
-module H = U.UriHash
-module C = Cps
-module O = Options
-module Y = Entity
-module M = Meta
-module A = Aut
-
-(* qualified identifier: uri, name, qualifiers *)
-type qid = M.uri * M.id * M.id list
-
-type context_node = qid option (* context node: None = root *)
-
-type status = {
-   path: M.id list;          (* current section path *) 
-   node: context_node;       (* current context node *)
-   nodes: context_node list; (* context node list *)
-   line: int;                (* line number *)
-   cover: string             (* initial segment of URI hierarchy *) 
-}
-
-type resolver = Local of int
-              | Global of M.pars
-
-let henv_size, hcnt_size = 7000, 4300 (* hash tables initial sizes *)
-
-let henv = H.create henv_size (* optimized global environment *)
-
-let hcnt = H.create hcnt_size (* optimized context *) 
-
-(* Internal functions *******************************************************)
-
-let id_of_name (id, _, _) = id
-
-let mk_qid st id path =
-   let uripath = if st.cover = "" then path else st.cover :: path in
-   let str = String.concat "/" uripath in
-   let str = Filename.concat str id in 
-   U.uri_of_string ("ld:/" ^ str ^ ".ld"), id, path
-
-let uri_of_qid (uri, _, _) = uri
-
-let complete_qid f st (id, is_local, qs) =
-   let f qs = f (mk_qid st id qs) in
-   let f path = C.list_rev_append f path ~tail:qs in
-   let rec skip f = function
-      | phd :: ptl, qshd :: _ when phd = qshd -> f ptl
-      | _ :: ptl, _ :: _                      -> skip f (ptl, qs)
-      | _                                     -> f []
-   in
-   if is_local then f st.path else skip f (st.path, qs)
-
-let relax_qid f st (_, id, path) =
-   let f path = f (mk_qid st id path) in
-   let f = function
-      | _ :: tl -> C.list_rev f tl
-      | []      -> assert false
-   in
-   C.list_rev f path
-
-let relax_opt_qid f st = function
-   | None     -> f None
-   | Some qid -> let f qid = f (Some qid) in relax_qid f st qid
-
-let resolve_lref f st l lenv id =
-   let rec aux f i = function
-     | []                            -> f None
-     | (name, _) :: _ when name = id -> f (Some (M.LRef (l, i)))
-     | _ :: tl                       -> aux f (succ i) tl
-   in
-   aux f 0 lenv
-
-let resolve_lref_strict f st l lenv id =
-   let f = function
-      | Some t -> f t
-      | None   -> assert false
-   in
-   resolve_lref f st l lenv id
-
-let resolve_gref f st qid =
-   try let args = H.find henv (uri_of_qid qid) in f qid (Some args)
-   with Not_found -> f qid None
-
-let resolve_gref_relaxed f st qid =
-(* this is not tail recursive *)
-   let rec g qid = function
-      | None      -> relax_qid (resolve_gref g st) st qid
-      | Some args -> f qid args
-   in
-   resolve_gref g st qid
-
-let get_pars f st = function
-   | None              -> f [] None
-   | Some qid as node ->
-      try let pars = H.find hcnt (uri_of_qid qid) in f pars None
-      with Not_found -> f [] (Some node)
-
-let get_pars_relaxed f st =
-(* this is not tail recursive *)
-   let rec g pars = function
-      | None      -> f pars 
-      | Some node -> relax_opt_qid (get_pars g st) st node
-   in
-   get_pars g st st.node
-
-(* this is not tail recursive on the GRef branch *)
-let rec xlate_term f st lenv = function
-   | A.Sort sort         -> 
-      f (M.Sort sort)
-   | A.Appl (v, t)       ->
-      let f vv tt = f (M.Appl (vv, tt)) in
-      let f vv = xlate_term (f vv) st lenv t in
-      xlate_term f st lenv v
-   | A.Abst (name, w, t) ->
-      let add name w lenv = (name, w) :: lenv in
-      let f ww tt = f (M.Abst (name, ww, tt)) in
-      let f ww = xlate_term (f ww) st (add name ww lenv) t in
-      xlate_term f st lenv w
-   | A.GRef (name, args) ->
-      let l = List.length lenv in
-      let g qid defs =
-        let map1 f = xlate_term f st lenv in       
-        let map2 f (id, _) = resolve_lref_strict f st l lenv id in
-         let f tail = 
-           let f args = f (M.GRef (l, uri_of_qid qid, args)) in
-            let f defs = C.list_rev_map_append f map2 defs ~tail in
-           C.list_sub_strict f defs args
-        in   
-        C.list_map f map1 args
-      in
-      let g qid = resolve_gref_relaxed g st qid in
-      let f = function
-         | Some t -> f t
-        | None   -> complete_qid g st name
-      in
-      resolve_lref f st l lenv (id_of_name name)
-
-let xlate_entity err f st = function
-   | A.Section (Some (_, name))     ->
-      err {st with path = name :: st.path; nodes = st.node :: st.nodes}
-   | A.Section None            ->
-      begin match st.path, st.nodes with
-        | _ :: ptl, nhd :: ntl -> 
-           err {st with path = ptl; node = nhd; nodes = ntl}
-         | _                    -> assert false
-      end
-   | A.Context None            ->
-      err {st with node = None}
-   | A.Context (Some name)     ->
-      let f name = err {st with node = Some name} in
-      complete_qid f st name 
-   | A.Block (name, w)         ->
-      let f qid = 
-         let f pars =
-           let f ww = 
-              H.add hcnt (uri_of_qid qid) ((name, ww) :: pars);
-              err {st with node = Some qid}
-           in
-            xlate_term f st pars w
-        in
-         get_pars_relaxed f st
-      in
-      complete_qid f st (name, true, [])
-   | A.Decl (name, w)          ->
-      let f pars = 
-         let f qid = 
-            let f ww =
-              H.add henv (uri_of_qid qid) pars;
-              let a = [Y.Mark st.line] in
-              let entry = pars, ww, None in
-              let entity = a, uri_of_qid qid, Y.Abst entry in
-              f {st with line = succ st.line} entity
-           in
-           xlate_term f st pars w
-        in
-         complete_qid f st (name, true, [])
-      in
-      get_pars_relaxed f st
-   | A.Def (name, w, trans, v) ->
-      let f pars = 
-         let f qid = 
-            let f ww vv = 
-              H.add henv (uri_of_qid qid) pars;
-              let a = Y.Mark st.line :: if trans then [] else [Y.Priv] in 
-              let entry = pars, ww, Some vv in
-              let entity = a, uri_of_qid qid, Y.Abbr entry in
-              f {st with line = succ st.line} entity
-           in
-           let f ww = xlate_term (f ww) st pars v in
-           xlate_term f st pars w
-        in
-         complete_qid f st (name, true, [])
-      in
-      get_pars_relaxed f st
-
-(* Interface functions ******************************************************)
-
-let initial_status () =
-   H.clear henv; H.clear hcnt; {
-   path = []; node = None; nodes = []; line = 1; cover = !O.cover
-}
-
-let refresh_status st = {st with
-  cover = !O.cover
-}  
-
-let meta_of_aut = xlate_entity
diff --git a/helm/software/lambda-delta/components/toplevel/metaAut.mli b/helm/software/lambda-delta/components/toplevel/metaAut.mli
deleted file mode 100644 (file)
index a1210c5..0000000
+++ /dev/null
@@ -1,20 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type status
-
-val initial_status: unit -> status 
-
-val refresh_status: status -> status
-
-val meta_of_aut: 
-   (status -> 'a) -> (status -> Meta.entity -> 'a) -> 
-   status -> Aut.command -> 'a
diff --git a/helm/software/lambda-delta/components/toplevel/metaBag.ml b/helm/software/lambda-delta/components/toplevel/metaBag.ml
deleted file mode 100644 (file)
index 991d7e8..0000000
+++ /dev/null
@@ -1,67 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module C = Cps
-module B = Bag
-module M = Meta
-
-(* Internal functions *******************************************************)
-
-let rec xlate_term c f = function
-   | M.Sort s            -> 
-      let f h = f (B.Sort h) in
-      if s then f 0 else f 1
-   | M.LRef (_, i)       ->
-      let l, _, _ = List.nth c i in
-      f (B.LRef l)
-   | M.GRef (_, uri, vs) ->
-      let map f t v = f (B.appl v t) in
-      let f vs = C.list_fold_left f map (B.GRef uri) vs in
-      C.list_map f (xlate_term c) vs
-   | M.Appl (v, t)       ->
-      let f v t = f (B.Appl (v, t)) in
-      let f v = xlate_term c (f v) t in
-      xlate_term c f v
-   | M.Abst (id, w, t)   ->
-      let f w = 
-         let l = B.new_location () in
-         let f t = f (B.Bind (l, id, B.Abst w, t)) in
-         let f c = xlate_term c f t in
-         B.push "meta" f c l id (B.Abst w)
-      in
-      xlate_term c f w
-
-let xlate_pars f pars =
-   let map f (id, w) c =
-      let l = B.new_location () in
-      let f w = B.push "meta" f c l id (B.Abst w) in
-      xlate_term c f w
-   in
-   C.list_fold_right f map pars B.empty_lenv
-
-let unwind_to_xlate_term f c t =
-   let map f t (l, id, b) = f (B.bind l id b t) in
-   let f t = C.list_fold_left f map t c in
-   xlate_term c f t
-
-let xlate_entry f = function 
-   | pars, u, None   ->
-      let f c = unwind_to_xlate_term f c u in      
-      xlate_pars f pars   
-   | pars, u, Some t ->
-      let f u t = f (B.Cast (u, t)) in
-      let f c u = unwind_to_xlate_term (f u) c t in
-      let f c = unwind_to_xlate_term (f c) c u in
-      xlate_pars f pars
-   
-(* Interface functions ******************************************************)
-
-let bag_of_meta = xlate_entry
diff --git a/helm/software/lambda-delta/components/toplevel/metaBag.mli b/helm/software/lambda-delta/components/toplevel/metaBag.mli
deleted file mode 100644 (file)
index 62ce68f..0000000
+++ /dev/null
@@ -1,12 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-val bag_of_meta: (Bag.term -> 'a) -> Meta.entry -> 'a
diff --git a/helm/software/lambda-delta/components/toplevel/metaBrg.ml b/helm/software/lambda-delta/components/toplevel/metaBrg.ml
deleted file mode 100644 (file)
index cde4daa..0000000
+++ /dev/null
@@ -1,66 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module C = Cps
-module Y = Entity
-module B = Brg
-module M = Meta
-
-(* Internal functions *******************************************************)
-
-let rec xlate_term c f = function
-   | M.Sort s            -> 
-      let f h = f (B.Sort ([], h)) in
-      if s then f 0 else f 1
-   | M.LRef (_, i)       ->
-      f (B.LRef ([], i))
-   | M.GRef (_, uri, vs) ->
-      let map f t v = f (B.appl [] v t) in
-      let f vs = C.list_fold_left f map (B.GRef ([], uri)) vs in
-      C.list_map f (xlate_term c) vs
-   | M.Appl (v, t)       ->
-      let f v t = f (B.Appl ([], v, t)) in
-      let f v = xlate_term c (f v) t in
-      xlate_term c f v
-   | M.Abst (id, w, t)   ->
-      let f w = 
-         let a = [Y.Name (id, true)] in
-        let f t = f (B.Bind (a, B.Abst w, t)) in
-         xlate_term (B.push c B.empty a (B.Abst w)) f t
-      in
-      xlate_term c f w
-
-let xlate_pars f pars =
-   let map f (id, w) c =
-      let a = [Y.Name (id, true)] in
-      let f w = f (B.push c B.empty a (B.Abst w)) in
-      xlate_term c f w
-   in
-   C.list_fold_right f map pars B.empty
-
-let unwind_to_xlate_term f c t =
-   let map t a b = B.bind a b t in
-   let f t = f (B.fold_left map t c) in
-   xlate_term c f t
-
-let xlate_entry f = function
-   | pars, u, None   ->
-      let f c = unwind_to_xlate_term f c u in      
-      xlate_pars f pars   
-   | pars, u, Some t ->
-      let f u t = f (B.Cast ([], u, t)) in
-      let f c u = unwind_to_xlate_term (f u) c t in
-      let f c = unwind_to_xlate_term (f c) c u in
-      xlate_pars f pars
-
-(* Interface functions ******************************************************)
-
-let brg_of_meta = xlate_entry
diff --git a/helm/software/lambda-delta/components/toplevel/metaBrg.mli b/helm/software/lambda-delta/components/toplevel/metaBrg.mli
deleted file mode 100644 (file)
index 4ce275f..0000000
+++ /dev/null
@@ -1,12 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-val brg_of_meta: (Brg.term -> 'a) -> Meta.entry -> 'a
diff --git a/helm/software/lambda-delta/components/toplevel/metaLibrary.ml b/helm/software/lambda-delta/components/toplevel/metaLibrary.ml
deleted file mode 100644 (file)
index 3ae116d..0000000
+++ /dev/null
@@ -1,36 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module F = Format
-module O = MetaOutput
-
-type out_channel = Pervasives.out_channel * F.formatter
-
-(* internal functions *******************************************************)
-
-let hal_dir = "hal"
-
-let hal_ext = ".hal"
-
-(* interface functions ******************************************************)
-
-let open_out f name =      
-   let _ = Sys.command (Printf.sprintf "mkdir -p %s" hal_dir) in
-   let och = open_out (Filename.concat hal_dir (name ^ hal_ext)) in
-   let frm = F.formatter_of_out_channel och in
-   F.pp_set_margin frm max_int;
-   f (och, frm)
-
-let write_entity f (_, frm) entity =
-   O.pp_entity f frm entity
-   
-let close_out f (och, _) =
-   close_out och; f ()
diff --git a/helm/software/lambda-delta/components/toplevel/metaLibrary.mli b/helm/software/lambda-delta/components/toplevel/metaLibrary.mli
deleted file mode 100644 (file)
index 2f6e41b..0000000
+++ /dev/null
@@ -1,18 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type out_channel
-
-val open_out: (out_channel -> 'a) -> string -> 'a
-
-val write_entity: (unit -> 'a) -> out_channel -> Meta.entity -> 'a
-
-val close_out: (unit -> 'a) -> out_channel -> 'a
diff --git a/helm/software/lambda-delta/components/toplevel/metaOutput.ml b/helm/software/lambda-delta/components/toplevel/metaOutput.ml
deleted file mode 100644 (file)
index 21d735d..0000000
+++ /dev/null
@@ -1,162 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module P = Printf
-module F = Format
-module U = NUri
-module C = Cps
-module L = Log
-module Y = Entity
-module M = Meta
-
-type counters = {
-   eabsts: int;
-   eabbrs: int;
-   pabsts: int;    
-   tsorts: int;
-   tlrefs: int;
-   tgrefs: int;
-   pappls: int;
-   tappls: int;
-   tabsts: int;
-   uris  : U.uri list;
-   nodes : int;
-   xnodes: int
-}
-
-let initial_counters = {
-   eabsts = 0; eabbrs = 0; pabsts = 0; pappls = 0;
-   tsorts = 0; tlrefs = 0; tgrefs = 0; tappls = 0; tabsts = 0;
-   uris = []; nodes = 0; xnodes = 0
-}
-
-let rec count_term f c = function
-   | M.Sort _          -> 
-      f {c with tsorts = succ c.tsorts; nodes = succ c.nodes}
-   | M.LRef _          -> 
-      f {c with tlrefs = succ c.tlrefs; nodes = succ c.nodes}
-   | M.GRef (_, u, ts) -> 
-      let c = {c with tgrefs = succ c.tgrefs} in
-      let c = {c with pappls = c.pappls + List.length ts} in
-      let c = {c with nodes = c.nodes + List.length ts} in
-      let c =    
-        if Cps.list_mem ~eq:U.eq u c.uris
-        then {c with nodes = succ c.nodes}
-        else {c with xnodes = succ c.xnodes}
-      in
-      Cps.list_fold_left f count_term c ts
-   | M.Appl (v, t)     -> 
-      let c = {c with tappls = succ c.tappls; nodes = succ c.nodes} in
-      let f c = count_term f c t in
-      count_term f c v
-   | M.Abst (_, w, t)  -> 
-      let c = {c with tabsts = succ c.tabsts; nodes = succ c.nodes} in
-      let f c = count_term f c t in
-      count_term f c w
-
-let count_par f c (_, w) = count_term f c w
-
-let count_xterm f c = function
-   | None   -> f c
-   | Some v -> count_term f c v
-
-let count_entity f c = function
-   | _, u, Y.Abst (pars, w, xv) ->
-      let c = {c with eabsts = succ c.eabsts} in
-      let c = {c with pabsts = c.pabsts + List.length pars} in
-      let c = {c with uris = u :: c.uris; nodes = succ c.nodes + List.length pars} in
-      let f c = count_xterm f c xv in      
-      let f c = count_term f c w in
-      Cps.list_fold_left f count_par c pars   
-   | _, _, Y.Abbr (pars, w, xv) ->
-      let c = {c with eabbrs = succ c.eabbrs; xnodes = succ c.xnodes} in
-      let c = {c with pabsts = c.pabsts + List.length pars} in
-      let c = {c with nodes = c.nodes + List.length pars} in
-      let f c = count_xterm f c xv in
-      let f c = count_term f c w in
-      Cps.list_fold_left f count_par c pars
-   | _, _, Y.Void               -> assert false
-
-let print_counters f c =
-   let terms = c.tsorts + c.tlrefs + c.tgrefs + c.tappls + c.tabsts in
-   let pars = c.pabsts + c.pappls in
-   let entries = c.eabsts + c.eabbrs in
-   let nodes = c.nodes + c.xnodes in
-   L.warn (P.sprintf "  Intermediate representation summary");
-   L.warn (P.sprintf "    Total entries:            %7u" entries);
-   L.warn (P.sprintf "      Declaration items:      %7u" c.eabsts);
-   L.warn (P.sprintf "      Definition items:       %7u" c.eabbrs);
-   L.warn (P.sprintf "    Total parameter items:    %7u" pars);
-   L.warn (P.sprintf "      Application items:      %7u" c.pappls);
-   L.warn (P.sprintf "      Abstraction items:      %7u" c.pabsts);
-   L.warn (P.sprintf "    Total term items:         %7u" terms);
-   L.warn (P.sprintf "      Sort items:             %7u" c.tsorts);
-   L.warn (P.sprintf "      Local reference items:  %7u" c.tlrefs);
-   L.warn (P.sprintf "      Global reference items: %7u" c.tgrefs);
-   L.warn (P.sprintf "      Application items:      %7u" c.tappls);
-   L.warn (P.sprintf "      Abstraction items:      %7u" c.tabsts);
-   L.warn (P.sprintf "    Global Int. Complexity:   %7u" c.nodes);
-   L.warn (P.sprintf "      + Abbreviation nodes:   %7u" nodes);
-   f ()
-
-let string_of_sort = function
-   | true -> "Type"
-   | false -> "Prop"
-
-let pp_transparent frm a =
-   let err () = F.fprintf frm "%s" "=" in
-   let f () = F.fprintf frm "%s" "~" in
-   Y.priv err f a
-
-let pp_list pp opend sep closed frm l =
-   let rec aux frm = function
-      | []       -> ()
-      | [hd]     -> pp frm hd
-      | hd :: tl -> F.fprintf frm "%a%s%a" pp hd sep aux tl 
-   in
-   if l = [] then () else F.fprintf frm "%s%a%s" opend aux l closed
-
-let pp_rev_list pp opend sep closed frm l =
-   pp_list pp opend sep closed frm (List.rev l)
-
-let rec pp_args frm args = pp_list pp_term "(" "," ")" frm args
-
-and pp_term frm = function
-   | M.Sort s            -> 
-      F.fprintf frm "@[*%s@]" (string_of_sort s)
-   | M.LRef (l, i)       ->
-      F.fprintf frm "@[%u@@#%u@]" l i
-   | M.GRef (l, uri, ts) ->
-      F.fprintf frm "@[%u@@$%s%a@]" l (U.string_of_uri uri) pp_args ts
-   | M.Appl (v, t)       ->
-      F.fprintf frm "@[(%a).%a@]" pp_term v pp_term t
-   | M.Abst (id, w, t)   ->
-      F.fprintf frm "@[[%s:%a].%a@]" id pp_term w pp_term t
-
-let pp_par frm (id, w) =
-   F.fprintf frm "%s:%a" id pp_term w
-
-let pp_pars = pp_rev_list pp_par "[" "," "]"
-
-let pp_body a frm = function
-   | None   -> ()
-   | Some t -> F.fprintf frm "%a%a" pp_transparent a pp_term t
-
-let pp_entity frm = function
-   | a, uri, Y.Abst (pars, u, body)
-   | a, uri, Y.Abbr (pars, u, body) ->
-      F.fprintf frm "@[%u@@%s%a%a:%a@]@\n%!" 
-         (Y.mark C.err C.start a) (U.string_of_uri uri) 
-        pp_pars pars (pp_body a) body pp_term u
-   | _, _, Y.Void                   -> assert false
-
-let pp_entity f frm entity =
-   pp_entity frm entity; f ()
diff --git a/helm/software/lambda-delta/components/toplevel/metaOutput.mli b/helm/software/lambda-delta/components/toplevel/metaOutput.mli
deleted file mode 100644 (file)
index 1a7b119..0000000
+++ /dev/null
@@ -1,20 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-type counters
-
-val initial_counters: counters
-
-val count_entity: (counters -> 'a) -> counters -> Meta.entity -> 'a
-
-val print_counters: (unit -> 'a) -> counters -> 'a
-
-val pp_entity: (unit -> 'a) -> Format.formatter -> Meta.entity -> 'a
diff --git a/helm/software/lambda-delta/components/toplevel/top.ml b/helm/software/lambda-delta/components/toplevel/top.ml
deleted file mode 100644 (file)
index 40fcda5..0000000
+++ /dev/null
@@ -1,399 +0,0 @@
-(*
-    ||M||  This file is part of HELM, an Hypertextual, Electronic        
-    ||A||  Library of Mathematics, developed at the Computer Science     
-    ||T||  Department, University of Bologna, Italy.                     
-    ||I||                                                                
-    ||T||  HELM is free software; you can redistribute it and/or         
-    ||A||  modify it under the terms of the GNU General Public License   
-    \   /  version 2 or (at your option) any later version.              
-     \ /   This software is distributed as is, NO WARRANTY.              
-      V_______________________________________________________________ *)
-
-module F    = Filename
-module P    = Printf
-module U    = NUri
-module C    = Cps
-module L    = Log
-module T    = Time
-module O    = Options
-module H    = Hierarchy
-module Op   = Output
-module Y    = Entity
-module X    = Library
-module AL   = AutLexer
-module AP   = AutProcess
-module AO   = AutOutput
-module DT   = CrgTxt
-module DA   = CrgAut
-module MA   = MetaAut
-module MO   = MetaOutput
-module ML   = MetaLibrary
-module DX   = CrgXml
-module DBrg = CrgBrg
-module MBrg = MetaBrg
-module BrgO = BrgOutput
-module BrgR = BrgReduction
-module BrgU = BrgUntrusted
-module MBag = MetaBag
-module BagO = BagOutput
-module BagT = BagType
-module BagU = BagUntrusted
-
-type status = {
-   ast : AP.status;
-   dst : DA.status;
-   mst : MA.status;
-   tst : DT.status;
-   ac  : AO.counters;
-   mc  : MO.counters;
-   brgc: BrgO.counters;
-   bagc: BagO.counters;
-   kst : Y.status
-}
-
-let flush_all () = L.flush 0; L.flush_err ()
-
-let bag_error s msg =
-   L.error BagO.specs (L.Warn s :: L.Loc :: msg); flush_all () 
-
-let brg_error s msg =
-   L.error BrgR.specs (L.Warn s :: L.Loc :: msg); flush_all () 
-
-let initial_status () = {
-   ac   = AO.initial_counters;
-   mc   = MO.initial_counters;
-   brgc = BrgO.initial_counters;
-   bagc = BagO.initial_counters;
-   mst  = MA.initial_status ();
-   dst  = DA.initial_status ();
-   tst  = DT.initial_status ();
-   ast  = AP.initial_status ();
-   kst  = Y.initial_status ()
-}
-
-let refresh_status st = {st with
-   mst = MA.refresh_status st.mst;
-   dst = DA.refresh_status st.dst;
-   tst = DT.refresh_status st.tst;
-   kst = Y.refresh_status st.kst
-}
-
-(* kernel related ***********************************************************)
-
-type kernel = Brg | Bag
-
-type kernel_entity = BrgEntity  of Brg.entity
-                   | BagEntity  of Bag.entity
-                  | CrgEntity  of Crg.entity
-                  | MetaEntity of Meta.entity
-
-let kernel = ref Brg
-
-let print_counters st = match !kernel with
-   | Brg -> BrgO.print_counters C.start st.brgc
-   | Bag -> BagO.print_counters C.start st.bagc
-
-let xlate_entity entity = match !kernel, entity with
-   | Brg, CrgEntity e  -> 
-      let f e = (BrgEntity e) in Y.xlate f DBrg.brg_of_crg e
-   | Brg, MetaEntity e -> 
-      let f e = (BrgEntity e) in Y.xlate f MBrg.brg_of_meta e
-   | Bag, MetaEntity e -> 
-      let f e = (BagEntity e) in Y.xlate f MBag.bag_of_meta e  
-   | _, entity         -> entity
-
-let pp_progress e =
-   let f a u =
-      let s = U.string_of_uri u in
-      let err () = L.warn (P.sprintf "%s" s) in
-      let f i = L.warn (P.sprintf "[%u] %s" i s) in
-      Y.mark err f a
-   in
-   match e with
-      | CrgEntity e -> Y.common f e
-      | BrgEntity e -> Y.common f e
-      | BagEntity e -> Y.common f e      
-      | MetaEntity e -> Y.common f e
-
-let count_entity st = function
-   | MetaEntity e -> {st with mc = MO.count_entity C.start st.mc e} 
-   | BrgEntity e  -> {st with brgc = BrgO.count_entity C.start st.brgc e}
-   | BagEntity e  -> {st with bagc = BagO.count_entity C.start st.bagc e}
-   | _            -> st
-
-let export_entity si xdir moch = function
-   | CrgEntity e  -> X.export_entity DX.export_term si xdir e
-   | BrgEntity e  -> X.export_entity BrgO.export_term si xdir e
-   | MetaEntity e ->
-      begin match moch with
-         | None     -> ()
-         | Some och -> ML.write_entity C.start och e
-      end
-   | BagEntity _  -> ()
-
-let type_check st k =
-   let brg_err msg = brg_error "Type Error" msg; failwith "Interrupted" in
-   let ok _ _ = st in
-   match k with
-      | BrgEntity entity -> BrgU.type_check brg_err ok st.kst entity
-      | BagEntity entity -> BagU.type_check ok st.kst entity
-      | CrgEntity _
-      | MetaEntity _     -> st
-
-(* extended lexer ***********************************************************)
-
-type 'token lexer = {
-   parse : Lexing.lexbuf -> 'token;
-   mutable tokbuf: 'token option;
-   mutable unget : bool
-}
-
-let initial_lexer parse = {
-   parse = parse; tokbuf = None; unget = false
-}
-
-let token xl lexbuf = match xl.tokbuf with
-   | Some token when xl.unget ->   
-      xl.unget <- false; token
-   | _                        ->
-      let token = xl.parse lexbuf in
-      xl.tokbuf <- Some token; token
-
-(* input related ************************************************************)
-
-type input = Text | Automath
-
-type input_entity = TxtEntity of Txt.command
-                  | AutEntity of Aut.command
-                 | NoEntity
-
-let type_of_input name =
-   if F.check_suffix name ".hln" then Text 
-   else if F.check_suffix name ".aut" then 
-      let _ = H.set_sorts 0 ["Set"; "Prop"] in
-      assert (H.set_graph "Z2");
-      Automath
-   else begin
-      L.warn (P.sprintf "Unknown file type: %s" name); exit 2
-   end
-
-let txt_xl = initial_lexer TxtLexer.token 
-
-let aut_xl = initial_lexer AutLexer.token 
-
-let parbuf = ref [] (* parser buffer *)
-
-let gen_text command = 
-   parbuf := TxtEntity command :: !parbuf
-
-let entity_of_input lexbuf i = match i, !parbuf with
-   | Automath, _    -> 
-      begin match AutParser.entry (token aut_xl) lexbuf with
-         | Some e -> aut_xl.unget <- true; AutEntity e
-         | None   -> NoEntity
-      end     
-   | Text, []       -> 
-      begin match TxtParser.entry (token txt_xl) lexbuf with
-         | Some e -> txt_xl.unget <- true; TxtEntity e
-         | None   -> NoEntity
-      end
-   | Text, hd :: tl ->
-      parbuf := tl; hd
-
-let process_input f st = function 
-   | AutEntity e     ->
-      let f ast e = f {st with ast = ast} (AutEntity e) in
-      AP.process_command f st.ast e
-   | xe              -> f st xe
-
-let count_input st = function
-   | AutEntity e -> {st with ac = AO.count_command C.start st.ac e}
-   | xe          -> st
-
-(****************************************************************************)
-
-let stage = ref 3
-let moch = ref None
-let meta = ref false
-let progress = ref false
-let preprocess = ref false
-let root = ref ""
-let cc = ref false
-let export = ref ""
-let old = ref false
-let st = ref (initial_status ())
-let streaming = ref false (* parsing style (temporary) *)
-
-let process_2 st entity =
-   let st = if !L.level > 2 then count_entity st entity else st in
-   if !export <> "" then export_entity !O.si !export !moch entity;
-   if !stage > 2 then type_check st entity else st
-           
-let process_1 st entity = 
-   if !progress then pp_progress entity;
-   let st = if !L.level > 2 then count_entity st entity else st in
-   if !export <> "" && !stage = 1 then export_entity !O.si !export !moch entity;
-   if !stage > 1 then process_2 st (xlate_entity entity) else st 
-
-let process_0 st entity = 
-   let f st entity =
-      if !stage = 0 then st else
-      match entity, !old with
-        | AutEntity e, true  ->
-            let frr mst = {st with mst = mst} in
-            let h mst e = process_1 {st with mst = mst} (MetaEntity e) in
-           MA.meta_of_aut frr h st.mst e 
-         | AutEntity e, false -> 
-            let err dst = {st with dst = dst} in
-            let g dst e = process_1 {st with dst = dst} (CrgEntity e) in
-           DA.crg_of_aut err g st.dst e
-         | TxtEntity e, _     -> 
-            let crr tst = {st with tst = tst} in
-            let d tst e = process_1 {st with tst = tst} (CrgEntity e) in
-           DT.crg_of_txt crr d gen_text st.tst e
-        | NoEntity, _        -> assert false
-   in
-   let st = if !L.level > 2 then count_input st entity else st in 
-   if !preprocess then process_input f st entity else f st entity
-
-let process_nostreaming st lexbuf input =
-   let rec aux1 book = match entity_of_input lexbuf input with
-      | NoEntity -> List.rev book
-      | e        -> aux1 (e :: book)   
-   in
-   let rec aux2 st = function
-      | []           -> st
-      | entity :: tl -> aux2 (process_0 st entity) tl
-   in
-   aux2 st (aux1 [])
-
-let rec process_streaming st lexbuf input = match entity_of_input lexbuf input with
-   | NoEntity -> st
-   | e        -> process_streaming (process_0 st e) lexbuf input   
-
-(****************************************************************************)
-
-let process st name =
-   let process = if !streaming then process_streaming else process_nostreaming in
-   let input = type_of_input name in
-   let ich = open_in name in
-   let lexbuf = Lexing.from_channel ich in 
-   let st = process st lexbuf input in
-   close_in ich; st, input
-
-let main =
-try 
-   let version_string = "Helena 0.8.1 M - August 2010" in
-   let print_version () = L.warn (version_string ^ "\n"); exit 0 in
-   let set_hierarchy s = 
-      if H.set_graph s then () else 
-         L.warn (P.sprintf "Unknown type hierarchy: %s" s)
-   in
-   let set_kernel = function
-      | "brg" -> kernel := Brg
-      | "bag" -> kernel := Bag
-      | s     -> L.warn (P.sprintf "Unknown kernel version: %s" s)
-   in
-   let set_summary i = L.level := i in
-   let set_stage i = stage := i in
-   let set_meta_file name =
-      let f och = moch := Some och in
-      ML.open_out f name
-   in
-   let set_xdir s = export := s in
-   let set_root s = root := s in
-   let close = function
-      | None     -> ()
-      | Some och -> ML.close_out C.start och
-   in
-   let clear_options () =
-      stage := 3; moch := None; meta := false; progress := false;
-      preprocess := false; root := ""; cc := false; export := "";
-      old := false; kernel := Brg; st := initial_status ();
-      L.clear (); O.clear (); H.clear (); Op.clear_reductions ();
-      streaming := false;
-   in
-   let process_file name =
-      if !L.level > 0 then T.gmtime version_string;      
-      if !L.level > 1 then
-         L.warn (P.sprintf "Processing file: %s" name);
-      if !L.level > 0 then T.utime_stamp "started";
-      let base_name = Filename.chop_extension (Filename.basename name) in
-      if !meta then set_meta_file base_name;
-      let mk_uri =
-         if !stage < 2 then Crg.mk_uri else
-        match !kernel with
-           | Brg -> Brg.mk_uri
-           | Bag -> Bag.mk_uri
-      in
-      let cover = F.concat !root base_name in
-      O.mk_uri := mk_uri; O.cover := cover;
-      let sst, input = process (refresh_status !st) name in
-      st := sst;
-      if !L.level > 0 then T.utime_stamp "processed";
-      if !L.level > 2 then begin
-         AO.print_counters C.start !st.ac;
-         if !preprocess then AO.print_process_counters C.start !st.ast;
-         if !stage > 0 then MO.print_counters C.start !st.mc;
-         if !stage > 1 then print_counters !st;
-         if !stage > 2 then Op.print_reductions ()
-      end
-   in
-   let exit () =
-      close !moch;
-      if !L.level > 0 then T.utime_stamp "at exit";
-      flush_all ()
-   in
-   let help = 
-      "Usage: helena [ -LPVXcgijmopqu1 | -Ss <number> | -x <dir> | -hkr <string> ]* [ <file> ]*\n\n" ^
-      "Summary levels: 0 just errors (default), 1 time stamps, 2 processed file names, \
-       3 data information, 4 typing information, 5 reduction information\n\n" ^
-       "Stages: 0 parsing, 1 to intermediate, 2 to untrusted, 3 to trusted (default)\n"
-   in
-   let help_L = " show lexer debug information" in 
-   let help_P = " show parser debug information" in 
-   let help_S = "<number>  set summary level (see above)" in
-   let help_V = " show version information" in
-   let help_X = " clear options" in
-   
-   let help_c = " output conversion constraints" in
-   let help_g = " always expand global definitions" in
-   let help_h = "<string>  set type hierarchy (default: Z1)" in
-   let help_i = " show local references by index" in
-   let help_j = " show URI of processed kernel objects" in
-   let help_k = "<string>  set kernel version (default: brg)" in
-   let help_m = " output intermediate representation (HAL)" in
-   let help_o = " use old abstract language instead of crg" in   
-   let help_p = " preprocess source" in
-   let help_q = " disable quotation of identifiers" in
-   let help_r = "<string>  set initial segment of URI hierarchy" in
-   let help_s = "<number>  set translation stage (see above)" in
-   let help_u = " activate sort inclusion" in
-   let help_x = "<dir>  export kernel entities (XML) to <dir>" in
-   
-   let help_1 = " parse files with streaming policy" in
-   L.box 0; L.box_err ();
-   at_exit exit;
-   Arg.parse [
-      ("-L", Arg.Set O.debug_lexer, help_L); 
-      ("-P", Arg.Set O.debug_parser, help_P); 
-      ("-S", Arg.Int set_summary, help_S);
-      ("-V", Arg.Unit print_version, help_V);
-      ("-X", Arg.Unit clear_options, help_X);
-      ("-c", Arg.Set cc, help_c);
-      ("-g", Arg.Set O.expand, help_g);
-      ("-h", Arg.String set_hierarchy, help_h);
-      ("-i", Arg.Set O.indexes, help_i);
-      ("-j", Arg.Set progress, help_j);      
-      ("-k", Arg.String set_kernel, help_k);
-      ("-m", Arg.Set meta, help_m); 
-      ("-o", Arg.Set old, help_o);      
-      ("-p", Arg.Set preprocess, help_p);
-      ("-q", Arg.Set O.unquote, help_q);      
-      ("-r", Arg.String set_root, help_r);
-      ("-s", Arg.Int set_stage, help_s);
-      ("-u", Arg.Set O.si, help_u);
-      ("-x", Arg.String set_xdir, help_x);
-      ("-1", Arg.Set streaming, help_1);      
-   ] process_file help;
-with BagT.TypeError msg -> bag_error "Type Error" msg
diff --git a/helm/software/lambda-delta/src/Make b/helm/software/lambda-delta/src/Make
new file mode 100644 (file)
index 0000000..8e332c3
--- /dev/null
@@ -0,0 +1 @@
+lib common text automath basic_ag basic_rg complete_rg toplevel
diff --git a/helm/software/lambda-delta/src/automath/Make b/helm/software/lambda-delta/src/automath/Make
new file mode 100644 (file)
index 0000000..29d2378
--- /dev/null
@@ -0,0 +1 @@
+aut autProcess autOutput autParser autLexer
diff --git a/helm/software/lambda-delta/src/automath/Omega.aut b/helm/software/lambda-delta/src/automath/Omega.aut
new file mode 100644 (file)
index 0000000..2466a60
--- /dev/null
@@ -0,0 +1,10 @@
+# The lambda-term \Omega
+# This book is not accepted in AUT-QE because [y:'type'] is not allowed
+# This book is accepted in lambda-delta with sort inclusion but Omega is not
+#    valid if sort inclusion is allowed on the term backbone only
+# This book is valid in lambda-delta with unrestricted sort inclusion 
+
++l 
+@ Delta := [x:[y:'type']'type']<x>x : [x:[y:'type']'type']'type'
+  Omega := <Delta>Delta             : 'type'
+-l
diff --git a/helm/software/lambda-delta/src/automath/aut.ml b/helm/software/lambda-delta/src/automath/aut.ml
new file mode 100644 (file)
index 0000000..00213b4
--- /dev/null
@@ -0,0 +1,25 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type id = string (* identifier *)
+
+type qid = id * bool * id list (* qualified identifier: name, local?, path *)
+
+type term = Sort of bool              (* sorts: true = TYPE, false = PROP *)
+         | GRef of qid * term list   (* reference: name, arguments *)
+         | Appl of term * term       (* application: argument, function *)
+         | Abst of id * term * term  (* abstraction: name, domain, scope *)
+         
+type command = Section of (bool * id) option  (* section: Some true = open, Some false = reopen, None = close last *)
+            | Context of qid option          (* context: Some = last node, None = root *)
+            | Block of id * term             (* block opener: name, domain *)
+            | Decl of id * term              (* declaration: name, domain *)
+            | Def of id * term * bool * term (* definition: name, domain, transparent?, body *)
diff --git a/helm/software/lambda-delta/src/automath/autLexer.mll b/helm/software/lambda-delta/src/automath/autLexer.mll
new file mode 100644 (file)
index 0000000..cb33d0c
--- /dev/null
@@ -0,0 +1,90 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+{ 
+   module L = Log
+   module O = Options
+   module P = AutParser
+   
+   let out s = if !O.debug_lexer then L.warn s else ()
+
+(* This turns an Automath identifier into an XML nmtoken *)
+   let quote id =
+      let l = String.length id in
+      let rec aux i =
+         if i < l then begin
+            if id.[i] = '\'' || id.[i] = '`' then id.[i] <- '_';
+           aux (succ i)
+         end else
+           id
+      in
+      aux 0
+}
+
+let LC  = ['#' '%']
+let OC  = "{"
+let CC  = "}"
+let SPC = [' ' '\t' '\n']+
+let NL  = "\n"
+let ID  = ['0'-'9' 'A'-'Z' 'a'-'z' '_' '\'' '`']+
+
+rule line_comment = parse
+   | NL  { () }
+   | OC  { block_comment lexbuf; line_comment lexbuf }
+   | _   { line_comment lexbuf }
+   | eof { () } 
+and block_comment = parse
+   | CC  { () }
+   | OC  { block_comment lexbuf; block_comment lexbuf }
+   | LC  { line_comment lexbuf; block_comment lexbuf  }
+   | _   { block_comment lexbuf }
+and token = parse
+   | SPC      { token lexbuf } 
+   | LC       { line_comment lexbuf; token lexbuf  }
+   | OC       { block_comment lexbuf; token lexbuf }
+   | "_E"     { out "E"; P.E         }
+   | "'_E'"   { out "E"; P.E         }
+   | "---"    { out "EB"; P.EB       }
+   | "'eb'"   { out "EB"; P.EB       }
+   | "EB"     { out "EB"; P.EB       }
+   | "--"     { out "EXIT"; P.EXIT   }
+   | "PN"     { out "PN"; P.PN       }
+   | "'pn'"   { out "PN"; P.PN       }
+   | "PRIM"   { out "PN"; P.PN       }
+   | "'prim'" { out "PN"; P.PN       }
+   | "???"    { out "PN"; P.PN       }
+   | "PROP"   { out "PROP"; P.PROP   }
+   | "'prop'" { out "PROP"; P.PROP   }
+   | "TYPE"   { out "TYPE"; P.TYPE   }
+   | "'type'" { out "TYPE"; P.TYPE   }
+   | ID       { out "ID"; 
+                   let s = Lexing.lexeme lexbuf in
+                   if !O.unquote then P.IDENT s else P.IDENT (quote s)
+              }
+   | ":="     { out "DEF"; P.DEF     }
+   | "("      { out "OP"; P.OP       }
+   | ")"      { out "CP"; P.CP       }
+   | "["      { out "OB"; P.OB       }
+   | "]"      { out "CB"; P.CB       }
+   | "<"      { out "OA"; P.OA       }
+   | ">"      { out "CA"; P.CA       }
+   | "@"      { out "AT"; P.AT       }
+   | "~"      { out "TD"; P.TD       }
+   | "\""     { out "QT"; P.QT       }
+   | ":"      { out "CN"; P.CN       }   
+   | ","      { out "CM"; P.CM       }
+   | ";"      { out "SC"; P.SC       }
+   | "."      { out "FS"; P.FS       }   
+   | "+"      { out "PLUS"; P.PLUS   }
+   | "-"      { out "MINUS"; P.MINUS }
+   | "*"      { out "TIMES"; P.TIMES }
+   | "="      { out "DEF"; P.DEF     }
+   | eof      { out "EOF"; P.EOF     }
diff --git a/helm/software/lambda-delta/src/automath/autOutput.ml b/helm/software/lambda-delta/src/automath/autOutput.ml
new file mode 100644 (file)
index 0000000..d692005
--- /dev/null
@@ -0,0 +1,100 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module P = Printf
+module C = Cps
+module L = Log
+module A = Aut
+module R = AutProcess
+
+type counters = {
+   sections: int;
+   contexts: int;
+   blocks:   int;
+   decls:    int;
+   defs:     int;
+   sorts:    int;
+   grefs:    int;
+   appls:    int;
+   absts:    int;
+   pars:     int;
+   xnodes:   int
+}
+
+let initial_counters = {
+   sections = 0; contexts = 0; blocks = 0; decls = 0; defs = 0;
+   sorts = 0; grefs = 0; appls = 0; absts = 0; pars = 0; xnodes = 0
+}
+
+let rec count_term f c = function
+   | A.Sort _         -> 
+      f {c with sorts = succ c.sorts; xnodes = succ c.xnodes}
+   | A.GRef (_, ts)   -> 
+      let c = {c with grefs = succ c.grefs} in
+      let c = {c with pars = c.pars + List.length ts} in
+      let c = {c with xnodes = succ c.xnodes + List.length ts} in
+      C.list_fold_left f count_term c ts
+   | A.Appl (v, t)    -> 
+      let c = {c with appls = succ c.appls; xnodes = succ c.xnodes} in
+      let f c = count_term f c t in
+      count_term f c v
+   | A.Abst (_, w, t) -> 
+      let c = {c with absts = succ c.absts; xnodes = succ c.xnodes} in
+      let f c = count_term f c t in
+      count_term f c w
+
+let count_command f c = function
+   | A.Section _        ->
+      f {c with sections = succ c.sections}
+   | A.Context _        ->
+      f {c with contexts = succ c.contexts}
+   | A.Block (_, w)     -> 
+      let c = {c with blocks = succ c.blocks; xnodes = succ c.xnodes} in
+      count_term f c w
+   | A.Decl (_, w)      -> 
+      let c = {c with decls = succ c.decls; xnodes = succ c.xnodes} in
+      count_term f c w
+   | A.Def (_, w, _, t) -> 
+      let c = {c with defs = succ c.defs; xnodes = succ c.xnodes} in
+      let f c = count_term f c t in
+      count_term f c w
+
+let print_counters f c =
+   let terms = c.sorts + c.grefs + c.appls + c.absts in
+   let entities = c.sections + c.contexts + c.blocks + c.decls + c.defs in
+   L.warn (P.sprintf "  Automath representation summary");
+   L.warn (P.sprintf "    Total book entities:      %7u" entities);
+   L.warn (P.sprintf "      Section entities:       %7u" c.sections);
+   L.warn (P.sprintf "      Context entities:       %7u" c.contexts);
+   L.warn (P.sprintf "      Block entities:         %7u" c.blocks);
+   L.warn (P.sprintf "      Declaration entities:   %7u" c.decls);
+   L.warn (P.sprintf "      Definition entities:    %7u" c.defs);
+   L.warn (P.sprintf "    Total Parameter items:    %7u" c.pars);
+   L.warn (P.sprintf "      Application items:      %7u" c.pars);
+   L.warn (P.sprintf "    Total term items:         %7u" terms);
+   L.warn (P.sprintf "      Sort items:             %7u" c.sorts);
+   L.warn (P.sprintf "      Reference items:        %7u" c.grefs);
+   L.warn (P.sprintf "      Application items:      %7u" c.appls);
+   L.warn (P.sprintf "      Abstraction items:      %7u" c.absts);
+   L.warn (P.sprintf "    Global Int. Complexity:   unknown");
+   L.warn (P.sprintf "      + Abbreviation nodes:   %7u" c.xnodes);
+   f ()
+
+let print_process_counters f c =
+   let f iao iar iac iag =
+      L.warn (P.sprintf "  Automath process summary");
+      L.warn (P.sprintf "    Implicit after opening:   %7u" iao);
+      L.warn (P.sprintf "    Implicit after reopening: %7u" iar);
+      L.warn (P.sprintf "    Implicit after closing:   %7u" iac);
+      L.warn (P.sprintf "    Implicit after global:    %7u" iag);
+      f ()
+   in
+   R.get_counters f c
diff --git a/helm/software/lambda-delta/src/automath/autOutput.mli b/helm/software/lambda-delta/src/automath/autOutput.mli
new file mode 100644 (file)
index 0000000..1a5f561
--- /dev/null
@@ -0,0 +1,20 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type counters
+
+val initial_counters: counters
+
+val count_command: (counters -> 'a) -> counters -> Aut.command -> 'a
+
+val print_counters: (unit -> 'a) -> counters -> 'a
+
+val print_process_counters: (unit -> 'a) -> AutProcess.status -> 'a
diff --git a/helm/software/lambda-delta/src/automath/autParser.mly b/helm/software/lambda-delta/src/automath/autParser.mly
new file mode 100644 (file)
index 0000000..e90ba3b
--- /dev/null
@@ -0,0 +1,100 @@
+/* Copyright (C) 2000, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ */
+
+%{
+   module O = Options
+   module A = Aut
+
+   let _ = Parsing.set_trace !O.debug_parser
+%}
+   %token <int> NUM
+   %token <string> IDENT
+   %token EOF MINUS PLUS TIMES AT FS CN CM SC QT TD OP CP OB CB OA CA
+   %token TYPE PROP DEF EB E PN EXIT
+    
+   %start entry
+   %type <Aut.command option> entry   
+%%
+   path: MINUS {} | FS {} ;
+   oftype: CN {} | CM {} ;
+   star: TIMES {} | AT {} ;
+   sc: E {} | SC {} | CN {} ;
+   eof: SC {} | EOF {} ;
+
+   expand:
+      |    { true  }
+      | TD { false }
+   ;
+   local:
+      |      { false }
+      | path { true  }
+   ;
+
+   idents:
+      | IDENT             { [$1]     }
+      | IDENT path idents { $1 :: $3 }
+   ;
+   qid:
+      | IDENT                    { ($1, true, [])  }
+      | IDENT QT QT              { ($1, true, [])  }
+      | IDENT QT local idents QT { ($1, $3, $4)    }
+   ;
+   term:
+      | TYPE                         { A.Sort true         }
+      | PROP                         { A.Sort false        }
+      | qid                          { A.GRef ($1, [])     }
+      | qid OP CP                    { A.GRef ($1, [])     }
+      | qid OP terms CP              { A.GRef ($1, $3)     } 
+      | OA term CA term              { A.Appl ($2, $4)     }
+      | OB IDENT oftype term CB term { A.Abst ($2, $4, $6) } 
+   ;
+   terms:
+      | term          { [$1]     }
+      | term CM terms { $1 :: $3 }
+   ;
+   
+   start:
+      | PLUS {} | MINUS {} | EXIT {} | eof {}
+      | star {} | IDENT {} | OB {} 
+   ; 
+   entity:
+      | PLUS IDENT                    { A.Section (Some (true, $2))  }
+      | PLUS TIMES IDENT              { A.Section (Some (false, $3)) }
+      | MINUS IDENT                   { A.Section None               }
+      | EXIT                          { A.Section None               }
+      | star                          { A.Context None               }
+      | qid star                      { A.Context (Some $1)          }
+      | IDENT DEF EB sc term          { A.Block ($1, $5)             }
+      | IDENT sc term DEF EB          { A.Block ($1, $3)             }
+      | OB IDENT oftype term CB       { A.Block ($2, $4)             }
+      | IDENT DEF PN sc term          { A.Decl ($1, $5)              }
+      | IDENT sc term DEF PN          { A.Decl ($1, $3)              }
+      | IDENT DEF expand term sc term { A.Def ($1, $6, $3, $4)       }
+      | IDENT sc term DEF expand term { A.Def ($1, $3, $5, $6)       }
+   ;
+   entry:
+      | entity start { Some $1 }
+      | eof          { None    }
+   ;
diff --git a/helm/software/lambda-delta/src/automath/autProcess.ml b/helm/software/lambda-delta/src/automath/autProcess.ml
new file mode 100644 (file)
index 0000000..405952f
--- /dev/null
@@ -0,0 +1,77 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module A = Aut
+
+type status = {
+   opening  : bool; (* just opened section *)
+   reopening: bool; (* just reopened section *)
+   closing  : bool; (* just closed section *)
+   explicit : bool; (* just found explicit context *)
+   block    : bool; (* just found block opener *)
+   iao      : int;  (* implicit context after opening section *)
+   iar      : int;  (* implicit context after reopening section *)
+   iac      : int;  (* implicit context after closing section *)
+   iag      : int   (* implicit context after global statement *)
+}
+
+(* internal functions *******************************************************)
+
+let orc_reset f st =
+   f {st with opening = false; reopening = false; closing = false}
+
+let orc_count f st =
+   let st = if st.opening then {st with iao = succ st.iao} else st in
+   let st = if st.reopening then {st with iar = succ st.iar} else st in
+   let st = if st.closing then {st with iac = succ st.iac} else st in
+   f st
+
+let exp_count f st =
+   let st = 
+      if st.explicit || st.block then st else {st with iag = succ st.iag} 
+   in
+   f st
+
+let proc_section f st = function
+   | Some (true, _)  -> f {st with opening = true} 
+   | Some (false, _) -> f {st with reopening = true} 
+   | None            -> f {st with closing = true}
+
+let proc_context f st =
+   orc_reset f {st with explicit = true}
+
+let proc_block f st =
+   orc_count (orc_reset f) {st with explicit = false; block = true}
+
+let proc_global f st =
+   let f st = 
+      orc_count (orc_reset f) {st with explicit = false; block = false}
+   in
+   exp_count f st
+
+let proc_command f st command = match command with
+   | A.Section section -> proc_section f st section command
+   | A.Context _       -> proc_context f st command  
+   | A.Block _         -> proc_block f st command
+   | A.Decl _          -> proc_global f st command
+   | A.Def _           -> proc_global f st command
+   
+(* interface functions ******************************************************)
+
+let initial_status () = {
+   opening = false; reopening = false; closing = false; 
+   explicit = false; block = false;
+   iao = 0; iar = 0; iac = 0; iag = 0
+}
+
+let process_command = proc_command
+
+let get_counters f st = f st.iao st.iar st.iac st.iag
diff --git a/helm/software/lambda-delta/src/automath/autProcess.mli b/helm/software/lambda-delta/src/automath/autProcess.mli
new file mode 100644 (file)
index 0000000..4145ff9
--- /dev/null
@@ -0,0 +1,19 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type status
+
+val initial_status: unit -> status
+
+val process_command: 
+   (status -> Aut.command -> 'a) -> status -> Aut.command -> 'a
+
+val get_counters: (int -> int -> int -> int -> 'a) -> status -> 'a
diff --git a/helm/software/lambda-delta/src/basic_ag/Make b/helm/software/lambda-delta/src/basic_ag/Make
new file mode 100644 (file)
index 0000000..1d2286b
--- /dev/null
@@ -0,0 +1,2 @@
+bag bagOutput 
+bagEnvironment bagSubstitution bagReduction bagType bagUntrusted
diff --git a/helm/software/lambda-delta/src/basic_ag/bag.ml b/helm/software/lambda-delta/src/basic_ag/bag.ml
new file mode 100644 (file)
index 0000000..1aa9b62
--- /dev/null
@@ -0,0 +1,93 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+(* kernel version: basic, absolute, global *)
+(* note          : experimental *) 
+
+type uri = Entity.uri
+type id = Entity.id
+
+type bind = Void         (* exclusion *)
+          | Abst of term (* abstraction *)
+          | Abbr of term (* abbreviation *)
+
+and term = Sort of int                    (* hierarchy index *)
+         | LRef of int                    (* location *)
+         | GRef of uri                    (* reference *)
+         | Cast of term * term            (* domain, element *)
+         | Appl of term * term            (* argument, function *)
+         | Bind of int * id * bind * term (* location, name, binder, scope *)
+
+type entity = term Entity.entity (* attrs, uri, binder *)
+
+type lenv = (int * id * bind) list (* location, name, binder *) 
+
+type message = (lenv, term) Log.item list
+
+(* helpers ******************************************************************)
+
+let mk_uri si root s =
+   let kernel = if si then "bag-si" else "bag" in
+   String.concat "/" ["ld:"; kernel; root; s ^ ".ld"]
+
+(* Currified constructors ***************************************************)
+
+let abst w = Abst w
+
+let abbr v = Abbr v
+
+let lref i = LRef i
+
+let cast u t = Cast (u, t)
+
+let appl u t = Appl (u, t)
+
+let bind l id b t = Bind (l, id, b, t)
+
+let bind_abst l id u t = Bind (l, id, Abst u, t)
+
+let bind_abbr l id v t = Bind (l, id, Abbr v, t)
+
+(* location handling functions **********************************************)
+
+let location = ref 0
+
+let new_location () = let loc = !location in incr location; loc
+
+let locations () = !location
+
+(* local environment handling functions *************************************)
+
+let empty_lenv = []
+
+let push msg f es l id b =
+   let rec does_not_occur loc = function
+      | []                          -> true
+      | (l, _, _) :: _ when l = loc -> false
+      | _ :: es                     -> does_not_occur l es
+   in
+   if not (does_not_occur l es) then failwith msg else
+   let c = (l, id, b) :: es in f c
+
+let append f es1 es2 = 
+   f (List.append es2 es1)
+
+let map f map es =
+   Cps.list_map f map es
+
+let contents f es = f es
+
+let get f es i =
+   let rec aux = function
+      | []               -> f None
+      | (l, id, b) :: tl -> if l = i then f (Some (id, b)) else aux tl
+   in
+   aux es
diff --git a/helm/software/lambda-delta/src/basic_ag/bagEnvironment.ml b/helm/software/lambda-delta/src/basic_ag/bagEnvironment.ml
new file mode 100644 (file)
index 0000000..04681cf
--- /dev/null
@@ -0,0 +1,39 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module U = NUri
+module L = Log
+module H = U.UriHash
+module Y = Entity
+module B = Bag
+
+exception ObjectNotFound of B.message
+
+let hsize = 7000 
+let env = H.create hsize
+
+(* Internal functions *******************************************************)
+
+let get_age = 
+   let age = ref 0 in
+   fun () -> incr age; !age
+
+let error uri = raise (ObjectNotFound (L.items1 (U.string_of_uri uri)))
+
+(* Interface functions ******************************************************)
+
+let set_entity f (a, uri, b) =
+   let age = get_age () in
+   let entry = (Y.Apix age :: a), uri, b in
+   H.add env uri entry; f entry
+
+let get_entity f uri =
+   try f (H.find env uri) with Not_found -> error uri
diff --git a/helm/software/lambda-delta/src/basic_ag/bagEnvironment.mli b/helm/software/lambda-delta/src/basic_ag/bagEnvironment.mli
new file mode 100644 (file)
index 0000000..4a44c05
--- /dev/null
@@ -0,0 +1,16 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+exception ObjectNotFound of Bag.message
+
+val set_entity: (Bag.entity -> 'a) -> Bag.entity -> 'a
+
+val get_entity: (Bag.entity -> 'a) -> Bag.uri -> 'a
diff --git a/helm/software/lambda-delta/src/basic_ag/bagOutput.ml b/helm/software/lambda-delta/src/basic_ag/bagOutput.ml
new file mode 100644 (file)
index 0000000..0bfc13e
--- /dev/null
@@ -0,0 +1,145 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module P = Printf
+module F = Format
+module U = NUri
+module L = Log
+module O = Options
+module Y = Entity
+module H = Hierarchy
+module B = Bag
+
+type counters = {
+   eabsts: int;
+   eabbrs: int;
+   tsorts: int;
+   tlrefs: int;
+   tgrefs: int;
+   tcasts: int;
+   tappls: int;
+   tabsts: int;
+   tabbrs: int
+}
+
+let initial_counters = {
+   eabsts = 0; eabbrs = 0; tsorts = 0; tlrefs = 0; tgrefs = 0;
+   tcasts = 0; tappls = 0; tabsts = 0; tabbrs = 0
+}
+
+let rec count_term_binder f c = function
+   | B.Abst w ->
+      let c = {c with tabsts = succ c.tabsts} in
+      count_term f c w
+   | B.Abbr v -> 
+      let c = {c with tabbrs = succ c.tabbrs} in
+      count_term f c v
+   | B.Void   -> f c
+
+and count_term f c = function
+   | B.Sort _            -> 
+      f {c with tsorts = succ c.tsorts}
+   | B.LRef _            -> 
+      f {c with tlrefs = succ c.tlrefs}
+   | B.GRef _            -> 
+      f {c with tgrefs = succ c.tgrefs}
+   | B.Cast (v, t)       -> 
+      let c = {c with tcasts = succ c.tcasts} in
+      let f c = count_term f c t in
+      count_term f c v
+   | B.Appl (v, t)       -> 
+      let c = {c with tappls = succ c.tappls} in
+      let f c = count_term f c t in
+      count_term f c v
+   | B.Bind (_, _, b, t) -> 
+      let f c = count_term_binder f c b in
+      count_term f c t
+
+let count_entity f c = function
+   | _, _, Y.Abst w -> 
+      let c = {c with eabsts = succ c.eabsts} in
+      count_term f c w
+   | _, _, Y.Abbr v -> 
+      let c = {c with eabbrs = succ c.eabbrs} in
+      count_term f c v
+   | _, _, Y.Void   -> assert false
+
+let print_counters f c =
+   let terms =
+      c.tsorts + c.tgrefs + c.tgrefs + c.tcasts + c.tappls + c.tabsts +
+      c.tabbrs
+   in
+   let items = c.eabsts + c.eabbrs in
+   let locations = B.locations () in
+   L.warn (P.sprintf "  Kernel representation summary (basic_ag)");
+   L.warn (P.sprintf "    Total entry items:        %7u" items);
+   L.warn (P.sprintf "      Declaration items:      %7u" c.eabsts);
+   L.warn (P.sprintf "      Definition items:       %7u" c.eabbrs);
+   L.warn (P.sprintf "    Total term items:         %7u" terms);
+   L.warn (P.sprintf "      Sort items:             %7u" c.tsorts);
+   L.warn (P.sprintf "      Local reference items:  %7u" c.tlrefs);
+   L.warn (P.sprintf "      Global reference items: %7u" c.tgrefs);
+   L.warn (P.sprintf "      Explicit Cast items:    %7u" c.tcasts);
+   L.warn (P.sprintf "      Application items:      %7u" c.tappls);
+   L.warn (P.sprintf "      Abstraction items:      %7u" c.tabsts);
+   L.warn (P.sprintf "      Abbreviation items:     %7u" c.tabbrs);
+   L.warn (P.sprintf "    Total binder locations:   %7u" locations);   
+   f ()
+
+let res l id =
+   if !O.indexes then P.sprintf "#%u" l else id
+
+let rec pp_term c frm = function
+   | B.Sort h                 -> 
+      let err () = F.fprintf frm "@[*%u@]" h in
+      let f s = F.fprintf frm "@[%s@]" s in
+      H.string_of_sort err f h 
+   | B.LRef i                 -> 
+      let f = function
+         | Some (id, _) -> F.fprintf frm "@[%s@]" id
+         | None         -> F.fprintf frm "@[#%u@]" i
+      in
+      if !O.indexes then f None else B.get f c i
+   | B.GRef s                    -> F.fprintf frm "@[$%s@]" (U.string_of_uri s)
+   | B.Cast (u, t)               ->
+      F.fprintf frm "@[{%a}.%a@]" (pp_term c) u (pp_term c) t
+   | B.Appl (v, t)               ->
+      F.fprintf frm "@[(%a).%a@]" (pp_term c) v (pp_term c) t
+   | B.Bind (l, id, B.Abst w, t) ->
+      let f cc =
+         F.fprintf frm "@[[%s:%a].%a@]" (res l id) (pp_term c) w (pp_term cc) t
+      in
+      B.push "output abst" f c l id (B.Abst w)
+   | B.Bind (l, id, B.Abbr v, t) ->
+      let f cc = 
+         F.fprintf frm "@[[%s=%a].%a@]" (res l id) (pp_term c) v (pp_term cc) t
+      in
+      B.push "output abbr" f c l id (B.Abbr v)
+   | B.Bind (l, id, B.Void, t)   ->
+      let f cc = F.fprintf frm "@[[%s].%a@]" (res l id) (pp_term cc) t in
+      B.push "output void" f c l id B.Void
+
+let pp_lenv frm c =
+   let pp_entry frm = function
+      | l, id, B.Abst w -> 
+         F.fprintf frm "@,@[%s : %a@]" (res l id) (pp_term c) w
+      | l, id, B.Abbr v -> 
+         F.fprintf frm "@,@[%s = %a@]" (res l id) (pp_term c) v
+      | l, id, B.Void   -> 
+         F.fprintf frm "@,%s" (res l id)
+   in
+   let iter map frm l = List.iter (map frm) l in
+   let f es = F.fprintf frm "%a" (iter pp_entry) (List.rev es) in
+   B.contents f c
+
+let specs = {
+   L.pp_term = pp_term; L.pp_lenv = pp_lenv
+}
diff --git a/helm/software/lambda-delta/src/basic_ag/bagOutput.mli b/helm/software/lambda-delta/src/basic_ag/bagOutput.mli
new file mode 100644 (file)
index 0000000..daa07a6
--- /dev/null
@@ -0,0 +1,20 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type counters
+
+val initial_counters: counters
+
+val count_entity: (counters -> 'a) -> counters -> Bag.entity -> 'a
+
+val print_counters: (unit -> 'a) -> counters -> 'a
+
+val specs: (Bag.lenv, Bag.term) Log.specs
diff --git a/helm/software/lambda-delta/src/basic_ag/bagReduction.ml b/helm/software/lambda-delta/src/basic_ag/bagReduction.ml
new file mode 100644 (file)
index 0000000..b7eb88f
--- /dev/null
@@ -0,0 +1,196 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module U = NUri
+module C = Cps
+module L = Log
+module Y = Entity
+module B = Bag
+module O = BagOutput
+module E = BagEnvironment
+module S = BagSubstitution
+
+type machine = {
+   i: int;
+   c: B.lenv;
+   s: B.term list
+}
+
+type whd_result =
+   | Sort_ of int
+   | LRef_ of int * B.term option
+   | GRef_ of B.entity
+   | Bind_ of int * B.id * B.term * B.term
+
+type ho_whd_result =
+   | Sort of int
+   | Abst of B.term
+
+(* Internal functions *******************************************************)
+
+let term_of_whdr = function
+   | Sort_ h             -> B.Sort h
+   | LRef_ (i, _)        -> B.LRef i
+   | GRef_ (_, uri, _)   -> B.GRef uri
+   | Bind_ (l, id, w, t) -> B.bind_abst l id w t
+
+let level = 5
+
+let log1 s c t =
+   let sc, st = s ^ " in the environment", "the term" in
+   L.log O.specs level (L.et_items1 sc c st t)
+
+let log2 s cu u ct t =
+   let s1, s2, s3 = s ^ " in the environment", "the term", "and in the environment" in
+   L.log O.specs level (L.et_items2 s1 cu s2 u ~sc2:s3 ~c2:ct s2 t)
+
+let empty_machine = {i = 0; c = B.empty_lenv; s = []}
+
+let inc m = {m with i = succ m.i}
+
+let unwind_to_term f m t =
+   let map f t (l, id, b) = f (B.Bind (l, id, b, t)) in
+   let f mc = C.list_fold_left f map t mc in
+   B.contents f m.c
+
+let unwind_stack f m =
+   let map f v = unwind_to_term f m v in
+   C.list_map f map m.s
+
+let get f c m i =
+   let f = function
+      | Some (_, b) -> f b
+      | None        -> assert false
+   in
+   let f c = B.get f c i in
+   B.append f c m.c
+
+let push msg f c m l id w = 
+   assert (m.s = []);
+   let f w = B.push msg f c l id (B.Abst w) in
+   unwind_to_term f m w
+
+(* to share *)
+let rec whd f c m x = 
+(*   L.warn "entering R.whd"; *)
+   match x with
+   | B.Sort h                    -> f m (Sort_ h)
+   | B.GRef uri                  ->
+      let f entry = f m (GRef_ entry) in
+      E.get_entity f uri
+   | B.LRef i                    ->
+      let f = function
+         | B.Void   -> f m (LRef_ (i, None))
+        | B.Abst t -> f m (LRef_ (i, Some t))
+        | B.Abbr t -> whd f c m t
+      in
+      get f c m i
+   | B.Cast (_, t)               -> whd f c m t
+   | B.Appl (v, t)               -> whd f c {m with s = v :: m.s} t   
+   | B.Bind (l, id, B.Abst w, t) -> 
+      begin match m.s with
+         | []      -> f m (Bind_ (l, id, w, t))
+        | v :: tl -> 
+            let nl = B.new_location () in
+           let f mc = S.subst (whd f c {m with c = mc; s = tl}) nl l t in
+           B.push "!" f m.c nl id (B.Abbr (B.Cast (w, v)))
+      end
+   | B.Bind (l, id, b, t)         -> 
+      let nl = B.new_location () in
+      let f mc = S.subst (whd f c {m with c = mc}) nl l t in
+      B.push "!" f m.c nl id b
+
+(* Interface functions ******************************************************)
+
+let rec ho_whd f c m x =
+(*   L.warn "entering R.ho_whd"; *)
+   let aux m = function
+      | Sort_ h                -> f (Sort h)
+      | Bind_ (_, _, w, _)     -> 
+         let f w = f (Abst w) in unwind_to_term f m w
+      | LRef_ (_, Some w)      -> ho_whd f c m w
+      | GRef_ (_, _, Y.Abst w) -> ho_whd f c m w  
+      | GRef_ (_, _, Y.Abbr v) -> ho_whd f c m v
+      | LRef_ (_, None)        -> assert false
+      | GRef_ (_, _, Y.Void)   -> assert false
+   in
+   whd aux c m x
+   
+let ho_whd f c t =
+   let f r = L.unbox level; f r in
+   L.box level; log1 "Now scanning" c t;
+   ho_whd f c empty_machine t
+
+let rec are_convertible f ~si a c m1 t1 m2 t2 =
+(*   L.warn "entering R.are_convertible"; *)
+   let rec aux m1 r1 m2 r2 =
+(*   L.warn "entering R.are_convertible_aux"; *)
+   let u, t = term_of_whdr r1, term_of_whdr r2 in
+   log2 "Now really converting" c u c t;   
+   match r1, r2 with
+      | Sort_ h1, Sort_ h2                                 ->
+         if h1 = h2 then f a else f false 
+      | LRef_ (i1, _), LRef_ (i2, _)                       ->
+         if i1 = i2 then are_convertible_stacks f ~si a c m1 m2 else f false
+      | GRef_ ((Y.Apix a1 :: _), _, Y.Abst _), 
+        GRef_ ((Y.Apix a2 :: _), _, Y.Abst _)              ->
+         if a1 = a2 then are_convertible_stacks f ~si a c m1 m2 else f false
+      | GRef_ ((Y.Apix a1 :: _), _, Y.Abbr v1), 
+        GRef_ ((Y.Apix a2 :: _), _, Y.Abbr v2)             ->
+         if a1 = a2 then
+           let f a = 
+              if a then f a else are_convertible f ~si true c m1 v1 m2 v2
+           in
+           are_convertible_stacks f ~si a c m1 m2
+        else
+        if a1 < a2 then whd (aux m1 r1) c m2 v2 else
+        whd (aux_rev m2 r2) c m1 v1
+      | _, GRef_ (_, _, Y.Abbr v2)                         ->
+         whd (aux m1 r1) c m2 v2
+      | GRef_ (_, _, Y.Abbr v1), _                         ->
+        whd (aux_rev m2 r2) c m1 v1      
+      | Bind_ (l1, id1, w1, t1), Bind_ (l2, id2, w2, t2)   ->
+          let l = B.new_location () in
+          let h c =
+             let m1, m2 = inc m1, inc m2 in
+             let f t1 = S.subst (are_convertible f ~si a c m1 t1 m2) l l2 t2 in
+             S.subst f l l1 t1
+        in
+         let f r = if r then push "!" h c m1 l id1 w1 else f false in
+        are_convertible f ~si a c m1 w1 m2 w2
+(* we detect the AUT-QE reduction rule for type/prop inclusion *)      
+      | Sort_ _, Bind_ (l2, id2, w2, t2) when si           ->
+        let m1, m2 = inc m1, inc m2 in
+        let f c = are_convertible f ~si a c m1 (term_of_whdr r1) m2 t2 in
+        push "nsi" f c m2 l2 id2 w2
+      | _                                                  -> f false
+   and aux_rev m2 r2 m1 r1 = aux m1 r1 m2 r2 in
+   let g m1 r1 = whd (aux m1 r1) c m2 t2 in 
+   if a = false then f false else whd g c m1 t1
+
+and are_convertible_stacks f ~si a c m1 m2 =
+(*   L.warn "entering R.are_convertible_stacks"; *)
+   let mm1, mm2 = {m1 with s = []}, {m2 with s = []} in
+   let map f a v1 v2 = are_convertible f ~si a c mm1 v1 mm2 v2 in
+   if List.length m1.s <> List.length m2.s then 
+      begin 
+(*         L.warn (Printf.sprintf "Different lengths: %u %u"
+           (List.length m1.s) (List.length m2.s) 
+        ); *)
+        f false
+      end
+   else
+      C.list_fold_left2 f map a m1.s m2.s
+
+let are_convertible f ?(si=false) c u t = 
+   let f b = L.unbox level; f b in
+   L.box level; log2 "Now converting" c u c t;
+   are_convertible f ~si true c empty_machine u empty_machine t
diff --git a/helm/software/lambda-delta/src/basic_ag/bagReduction.mli b/helm/software/lambda-delta/src/basic_ag/bagReduction.mli
new file mode 100644 (file)
index 0000000..8f32faa
--- /dev/null
@@ -0,0 +1,20 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type ho_whd_result =
+   | Sort of int
+   | Abst of Bag.term
+
+val ho_whd: 
+   (ho_whd_result -> 'a) -> Bag.lenv -> Bag.term -> 'a
+
+val are_convertible:
+   (bool -> 'a) -> ?si:bool -> Bag.lenv -> Bag.term -> Bag.term -> 'a
diff --git a/helm/software/lambda-delta/src/basic_ag/bagSubstitution.ml b/helm/software/lambda-delta/src/basic_ag/bagSubstitution.ml
new file mode 100644 (file)
index 0000000..ad75d63
--- /dev/null
@@ -0,0 +1,48 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module S = Share
+module B = Bag
+
+(* Internal functions *******************************************************)
+
+let rec lref_map_bind f map b = match b with
+   | B.Abbr v ->
+      let f v' = f (S.sh1 v v' b B.abbr) in
+      lref_map f map v      
+   | B.Abst w ->
+      let f w' = f (S.sh1 w w' b B.abst) in
+      lref_map f map w
+   | B.Void   -> f b
+
+and lref_map f map t = match t with
+   | B.LRef i            -> 
+      let ii = map i in f (S.sh1 i ii t B.lref)
+   | B.GRef _            -> f t
+   | B.Sort _            -> f t
+   | B.Cast (w, u)       ->
+      let f w' u' = f (S.sh2 w w' u u' t B.cast) in
+      let f w' = lref_map (f w') map u in 
+      lref_map f map w
+   | B.Appl (w, u)       ->
+      let f w' u' = f (S.sh2 w w' u u' t B.appl) in
+      let f w' = lref_map (f w') map u in 
+      lref_map f map w
+   | B.Bind (l, id, b, u) ->
+      let f b' u' = f (S.sh2 b b' u u' t (B.bind l id)) in
+      let f b' = lref_map (f b') map u in 
+      lref_map_bind f map b
+
+(* Interface functions ******************************************************)
+
+let subst f new_l old_l t =
+   let map i = if i = old_l then new_l else i in
+   if new_l = old_l then f t else lref_map f map t
diff --git a/helm/software/lambda-delta/src/basic_ag/bagSubstitution.mli b/helm/software/lambda-delta/src/basic_ag/bagSubstitution.mli
new file mode 100644 (file)
index 0000000..b48c056
--- /dev/null
@@ -0,0 +1,12 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+val subst: (Bag.term -> 'a) -> int -> int -> Bag.term -> 'a
diff --git a/helm/software/lambda-delta/src/basic_ag/bagType.ml b/helm/software/lambda-delta/src/basic_ag/bagType.ml
new file mode 100644 (file)
index 0000000..bb4ee83
--- /dev/null
@@ -0,0 +1,127 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module U = NUri
+module C = Cps
+module S = Share
+module L = Log
+module Y = Entity
+module H = Hierarchy
+module B = Bag
+module O = BagOutput
+module E = BagEnvironment
+module R = BagReduction
+
+exception TypeError of B.message
+
+(* Internal functions *******************************************************)
+
+let level = 4
+
+let log1 s c t =
+   let sc, st = s ^ " in the envireonment", "the term" in
+   L.log O.specs level (L.et_items1 sc c st t)
+
+let error1 st c t =
+   let sc = "In the envireonment" in
+   raise (TypeError (L.et_items1 sc c st t))
+
+let error3 c t1 t2 t3 =
+   let sc, st1, st2, st3 = 
+      "In the envireonment", "the term", "is of type", "but must be of type"
+   in
+   raise (TypeError (L.et_items3 sc c st1 t1 st2 t2 st3 t3))
+
+let mk_gref u l =
+   let map t v = B.Appl (v, t) in
+   List.fold_left map (B.GRef u) l
+
+(* Interface functions ******************************************************)
+
+let rec b_type_of f st c x = 
+(*   L.warn "Entering T.b_type_of"; *)
+   log1 "Now checking" c x;
+   match x with
+   | B.Sort h                    ->
+      let h = H.apply h in f x (B.Sort h) 
+   | B.LRef i                    ->
+      let f = function
+         | Some (_, B.Abst w)               -> f x w
+        | Some (_, B.Abbr (B.Cast (w, v))) -> f x w
+        | Some (_, B.Abbr _)               -> assert false
+        | Some (_, B.Void)                 -> 
+           error1 "reference to excluded variable" c x
+         | None                             ->
+           error1 "variable not found" c x      
+      in
+      B.get f c i
+   | B.GRef uri                  ->
+      let f = function
+         | _, _, Y.Abst w               -> f x w
+        | _, _, Y.Abbr (B.Cast (w, v)) -> f x w
+        | _, _, Y.Abbr _               -> assert false
+        | _, _, Y.Void                 -> assert false
+      in
+      E.get_entity f uri   
+   | B.Bind (l, id, B.Abbr v, t) ->
+      let f xv xt tt =
+         f (S.sh2 v xv t xt x (B.bind_abbr l id)) (B.bind_abbr l id xv tt)
+      in
+      let f xv cc = b_type_of (f xv) st cc t in
+      let f xv = B.push "type abbr" (f xv) c l id (B.Abbr xv) in
+      let f xv vv = match xv with 
+        | B.Cast _ -> f xv
+         | _        -> f (B.Cast (vv, xv))
+      in
+      type_of f st c v
+   | B.Bind (l, id, B.Abst u, t) ->
+      let f xu xt tt =
+        f (S.sh2 u xu t xt x (B.bind_abst l id)) (B.bind_abst l id xu tt)
+      in
+      let f xu cc = b_type_of (f xu) st cc t in
+      let f xu _ = B.push "type abst" (f xu) c l id (B.Abst xu) in
+      type_of f st c u
+   | B.Bind (l, id, B.Void, t)   ->
+      let f xt tt = 
+         f (S.sh1 t xt x (B.bind l id B.Void)) (B.bind l id B.Void tt)
+      in
+      let f cc = b_type_of f st cc t in
+      B.push "type void" f c l id B.Void   
+   | B.Appl (v, t)            ->
+      let f xv vv xt tt = function
+        | R.Abst w                             -> 
+            L.box (succ level);
+           L.log O.specs (succ level) (L.t_items1 "Just scanned" c w);
+           L.unbox (succ level);
+           let f a =                
+(*            L.warn (Printf.sprintf "Convertible: %b" a); *)
+              if a then f (S.sh2 v xv t xt x B.appl) (B.appl xv tt)
+              else error3 c xv vv w
+           in
+           R.are_convertible f ~si:st.Y.si c w vv
+        | _                                    -> 
+           error1 "not a function" c xt
+      in
+      let f xv vv xt tt = R.ho_whd (f xv vv xt tt) c tt in
+      let f xv vv = b_type_of (f xv vv) st c t in
+      type_of f st c v
+   | B.Cast (u, t)            ->
+      let f xu xt tt a =  
+         (* L.warn (Printf.sprintf "Convertible: %b" a); *)
+        if a then f (S.sh2 u xu t xt x B.cast) xu else error3 c xt tt xu
+      in
+      let f xu xt tt = R.are_convertible (f xu xt tt) ~si:st.Y.si c xu tt in
+      let f xu _ = b_type_of (f xu) st c t in
+      type_of f st c u
+
+and type_of f st c x =
+   let f t u = L.unbox level; f t u in
+   L.box level; b_type_of f st c x
diff --git a/helm/software/lambda-delta/src/basic_ag/bagType.mli b/helm/software/lambda-delta/src/basic_ag/bagType.mli
new file mode 100644 (file)
index 0000000..31a421b
--- /dev/null
@@ -0,0 +1,16 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+exception TypeError of Bag.message
+
+val type_of: 
+   (Bag.term -> Bag.term -> 'a) ->
+   Entity.status -> Bag.lenv -> Bag.term -> 'a
diff --git a/helm/software/lambda-delta/src/basic_ag/bagUntrusted.ml b/helm/software/lambda-delta/src/basic_ag/bagUntrusted.ml
new file mode 100644 (file)
index 0000000..33d6a5f
--- /dev/null
@@ -0,0 +1,29 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module U = NUri
+module L = Log
+module Y = Entity
+module B = Bag
+module E = BagEnvironment
+module T = BagType
+
+(* Interface functions ******************************************************)
+
+(* to share *)
+let type_check f st = function
+   | a, uri, Y.Abst t ->
+      let f xt tt = E.set_entity (f tt) (a, uri, Y.Abst xt) in
+      L.loc := U.string_of_uri uri; T.type_of f st B.empty_lenv t
+   | a, uri, Y.Abbr t ->
+      let f xt tt = E.set_entity (f tt) (a, uri, Y.Abbr xt) in
+      L.loc := U.string_of_uri uri; T.type_of f st B.empty_lenv t
+   | _, _, Y.Void     -> assert false
diff --git a/helm/software/lambda-delta/src/basic_ag/bagUntrusted.mli b/helm/software/lambda-delta/src/basic_ag/bagUntrusted.mli
new file mode 100644 (file)
index 0000000..af96740
--- /dev/null
@@ -0,0 +1,13 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+val type_check:
+   (Bag.term -> Bag.entity -> 'a) -> Entity.status -> Bag.entity -> 'a
diff --git a/helm/software/lambda-delta/src/basic_rg/Make b/helm/software/lambda-delta/src/basic_rg/Make
new file mode 100644 (file)
index 0000000..ee53ca2
--- /dev/null
@@ -0,0 +1,2 @@
+brg brgOutput
+brgEnvironment brgSubstitution brgReduction brgType brgUntrusted
diff --git a/helm/software/lambda-delta/src/basic_rg/brg.ml b/helm/software/lambda-delta/src/basic_rg/brg.ml
new file mode 100644 (file)
index 0000000..efc5d75
--- /dev/null
@@ -0,0 +1,83 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+(* kernel version: basic, relative, global *)
+(* note          : ufficial basic lambda-delta *) 
+
+type uri = Entity.uri
+type id = Entity.id
+type attrs = Entity.attrs
+
+type bind = Void         (*      *)
+          | Abst of term (* type *)
+          | Abbr of term (* body *)
+
+and term = Sort of attrs * int         (* attrs, hierarchy index *)
+         | LRef of attrs * int         (* attrs, position index *)
+         | GRef of attrs * uri         (* attrs, reference *)
+         | Cast of attrs * term * term (* attrs, type, term *)
+         | Appl of attrs * term * term (* attrs, argument, function *)
+         | Bind of attrs * bind * term (* attrs, binder, scope *)
+
+type entity = term Entity.entity (* attrs, uri, binder *)
+
+type lenv = Null
+(* Cons: tail, relative local environment, attrs, binder *) 
+          | Cons of lenv * lenv * attrs * bind 
+
+(* helpers ******************************************************************)
+
+let mk_uri si root s =
+   let kernel = if si then "brg-si" else "brg" in
+   String.concat "/" ["ld:"; kernel; root; s ^ ".ld"]
+
+(* Currified constructors ***************************************************)
+
+let abst w = Abst w
+
+let abbr v = Abbr v
+
+let lref a i = LRef (a, i)
+
+let cast a u t = Cast (a, u, t)
+
+let appl a u t = Appl (a, u, t)
+
+let bind a b t = Bind (a, b, t)
+
+let bind_abst a u t = Bind (a, Abst u, t)
+
+let bind_abbr a v t = Bind (a, Abbr v, t)
+
+let bind_void a t = Bind (a, Void, t)
+
+(* local environment handling functions *************************************)
+
+let empty = Null
+
+let push e c a b = Cons (e, c, a, b)
+
+let rec get i = function
+   | Null                         -> Null, Null, [], Void
+   | Cons (e, c, a, b) when i = 0 -> e, c, a, b
+   | Cons (e, _, _, _)            -> get (pred i) e
+
+let get e i = get i e
+
+(* used in BrgOutput.pp_lenv *)
+let rec fold_right f map e x = match e with   
+   | Null              -> f x
+   | Cons (e, c, a, b) -> fold_right (map f e c a b) map e x
+
+(* used in MetaBrg.unwind_to_xlate_term *)
+let rec fold_left map x = function
+   | Null              -> x
+   | Cons (e, _, a, b) -> fold_left map (map x a b) e
diff --git a/helm/software/lambda-delta/src/basic_rg/brgEnvironment.ml b/helm/software/lambda-delta/src/basic_rg/brgEnvironment.ml
new file mode 100644 (file)
index 0000000..121da88
--- /dev/null
@@ -0,0 +1,35 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module U = NUri
+module H = U.UriHash
+module Y = Entity
+module B = Brg
+
+let hsize = 7000 
+let env = H.create hsize
+
+(* Internal functions *******************************************************)
+
+let get_age = 
+   let age = ref 0 in
+   fun () -> incr age; !age
+
+(* Interface functions ******************************************************)
+
+(* decps *)
+let set_entity (a, uri, b) =
+   let age = get_age () in
+   let entity = (Y.Apix age :: a), uri, b in
+   H.add env uri entity; entity
+
+let get_entity uri =
+   try H.find env uri with Not_found -> [], uri, Y.Void
diff --git a/helm/software/lambda-delta/src/basic_rg/brgEnvironment.mli b/helm/software/lambda-delta/src/basic_rg/brgEnvironment.mli
new file mode 100644 (file)
index 0000000..1f51f1e
--- /dev/null
@@ -0,0 +1,14 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+val set_entity: Brg.entity -> Brg.entity
+
+val get_entity: Brg.uri -> Brg.entity
diff --git a/helm/software/lambda-delta/src/basic_rg/brgOutput.ml b/helm/software/lambda-delta/src/basic_rg/brgOutput.ml
new file mode 100644 (file)
index 0000000..186349a
--- /dev/null
@@ -0,0 +1,258 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module P = Printf
+module F = Format
+module C = Cps
+module U = NUri
+module L = Log
+module O = Options
+module Y = Entity
+module X = Library
+module H = Hierarchy
+module B = Brg
+
+(* nodes count **************************************************************)
+
+type counters = {
+   eabsts: int;
+   eabbrs: int;
+   evoids: int;
+   tsorts: int;
+   tlrefs: int;
+   tgrefs: int;
+   tcasts: int;
+   tappls: int;
+   tabsts: int;
+   tabbrs: int;
+   tvoids: int;
+   uris  : B.uri list;
+   nodes : int;
+   xnodes: int
+}
+
+let initial_counters = {
+   eabsts = 0; eabbrs = 0; evoids = 0; 
+   tsorts = 0; tlrefs = 0; tgrefs = 0; tcasts = 0; tappls = 0;
+   tabsts = 0; tabbrs = 0; tvoids = 0;
+   uris = []; nodes = 0; xnodes = 0
+}
+
+let rec count_term_binder f c e = function
+   | B.Abst w ->
+      let c = {c with tabsts = succ c.tabsts; nodes = succ c.nodes} in
+      count_term f c e w
+   | B.Abbr v -> 
+      let c = {c with tabbrs = succ c.tabbrs; xnodes = succ c.xnodes} in
+      count_term f c e v
+   | B.Void   ->
+      let c = {c with tvoids = succ c.tvoids; xnodes = succ c.xnodes} in   
+      f c
+
+and count_term f c e = function
+   | B.Sort _         -> 
+      f {c with tsorts = succ c.tsorts; nodes = succ c.nodes}
+   | B.LRef (_, i)    -> 
+      begin match B.get e i with
+        | _, _, _, B.Abst _
+        | _, _, _, B.Void   ->
+           f {c with tlrefs = succ c.tlrefs; nodes = succ c.nodes}
+        | _, _, _, B.Abbr _ ->
+           f {c with tlrefs = succ c.tlrefs; xnodes = succ c.xnodes}
+      end      
+   | B.GRef (_, u)    -> 
+      let c =    
+        if Cps.list_mem ~eq:U.eq u c.uris
+        then {c with nodes = succ c.nodes}
+        else {c with xnodes = succ c.xnodes}
+      in
+      f {c with tgrefs = succ c.tgrefs}
+   | B.Cast (_, v, t) -> 
+      let c = {c with tcasts = succ c.tcasts} in
+      let f c = count_term f c e t in
+      count_term f c e v
+   | B.Appl (_, v, t) -> 
+      let c = {c with tappls = succ c.tappls; nodes = succ c.nodes} in
+      let f c = count_term f c e t in
+      count_term f c e v
+   | B.Bind (a, b, t) -> 
+      let f c = count_term f c (B.push e B.empty a b) t in
+      count_term_binder f c e b
+
+let count_entity f c = function
+   | _, u, Y.Abst w -> 
+      let c = {c with
+         eabsts = succ c.eabsts; nodes = succ c.nodes; uris = u :: c.uris
+      } in
+      count_term f c B.empty w
+   | _, _, Y.Abbr v ->  
+      let c = {c with eabbrs = succ c.eabbrs; xnodes = succ c.xnodes} in
+      count_term f c B.empty v
+   | _, _, Y.Void   -> assert false
+
+let print_counters f c =
+   let terms =
+      c.tsorts + c.tgrefs + c.tgrefs + c.tcasts + c.tappls + c.tabsts +
+      c.tabbrs
+   in
+   let items = c.eabsts + c.eabbrs in
+   let nodes = c.nodes + c.xnodes in
+   L.warn (P.sprintf "  Kernel representation summary (basic_rg)");
+   L.warn (P.sprintf "    Total entry items:        %7u" items);
+   L.warn (P.sprintf "      Declaration items:      %7u" c.eabsts);
+   L.warn (P.sprintf "      Definition items:       %7u" c.eabbrs);
+   L.warn (P.sprintf "    Total term items:         %7u" terms);
+   L.warn (P.sprintf "      Sort items:             %7u" c.tsorts);
+   L.warn (P.sprintf "      Local reference items:  %7u" c.tlrefs);
+   L.warn (P.sprintf "      Global reference items: %7u" c.tgrefs);
+   L.warn (P.sprintf "      Explicit Cast items:    %7u" c.tcasts);
+   L.warn (P.sprintf "      Application items:      %7u" c.tappls);
+   L.warn (P.sprintf "      Abstraction items:      %7u" c.tabsts);
+   L.warn (P.sprintf "      Abbreviation items:     %7u" c.tabbrs);
+   L.warn (P.sprintf "    Global Int. Complexity:   %7u" c.nodes);
+   L.warn (P.sprintf "      + Abbreviation nodes:   %7u" nodes);
+   f ()
+
+(* supplementary annotation *************************************************)
+
+let rec does_not_occur f n r = function
+   | B.Null              -> f true
+   | B.Cons (e, _, a, _) ->
+      let f n1 r1 =
+         if n1 = n && r1 = r then f false else does_not_occur f n r e
+      in
+      Y.name C.err f a 
+
+let rename f e a =
+   let rec aux f e n r =
+      let f = function
+         | true  -> f n r
+        | false -> aux f e (n ^ "_") r
+      in
+      does_not_occur f n r e
+   in
+   let f n0 r0 =
+      let f n r = if n = n0 && r = r0 then f a else f (Y.Name (n, r) :: a) in
+      aux f e n0 r0 
+   in
+   Y.name C.err f a
+
+(* lenv/term pretty printing ************************************************)
+
+let name err frm a =
+   let f n = function 
+      | true  -> F.fprintf frm "%s" n
+      | false -> F.fprintf frm "^%s" n
+   in      
+   Y.name err f a
+
+let rec pp_term e frm = function
+   | B.Sort (_, h)           -> 
+      let err _ = F.fprintf frm "@[*%u@]" h in
+      let f s = F.fprintf frm "@[%s@]" s in
+      H.string_of_sort err f h 
+   | B.LRef (_, i)           -> 
+      let err _ = F.fprintf frm "@[#%u@]" i in
+      if !O.indexes then err () else      
+      let _, _, a, b = B.get e i in
+      F.fprintf frm "@[%a@]" (name err) a
+   | B.GRef (_, s)           ->
+      F.fprintf frm "@[$%s@]" (U.string_of_uri s)
+   | B.Cast (_, u, t)        ->
+      F.fprintf frm "@[{%a}.%a@]" (pp_term e) u (pp_term e) t
+   | B.Appl (_, v, t)        ->
+      F.fprintf frm "@[(%a).%a@]" (pp_term e) v (pp_term e) t
+   | B.Bind (a, B.Abst w, t) ->
+      let f a =
+         let ee = B.push e B.empty a (B.abst w) in
+        F.fprintf frm "@[[%a:%a].%a@]" (name C.err) a (pp_term e) w (pp_term ee) t
+      in
+      rename f e a
+   | B.Bind (a, B.Abbr v, t) ->
+      let f a = 
+         let ee = B.push e B.empty a (B.abbr v) in
+        F.fprintf frm "@[[%a=%a].%a@]" (name C.err) a (pp_term e) v (pp_term ee) t
+      in
+      rename f e a
+   | B.Bind (a, B.Void, t)   ->
+      let f a = 
+         let ee = B.push e B.empty a B.Void in
+         F.fprintf frm "@[[%a].%a@]" (name C.err) a (pp_term ee) t
+      in
+      rename f e a
+
+let pp_lenv frm e =
+   let pp_entry f e c a b x = f x (*match b with
+      | B.Abst (a, w) -> 
+         let f a = F.fprintf frm "@,@[%a : %a@]" (name C.err) a (pp_term e) w; f a in
+         rename f x a
+      | B.Abbr (a, v) -> 
+         let f a = F.fprintf frm "@,@[%a = %a@]" (name C.err) a (pp_term e) v; f a in
+        rename f c a
+      | B.Void a      -> 
+         let f a = F.fprintf frm "@,%a" (name C.err) a; f a in
+        rename f c a
+*)   in
+   B.fold_right ignore pp_entry e B.empty
+
+let specs = {
+   L.pp_term = pp_term; L.pp_lenv = pp_lenv
+}
+
+(* term xml printing ********************************************************)
+
+let rec exp_term e t out tab = match t with
+   | B.Sort (a, l)    ->
+      let a =
+         let err _ = a in
+         let f s = Y.Name (s, true) :: a in
+        H.string_of_sort err f l
+      in
+      let attrs = [X.position l; X.name a] in
+      X.tag X.sort attrs out tab
+   | B.LRef (a, i)    ->
+      let a = 
+        let err _ = a in
+        let f n r = Y.Name (n, r) :: a in
+         let _, _, a, b = B.get e i in
+        Y.name err f a
+      in
+      let attrs = [X.position i; X.name a] in
+      X.tag X.lref attrs out tab
+   | B.GRef (a, n)    ->
+      let a = Y.Name (U.name_of_uri n, true) :: a in
+      let attrs = [X.uri n; X.name a] in
+      X.tag X.gref attrs out tab
+   | B.Cast (a, u, t) ->
+      let attrs = [] in
+      X.tag X.cast attrs ~contents:(exp_term e u) out tab;
+      exp_term e t out tab
+   | B.Appl (a, v, t) ->
+      let attrs = [] in
+      X.tag X.appl attrs ~contents:(exp_term e v) out tab;
+      exp_term e t out tab
+   | B.Bind (a, b, t)    ->
+      let a = rename C.start e a in
+      exp_bind e a b out tab; 
+      exp_term (B.push e B.empty a b) t out tab 
+
+and exp_bind e a b out tab = match b with
+   | B.Abst w ->
+      let attrs = [X.name a; X.mark a] in
+      X.tag X.abst attrs ~contents:(exp_term e w) out tab
+   | B.Abbr v ->
+      let attrs = [X.name a; X.mark a] in
+      X.tag X.abbr attrs ~contents:(exp_term e v) out tab
+   | B.Void   ->
+      let attrs = [X.name a; X.mark a] in
+      X.tag X.void attrs out tab
+
+let export_term = exp_term B.empty
diff --git a/helm/software/lambda-delta/src/basic_rg/brgOutput.mli b/helm/software/lambda-delta/src/basic_rg/brgOutput.mli
new file mode 100644 (file)
index 0000000..772f43c
--- /dev/null
@@ -0,0 +1,25 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type counters
+
+val initial_counters: counters
+
+val count_entity: (counters -> 'a) -> counters -> Brg.entity -> 'a
+
+val print_counters: (unit -> 'a) -> counters -> 'a
+
+val specs: (Brg.lenv, Brg.term) Log.specs
+
+val export_term: Brg.term -> Library.pp
+(*
+val export_term: Format.formatter -> Brg.term -> unit
+*)
diff --git a/helm/software/lambda-delta/src/basic_rg/brgReduction.ml b/helm/software/lambda-delta/src/basic_rg/brgReduction.ml
new file mode 100644 (file)
index 0000000..03ed05b
--- /dev/null
@@ -0,0 +1,210 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module U = NUri
+module C = Cps
+module S = Share
+module L = Log
+module Y = Entity
+module P = Output
+module B = Brg
+module O = BrgOutput
+module E = BrgEnvironment
+
+type kam = {
+   e: B.lenv;                 (* environment *)
+   s: (B.lenv * B.term) list; (* stack       *)
+   d: int                     (* depth       *)
+}
+
+(* Internal functions *******************************************************)
+
+let level = 5
+
+let log1 s c t =
+   let sc, st = s ^ " in the environment", "the term" in
+   L.log O.specs level (L.et_items1 sc c st t)
+
+let log2 s cu u ct t =
+   let s1, s2, s3 = s ^ " in the environment", "the term", "and in the environment" in
+   L.log O.specs level (L.et_items2 s1 cu s2 u ~sc2:s3 ~c2:ct s2 t)
+
+let rec list_and map = function
+   | hd1 :: tl1, hd2 :: tl2 ->
+      if map hd1 hd2 then list_and map (tl1, tl2) else false
+   | l1, l2                 -> l1 = l2
+
+(* check closure *)
+let are_alpha_convertible err f t1 t2 =
+   let rec aux f = function
+      | B.Sort (_, p1), B.Sort (_, p2)
+      | B.LRef (_, p1), B.LRef (_, p2)         ->
+         if p1 = p2 then f () else err ()
+      | B.GRef (_, u1), B.GRef (_, u2)         ->
+         if U.eq u1 u2 then f () else err ()
+      | B.Cast (_, v1, t1), B.Cast (_, v2, t2)         
+      | B.Appl (_, v1, t1), B.Appl (_, v2, t2) ->
+         let f _ = aux f (t1, t2) in
+        aux f (v1, v2)
+      | B.Bind (_, b1, t1), B.Bind (_, b2, t2) ->
+         let f _ = aux f (t1, t2) in
+        aux_bind f (b1, b2)
+      | _                                      -> err ()
+   and aux_bind f = function
+      | B.Abbr v1, B.Abbr v2
+      | B.Abst v1, B.Abst v2                   -> aux f (v1, v2)
+      | B.Void, B.Void                         -> f ()
+      | _                                      -> err ()
+   in
+   if S.eq t1 t2 then f () else aux f (t1, t2)
+
+let get m i =
+   let _, c, a, b = B.get m.e i in c, a, b
+
+(* to share *)
+let rec step st m x = 
+(*   L.warn "entering R.step"; *)
+   match x with
+   | B.Sort _                -> m, None, x
+   | B.GRef (_, uri)         ->
+      begin match E.get_entity uri with
+         | _, _, Y.Abbr v when st.Y.delta ->
+           P.add ~gdelta:1 (); step st m v
+         | _, _, Y.Abst w when st.Y.rt    ->
+            P.add ~grt:1 (); step st m w        
+        | a, _, Y.Abbr v                 ->
+           let e = Y.apix C.err C.start a in
+           m, Some (e, a, B.Abbr v), x   
+        | a, _, Y.Abst w                 ->
+           let e = Y.apix C.err C.start a in
+           m, Some (e, a, B.Abst w), x
+        | _, _, Y.Void                   -> assert false
+      end
+   | B.LRef (_, i)           ->
+      begin match get m i with
+        | c, _, B.Abbr v              ->
+           P.add ~ldelta:1 ();
+           step st {m with e = c} v
+        | c, _, B.Abst w when st.Y.rt ->
+            P.add ~lrt:1 ();
+            step st {m with e = c} w
+        | c, _, B.Void                ->
+           assert false
+        | c, a, (B.Abst _ as b)       ->
+           let e = Y.apix C.err C.start a in
+           {m with e = c}, Some (e, a, b), x
+      end
+   | B.Cast (_, _, t)        ->
+      P.add ~tau:1 ();
+      step st m t
+   | B.Appl (_, v, t)        ->
+      step st {m with s = (m.e, v) :: m.s} t   
+   | B.Bind (a, B.Abst w, t) ->
+      begin match m.s with
+         | []          -> m, None, x
+        | (c, v) :: s ->
+            P.add ~beta:1 ~upsilon:(List.length s) ();
+           let e = B.push m.e c a (B.abbr v) (* (B.Cast ([], w, v)) *) in 
+           step st {m with e = e; s = s} t
+      end
+   | B.Bind (a, b, t)        ->
+      P.add ~upsilon:(List.length m.s) ();
+      let e = B.push m.e m.e a b in 
+      step st {m with e = e} t
+
+let push m a b = 
+   assert (m.s = []);
+   let a, d = match b with
+      | B.Abst _ -> Y.Apix m.d :: a, succ m.d
+      | b        -> a, m.d
+   in
+   let e = B.push m.e m.e a b in
+   {m with e = e; d = d}
+
+let rec ac_nfs st (m1, r1, u) (m2, r2, t) =
+   log2 "Now converting nfs" m1.e u m2.e t;
+   match r1, u, r2, t with
+      | _, B.Sort (_, h1), _, B.Sort (_, h2)                   ->
+         h1 = h2  
+      | Some (e1, _, B.Abst _), _, Some (e2, _, B.Abst _), _   ->
+        if e1 = e2 then ac_stacks st m1 m2 else false
+      | Some (e1, _, B.Abbr v1), _, Some (e2, _, B.Abbr v2), _ ->
+         if e1 = e2 then
+           if ac_stacks st m1 m2 then true else begin
+              P.add ~gdelta:2 (); ac st m1 v1 m2 v2
+           end
+        else if e1 < e2 then begin 
+            P.add ~gdelta:1 ();
+           ac_nfs st (m1, r1, u) (step st m2 v2)
+        end else begin
+           P.add ~gdelta:1 ();
+           ac_nfs st (step st m1 v1) (m2, r2, t) 
+         end
+      | _, _, Some (_, _, B.Abbr v2), _                        ->
+         P.add ~gdelta:1 ();
+        ac_nfs st (m1, r1, u) (step st m2 v2)      
+      | Some (_, _, B.Abbr v1), _, _, _                        ->
+         P.add ~gdelta:1 ();
+        ac_nfs st (step st m1 v1) (m2, r2, t)             
+      | _, B.Bind (a1, (B.Abst w1 as b1), t1), 
+        _, B.Bind (a2, (B.Abst w2 as b2), t2)                  ->
+        if ac {st with Y.si = false} m1 w1 m2 w2 then
+           ac st (push m1 a1 b1) t1 (push m2 a2 b2) t2
+        else false
+      | _, B.Sort _, _, B.Bind (a, b, t) when st.Y.si          ->
+        P.add ~si:1 ();
+        ac st (push m1 a b) u (push m2 a b) t
+      | _                                                      -> false
+
+and ac st m1 t1 m2 t2 =
+(*   L.warn "entering R.are_convertible"; *)
+   ac_nfs st (step st m1 t1) (step st m2 t2)
+
+and ac_stacks st m1 m2 =
+(*   L.warn "entering R.are_convertible_stacks"; *)
+   if List.length m1.s <> List.length m2.s then false else
+   let map (c1, v1) (c2, v2) =
+      let m1, m2 = {m1 with e = c1; s = []}, {m2 with e = c2; s = []} in
+      ac {st with Y.si = false} m1 v1 m2 v2
+   in
+   list_and map (m1.s, m2.s)
+
+(* Interface functions ******************************************************)
+
+let empty_kam = { 
+   e = B.empty; s = []; d = 0
+}
+
+let get m i =
+   assert (m.s = []);
+   let _, _, _, b = B.get m.e i in b
+
+let xwhd st m t =
+   L.box level; log1 "Now scanning" m.e t;   
+   let m, _, t = step {st with Y.delta = true; Y.rt = true} m t in
+   L.unbox level; m, t
+
+let are_convertible st mu u mw w = 
+   L.box level; log2 "Now converting" mu.e u mw.e w;
+   let r = ac {st with Y.delta = st.Y.expand; Y.rt = false} mu u mw w in   
+   L.unbox level; r
+(*    let err _ = in 
+      if S.eq mu mw then are_alpha_convertible err f u w else err () *)
+
+(* error reporting **********************************************************)
+
+let pp_term m frm t = O.specs.L.pp_term m.e frm t
+
+let pp_lenv frm m = O.specs.L.pp_lenv frm m.e
+
+let specs = {
+   L.pp_term = pp_term; L.pp_lenv = pp_lenv
+}
diff --git a/helm/software/lambda-delta/src/basic_rg/brgReduction.mli b/helm/software/lambda-delta/src/basic_rg/brgReduction.mli
new file mode 100644 (file)
index 0000000..eebb157
--- /dev/null
@@ -0,0 +1,26 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type kam
+
+val empty_kam: kam
+
+val get: kam -> int -> Brg.bind
+
+val push: kam -> Entity.attrs -> Brg.bind -> kam
+
+val xwhd: Entity.status -> kam -> Brg.term -> kam * Brg.term 
+
+(* arguments: expected type, inferred type *) 
+val are_convertible: 
+   Entity.status -> kam -> Brg.term -> kam -> Brg.term -> bool
+
+val specs: (kam, Brg.term) Log.specs
diff --git a/helm/software/lambda-delta/src/basic_rg/brgSubstitution.ml b/helm/software/lambda-delta/src/basic_rg/brgSubstitution.ml
new file mode 100644 (file)
index 0000000..5c9d91a
--- /dev/null
@@ -0,0 +1,46 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module B = Brg
+(* module O = Output *)
+
+let rec icm a = function
+   | B.Sort _
+   | B.LRef _
+   | B.GRef _                -> succ a
+   | B.Bind (_, B.Void, t)   -> icm (succ a) t
+   | B.Cast (_, u, t)        -> icm (icm a u) t
+   | B.Appl (_, u, t)
+   | B.Bind (_, B.Abst u, t)
+   | B.Bind (_, B.Abbr u, t) -> icm (icm (succ a) u) t
+
+let iter map d =
+   let rec iter_bind d = function
+      | B.Void   -> B.Void
+      | B.Abst w -> B.Abst (iter_term d w)
+      | B.Abbr v -> B.Abbr (iter_term d v)
+   and iter_term d = function
+      | B.Sort _ as t      -> t
+      | B.GRef _ as t      -> t
+      | B.LRef (a, i) as t -> if i < d then t else map d a i
+      | B.Cast (a, w, v)   -> B.Cast (a, iter_term d w, iter_term d v)
+      | B.Appl (a, w, u)   -> B.Appl (a, iter_term d w, iter_term d u)
+      | B.Bind (a, b, u)   -> B.Bind (a, iter_bind d b, iter_term (succ d) u)
+   in
+   iter_term d
+
+let lift_map h _ a i =
+   if i + h >= 0 then B.LRef (a, i + h) else assert false
+
+let lift h d t =
+   if h = 0 then t else begin
+(*      O.icm := succ (* icm *) !O.icm (*t*); *) iter (lift_map h) d t
+   end
diff --git a/helm/software/lambda-delta/src/basic_rg/brgSubstitution.mli b/helm/software/lambda-delta/src/basic_rg/brgSubstitution.mli
new file mode 100644 (file)
index 0000000..a171766
--- /dev/null
@@ -0,0 +1,15 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+val lift: int -> int -> Brg.term -> Brg.term
+(*
+val lift_bind: (Brg.bind -> 'a) -> int -> int -> Brg.bind -> 'a
+*)
diff --git a/helm/software/lambda-delta/src/basic_rg/brgType.ml b/helm/software/lambda-delta/src/basic_rg/brgType.ml
new file mode 100644 (file)
index 0000000..8b119e5
--- /dev/null
@@ -0,0 +1,131 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module U = NUri
+module C = Cps
+module A = Share
+module L = Log
+module H = Hierarchy
+module Y = Entity
+module B = Brg
+module O = BrgOutput
+module E = BrgEnvironment
+module S = BrgSubstitution
+module R = BrgReduction
+
+type message = (R.kam, B.term) Log.message
+
+(* Internal functions *******************************************************)
+
+let level = 4
+
+let message1 st1 m t1 =
+   L.et_items1 "In the environment" m st1 t1
+
+let log1 s m t =
+   let s =  s ^ " the term" in
+   L.log R.specs level (message1 s m t) 
+
+let error1 err s m t =
+   err (message1 s m t)
+
+let message3 m t1 t2 ?mu t3 =    
+   let sm, st1, st2 = "In the environment", "the term", "is of type" in
+   match mu with
+      | Some mu ->
+         let smu, st3 = "but in the environment", "it must be of type" in
+         L.et_items3 sm m st1 t1 st2 t2 ~sc3:smu ~c3:mu st3 t3
+      | None    ->
+         let st3 = "but it must be of type" in
+         L.et_items3 sm m st1 t1 st2 t2 st3 t3
+   
+let error3 err m t1 t2 ?mu t3 =
+   err (message3 m t1 t2 ?mu t3)
+
+let assert_convertibility err f st m u w v =
+   if R.are_convertible st m u m w then f () else
+   error3 err m v w u
+
+let assert_applicability err f st m u w v =
+   match R.xwhd st m u with 
+      | _, B.Sort _                 -> error1 err "not a function type" m u
+      | mu, B.Bind (_, B.Abst u, _) -> 
+         if R.are_convertible st mu u m w then f () else
+        error3 err m v w ~mu u
+      | _                         -> assert false (**)
+
+let rec b_type_of err f st m x =
+   log1 "Now checking" m x;
+   match x with
+   | B.Sort (a, h)           ->
+      let h = H.apply h in f x (B.Sort (a, h)) 
+   | B.LRef (_, i)           ->
+      begin match R.get m i with
+         | B.Abst w                  ->
+           f x (S.lift (succ i) (0) w)
+        | B.Abbr (B.Cast (_, w, _)) -> 
+           f x (S.lift (succ i) (0) w)
+        | B.Abbr _                  -> assert false
+        | B.Void                    -> 
+           error1 err "reference to excluded variable" m x
+      end
+   | B.GRef (_, uri)         ->
+      begin match E.get_entity uri with
+         | _, _, Y.Abst w                  -> f x w
+        | _, _, Y.Abbr (B.Cast (_, w, _)) -> f x w
+        | _, _, Y.Abbr _                  -> assert false
+        | _, _, Y.Void                    ->
+            error1 err "reference to unknown entry" m x
+      end
+   | B.Bind (a, B.Abbr v, t) ->
+      let f xv xt tt =
+         f (A.sh2 v xv t xt x (B.bind_abbr a)) (B.bind_abbr a xv tt)
+      in
+      let f xv m = b_type_of err (f xv) st m t in
+      let f xv = f xv (R.push m a (B.abbr xv)) in
+      let f xv vv = match xv with 
+        | B.Cast _ -> f xv
+         | _        -> f (B.Cast ([], vv, xv))
+      in
+      type_of err f st m v
+   | B.Bind (a, B.Abst u, t) ->
+      let f xu xt tt =
+        f (A.sh2 u xu t xt x (B.bind_abst a)) (B.bind_abst a xu tt)
+      in
+      let f xu m = b_type_of err (f xu) st m t in
+      let f xu _ = f xu (R.push m a (B.abst xu)) in
+      type_of err f st m u
+   | B.Bind (a, B.Void, t)   ->
+      let f xt tt = 
+         f (A.sh1 t xt x (B.bind_void a)) (B.bind_void a tt)
+      in
+      b_type_of err f st (R.push m a B.Void) t
+         
+   | B.Appl (a, v, t)        ->
+      let f xv vv xt tt = 
+         let f _ = f (A.sh2 v xv t xt x (B.appl a)) (B.appl a xv tt) in
+         assert_applicability err f st m tt vv xv
+      in
+      let f xv vv = b_type_of err (f xv vv) st m t in
+      type_of err f st m v
+   | B.Cast (a, u, t)        ->
+      let f xu xt tt =  
+        let f _ = f (A.sh2 u xu t xt x (B.cast a)) xu in
+         assert_convertibility err f st m xu tt xt
+      in
+      let f xu _ = b_type_of err (f xu) st m t in
+      type_of err f st m u
+
+(* Interface functions ******************************************************)
+
+and type_of err f st m x =
+   let f t u = L.unbox level; f t u in
+   L.box level; b_type_of err f st m x
diff --git a/helm/software/lambda-delta/src/basic_rg/brgType.mli b/helm/software/lambda-delta/src/basic_rg/brgType.mli
new file mode 100644 (file)
index 0000000..5d9350b
--- /dev/null
@@ -0,0 +1,16 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type message = (BrgReduction.kam, Brg.term) Log.message
+
+val type_of: 
+   (message -> 'a) -> (Brg.term -> Brg.term -> 'a) -> 
+   Entity.status -> BrgReduction.kam -> Brg.term -> 'a
diff --git a/helm/software/lambda-delta/src/basic_rg/brgUntrusted.ml b/helm/software/lambda-delta/src/basic_rg/brgUntrusted.ml
new file mode 100644 (file)
index 0000000..4c1ae61
--- /dev/null
@@ -0,0 +1,38 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module U = NUri
+module L = Log
+module Y = Entity
+module B = Brg
+module E = BrgEnvironment
+module R = BrgReduction
+module T = BrgType
+
+(* Interface functions ******************************************************)
+
+(* to share *)
+let type_check err f st = function
+   | a, uri, Y.Abst t ->
+      let f xt tt = 
+         let e = E.set_entity (a, uri, Y.Abst xt) in f tt e
+      in
+      L.loc := U.string_of_uri uri; T.type_of err f st R.empty_kam t
+   | a, uri, Y.Abbr t ->
+      let f xt tt = 
+         let xt = match xt with
+           | B.Cast _ -> xt
+           | _        -> B.Cast ([], tt, xt)
+        in
+         let e = E.set_entity (a, uri, Y.Abbr xt) in f tt e
+      in
+      L.loc := U.string_of_uri uri; T.type_of err f st R.empty_kam t
+   | _, _, Y.Void     -> assert false
diff --git a/helm/software/lambda-delta/src/basic_rg/brgUntrusted.mli b/helm/software/lambda-delta/src/basic_rg/brgUntrusted.mli
new file mode 100644 (file)
index 0000000..d395eb5
--- /dev/null
@@ -0,0 +1,14 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+val type_check:
+   (BrgType.message -> 'a) -> (Brg.term -> Brg.entity -> 'a) -> 
+   Entity.status -> Brg.entity -> 'a
diff --git a/helm/software/lambda-delta/src/common/Make b/helm/software/lambda-delta/src/common/Make
new file mode 100644 (file)
index 0000000..de13dd4
--- /dev/null
@@ -0,0 +1 @@
+options hierarchy output entity marks alpha library
diff --git a/helm/software/lambda-delta/src/common/alpha.ml b/helm/software/lambda-delta/src/common/alpha.ml
new file mode 100644 (file)
index 0000000..01c2aaf
--- /dev/null
@@ -0,0 +1,39 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module Y = Entity
+
+(* internal functions *******************************************************)
+
+let rec rename ns n =
+   let token, mode = n in
+   let n = token ^ "_", mode in
+   if List.mem n ns then rename ns n else n
+
+let alpha_name acc attr =
+   let ns, a = acc in
+   match attr with
+      | Y.Name n ->
+        if List.mem n ns then
+            let n = rename ns n in
+           n :: ns, Y.Name n :: a
+        else 
+           n :: ns, attr :: a
+      | _        -> assert false 
+
+(* interface functions ******************************************************)
+
+let alpha ns a =
+   let f a names =
+      let _, names = List.fold_left alpha_name (ns, []) (List.rev names) in
+      List.rev_append a names
+   in
+   Y.get_names f a
diff --git a/helm/software/lambda-delta/src/common/alpha.mli b/helm/software/lambda-delta/src/common/alpha.mli
new file mode 100644 (file)
index 0000000..a08e98e
--- /dev/null
@@ -0,0 +1,12 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+val alpha: Entity.names -> Entity.attrs -> Entity.attrs
diff --git a/helm/software/lambda-delta/src/common/entity.ml b/helm/software/lambda-delta/src/common/entity.ml
new file mode 100644 (file)
index 0000000..e32b347
--- /dev/null
@@ -0,0 +1,127 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module O = Options
+
+type uri = NUri.uri
+type id = Aut.id
+type name = id * bool (* token, real? *)
+
+type names = name list
+
+type attr = Name of name      (* name *)
+          | Apix of int       (* additional position index *)
+         | Mark of int       (* node marker *)
+         | Meta of string    (* metaliguistic annotation *)
+         | Priv              (* private global definition *)
+
+type attrs = attr list (* attributes *)
+
+type 'term bind = Abst of 'term (* declaration: domain *)
+                | Abbr of 'term (* definition: body *)
+               | Void          (* exclusion *)
+
+type 'term entity = attrs * uri * 'term bind (* attrs, name, binder *)
+
+type status = {
+   delta: bool;        (* global delta-expansion *)
+   rt: bool;           (* reference typing *)
+   si: bool;           (* sort inclusion *)
+   expand: bool        (* always expand global definitions *)
+}
+
+(* helpers ******************************************************************)
+
+let common f (a, u, _) = f a u
+
+let rec name err f = function
+   | Name (n, r) :: _ -> f n r
+   | _ :: tl          -> name err f tl
+   | []               -> err ()
+
+let names f map l a =
+   let rec aux f i a = function   
+      | []                -> f a
+      | Name (n, r) :: tl -> aux (map f i n r) false a tl
+      | _ :: tl           -> aux f i a tl
+   in
+   aux f true a l
+
+let rec get_name err f j = function
+   | []                          -> err ()
+   | Name (n, r) :: _ when j = 0 -> f n r
+   | Name _ :: tl                -> get_name err f (pred j) tl
+   | _ :: tl                     -> get_name err f j tl
+
+let rec get_names f = function
+   | []                -> f [] []
+   | Name _ as n :: tl ->
+      let f a ns = f a (n :: ns) in get_names f tl
+   | e :: tl           ->
+      let f a = f (e :: a) in get_names f tl
+
+let count_names a =
+   let rec aux k = function
+      | []           -> k
+      | Name _ :: tl -> aux (succ k) tl
+      | _ :: tl      -> aux k tl
+   in
+   aux 0 a
+
+let rec apix err f = function
+   | Apix i :: _ -> f i
+   | _ :: tl     -> apix err f tl
+   | []          -> err ()
+
+let rec mark err f = function
+   | Mark i :: _ -> f i
+   | _ :: tl     -> mark err f tl
+   | []          -> err ()
+
+let rec priv err f = function
+   | Priv :: _ -> f ()
+   | _ :: tl   -> priv err f tl
+   | []        -> err ()
+
+let rec meta err f = function
+   | Meta s :: _ -> f s
+   | _ :: tl     -> meta err f tl
+   | []          -> err ()
+
+let resolve err f name a =
+   let rec aux i = function
+      | Name (n, true) :: _ when n = name -> f i
+      | _ :: tl                           -> aux (succ i) tl
+      | []                                -> err i
+   in
+   aux 0 a
+
+let rec rev_append_names ns = function
+   | []           -> ns
+   | Name n :: tl -> rev_append_names (n :: ns) tl
+   | _ :: tl      -> rev_append_names ns tl
+
+let xlate f xlate_term = function
+   | a, uri, Abst t ->
+      let f t = f (a, uri, Abst t) in xlate_term f t
+   | a, uri, Abbr t ->
+      let f t = f (a, uri, Abbr t) in xlate_term f t
+   | _, _, Void   ->
+      assert false
+
+let initial_status () = {
+   delta = false; rt = false; si = !O.si; expand = !O.expand
+}
+
+let refresh_status st = {st with
+   si = !O.si; expand = !O.expand
+}
+
diff --git a/helm/software/lambda-delta/src/common/hierarchy.ml b/helm/software/lambda-delta/src/common/hierarchy.ml
new file mode 100644 (file)
index 0000000..b7d4283
--- /dev/null
@@ -0,0 +1,64 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module H = Hashtbl
+module S = Scanf
+module C = Cps
+
+type graph = string * (int -> int)
+
+let sorts = 3
+let sort = H.create sorts
+
+let default_graph = "Z1"
+
+(* Internal functions *******************************************************)
+
+let set_sort h s =
+   H.add sort h s; succ h
+
+let graph_of_string err f s =
+   try 
+      let x = S.sscanf s "Z%u" C.start in 
+      if x > 0 then f (s, fun h -> x + h) else err ()
+   with
+      S.Scan_failure _ | Failure _ | End_of_file -> err ()
+
+let graph = ref (graph_of_string C.err C.start default_graph)
+
+(* Interface functions ******************************************************)
+
+let set_sorts i ss =   
+   List.fold_left set_sort i ss
+
+let string_of_sort err f h =
+   try f (H.find sort h) with Not_found -> err ()
+
+let sort_of_string err f s =
+   let map h n = function
+      | None when n = s -> Some h
+      | xh              -> xh
+   in
+   match H.fold map sort None with
+      | None   -> err ()
+      | Some h -> f h
+
+let string_of_graph () = fst !graph
+
+let apply h = snd !graph h
+
+let set_graph s =
+   let err () = false in
+   let f g = graph := g; true in
+   graph_of_string err f s
+
+let clear () =
+   H.clear sort; graph := graph_of_string C.err C.start default_graph
diff --git a/helm/software/lambda-delta/src/common/hierarchy.mli b/helm/software/lambda-delta/src/common/hierarchy.mli
new file mode 100644 (file)
index 0000000..04feaf9
--- /dev/null
@@ -0,0 +1,24 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+val set_sorts: int -> string list -> int
+
+val string_of_sort: (unit -> 'a) -> (string -> 'a) -> int -> 'a
+
+val sort_of_string: (unit -> 'a) -> (int -> 'a) -> string -> 'a
+
+val set_graph: string -> bool
+
+val string_of_graph: unit -> string
+
+val apply: int -> int
+
+val clear: unit -> unit
diff --git a/helm/software/lambda-delta/src/common/library.ml b/helm/software/lambda-delta/src/common/library.ml
new file mode 100644 (file)
index 0000000..8a68011
--- /dev/null
@@ -0,0 +1,132 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module F = Filename
+module U = NUri
+module C = Cps
+module H = Hierarchy
+module Y = Entity
+
+(* internal functions *******************************************************)
+
+let base = "xml"
+
+let obj_ext = ".xml"
+
+let root = "ENTITY"
+
+let system = "http://helm.cs.unibo.it/lambda-delta/" ^ base ^ "/ld.dtd"
+
+let path_of_uri xdir uri =
+   let base = F.concat xdir base in 
+   F.concat base (Str.string_after (U.string_of_uri uri) 3)
+
+(* interface functions ******************************************************)
+
+type och = string -> unit
+
+type attr = string * string
+
+type pp = och -> int -> unit
+
+let attribute out (name, contents) =
+   if contents <> "" then begin
+      out " "; out name; out "=\""; out contents; out "\""
+   end
+
+let xml out version encoding =
+   out "<?xml";
+      attribute out ("version", version);
+      attribute out ("encoding", encoding);
+   out "?>\n\n"
+
+let doctype out root system =
+   out "<!DOCTYPE "; out root; out " SYSTEM \""; out system; out "\">\n\n"
+
+let tag tag attrs ?contents out indent =
+   let spc = String.make indent ' ' in
+   out spc; out "<"; out tag; List.iter (attribute out) attrs;
+   match contents with
+      | None      -> out "/>\n"
+      | Some cont -> 
+         out ">\n"; cont out (indent + 3); out spc; 
+        out "</"; out tag; out ">\n"
+
+let sort = "Sort"
+
+let lref = "LRef"
+
+let gref = "GRef"
+
+let cast = "Cast"
+
+let appl = "Appl"
+
+let proj = "Proj"
+
+let abst = "Abst"
+
+let abbr = "Abbr"
+
+let void = "Void"
+
+let position i =
+   "position", string_of_int i
+
+let offset j = 
+   let contents = if j > 0 then string_of_int j else "" in
+   "offset", contents
+
+let uri u =
+   "uri", U.string_of_uri u
+
+let arity n =
+   let contents = if n > 1 then string_of_int n else "" in
+   "arity", contents
+
+let name a =
+   let map f i n r s =
+      let n = if r then n else "^" ^ n in 
+      let spc = if i then "" else " " in
+      f (s ^ n ^ spc)
+   in
+   let f s = "name", s in
+   Y.names f map a ""
+
+let mark a =
+   let err () = "mark", "" in
+   let f i = "mark", string_of_int i in
+   Y.mark err f a
+
+(* TODO: the string s must be quoted *)
+let meta a =
+   let err () = "meta", "" in
+   let f s = "meta", s in
+   Y.meta err f a
+
+let export_entity pp_term si xdir (a, u, b) =
+   let path = path_of_uri xdir u in
+   let _ = Sys.command (Printf.sprintf "mkdir -p %s" (F.dirname path)) in
+   let och = open_out (path ^ obj_ext) in
+   let out = output_string och in
+   xml out "1.0" "UTF-8"; doctype out root system;
+   let a = Y.Name (U.name_of_uri u, true) :: a in
+   let attrs = [uri u; name a; mark a; meta a] in 
+   let contents = match b with
+      | Y.Abst w -> tag "ABST" attrs ~contents:(pp_term w) 
+      | Y.Abbr v -> tag "ABBR" attrs ~contents:(pp_term v)
+      | Y.Void   -> assert false
+   in
+   let opts = if si then "si" else "" in
+   let shp = H.string_of_graph () in
+   let attrs = ["hierarchy", shp; "options", opts] in
+   tag root attrs ~contents out 0;
+   close_out och
diff --git a/helm/software/lambda-delta/src/common/library.mli b/helm/software/lambda-delta/src/common/library.mli
new file mode 100644 (file)
index 0000000..ed3f7bb
--- /dev/null
@@ -0,0 +1,53 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type och = string -> unit
+
+type attr = string * string
+
+type pp = och -> int -> unit
+
+val export_entity:
+   ('term -> pp) -> bool -> string -> 'term Entity.entity -> unit
+
+val tag: string -> attr list -> ?contents:pp -> pp 
+
+val sort: string
+
+val lref: string
+
+val gref: string
+
+val cast: string
+
+val appl: string
+
+val proj: string
+
+val abst: string
+
+val abbr: string
+
+val void: string
+
+val position: int -> attr
+
+val offset: int -> attr
+
+val uri: Entity.uri -> attr
+
+val arity: int -> attr
+
+val name: Entity.attrs -> attr
+
+val mark: Entity.attrs -> attr
+
+val meta: Entity.attrs -> attr
diff --git a/helm/software/lambda-delta/src/common/marks.ml b/helm/software/lambda-delta/src/common/marks.ml
new file mode 100644 (file)
index 0000000..026414e
--- /dev/null
@@ -0,0 +1,21 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module Y = Entity
+
+(* interface functions ******************************************************)
+
+let new_location =
+   let location = ref 0 in
+   fun () -> incr location; !location
+
+let new_mark () =
+   Y.Mark (new_location ())
diff --git a/helm/software/lambda-delta/src/common/options.ml b/helm/software/lambda-delta/src/common/options.ml
new file mode 100644 (file)
index 0000000..d9783c7
--- /dev/null
@@ -0,0 +1,42 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module C = Cps
+
+type uri_generator = string -> string
+
+(* interface functions ******************************************************)
+
+let indexes = ref false      (* show de Bruijn indexes *)
+
+let expand = ref false       (* always expand global definitions *)
+
+let si = ref false           (* use sort inclusion *)
+
+let unquote = ref false      (* do not quote identifiers when lexing *)
+
+let icm = ref 0              (* complexity measure of relocated terms *)
+
+let cover = ref ""           (* initial uri segment *)
+
+let debug_parser = ref false (* output parser debug information *)
+
+let debug_lexer = ref false  (* output lexer debug information *)
+
+let mk_uri = ref (fun _ _ -> C.err : bool -> string -> uri_generator) 
+
+let get_mk_uri () =
+   !mk_uri !si !cover
+
+let clear () =
+   expand := false; si := false; cover := ""; indexes := false; icm := 0;
+   debug_parser := false; debug_lexer := false;
+   mk_uri := fun _ _ -> C.err 
diff --git a/helm/software/lambda-delta/src/common/output.ml b/helm/software/lambda-delta/src/common/output.ml
new file mode 100644 (file)
index 0000000..8270c5d
--- /dev/null
@@ -0,0 +1,72 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module P = Printf
+module L = Log
+module O = Options
+
+type reductions = {
+   beta   : int;
+   zeta   : int;
+   upsilon: int;
+   tau    : int;
+   ldelta : int;
+   gdelta : int;
+   si     : int;
+   lrt    : int;
+   grt    : int
+}
+
+let initial_reductions = {
+   beta = 0; upsilon = 0; tau = 0; zeta = 0; ldelta = 0; gdelta = 0;
+   si = 0; lrt = 0; grt = 0
+}
+
+let reductions = ref initial_reductions
+
+let clear_reductions () = reductions := initial_reductions
+
+let add 
+   ?(beta=0) ?(upsilon=0) ?(tau=0) ?(ldelta=0) ?(gdelta=0) ?(zeta=0) 
+   ?(si=0) ?(lrt=0) ?(grt=0) ()
+= reductions := {
+   beta = !reductions.beta + beta;
+   zeta = !reductions.zeta + zeta;
+   upsilon = !reductions.upsilon + upsilon;
+   tau = !reductions.tau + tau;
+   ldelta = !reductions.ldelta + ldelta;
+   gdelta = !reductions.gdelta + gdelta;
+   si = !reductions.si + si;
+   lrt = !reductions.lrt + lrt;
+   grt = !reductions.grt + grt
+}
+
+let print_reductions () =
+   let r = !reductions in
+   let rs = r.beta + r.ldelta + r.zeta + r.upsilon + r.tau + r.gdelta in
+   let prs = r.si + r.lrt + r.grt in
+   let delta = r.ldelta + r.gdelta in
+   let rt = r.lrt + r.grt in   
+   L.warn (P.sprintf "  Reductions summary");
+   L.warn (P.sprintf "    Proper reductions:        %7u" rs);
+   L.warn (P.sprintf "      Beta:                   %7u" r.beta);
+   L.warn (P.sprintf "      Delta:                  %7u" delta);
+   L.warn (P.sprintf "        Local:                %7u" r.ldelta);
+   L.warn (P.sprintf "        Global:               %7u" r.gdelta);
+   L.warn (P.sprintf "      Zeta:                   %7u" r.zeta);
+   L.warn (P.sprintf "      Upsilon:                %7u" r.upsilon);
+   L.warn (P.sprintf "      Tau:                    %7u" r.tau);
+   L.warn (P.sprintf "    Pseudo reductions:        %7u" prs);
+   L.warn (P.sprintf "      Reference typing:       %7u" rt);
+   L.warn (P.sprintf "        Local:                %7u" r.lrt);
+   L.warn (P.sprintf "        Global:               %7u" r.grt);
+   L.warn (P.sprintf "      Sort inclusion:         %7u" r.si);
+   L.warn (P.sprintf "  Relocated nodes (icm):      %7u" !O.icm)
diff --git a/helm/software/lambda-delta/src/common/output.mli b/helm/software/lambda-delta/src/common/output.mli
new file mode 100644 (file)
index 0000000..20b83f0
--- /dev/null
@@ -0,0 +1,19 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+val clear_reductions: unit -> unit
+
+val add: 
+   ?beta:int -> ?upsilon:int -> ?tau:int -> ?ldelta:int -> ?gdelta:int ->
+   ?zeta:int -> ?si:int -> ?lrt:int -> ?grt:int ->
+   unit -> unit
+
+val print_reductions: unit -> unit
diff --git a/helm/software/lambda-delta/src/complete_rg/Make b/helm/software/lambda-delta/src/complete_rg/Make
new file mode 100644 (file)
index 0000000..d7a45f9
--- /dev/null
@@ -0,0 +1 @@
+crg crgOutput crgXml crgTxt crgAut crgBrg
diff --git a/helm/software/lambda-delta/src/complete_rg/crg.ml b/helm/software/lambda-delta/src/complete_rg/crg.ml
new file mode 100644 (file)
index 0000000..07a4cb3
--- /dev/null
@@ -0,0 +1,94 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+(* kernel version: complete, relative, global *)
+(* note          : fragment of complete lambda-delta serving as abstract layer *) 
+
+module Y = Entity
+
+type uri = Y.uri
+type id = Y.id
+type attrs = Y.attrs
+
+type bind = Abst of term list (* domains *)
+          | Abbr of term list (* bodies  *)
+          | Void of int       (* number of exclusions *)
+
+and term = TSort of attrs * int              (* attrs, hierarchy index *)
+         | TLRef of attrs * int * int        (* attrs, position indexes *)
+         | TGRef of attrs * uri              (* attrs, reference *)
+         | TCast of attrs * term * term      (* attrs, domain, element *)
+         | TAppl of attrs * term list * term (* attrs, arguments, function *)
+        | TProj of attrs * lenv * term      (* attrs, closure, member *)
+        | TBind of attrs * bind * term      (* attrs, binder, scope *)
+
+and lenv = ESort                        (* top *)
+         | EProj of lenv * attrs * lenv (* environment, attrs, closure *) 
+         | EBind of lenv * attrs * bind (* environment, attrs, binder *)
+
+type entity = term Y.entity
+
+(* helpers ******************************************************************)
+
+let mk_uri si root s =
+   let kernel = if si then "crg-si" else "crg" in
+   String.concat "/" ["ld:"; kernel; root; s ^ ".ld"]
+
+let empty_lenv = ESort
+
+let push_bind f lenv a b = f (EBind (lenv, a, b))
+
+let push_proj f lenv a e = f (EProj (lenv, a, e))
+
+let push2 err f lenv attr ?t () = match lenv, t with
+   | EBind (e, a, Abst ws), Some t -> f (EBind (e, (attr :: a), Abst (t :: ws)))
+   | EBind (e, a, Abbr vs), Some t -> f (EBind (e, (attr :: a), Abbr (t :: vs)))
+   | EBind (e, a, Void n), None    -> f (EBind (e, (attr :: a), Void (succ n)))
+   | _                             -> err ()
+
+(* this id not tail recursive *)
+let resolve_lref err f id lenv =
+   let rec aux f i k = function
+     | ESort                  -> err ()
+     | EBind (tl, a, _)       ->
+        let err kk = aux f (succ i) (k + kk) tl in
+       let f j = f i j (k + j) in
+       Y.resolve err f id a
+     | EProj _                -> assert false (* TODO *)
+   in
+   aux f 0 0 lenv
+
+let rec get_name err f i j = function
+   | ESort                      -> err i
+   | EBind (_, a, _) when i = 0 -> 
+      let err () = err i in
+      Y.get_name err f j a
+   | EBind (tl, _, _)           -> 
+      get_name err f (pred i) j tl
+   | EProj (tl, _, e)           ->
+      let err i = get_name err f i j tl in 
+      get_name err f i j e
+
+let get_index err f i j lenv =
+   let rec aux f i k = function
+      | ESort                      -> err i
+      | EBind (_, a, _) when i = 0 ->
+        if Y.count_names a > j then f (k + j) else err i
+      | EBind (tl, a, _)           -> 
+         aux f (pred i) (k + Y.count_names a) tl
+      | EProj _                    -> assert false (* TODO *)
+   in
+   aux f i 0 lenv
+
+let rec names_of_lenv ns = function
+   | ESort            -> ns
+   | EBind (tl, a, _) -> names_of_lenv (Y.rev_append_names ns a) tl
+   | EProj (tl, _, e) -> names_of_lenv (names_of_lenv ns e) tl
diff --git a/helm/software/lambda-delta/src/complete_rg/crgAut.ml b/helm/software/lambda-delta/src/complete_rg/crgAut.ml
new file mode 100644 (file)
index 0000000..0b95adf
--- /dev/null
@@ -0,0 +1,224 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module U = NUri
+module H = U.UriHash
+module C = Cps
+module O = Options
+module Y = Entity
+module A = Aut
+module D = Crg
+
+(* qualified identifier: uri, name, qualifiers *)
+type qid = D.uri * D.id * D.id list
+
+type context = Y.attrs * D.term list
+
+type context_node = qid option (* context node: None = root *)
+
+type status = {
+   path: D.id list;          (* current section path *) 
+   node: context_node;       (* current context node *)
+   nodes: context_node list; (* context node list *)
+   line: int;                (* line number *)
+   mk_uri:O.uri_generator    (* uri generator *) 
+}
+
+type resolver = Local of int
+              | Global of context
+
+let henv_size, hcnt_size = 7000, 4300 (* hash tables initial sizes *)
+
+let henv = H.create henv_size (* optimized global environment *)
+
+let hcnt = H.create hcnt_size (* optimized context *)
+
+(* Internal functions *******************************************************)
+
+let empty_cnt = [], []
+
+let add_abst (a, ws) id w = 
+   Y.Name (id, true) :: a, w :: ws 
+
+let lenv_of_cnt (a, ws) = 
+   D.push_bind C.start D.empty_lenv a (D.Abst ws)
+
+let mk_lref f i j k = f (D.TLRef ([Y.Apix k], i, j))
+
+let id_of_name (id, _, _) = id
+
+let mk_qid f st id path =
+   let str = String.concat "/" path in
+   let str = Filename.concat str id in 
+   let str = st.mk_uri str in
+   f (U.uri_of_string str, id, path)
+
+let uri_of_qid (uri, _, _) = uri
+
+let complete_qid f st (id, is_local, qs) =
+   let f path = C.list_rev_append (mk_qid f st id) path ~tail:qs in
+   let rec skip f = function
+      | phd :: ptl, qshd :: _ when phd = qshd -> f ptl
+      | _ :: ptl, _ :: _                      -> skip f (ptl, qs)
+      | _                                     -> f []
+   in
+   if is_local then f st.path else skip f (st.path, qs)
+
+let relax_qid f st (_, id, path) =
+   let f = function
+      | _ :: tl -> C.list_rev (mk_qid f st id) tl
+      | []      -> assert false
+   in
+   C.list_rev f path
+
+let relax_opt_qid f st = function
+   | None     -> f None
+   | Some qid -> let f qid = f (Some qid) in relax_qid f st qid
+
+let resolve_gref err f st qid =
+   try let cnt = H.find henv (uri_of_qid qid) in f qid cnt
+   with Not_found -> err qid 
+
+let resolve_gref_relaxed f st qid =
+(* this is not tail recursive *)   
+   let rec err qid = relax_qid (resolve_gref err f st) st qid in
+   resolve_gref err f st qid
+
+let get_cnt err f st = function
+   | None              -> f empty_cnt
+   | Some qid as node ->
+      try let cnt = H.find hcnt (uri_of_qid qid) in f cnt
+      with Not_found -> err node
+
+let get_cnt_relaxed f st =
+(* this is not tail recursive *)   
+   let rec err node = relax_opt_qid (get_cnt err f st) st node in
+   get_cnt err f st st.node
+
+(* this is not tail recursive in the GRef branch *)
+let rec xlate_term f st lenv = function
+   | A.Sort s            -> 
+      let f h = f (D.TSort ([], h)) in
+      if s then f 0 else f 1
+   | A.Appl (v, t)       ->
+      let f vv tt = f (D.TAppl ([], [vv], tt)) in
+      let f vv = xlate_term (f vv) st lenv t in
+      xlate_term f st lenv v
+   | A.Abst (name, w, t) ->
+      let f ww = 
+         let a, b = [Y.Name (name, true)], (D.Abst [ww]) in
+        let f tt = f (D.TBind (a, b, tt)) in
+         let f lenv = xlate_term f st lenv t in
+        D.push_bind f lenv a b
+      in
+      xlate_term f st lenv w
+   | A.GRef (name, args) ->
+      let map1 f = function
+           | Y.Name (id, _) -> f (A.GRef ((id, true, []), []))
+           | _              -> C.err ()
+      in
+      let map2 f = xlate_term f st lenv in
+      let g qid (a, _) =
+         let gref = D.TGRef ([], uri_of_qid qid) in
+        match args, a with
+           | [], [] -> f gref
+           | _      -> 
+              let f args = f (D.TAppl ([], args, gref)) in
+              let f args = f (List.rev_map (map2 C.start) args) in
+              let f a = C.list_rev_map_append f map1 a ~tail:args in
+              C.list_sub_strict f a args
+      in
+      let g qid = resolve_gref_relaxed g st qid in
+      let err () = complete_qid g st name in
+      D.resolve_lref err (mk_lref f) (id_of_name name) lenv
+
+let xlate_entity err f st = function
+   | A.Section (Some (_, name))     ->
+      err {st with path = name :: st.path; nodes = st.node :: st.nodes}
+   | A.Section None            ->
+      begin match st.path, st.nodes with
+        | _ :: ptl, nhd :: ntl -> 
+           err {st with path = ptl; node = nhd; nodes = ntl}
+         | _                    -> assert false
+      end
+   | A.Context None            ->
+      err {st with node = None}
+   | A.Context (Some name)     ->
+      let f name = err {st with node = Some name} in
+      complete_qid f st name 
+   | A.Block (name, w)         ->
+      let f qid = 
+         let f cnt =
+           let lenv = lenv_of_cnt cnt in
+           let ww = xlate_term C.start st lenv w in
+           H.add hcnt (uri_of_qid qid) (add_abst cnt name ww);
+           err {st with node = Some qid}
+        in
+         get_cnt_relaxed f st
+      in
+      complete_qid f st (name, true, [])
+   | A.Decl (name, w)          ->
+      let f cnt =
+         let a, ws = cnt in
+         let lenv = lenv_of_cnt cnt in
+        let f qid = 
+            let ww = xlate_term C.start st lenv w in
+           H.add henv (uri_of_qid qid) cnt;
+           let t = match ws with
+              | [] -> ww
+              | _  -> D.TBind (a, D.Abst ws, ww)
+           in
+(*
+           print_newline (); CrgOutput.pp_term print_string t;
+*)
+           let b = Y.Abst t in
+           let entity = [Y.Mark st.line], uri_of_qid qid, b in
+           f {st with line = succ st.line} entity
+        in
+         complete_qid f st (name, true, [])
+      in
+      get_cnt_relaxed f st
+   | A.Def (name, w, trans, v) ->
+      let f cnt = 
+        let a, ws = cnt in
+        let lenv = lenv_of_cnt cnt in
+         let f qid = 
+            let ww = xlate_term C.start st lenv w in
+           let vv = xlate_term C.start st lenv v in
+           H.add henv (uri_of_qid qid) cnt;
+            let t = match ws with
+              | [] -> D.TCast ([], ww, vv)
+              | _  -> D.TBind (a, D.Abst ws, D.TCast ([], ww, vv))
+           in
+(*
+           print_newline (); CrgOutput.pp_term print_string t;
+*)
+           let b = Y.Abbr t in
+           let a = Y.Mark st.line :: if trans then [] else [Y.Priv] in
+           let entity = a, uri_of_qid qid, b in
+           f {st with line = succ st.line} entity
+        in
+         complete_qid f st (name, true, [])
+      in
+      get_cnt_relaxed f st
+
+(* Interface functions ******************************************************)
+
+let initial_status () =
+   H.clear henv; H.clear hcnt; {
+   path = []; node = None; nodes = []; line = 1; mk_uri = O.get_mk_uri ()
+}
+
+let refresh_status st = {st with
+   mk_uri = O.get_mk_uri ()
+}
+
+let crg_of_aut = xlate_entity
diff --git a/helm/software/lambda-delta/src/complete_rg/crgAut.mli b/helm/software/lambda-delta/src/complete_rg/crgAut.mli
new file mode 100644 (file)
index 0000000..c7d93d3
--- /dev/null
@@ -0,0 +1,19 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type status
+
+val initial_status: unit -> status 
+
+val refresh_status: status -> status
+
+val crg_of_aut: (status -> 'a) -> (status -> Crg.entity -> 'a) -> 
+                status -> Aut.command -> 'a
diff --git a/helm/software/lambda-delta/src/complete_rg/crgBrg.ml b/helm/software/lambda-delta/src/complete_rg/crgBrg.ml
new file mode 100644 (file)
index 0000000..2b31293
--- /dev/null
@@ -0,0 +1,101 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module C = Cps
+module Y = Entity
+module M = Marks
+module D = Crg
+module B = Brg
+
+(* internal functions: crg to brg term **************************************)
+
+let rec lenv_fold_left map1 map2 x = function
+   | D.ESort            -> x
+   | D.EBind (tl, a, b) -> lenv_fold_left map1 map2 (map1 x a b) tl
+   | D.EProj (tl, a, e) -> lenv_fold_left map1 map2 (map2 x a e) tl
+
+let rec xlate_term f = function
+   | D.TSort (a, l)     -> f (B.Sort (a, l))
+   | D.TGRef (a, n)     -> f (B.GRef (a, n))
+   | D.TLRef (a, _, _)  -> let f i = f (B.LRef (a, i)) in Y.apix C.err f a
+   | D.TCast (a, u, t)  ->
+      let f uu tt = f (B.Cast (a, uu, tt)) in
+      let f uu = xlate_term (f uu) t in
+      xlate_term f u 
+   | D.TAppl (a, vs, t) ->
+      let map f v tt = let f vv = f (B.Appl (a, vv, tt)) in xlate_term f v in
+      let f tt = C.list_fold_right f map vs tt in
+      xlate_term f t
+   | D.TProj (a, e, t)  ->
+      let f tt = f (lenv_fold_left xlate_bind xlate_proj tt e) in
+      xlate_term f t
+   | D.TBind (ab, D.Abst ws, D.TCast (ac, u, t)) ->
+      xlate_term f (D.TCast (ac, D.TBind (ab, D.Abst ws, u), D.TBind (ab, D.Abst ws, t)))
+   | D.TBind (a, b, t)  ->
+      let f tt = f (xlate_bind tt a b) in xlate_term f t
+
+and xlate_bind x a b =
+   let f a ns = a, ns in
+   let a, ns = Y.get_names f a in 
+   match b with
+      | D.Abst ws ->
+         let map x n w = 
+           let f ww = B.Bind (n :: M.new_mark () :: a, B.Abst ww, x) in 
+           xlate_term f w
+        in
+        List.fold_left2 map x ns ws 
+      | D.Abbr vs ->
+         let map x n v = 
+           let f vv = B.Bind (n :: a, B.Abbr vv, x) in 
+           xlate_term f v
+        in
+        List.fold_left2 map x ns vs
+      | D.Void _  ->
+         let map x n = B.Bind (n :: a, B.Void, x) in
+        List.fold_left map x ns
+
+and xlate_proj x _ e =
+   lenv_fold_left xlate_bind xlate_proj x e
+
+(* internal functions: brg to crg term **************************************)
+
+let rec xlate_bk_term f = function
+   | B.Sort (a, l)     -> f (D.TSort (a, l))
+   | B.GRef (a, n)     -> f (D.TGRef (a, n))
+   | B.LRef (a, i)     -> f (D.TLRef (a, i, 0))
+   | B.Cast (a, u, t)  ->
+      let f uu tt = f (D.TCast (a, uu, tt)) in
+      let f uu = xlate_bk_term (f uu) t in
+      xlate_bk_term f u 
+   | B.Appl (a, u, t)  ->
+      let f uu tt = f (D.TAppl (a, [uu], tt)) in
+      let f uu = xlate_bk_term (f uu) t in
+      xlate_bk_term f u 
+   | B.Bind (a, b, t)  ->
+      let f bb tt = f (D.TBind (a, bb, tt)) in
+      let f bb = xlate_bk_term (f bb) t in
+      xlate_bk_bind f b
+
+and xlate_bk_bind f = function
+   | B.Abst t ->
+      let f tt = f (D.Abst [tt]) in
+      xlate_bk_term f t
+   | B.Abbr t ->
+      let f tt = f (D.Abbr [tt]) in
+      xlate_bk_term f t
+   | B.Void   -> f (D.Void 1)
+   
+(* interface functions ******************************************************)
+
+let brg_of_crg f t =
+   f (xlate_term C.start t)
+
+let crg_of_brg = xlate_bk_term
diff --git a/helm/software/lambda-delta/src/complete_rg/crgBrg.mli b/helm/software/lambda-delta/src/complete_rg/crgBrg.mli
new file mode 100644 (file)
index 0000000..84c7f23
--- /dev/null
@@ -0,0 +1,14 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+val brg_of_crg: (Brg.term -> 'a) -> Crg.term -> 'a
+
+val crg_of_brg: (Crg.term -> 'a) -> Brg.term -> 'a
diff --git a/helm/software/lambda-delta/src/complete_rg/crgOutput.ml b/helm/software/lambda-delta/src/complete_rg/crgOutput.ml
new file mode 100644 (file)
index 0000000..6da54cb
--- /dev/null
@@ -0,0 +1,59 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module P = Printf
+module U = NUri
+module C = Cps
+module H = Hierarchy
+module Y = Entity
+module D = Crg
+
+(****************************************************************************)
+
+let pp_attrs out a =
+   let map = function
+      | Y.Name (s, true)  -> out (P.sprintf "%s;" s)
+      | Y.Name (s, false) -> out (P.sprintf "~%s;" s)
+      | Y.Apix i          -> out (P.sprintf "+%i;" i)
+      | Y.Mark i          -> out (P.sprintf "@%i;" i)
+      | Y.Meta s          -> out (P.sprintf "\"%s\";" s)
+      | Y.Priv            -> out (P.sprintf "%s;" "~")
+   in
+   List.iter map a
+
+let rec pp_term out = function
+   | D.TSort (a, l)    -> pp_attrs out a; out (P.sprintf "*%u" l)
+   | D.TLRef (a, i, j) -> pp_attrs out a; out (P.sprintf "#(%u,%u)" i j)
+   | D.TGRef (a, u)    -> pp_attrs out a; out (P.sprintf "$")
+   | D.TCast (a, x, y) -> pp_attrs out a; out "<"; pp_term out x; out ">."; pp_term out y
+   | D.TProj (a, x, y) -> assert false
+   | D.TAppl (a, x, y) -> pp_attrs out a; pp_terms "(" ")" out x; pp_term out y
+   | D.TBind (a, x, y) -> pp_attrs out a; pp_bind out x; pp_term out y
+
+and pp_terms bg eg out vs =
+   let rec aux = function
+      | []      -> ()
+      | [v]     -> pp_term out v
+      | v :: vs -> pp_term out v; out ", "; aux vs
+   in
+   out bg; aux vs; out (eg ^ ".")
+
+and pp_bind out = function
+   | D.Abst x -> pp_terms "[:" "]" out x
+   | D.Abbr x -> pp_terms "[=" "]" out x
+   | D.Void x -> out (P.sprintf "[%u]" x)
+
+let rec pp_lenv out = function
+   | D.ESort           -> ()
+   | D.EProj (x, a, y) -> assert false
+   | D.EBind (x, a, y) -> pp_lenv out x; pp_attrs out a; pp_bind out y
+
+(****************************************************************************)
diff --git a/helm/software/lambda-delta/src/complete_rg/crgOutput.mli b/helm/software/lambda-delta/src/complete_rg/crgOutput.mli
new file mode 100644 (file)
index 0000000..d804937
--- /dev/null
@@ -0,0 +1,12 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+val pp_term: (string -> unit) -> Crg.term -> unit
diff --git a/helm/software/lambda-delta/src/complete_rg/crgTxt.ml b/helm/software/lambda-delta/src/complete_rg/crgTxt.ml
new file mode 100644 (file)
index 0000000..34727af
--- /dev/null
@@ -0,0 +1,160 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module U  = NUri
+module H  = Hierarchy
+module C  = Cps
+module O  = Options
+module Y  = Entity
+module T  = Txt
+module TT = TxtTxt
+module D  = Crg
+
+type status = {
+   path  : T.id list;      (* current section path *)
+   line  : int;            (* line number *)
+   sort  : int;            (* first default sort index *)
+   mk_uri: O.uri_generator (* uri generator *) 
+}
+
+let henv_size = 7000 (* hash tables initial size *)
+
+let henv = Hashtbl.create henv_size (* optimized global environment *)
+
+(* Internal functions *******************************************************)
+
+let name_of_id ?(r=true) id = Y.Name (id, r)
+
+let mk_lref f i j k = f (D.TLRef ([Y.Apix k], i, j))
+
+let mk_gref f uri = f (D.TGRef ([], uri))
+
+let uri_of_id st id path =
+   let str = String.concat "/" path in
+   let str = Filename.concat str id in 
+   let str = st.mk_uri str in
+   U.uri_of_string str
+
+let resolve_gref err f st id =
+   try f (Hashtbl.find henv id)
+   with Not_found -> err ()
+
+let rec xlate_term f st lenv = function
+   | T.Inst _
+   | T.Impl _       -> assert false
+   | T.Sort h       -> 
+      f (D.TSort ([], h))
+   | T.NSrt id      -> 
+      let f h = f (D.TSort ([], h)) in
+      H.sort_of_string C.err f id
+   | T.LRef (i, j)  ->    
+      D.get_index C.err (mk_lref f i j) i j lenv
+   | T.NRef id      ->
+      let err () = resolve_gref C.err (mk_gref f) st id in
+      D.resolve_lref err (mk_lref f) id lenv
+   | T.Cast (u, t)  ->
+      let f uu tt = f (D.TCast ([], uu, tt)) in
+      let f uu = xlate_term (f uu) st lenv t in
+      xlate_term f st lenv u
+   | T.Appl (vs, t) ->
+      let map f = xlate_term f st lenv in
+      let f vvs tt = f (D.TAppl ([], vvs, tt)) in
+      let f vvs = xlate_term (f vvs) st lenv t in
+      C.list_map f map vs
+   | T.Bind (b, t)  ->
+      let abst_map (lenv, a, wws) (id, r, w) = 
+         let attr = name_of_id ~r id in
+        let ww = xlate_term C.start st lenv w in
+        D.push2 C.err C.start lenv attr ~t:ww (), attr :: a, ww :: wws
+      in
+      let abbr_map (lenv, a, wws) (id, w) = 
+         let attr = name_of_id id in
+        let ww = xlate_term C.start st lenv w in
+        D.push2 C.err C.start lenv attr ~t:ww (), attr :: a, ww :: wws
+      in
+      let void_map (lenv, a, n) id = 
+        let attr = name_of_id id in
+        D.push2 C.err C.start lenv attr (), attr :: a, succ n
+      in
+      let lenv, aa, bb = match b with
+         | T.Abst xws ->
+           let lenv = D.push_bind C.start lenv [] (D.Abst []) in
+           let lenv, aa, wws = List.fold_left abst_map (lenv, [], []) xws in
+           lenv, aa, D.Abst wws
+         | T.Abbr xvs ->
+           let lenv = D.push_bind C.start lenv [] (D.Abbr []) in
+           let lenv, aa, vvs = List.fold_left abbr_map (lenv, [], []) xvs in
+           lenv, aa, D.Abbr vvs
+         | T.Void ids ->
+           let lenv = D.push_bind C.start lenv [] (D.Void 0) in
+           let lenv, aa, n = List.fold_left void_map (lenv, [], 0) ids in
+           lenv, aa, D.Void n
+      in
+      let f tt = f (D.TBind (aa, bb, tt)) in
+      xlate_term f st lenv t
+
+let xlate_term f st lenv t =
+   TT.contract (xlate_term f st lenv) t
+
+let mk_contents tt = function
+   | T.Decl -> [], Y.Abst tt
+   | T.Ax   -> [], Y.Abst tt
+   | T.Def  -> [], Y.Abbr tt
+   | T.Th   -> [], Y.Abbr tt
+
+let xlate_entity err f gen st = function
+   | T.Require _                  ->
+      err st
+   | T.Section (Some name)        ->
+      err {st with path = name :: st.path}
+   | T.Section None               ->
+      begin match st.path with
+        | _ :: ptl -> 
+           err {st with path = ptl}
+         | _        -> assert false
+      end
+   | T.Sorts sorts                ->
+      let map st (xix, s) =
+         let ix = match xix with 
+           | None    -> st.sort
+           | Some ix -> ix
+        in
+         {st with sort = H.set_sorts ix [s]}
+      in
+      err (List.fold_left map st sorts)
+   | T.Graph id                   ->
+      assert (H.set_graph id); err st
+   | T.Entity (kind, id, meta, t) ->
+      let uri = uri_of_id st id st.path in
+      Hashtbl.add henv id uri;
+      let tt = xlate_term C.start st D.empty_lenv t in
+(*
+      print_newline (); CrgOutput.pp_term print_string tt;
+*)
+      let a, b = mk_contents tt kind in 
+      let a = if meta <> "" then Y.Meta meta :: a else a in
+      let entity = Y.Mark st.line :: a, uri, b in
+      f {st with line = succ st.line} entity
+   | T.Generate _                 ->
+      err st
+
+(* Interface functions ******************************************************)
+
+let initial_status () =
+   Hashtbl.clear henv; {
+   path = []; line = 1; sort = 0; mk_uri = O.get_mk_uri ()
+}
+
+let refresh_status st = {st with
+   mk_uri = O.get_mk_uri ()
+}
+
+let crg_of_txt = xlate_entity
diff --git a/helm/software/lambda-delta/src/complete_rg/crgTxt.mli b/helm/software/lambda-delta/src/complete_rg/crgTxt.mli
new file mode 100644 (file)
index 0000000..150268a
--- /dev/null
@@ -0,0 +1,19 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type status
+
+val initial_status: unit -> status 
+
+val refresh_status: status -> status
+
+val crg_of_txt: (status -> 'a) -> (status -> Crg.entity -> 'a) ->
+                (Txt.command -> unit) -> status -> Txt.command -> 'a
diff --git a/helm/software/lambda-delta/src/complete_rg/crgXml.ml b/helm/software/lambda-delta/src/complete_rg/crgXml.ml
new file mode 100644 (file)
index 0000000..111cfed
--- /dev/null
@@ -0,0 +1,114 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module U = NUri
+module C = Cps
+module H = Hierarchy
+module Y = Entity
+module A = Alpha
+module X = Library
+module D = Crg
+
+(* internal functions *******************************************************)
+
+let rec list_iter map l out tab = match l with
+   | []       -> ()
+   | hd :: tl -> map hd out tab; list_iter map tl out tab
+
+let list_rev_iter map e ns l out tab =
+   let rec aux err f e = function
+      | [], []            -> f e
+      | n :: ns, hd :: tl -> 
+        let f e =
+(*     
+           pp_lenv print_string e; print_string " |- "; 
+          pp_term print_string hd; print_newline ();
+*)
+          map e hd out tab; f (D.push2 C.err C.start e n ~t:hd ())
+       in
+       aux err f e (ns, tl) 
+      | _                 -> err ()
+   in
+   ignore (aux C.err C.start e (ns, l))
+
+let lenv_iter map1 map2 l out tab = 
+   let rec aux f = function
+      | D.ESort              -> f ()
+      | D.EBind (lenv, a, b) -> aux (fun () -> map1 a b out tab; f ()) lenv
+      | D.EProj (lenv, a, e) -> aux (fun () -> map2 a e out tab; f ()) lenv
+   in 
+   aux C.start l
+
+let rec exp_term e t out tab = match t with
+   | D.TSort (a, l)       ->
+      let a =
+         let err _ = a in
+         let f s = Y.Name (s, true) :: a in
+        H.string_of_sort err f l
+      in
+      let attrs = [X.position l; X.name a] in
+      X.tag X.sort attrs out tab
+   | D.TLRef (a, i, j)    ->
+      let a = 
+         let err _ = a in
+        let f n r = Y.Name (n, r) :: a in
+         D.get_name err f i j e
+      in
+      let attrs = [X.position i; X.offset j; X.name a] in
+      X.tag X.lref attrs out tab
+   | D.TGRef (a, n)       ->
+      let a = Y.Name (U.name_of_uri n, true) :: a in
+      let attrs = [X.uri n; X.name a] in
+      X.tag X.gref attrs out tab
+   | D.TCast (a, u, t)    ->
+      let attrs = [] in
+      X.tag X.cast attrs ~contents:(exp_term e u) out tab;
+      exp_term e t out tab
+   | D.TAppl (a, vs, t)   ->
+      let attrs = [X.arity (List.length vs)] in
+      X.tag X.appl attrs ~contents:(list_iter (exp_term e) vs) out tab;
+      exp_term e t out tab
+   | D.TProj (a, lenv, t) ->
+      let attrs = [] in
+      X.tag X.proj attrs ~contents:(lenv_iter (exp_bind e) (exp_eproj e) lenv) out tab;
+      exp_term (D.push_proj C.start e a lenv) t out tab
+   | D.TBind (a, b, t) ->
+(* NOTE: the inner binders are alpha-converted first *)
+(*       so undesirable renamings might occur        *)
+(* EX:   we rename [x][x]x to [x][x_]x_              *)
+(*       whereas [x_][x]x would be more desirable    *)
+      let a = A.alpha (D.names_of_lenv [] e) a in
+      exp_bind e a b out tab; 
+      exp_term (D.push_bind C.start e a b) t out tab 
+
+and exp_bind e a b out tab = 
+   let f a ns = a, ns in
+   let a, ns = Y.get_names f a in 
+   match b with
+      | D.Abst ws ->
+        let e = D.push_bind C.start e a (D.Abst []) in
+        let attrs = [X.name ns; X.mark a; X.arity (List.length ws)] in
+         X.tag X.abst attrs ~contents:(list_rev_iter exp_term e ns ws) out tab
+      | D.Abbr vs ->
+         let e = D.push_bind C.start e a (D.Abbr []) in
+         let attrs = [X.name ns; X.mark a; X.arity (List.length vs)] in
+         X.tag X.abbr attrs ~contents:(list_rev_iter exp_term e ns vs) out tab
+      | D.Void n ->
+         let attrs = [X.name a; X.mark a; X.arity n] in
+         X.tag X.void attrs out tab
+
+and exp_eproj e a lenv out tab =
+   let attrs = [] in
+   X.tag X.proj attrs ~contents:(lenv_iter (exp_bind e) (exp_eproj e) lenv) out tab
+
+(* interface functions ******************************************************)
+
+let export_term = exp_term D.empty_lenv
diff --git a/helm/software/lambda-delta/src/complete_rg/crgXml.mli b/helm/software/lambda-delta/src/complete_rg/crgXml.mli
new file mode 100644 (file)
index 0000000..c326a98
--- /dev/null
@@ -0,0 +1,12 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+val export_term: Crg.term -> Library.pp
diff --git a/helm/software/lambda-delta/src/lib/Make b/helm/software/lambda-delta/src/lib/Make
new file mode 100644 (file)
index 0000000..45d5eac
--- /dev/null
@@ -0,0 +1 @@
+cps share log time
diff --git a/helm/software/lambda-delta/src/lib/cps.ml b/helm/software/lambda-delta/src/lib/cps.ml
new file mode 100644 (file)
index 0000000..10ec623
--- /dev/null
@@ -0,0 +1,83 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+let err _ = assert false
+
+let start x = x
+
+let id f x = f x
+
+let rec list_sub_strict f l1 l2 = match l1, l2 with
+   | _, []              -> f l1
+   | _ :: tl1, _ :: tl2 -> list_sub_strict f tl1 tl2
+   | _                  -> assert false
+
+(* this is not tail recursive *)
+let rec list_fold_left f map a = function
+   | []       -> f a
+   | hd :: tl -> 
+      let f a = list_fold_left f map a tl in
+      map f a hd
+
+(* this is not tail recursive *)
+let rec list_rev_map_append f map ~tail = function
+      | []       -> f tail        
+      | hd :: tl ->
+         let f hd = list_rev_map_append f map ~tail:(hd :: tail) tl in
+         map f hd
+
+(* this is not tail recursive *)
+let rec list_forall2 f map l1 l2 = match l1, l2 with
+   | [], []                 -> f true
+   | hd1 :: tl1, hd2 :: tl2 ->
+      let f b = if b then list_forall2 f map tl1 tl2 else f false in
+      map f hd1 hd2
+   | _                      -> f false
+
+let list_rev_append f =
+   list_rev_map_append f (fun f t -> f t)
+
+let list_rev_map =
+   list_rev_map_append ~tail:[]
+
+let list_rev =
+   list_rev_append ~tail:[]
+
+let list_iter f map l =
+   let map f () x = map f x in
+   list_fold_left f map () l
+
+(* this is not tail recursive *)
+let rec list_fold_left2 f map a l1 l2 = match l1, l2 with
+   | [], []                 -> f a
+   | hd1 :: tl1, hd2 :: tl2 -> 
+      let f a = list_fold_left2 f map a tl1 tl2 in
+      map f a hd1 hd2
+   | _                      -> assert false
+
+let list_iter2 f map l1 l2 =
+   let map f () x1 x2 = map f x1 x2 in
+   list_fold_left2 f map () l1 l2
+
+let rec list_fold_right f map l a = match l with
+   | []       -> f a
+   | hd :: tl -> list_fold_right (map f hd) map tl a
+
+let list_map f map l =
+   let map f hd a = 
+      let f hd = f (hd :: a) in map f hd
+   in
+   list_fold_right f map l []
+
+let rec list_mem ?(eq=(=)) a = function
+   | []                   -> false
+   | hd :: _ when eq a hd -> true
+   | _ :: tl              -> list_mem ~eq a tl
diff --git a/helm/software/lambda-delta/src/lib/log.ml b/helm/software/lambda-delta/src/lib/log.ml
new file mode 100644 (file)
index 0000000..03e7b5b
--- /dev/null
@@ -0,0 +1,95 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module P = Printf
+module F = Format
+module C = Cps
+
+type ('a, 'b) item = Term of 'a * 'b
+                   | LEnv of 'a
+                   | Warn of string
+                  | String of string
+                   | Loc
+
+type ('a, 'b) message = ('a, 'b) item list
+
+type ('a, 'b) specs = {
+   pp_term: 'a -> F.formatter -> 'b -> unit;
+   pp_lenv: F.formatter -> 'a -> unit
+}
+
+let level = ref 0
+
+let loc = ref "unknown location"
+
+(* Internal functions *******************************************************)
+
+let clear () = 
+   level := 0; loc := "unknown location"
+
+let std = F.std_formatter
+
+let err = F.err_formatter
+
+let pp_items frm st l items =   
+   let pp_item frm = function
+      | Term (c, t) -> F.fprintf frm "@,%a" (st.pp_term c) t
+      | LEnv c      -> F.fprintf frm "%a" st.pp_lenv c
+      | Warn s      -> F.fprintf frm "@,%s" s
+      | String s    -> F.fprintf frm "%s " s
+      | Loc         -> F.fprintf frm " <%s>" !loc 
+   in
+   let iter map frm l = List.iter (map frm) l in
+   if !level >= l then F.fprintf frm "%a" (iter pp_item) items
+
+(* Interface functions ******************************************************)
+
+let box l = 
+   if !level >= l then
+   begin F.fprintf std "@,@[<v 2>%s" "  "; F.pp_print_if_newline std () end
+
+let unbox l = if !level >= l then F.fprintf std "@]"
+
+let flush l = if !level >= l then F.fprintf std "@]@."
+
+let box_err () = F.fprintf err "@[<v>"
+
+let flush_err () = F.fprintf err "@]@."
+
+let log st l items = pp_items std st l items
+
+let error st items = pp_items err st 0 items
+
+let items1 s = [Warn s]
+
+let t_items1 st c t =
+   [Warn st; Term (c, t)]
+
+let et_items1 sc c st t =
+   [Warn sc; LEnv c; Warn st; Term (c, t)]
+
+let et_items2 sc1 c1 st1 t1 ?sc2 ?c2 st2 t2 =
+   let tl = match sc2, c2 with
+      | Some sc2, Some c2 -> et_items1 sc2 c2 st2 t2
+      | None, None        -> t_items1 st2 c1 t2
+      | _                 -> assert false
+   in
+   et_items1 sc1 c1 st1 t1 @ tl  
+
+let et_items3 sc1 c1 st1 t1 ?sc2 ?c2 st2 t2 ?sc3 ?c3 st3 t3 =
+   let tl = match sc3, c3 with
+      | Some sc3, Some c3 -> et_items1 sc3 c3 st3 t3
+      | None, None        -> t_items1 st3 c1 t3 
+      | _                 -> assert false
+   in   
+   et_items2 sc1 c1 st1 t1 ?sc2 ?c2 st2 t2 @ tl 
+
+let warn msg = F.fprintf std "@,%s" msg
diff --git a/helm/software/lambda-delta/src/lib/log.mli b/helm/software/lambda-delta/src/lib/log.mli
new file mode 100644 (file)
index 0000000..9e0f054
--- /dev/null
@@ -0,0 +1,63 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type ('a, 'b) item = Term of 'a * 'b
+                   | LEnv of 'a
+                   | Warn of string
+                  | String of string
+                  | Loc
+
+type ('a, 'b) message = ('a, 'b) item list
+
+type ('a, 'b) specs = {
+   pp_term: 'a -> Format.formatter -> 'b -> unit;
+   pp_lenv: Format.formatter -> 'a -> unit
+}
+
+val loc: string ref
+
+val level: int ref
+
+val clear: unit -> unit
+
+val warn: string -> unit
+
+val box: int -> unit
+
+val unbox: int -> unit
+
+val flush: int -> unit
+
+val box_err: unit -> unit
+
+val flush_err: unit -> unit
+
+val log: ('a, 'b) specs -> int -> ('a, 'b) message -> unit
+
+val error: ('a, 'b) specs -> ('a, 'b) message -> unit
+
+val items1: string -> ('a, 'b) message
+
+val t_items1: string -> 'a -> 'b -> ('a, 'b) message
+
+val et_items1:
+   string -> 'a -> string -> 'b -> ('a, 'b) message
+
+val et_items2:
+   string -> 'a -> string -> 'b -> 
+   ?sc2:string -> ?c2:'a -> string -> 'b -> 
+   ('a, 'b) message
+
+val et_items3:
+   string -> 'a -> string -> 'b -> 
+   ?sc2:string -> ?c2:'a -> string -> 'b -> 
+   ?sc3:string -> ?c3:'a -> string -> 'b ->
+   ('a, 'b) message
diff --git a/helm/software/lambda-delta/src/lib/share.ml b/helm/software/lambda-delta/src/lib/share.ml
new file mode 100644 (file)
index 0000000..600ae9d
--- /dev/null
@@ -0,0 +1,21 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+let sh a b =
+   if a == b then a else b
+
+let sh1 a1 a2 b1 b2 =
+   if a1 == a2 then b1 else b2 (sh a1 a2)
+
+let sh2 a1 a2 b1 b2 c1 c2 =
+   if a1 == a2 && b1 == b2 then c1 else c2 (sh a1 a2) (sh b1 b2)
+
+let eq a b = (a == b) || (a = b)
diff --git a/helm/software/lambda-delta/src/lib/time.ml b/helm/software/lambda-delta/src/lib/time.ml
new file mode 100644 (file)
index 0000000..42d7d39
--- /dev/null
@@ -0,0 +1,34 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module P = Printf
+module L = Log
+
+let utime_stamp =
+   let old = ref 0.0 in
+   fun msg -> 
+      let times = Unix.times () in
+      let stamp = times.Unix.tms_utime in
+      let lap = stamp -. !old in
+      L.warn (P.sprintf "USR TIME STAMP (%s): %f (%f)" msg stamp lap);
+      old := stamp
+
+let gmtime msg =
+   let gmt = Unix.gmtime (Unix.time ()) in
+   let yy = gmt.Unix.tm_year + 1900 in
+   let mm = gmt.Unix.tm_mon + 1 in
+   let dd = gmt.Unix.tm_mday in
+   let h = gmt.Unix.tm_hour in
+   let m = gmt.Unix.tm_min in
+   let s = gmt.Unix.tm_sec in
+   L.warn (
+      P.sprintf "UTC TIME STAMP (%s): %u/%u/%u %u:%u:%u" msg yy mm dd h m s
+   )
diff --git a/helm/software/lambda-delta/src/text/Make b/helm/software/lambda-delta/src/text/Make
new file mode 100644 (file)
index 0000000..f1c0ffe
--- /dev/null
@@ -0,0 +1 @@
+txt txtParser txtLexer txtTxt
diff --git a/helm/software/lambda-delta/src/text/prova.hln b/helm/software/lambda-delta/src/text/prova.hln
new file mode 100644 (file)
index 0000000..a782fda
--- /dev/null
@@ -0,0 +1,11 @@
+\open pippo
+
+\global a : *Set
+
+\global b : *Prop
+
+\global f = [x:*Set].[y:*Prop].x
+
+\global "commento\"" c = f(a,b) : *Set
+
+\close
diff --git a/helm/software/lambda-delta/src/text/txt.ml b/helm/software/lambda-delta/src/text/txt.ml
new file mode 100644 (file)
index 0000000..dbcc067
--- /dev/null
@@ -0,0 +1,43 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type ix = int (* index *)
+
+type id = string (* identifier *)
+
+type desc = string (* description *)
+
+type kind = Decl (* generic declaration *) 
+          | Ax   (* axiom               *)
+         | Def  (* generic definition  *)
+         | Th   (* theorem             *)
+
+type bind = Abst of (id * bool * term) list (* name, real?, domain *)
+          | Abbr of (id * term) list        (* name, bodies        *)
+          | Void of id list                 (* names               *)
+
+and term = Sort of ix                      (* level                          *)
+         | NSrt of id                      (* named level                    *)
+        | LRef of ix * ix                 (* index, offset                  *)
+        | NRef of id                      (* name                           *)
+        | Cast of term * term             (* domain, element                *)
+        | Appl of term list * term        (* arguments, function            *)
+        | Bind of bind * term             (* binder, scope                  *)
+        | Inst of term * term list        (* function, arguments            *)
+        | Impl of bool * id * term * term (* strong?, label, source, target *)
+
+type command = Require of id list                (* required files: names *)
+             | Graph of id                       (* hierarchy graph: name *) 
+             | Sorts of (int option * id) list   (* sorts: index, name *)
+            | Section of id option              (* section: Some id = open, None = close last *)
+            | Entity of kind * id * desc * term (* entity: class, name, description, contents *) 
+             | Generate of term list             (* predefined generated entity: arguments *)
+            
diff --git a/helm/software/lambda-delta/src/text/txtLexer.mll b/helm/software/lambda-delta/src/text/txtLexer.mll
new file mode 100644 (file)
index 0000000..dc293bd
--- /dev/null
@@ -0,0 +1,72 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+{ 
+   module L = Log
+   module O = Options
+   module P = TxtParser
+   
+   let out s = if !O.debug_lexer then L.warn s else ()
+}
+
+let BS    = "\\"
+let SPC   = [' ' '\t' '\n']+
+let OC    = "\\*"
+let CC    = "*\\"
+let FIG   = ['0'-'9']
+let ALPHA = ['A'-'Z' 'a'-'z' '_']
+let QT    = '"'
+let ID    = ALPHA+ (ALPHA | FIG)*
+let IX    = FIG+
+
+rule block_comment = parse
+   | CC  { () }
+   | OC  { block_comment lexbuf; block_comment lexbuf }
+   | _   { block_comment lexbuf }
+and qstring = parse
+   | QT    { ""                                }
+   | SPC   { " " ^ qstring lexbuf              }  
+   | BS BS { "\\" ^ qstring lexbuf             } 
+   | BS QT { "\"" ^ qstring lexbuf             }  
+   | _ as c { String.make 1 c ^ qstring lexbuf }
+and token = parse
+   | SPC          { token lexbuf                                        } 
+   | OC           { block_comment lexbuf; token lexbuf                  }
+   | ID as id     { out ("ID " ^ id); P.ID id                           }
+   | IX as ix     { out ("IX " ^ ix); P.IX (int_of_string ix)           }
+   | QT           { let s = qstring lexbuf in out ("STR " ^ s); P.STR s }
+   | "\\graph"    { out "GRAPH"; P.GRAPH }
+   | "\\decl"     { out "DECL"; P.DECL   }
+   | "\\ax"       { out "AX"; P.AX       }
+   | "\\def"      { out "DEF"; P.DEF     }
+   | "\\th"       { out "TH"; P.TH       }
+   | "\\generate" { out "GEN"; P.GEN     }
+   | "\\require"  { out "REQ"; P.REQ     }
+   | "\\open"     { out "OPEN"; P.OPEN   } 
+   | "\\close"    { out "CLOSE"; P.CLOSE }
+   | "\\sorts"    { out "SORTS"; P.SORTS }
+   | "("          { out "OP"; P.OP       }
+   | ")"          { out "CP"; P.CP       }
+   | "["          { out "OB"; P.OB       }
+   | "]"          { out "CB"; P.CB       }
+   | "<"          { out "OA"; P.OA       }
+   | ">"          { out "CA"; P.CA       }
+   | "."          { out "FS"; P.FS       }   
+   | ":"          { out "CN"; P.CN       }   
+   | ","          { out "CM"; P.CM       }
+   | "="          { out "EQ"; P.EQ       }
+   | "*"          { out "STAR"; P.STAR   }
+   | "#"          { out "HASH"; P.HASH   }
+   | "+"          { out "PLUS"; P.PLUS   }
+   | "~"          { out "TE"; P.TE       }
+   | "->"         { out "WTO"; P.WTO     }
+   | "=>"         { out "STO"; P.STO     }
+   | eof          { out "EOF"; P.EOF     }
diff --git a/helm/software/lambda-delta/src/text/txtParser.mly b/helm/software/lambda-delta/src/text/txtParser.mly
new file mode 100644 (file)
index 0000000..694e308
--- /dev/null
@@ -0,0 +1,153 @@
+/* Copyright (C) 2000, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ */
+
+%{
+   module O = Options
+   module T = Txt
+   
+   let _ = Parsing.set_trace !O.debug_parser
+%}
+   %token <int> IX
+   %token <string> ID STR
+   %token OP CP OB CB OA CA FS CN CM EQ STAR HASH PLUS TE WTO STO 
+   %token GRAPH DECL AX DEF TH GEN REQ OPEN CLOSE SORTS EOF
+
+   %start entry
+   %type <Txt.command option> entry
+
+   %nonassoc CP CB CA
+   %right WTO STO
+%%
+   hash:
+      |      {}
+      | HASH {}
+   ;
+   fs:
+      |    {}
+      | FS {}
+   ;
+   comment:
+      |     { "" }
+      | STR { $1 }
+   ;
+   ids:
+      | ID        { [$1]     }
+      | ID CM ids { $1 :: $3 }
+   ;
+   sort:
+      | ID    { None, $1    }
+      | IX ID { Some $1, $2 }
+   ;
+   sorts:
+      | sort          { [$1]     }
+      | sort CM sorts { $1 :: $3 }
+   ;
+
+   abst:
+      | ID CN term { $1, true, $3  }
+      | TE term    { "", false, $2 }
+      | ID TE term { $1, false, $3 }
+   ;
+   abbr:
+      | ID EQ term { $1, $3 }
+   ;
+   absts:
+      | abst          { [$1]     }
+      | abst CM absts { $1 :: $3 }
+   ;
+   abbrs:
+      | abbr          { [$1]     }
+      | abbr CM abbrs { $1 :: $3 }
+   ;   
+   binder: 
+      | absts { T.Abst $1 }
+      | abbrs { T.Abbr $1 }
+      | ids   { T.Void $1 }
+   ;      
+   atom:
+      | STAR IX          { T.Sort $2         }
+      | STAR ID          { T.NSrt $2         }
+      | hash IX          { T.LRef ($2, 0)    }
+      | hash IX PLUS IX  { T.LRef ($2, $4)   }
+      | ID               { T.NRef $1         }
+      | HASH ID          { T.NRef $2         }
+      | atom OP term CP  { T.Inst ($1, [$3]) }
+      | atom OP terms CP { T.Inst ($1, $3)   }
+   ;
+   term:
+      | atom                 { $1                         }
+      | OA term CA fs term   { T.Cast ($2, $5)            }
+      | OP term CP fs term   { T.Appl ([$2], $5)          }
+      | OP terms CP fs term  { T.Appl ($2, $5)            }
+      | OB binder CB fs term { T.Bind ($2, $5)            }
+      | term WTO term        { T.Impl (false, "", $1, $3) }
+      | ID TE term WTO term  { T.Impl (false, $1, $3, $5) }
+      | term STO term        { T.Impl (true, "", $1, $3)  }
+      | ID TE term STO term  { T.Impl (true, $1, $3, $5)  }
+      | OP term CP           { $2                         }
+   ;
+   terms:
+      | term CM term  { [$1; $3] }
+      | term CM terms { $1 :: $3 }
+   ;
+   
+   decl:
+      | DECL { T.Decl }
+      | AX   { T.Ax   }
+   ;
+   def:   
+      | DEF  { T.Def } 
+      | TH   { T.Th  }
+   ;
+   xentity:
+      | GRAPH ID
+         { T.Graph $2                             }
+      | decl comment ID CN term
+         { T.Entity ($1, $3, $2, $5)              }
+      | def comment ID EQ term
+         { T.Entity ($1, $3, $2, $5)              }
+      | def comment ID EQ term CN term
+         { T.Entity ($1, $3, $2, T.Cast ($7, $5)) }
+      | GEN term
+         { T.Generate [$2]                        }
+      | GEN terms
+         { T.Generate $2                          }      
+      | REQ ids
+         { T.Require $2                           }
+      | OPEN ID                           
+         { T.Section (Some $2)                    }
+      | CLOSE                             
+         { T.Section None                         }
+      | SORTS sorts
+         { T.Sorts $2                             }
+   ;
+   start: 
+      | GRAPH {} | decl {} | def {} | GEN {} |
+      | REQ {} | OPEN {} | CLOSE {} | SORTS {} | EOF {}
+   ;
+   entry:
+      | xentity start { Some $1 }
+      | EOF           { None    }
+   ;
diff --git a/helm/software/lambda-delta/src/text/txtTxt.ml b/helm/software/lambda-delta/src/text/txtTxt.ml
new file mode 100644 (file)
index 0000000..1d501fe
--- /dev/null
@@ -0,0 +1,62 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module C = Cps
+module T = Txt
+
+(* Interface functions ******************************************************)
+
+let rec contract f = function
+   | T.Inst (t, vs)           ->
+      let tt = T.Appl (List.rev vs, t) in 
+      contract f tt
+   | T.Impl (false, id, w, t) ->
+      let tt = T.Bind (T.Abst [id, false, w], t) in 
+      contract f tt      
+   | T.Impl (true, id, w, t)  -> 
+      let f = function
+         | T.Bind (T.Abst [xw], T.Bind (T.Abst xws, tt)) ->
+            f (T.Bind (T.Abst (xw :: xws), tt))
+        | tt                                            -> f tt
+      in
+      let tt = T.Impl (false, id, w, t) in
+      contract f tt
+   | T.Sort _ 
+   | T.NSrt _     
+   | T.LRef _
+   | T.NRef _ as t            -> f t
+   | T.Cast (u, t)            ->
+      let f tt uu = f (T.Cast (uu, tt)) in
+      let f tt = contract (f tt) u in
+      contract f t
+    | T.Appl (vs, t)          ->
+      let f tt vvs = f (T.Appl (vvs, tt)) in
+      let f tt = C.list_map (f tt) contract vs in
+      contract f t      
+   | T.Bind (b, t)            ->
+      let f tt bb = f (T.Bind (bb, tt)) in
+      let f tt = contract_binder (f tt) b in
+      contract f t
+
+and contract_binder f = function
+   | T.Void n as b -> f b
+   | T.Abbr xvs    ->
+      let map f (id, v) = 
+         let f vv = f (id, vv) in contract f v
+      in
+      let f xvvs = f (T.Abbr xvvs) in
+      C.list_map f map xvs
+   | T.Abst xws    ->
+      let map f (id, real, w) = 
+         let f ww = f (id, real, ww) in contract f w
+      in
+      let f xwws = f (T.Abst xwws) in
+      C.list_map f map xws
diff --git a/helm/software/lambda-delta/src/text/txtTxt.mli b/helm/software/lambda-delta/src/text/txtTxt.mli
new file mode 100644 (file)
index 0000000..3574876
--- /dev/null
@@ -0,0 +1,12 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+val contract: (Txt.term -> 'a) -> Txt.term -> 'a
diff --git a/helm/software/lambda-delta/src/toplevel/Make b/helm/software/lambda-delta/src/toplevel/Make
new file mode 100644 (file)
index 0000000..a8a72e1
--- /dev/null
@@ -0,0 +1 @@
+meta metaOutput metaLibrary metaAut metaBag metaBrg top
diff --git a/helm/software/lambda-delta/src/toplevel/meta.ml b/helm/software/lambda-delta/src/toplevel/meta.ml
new file mode 100644 (file)
index 0000000..5539772
--- /dev/null
@@ -0,0 +1,25 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type uri = Entity.uri
+type id = Entity.id
+
+type term = Sort of bool                  (* sorts: true = TYPE, false = PROP *)
+         | LRef of int * int             (* local reference: local environment length, de bruijn index *)
+         | GRef of int * uri * term list (* global reference: local environment length, name, arguments *)
+         | Appl of term * term           (* application: argument, function *)
+         | Abst of id * term * term      (* abstraction: name, domain, scope *)
+
+type pars = (id * term) list (* parameter declarations: name, type *)
+
+type entry = pars * term * term option (* parameters, domain, body *)
+
+type entity = entry Entity.entity
diff --git a/helm/software/lambda-delta/src/toplevel/metaAut.ml b/helm/software/lambda-delta/src/toplevel/metaAut.ml
new file mode 100644 (file)
index 0000000..dd6c4a6
--- /dev/null
@@ -0,0 +1,218 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module U = NUri
+module H = U.UriHash
+module C = Cps
+module O = Options
+module Y = Entity
+module M = Meta
+module A = Aut
+
+(* qualified identifier: uri, name, qualifiers *)
+type qid = M.uri * M.id * M.id list
+
+type context_node = qid option (* context node: None = root *)
+
+type status = {
+   path: M.id list;          (* current section path *) 
+   node: context_node;       (* current context node *)
+   nodes: context_node list; (* context node list *)
+   line: int;                (* line number *)
+   cover: string             (* initial segment of URI hierarchy *) 
+}
+
+type resolver = Local of int
+              | Global of M.pars
+
+let henv_size, hcnt_size = 7000, 4300 (* hash tables initial sizes *)
+
+let henv = H.create henv_size (* optimized global environment *)
+
+let hcnt = H.create hcnt_size (* optimized context *) 
+
+(* Internal functions *******************************************************)
+
+let id_of_name (id, _, _) = id
+
+let mk_qid st id path =
+   let uripath = if st.cover = "" then path else st.cover :: path in
+   let str = String.concat "/" uripath in
+   let str = Filename.concat str id in 
+   U.uri_of_string ("ld:/" ^ str ^ ".ld"), id, path
+
+let uri_of_qid (uri, _, _) = uri
+
+let complete_qid f st (id, is_local, qs) =
+   let f qs = f (mk_qid st id qs) in
+   let f path = C.list_rev_append f path ~tail:qs in
+   let rec skip f = function
+      | phd :: ptl, qshd :: _ when phd = qshd -> f ptl
+      | _ :: ptl, _ :: _                      -> skip f (ptl, qs)
+      | _                                     -> f []
+   in
+   if is_local then f st.path else skip f (st.path, qs)
+
+let relax_qid f st (_, id, path) =
+   let f path = f (mk_qid st id path) in
+   let f = function
+      | _ :: tl -> C.list_rev f tl
+      | []      -> assert false
+   in
+   C.list_rev f path
+
+let relax_opt_qid f st = function
+   | None     -> f None
+   | Some qid -> let f qid = f (Some qid) in relax_qid f st qid
+
+let resolve_lref f st l lenv id =
+   let rec aux f i = function
+     | []                            -> f None
+     | (name, _) :: _ when name = id -> f (Some (M.LRef (l, i)))
+     | _ :: tl                       -> aux f (succ i) tl
+   in
+   aux f 0 lenv
+
+let resolve_lref_strict f st l lenv id =
+   let f = function
+      | Some t -> f t
+      | None   -> assert false
+   in
+   resolve_lref f st l lenv id
+
+let resolve_gref f st qid =
+   try let args = H.find henv (uri_of_qid qid) in f qid (Some args)
+   with Not_found -> f qid None
+
+let resolve_gref_relaxed f st qid =
+(* this is not tail recursive *)
+   let rec g qid = function
+      | None      -> relax_qid (resolve_gref g st) st qid
+      | Some args -> f qid args
+   in
+   resolve_gref g st qid
+
+let get_pars f st = function
+   | None              -> f [] None
+   | Some qid as node ->
+      try let pars = H.find hcnt (uri_of_qid qid) in f pars None
+      with Not_found -> f [] (Some node)
+
+let get_pars_relaxed f st =
+(* this is not tail recursive *)
+   let rec g pars = function
+      | None      -> f pars 
+      | Some node -> relax_opt_qid (get_pars g st) st node
+   in
+   get_pars g st st.node
+
+(* this is not tail recursive on the GRef branch *)
+let rec xlate_term f st lenv = function
+   | A.Sort sort         -> 
+      f (M.Sort sort)
+   | A.Appl (v, t)       ->
+      let f vv tt = f (M.Appl (vv, tt)) in
+      let f vv = xlate_term (f vv) st lenv t in
+      xlate_term f st lenv v
+   | A.Abst (name, w, t) ->
+      let add name w lenv = (name, w) :: lenv in
+      let f ww tt = f (M.Abst (name, ww, tt)) in
+      let f ww = xlate_term (f ww) st (add name ww lenv) t in
+      xlate_term f st lenv w
+   | A.GRef (name, args) ->
+      let l = List.length lenv in
+      let g qid defs =
+        let map1 f = xlate_term f st lenv in       
+        let map2 f (id, _) = resolve_lref_strict f st l lenv id in
+         let f tail = 
+           let f args = f (M.GRef (l, uri_of_qid qid, args)) in
+            let f defs = C.list_rev_map_append f map2 defs ~tail in
+           C.list_sub_strict f defs args
+        in   
+        C.list_map f map1 args
+      in
+      let g qid = resolve_gref_relaxed g st qid in
+      let f = function
+         | Some t -> f t
+        | None   -> complete_qid g st name
+      in
+      resolve_lref f st l lenv (id_of_name name)
+
+let xlate_entity err f st = function
+   | A.Section (Some (_, name))     ->
+      err {st with path = name :: st.path; nodes = st.node :: st.nodes}
+   | A.Section None            ->
+      begin match st.path, st.nodes with
+        | _ :: ptl, nhd :: ntl -> 
+           err {st with path = ptl; node = nhd; nodes = ntl}
+         | _                    -> assert false
+      end
+   | A.Context None            ->
+      err {st with node = None}
+   | A.Context (Some name)     ->
+      let f name = err {st with node = Some name} in
+      complete_qid f st name 
+   | A.Block (name, w)         ->
+      let f qid = 
+         let f pars =
+           let f ww = 
+              H.add hcnt (uri_of_qid qid) ((name, ww) :: pars);
+              err {st with node = Some qid}
+           in
+            xlate_term f st pars w
+        in
+         get_pars_relaxed f st
+      in
+      complete_qid f st (name, true, [])
+   | A.Decl (name, w)          ->
+      let f pars = 
+         let f qid = 
+            let f ww =
+              H.add henv (uri_of_qid qid) pars;
+              let a = [Y.Mark st.line] in
+              let entry = pars, ww, None in
+              let entity = a, uri_of_qid qid, Y.Abst entry in
+              f {st with line = succ st.line} entity
+           in
+           xlate_term f st pars w
+        in
+         complete_qid f st (name, true, [])
+      in
+      get_pars_relaxed f st
+   | A.Def (name, w, trans, v) ->
+      let f pars = 
+         let f qid = 
+            let f ww vv = 
+              H.add henv (uri_of_qid qid) pars;
+              let a = Y.Mark st.line :: if trans then [] else [Y.Priv] in 
+              let entry = pars, ww, Some vv in
+              let entity = a, uri_of_qid qid, Y.Abbr entry in
+              f {st with line = succ st.line} entity
+           in
+           let f ww = xlate_term (f ww) st pars v in
+           xlate_term f st pars w
+        in
+         complete_qid f st (name, true, [])
+      in
+      get_pars_relaxed f st
+
+(* Interface functions ******************************************************)
+
+let initial_status () =
+   H.clear henv; H.clear hcnt; {
+   path = []; node = None; nodes = []; line = 1; cover = !O.cover
+}
+
+let refresh_status st = {st with
+  cover = !O.cover
+}  
+
+let meta_of_aut = xlate_entity
diff --git a/helm/software/lambda-delta/src/toplevel/metaAut.mli b/helm/software/lambda-delta/src/toplevel/metaAut.mli
new file mode 100644 (file)
index 0000000..a1210c5
--- /dev/null
@@ -0,0 +1,20 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type status
+
+val initial_status: unit -> status 
+
+val refresh_status: status -> status
+
+val meta_of_aut: 
+   (status -> 'a) -> (status -> Meta.entity -> 'a) -> 
+   status -> Aut.command -> 'a
diff --git a/helm/software/lambda-delta/src/toplevel/metaBag.ml b/helm/software/lambda-delta/src/toplevel/metaBag.ml
new file mode 100644 (file)
index 0000000..991d7e8
--- /dev/null
@@ -0,0 +1,67 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module C = Cps
+module B = Bag
+module M = Meta
+
+(* Internal functions *******************************************************)
+
+let rec xlate_term c f = function
+   | M.Sort s            -> 
+      let f h = f (B.Sort h) in
+      if s then f 0 else f 1
+   | M.LRef (_, i)       ->
+      let l, _, _ = List.nth c i in
+      f (B.LRef l)
+   | M.GRef (_, uri, vs) ->
+      let map f t v = f (B.appl v t) in
+      let f vs = C.list_fold_left f map (B.GRef uri) vs in
+      C.list_map f (xlate_term c) vs
+   | M.Appl (v, t)       ->
+      let f v t = f (B.Appl (v, t)) in
+      let f v = xlate_term c (f v) t in
+      xlate_term c f v
+   | M.Abst (id, w, t)   ->
+      let f w = 
+         let l = B.new_location () in
+         let f t = f (B.Bind (l, id, B.Abst w, t)) in
+         let f c = xlate_term c f t in
+         B.push "meta" f c l id (B.Abst w)
+      in
+      xlate_term c f w
+
+let xlate_pars f pars =
+   let map f (id, w) c =
+      let l = B.new_location () in
+      let f w = B.push "meta" f c l id (B.Abst w) in
+      xlate_term c f w
+   in
+   C.list_fold_right f map pars B.empty_lenv
+
+let unwind_to_xlate_term f c t =
+   let map f t (l, id, b) = f (B.bind l id b t) in
+   let f t = C.list_fold_left f map t c in
+   xlate_term c f t
+
+let xlate_entry f = function 
+   | pars, u, None   ->
+      let f c = unwind_to_xlate_term f c u in      
+      xlate_pars f pars   
+   | pars, u, Some t ->
+      let f u t = f (B.Cast (u, t)) in
+      let f c u = unwind_to_xlate_term (f u) c t in
+      let f c = unwind_to_xlate_term (f c) c u in
+      xlate_pars f pars
+   
+(* Interface functions ******************************************************)
+
+let bag_of_meta = xlate_entry
diff --git a/helm/software/lambda-delta/src/toplevel/metaBag.mli b/helm/software/lambda-delta/src/toplevel/metaBag.mli
new file mode 100644 (file)
index 0000000..62ce68f
--- /dev/null
@@ -0,0 +1,12 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+val bag_of_meta: (Bag.term -> 'a) -> Meta.entry -> 'a
diff --git a/helm/software/lambda-delta/src/toplevel/metaBrg.ml b/helm/software/lambda-delta/src/toplevel/metaBrg.ml
new file mode 100644 (file)
index 0000000..cde4daa
--- /dev/null
@@ -0,0 +1,66 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module C = Cps
+module Y = Entity
+module B = Brg
+module M = Meta
+
+(* Internal functions *******************************************************)
+
+let rec xlate_term c f = function
+   | M.Sort s            -> 
+      let f h = f (B.Sort ([], h)) in
+      if s then f 0 else f 1
+   | M.LRef (_, i)       ->
+      f (B.LRef ([], i))
+   | M.GRef (_, uri, vs) ->
+      let map f t v = f (B.appl [] v t) in
+      let f vs = C.list_fold_left f map (B.GRef ([], uri)) vs in
+      C.list_map f (xlate_term c) vs
+   | M.Appl (v, t)       ->
+      let f v t = f (B.Appl ([], v, t)) in
+      let f v = xlate_term c (f v) t in
+      xlate_term c f v
+   | M.Abst (id, w, t)   ->
+      let f w = 
+         let a = [Y.Name (id, true)] in
+        let f t = f (B.Bind (a, B.Abst w, t)) in
+         xlate_term (B.push c B.empty a (B.Abst w)) f t
+      in
+      xlate_term c f w
+
+let xlate_pars f pars =
+   let map f (id, w) c =
+      let a = [Y.Name (id, true)] in
+      let f w = f (B.push c B.empty a (B.Abst w)) in
+      xlate_term c f w
+   in
+   C.list_fold_right f map pars B.empty
+
+let unwind_to_xlate_term f c t =
+   let map t a b = B.bind a b t in
+   let f t = f (B.fold_left map t c) in
+   xlate_term c f t
+
+let xlate_entry f = function
+   | pars, u, None   ->
+      let f c = unwind_to_xlate_term f c u in      
+      xlate_pars f pars   
+   | pars, u, Some t ->
+      let f u t = f (B.Cast ([], u, t)) in
+      let f c u = unwind_to_xlate_term (f u) c t in
+      let f c = unwind_to_xlate_term (f c) c u in
+      xlate_pars f pars
+
+(* Interface functions ******************************************************)
+
+let brg_of_meta = xlate_entry
diff --git a/helm/software/lambda-delta/src/toplevel/metaBrg.mli b/helm/software/lambda-delta/src/toplevel/metaBrg.mli
new file mode 100644 (file)
index 0000000..4ce275f
--- /dev/null
@@ -0,0 +1,12 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+val brg_of_meta: (Brg.term -> 'a) -> Meta.entry -> 'a
diff --git a/helm/software/lambda-delta/src/toplevel/metaLibrary.ml b/helm/software/lambda-delta/src/toplevel/metaLibrary.ml
new file mode 100644 (file)
index 0000000..3ae116d
--- /dev/null
@@ -0,0 +1,36 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module F = Format
+module O = MetaOutput
+
+type out_channel = Pervasives.out_channel * F.formatter
+
+(* internal functions *******************************************************)
+
+let hal_dir = "hal"
+
+let hal_ext = ".hal"
+
+(* interface functions ******************************************************)
+
+let open_out f name =      
+   let _ = Sys.command (Printf.sprintf "mkdir -p %s" hal_dir) in
+   let och = open_out (Filename.concat hal_dir (name ^ hal_ext)) in
+   let frm = F.formatter_of_out_channel och in
+   F.pp_set_margin frm max_int;
+   f (och, frm)
+
+let write_entity f (_, frm) entity =
+   O.pp_entity f frm entity
+   
+let close_out f (och, _) =
+   close_out och; f ()
diff --git a/helm/software/lambda-delta/src/toplevel/metaLibrary.mli b/helm/software/lambda-delta/src/toplevel/metaLibrary.mli
new file mode 100644 (file)
index 0000000..2f6e41b
--- /dev/null
@@ -0,0 +1,18 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type out_channel
+
+val open_out: (out_channel -> 'a) -> string -> 'a
+
+val write_entity: (unit -> 'a) -> out_channel -> Meta.entity -> 'a
+
+val close_out: (unit -> 'a) -> out_channel -> 'a
diff --git a/helm/software/lambda-delta/src/toplevel/metaOutput.ml b/helm/software/lambda-delta/src/toplevel/metaOutput.ml
new file mode 100644 (file)
index 0000000..21d735d
--- /dev/null
@@ -0,0 +1,162 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module P = Printf
+module F = Format
+module U = NUri
+module C = Cps
+module L = Log
+module Y = Entity
+module M = Meta
+
+type counters = {
+   eabsts: int;
+   eabbrs: int;
+   pabsts: int;    
+   tsorts: int;
+   tlrefs: int;
+   tgrefs: int;
+   pappls: int;
+   tappls: int;
+   tabsts: int;
+   uris  : U.uri list;
+   nodes : int;
+   xnodes: int
+}
+
+let initial_counters = {
+   eabsts = 0; eabbrs = 0; pabsts = 0; pappls = 0;
+   tsorts = 0; tlrefs = 0; tgrefs = 0; tappls = 0; tabsts = 0;
+   uris = []; nodes = 0; xnodes = 0
+}
+
+let rec count_term f c = function
+   | M.Sort _          -> 
+      f {c with tsorts = succ c.tsorts; nodes = succ c.nodes}
+   | M.LRef _          -> 
+      f {c with tlrefs = succ c.tlrefs; nodes = succ c.nodes}
+   | M.GRef (_, u, ts) -> 
+      let c = {c with tgrefs = succ c.tgrefs} in
+      let c = {c with pappls = c.pappls + List.length ts} in
+      let c = {c with nodes = c.nodes + List.length ts} in
+      let c =    
+        if Cps.list_mem ~eq:U.eq u c.uris
+        then {c with nodes = succ c.nodes}
+        else {c with xnodes = succ c.xnodes}
+      in
+      Cps.list_fold_left f count_term c ts
+   | M.Appl (v, t)     -> 
+      let c = {c with tappls = succ c.tappls; nodes = succ c.nodes} in
+      let f c = count_term f c t in
+      count_term f c v
+   | M.Abst (_, w, t)  -> 
+      let c = {c with tabsts = succ c.tabsts; nodes = succ c.nodes} in
+      let f c = count_term f c t in
+      count_term f c w
+
+let count_par f c (_, w) = count_term f c w
+
+let count_xterm f c = function
+   | None   -> f c
+   | Some v -> count_term f c v
+
+let count_entity f c = function
+   | _, u, Y.Abst (pars, w, xv) ->
+      let c = {c with eabsts = succ c.eabsts} in
+      let c = {c with pabsts = c.pabsts + List.length pars} in
+      let c = {c with uris = u :: c.uris; nodes = succ c.nodes + List.length pars} in
+      let f c = count_xterm f c xv in      
+      let f c = count_term f c w in
+      Cps.list_fold_left f count_par c pars   
+   | _, _, Y.Abbr (pars, w, xv) ->
+      let c = {c with eabbrs = succ c.eabbrs; xnodes = succ c.xnodes} in
+      let c = {c with pabsts = c.pabsts + List.length pars} in
+      let c = {c with nodes = c.nodes + List.length pars} in
+      let f c = count_xterm f c xv in
+      let f c = count_term f c w in
+      Cps.list_fold_left f count_par c pars
+   | _, _, Y.Void               -> assert false
+
+let print_counters f c =
+   let terms = c.tsorts + c.tlrefs + c.tgrefs + c.tappls + c.tabsts in
+   let pars = c.pabsts + c.pappls in
+   let entries = c.eabsts + c.eabbrs in
+   let nodes = c.nodes + c.xnodes in
+   L.warn (P.sprintf "  Intermediate representation summary");
+   L.warn (P.sprintf "    Total entries:            %7u" entries);
+   L.warn (P.sprintf "      Declaration items:      %7u" c.eabsts);
+   L.warn (P.sprintf "      Definition items:       %7u" c.eabbrs);
+   L.warn (P.sprintf "    Total parameter items:    %7u" pars);
+   L.warn (P.sprintf "      Application items:      %7u" c.pappls);
+   L.warn (P.sprintf "      Abstraction items:      %7u" c.pabsts);
+   L.warn (P.sprintf "    Total term items:         %7u" terms);
+   L.warn (P.sprintf "      Sort items:             %7u" c.tsorts);
+   L.warn (P.sprintf "      Local reference items:  %7u" c.tlrefs);
+   L.warn (P.sprintf "      Global reference items: %7u" c.tgrefs);
+   L.warn (P.sprintf "      Application items:      %7u" c.tappls);
+   L.warn (P.sprintf "      Abstraction items:      %7u" c.tabsts);
+   L.warn (P.sprintf "    Global Int. Complexity:   %7u" c.nodes);
+   L.warn (P.sprintf "      + Abbreviation nodes:   %7u" nodes);
+   f ()
+
+let string_of_sort = function
+   | true -> "Type"
+   | false -> "Prop"
+
+let pp_transparent frm a =
+   let err () = F.fprintf frm "%s" "=" in
+   let f () = F.fprintf frm "%s" "~" in
+   Y.priv err f a
+
+let pp_list pp opend sep closed frm l =
+   let rec aux frm = function
+      | []       -> ()
+      | [hd]     -> pp frm hd
+      | hd :: tl -> F.fprintf frm "%a%s%a" pp hd sep aux tl 
+   in
+   if l = [] then () else F.fprintf frm "%s%a%s" opend aux l closed
+
+let pp_rev_list pp opend sep closed frm l =
+   pp_list pp opend sep closed frm (List.rev l)
+
+let rec pp_args frm args = pp_list pp_term "(" "," ")" frm args
+
+and pp_term frm = function
+   | M.Sort s            -> 
+      F.fprintf frm "@[*%s@]" (string_of_sort s)
+   | M.LRef (l, i)       ->
+      F.fprintf frm "@[%u@@#%u@]" l i
+   | M.GRef (l, uri, ts) ->
+      F.fprintf frm "@[%u@@$%s%a@]" l (U.string_of_uri uri) pp_args ts
+   | M.Appl (v, t)       ->
+      F.fprintf frm "@[(%a).%a@]" pp_term v pp_term t
+   | M.Abst (id, w, t)   ->
+      F.fprintf frm "@[[%s:%a].%a@]" id pp_term w pp_term t
+
+let pp_par frm (id, w) =
+   F.fprintf frm "%s:%a" id pp_term w
+
+let pp_pars = pp_rev_list pp_par "[" "," "]"
+
+let pp_body a frm = function
+   | None   -> ()
+   | Some t -> F.fprintf frm "%a%a" pp_transparent a pp_term t
+
+let pp_entity frm = function
+   | a, uri, Y.Abst (pars, u, body)
+   | a, uri, Y.Abbr (pars, u, body) ->
+      F.fprintf frm "@[%u@@%s%a%a:%a@]@\n%!" 
+         (Y.mark C.err C.start a) (U.string_of_uri uri) 
+        pp_pars pars (pp_body a) body pp_term u
+   | _, _, Y.Void                   -> assert false
+
+let pp_entity f frm entity =
+   pp_entity frm entity; f ()
diff --git a/helm/software/lambda-delta/src/toplevel/metaOutput.mli b/helm/software/lambda-delta/src/toplevel/metaOutput.mli
new file mode 100644 (file)
index 0000000..1a7b119
--- /dev/null
@@ -0,0 +1,20 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+type counters
+
+val initial_counters: counters
+
+val count_entity: (counters -> 'a) -> counters -> Meta.entity -> 'a
+
+val print_counters: (unit -> 'a) -> counters -> 'a
+
+val pp_entity: (unit -> 'a) -> Format.formatter -> Meta.entity -> 'a
diff --git a/helm/software/lambda-delta/src/toplevel/top.ml b/helm/software/lambda-delta/src/toplevel/top.ml
new file mode 100644 (file)
index 0000000..40fcda5
--- /dev/null
@@ -0,0 +1,399 @@
+(*
+    ||M||  This file is part of HELM, an Hypertextual, Electronic        
+    ||A||  Library of Mathematics, developed at the Computer Science     
+    ||T||  Department, University of Bologna, Italy.                     
+    ||I||                                                                
+    ||T||  HELM is free software; you can redistribute it and/or         
+    ||A||  modify it under the terms of the GNU General Public License   
+    \   /  version 2 or (at your option) any later version.              
+     \ /   This software is distributed as is, NO WARRANTY.              
+      V_______________________________________________________________ *)
+
+module F    = Filename
+module P    = Printf
+module U    = NUri
+module C    = Cps
+module L    = Log
+module T    = Time
+module O    = Options
+module H    = Hierarchy
+module Op   = Output
+module Y    = Entity
+module X    = Library
+module AL   = AutLexer
+module AP   = AutProcess
+module AO   = AutOutput
+module DT   = CrgTxt
+module DA   = CrgAut
+module MA   = MetaAut
+module MO   = MetaOutput
+module ML   = MetaLibrary
+module DX   = CrgXml
+module DBrg = CrgBrg
+module MBrg = MetaBrg
+module BrgO = BrgOutput
+module BrgR = BrgReduction
+module BrgU = BrgUntrusted
+module MBag = MetaBag
+module BagO = BagOutput
+module BagT = BagType
+module BagU = BagUntrusted
+
+type status = {
+   ast : AP.status;
+   dst : DA.status;
+   mst : MA.status;
+   tst : DT.status;
+   ac  : AO.counters;
+   mc  : MO.counters;
+   brgc: BrgO.counters;
+   bagc: BagO.counters;
+   kst : Y.status
+}
+
+let flush_all () = L.flush 0; L.flush_err ()
+
+let bag_error s msg =
+   L.error BagO.specs (L.Warn s :: L.Loc :: msg); flush_all () 
+
+let brg_error s msg =
+   L.error BrgR.specs (L.Warn s :: L.Loc :: msg); flush_all () 
+
+let initial_status () = {
+   ac   = AO.initial_counters;
+   mc   = MO.initial_counters;
+   brgc = BrgO.initial_counters;
+   bagc = BagO.initial_counters;
+   mst  = MA.initial_status ();
+   dst  = DA.initial_status ();
+   tst  = DT.initial_status ();
+   ast  = AP.initial_status ();
+   kst  = Y.initial_status ()
+}
+
+let refresh_status st = {st with
+   mst = MA.refresh_status st.mst;
+   dst = DA.refresh_status st.dst;
+   tst = DT.refresh_status st.tst;
+   kst = Y.refresh_status st.kst
+}
+
+(* kernel related ***********************************************************)
+
+type kernel = Brg | Bag
+
+type kernel_entity = BrgEntity  of Brg.entity
+                   | BagEntity  of Bag.entity
+                  | CrgEntity  of Crg.entity
+                  | MetaEntity of Meta.entity
+
+let kernel = ref Brg
+
+let print_counters st = match !kernel with
+   | Brg -> BrgO.print_counters C.start st.brgc
+   | Bag -> BagO.print_counters C.start st.bagc
+
+let xlate_entity entity = match !kernel, entity with
+   | Brg, CrgEntity e  -> 
+      let f e = (BrgEntity e) in Y.xlate f DBrg.brg_of_crg e
+   | Brg, MetaEntity e -> 
+      let f e = (BrgEntity e) in Y.xlate f MBrg.brg_of_meta e
+   | Bag, MetaEntity e -> 
+      let f e = (BagEntity e) in Y.xlate f MBag.bag_of_meta e  
+   | _, entity         -> entity
+
+let pp_progress e =
+   let f a u =
+      let s = U.string_of_uri u in
+      let err () = L.warn (P.sprintf "%s" s) in
+      let f i = L.warn (P.sprintf "[%u] %s" i s) in
+      Y.mark err f a
+   in
+   match e with
+      | CrgEntity e -> Y.common f e
+      | BrgEntity e -> Y.common f e
+      | BagEntity e -> Y.common f e      
+      | MetaEntity e -> Y.common f e
+
+let count_entity st = function
+   | MetaEntity e -> {st with mc = MO.count_entity C.start st.mc e} 
+   | BrgEntity e  -> {st with brgc = BrgO.count_entity C.start st.brgc e}
+   | BagEntity e  -> {st with bagc = BagO.count_entity C.start st.bagc e}
+   | _            -> st
+
+let export_entity si xdir moch = function
+   | CrgEntity e  -> X.export_entity DX.export_term si xdir e
+   | BrgEntity e  -> X.export_entity BrgO.export_term si xdir e
+   | MetaEntity e ->
+      begin match moch with
+         | None     -> ()
+         | Some och -> ML.write_entity C.start och e
+      end
+   | BagEntity _  -> ()
+
+let type_check st k =
+   let brg_err msg = brg_error "Type Error" msg; failwith "Interrupted" in
+   let ok _ _ = st in
+   match k with
+      | BrgEntity entity -> BrgU.type_check brg_err ok st.kst entity
+      | BagEntity entity -> BagU.type_check ok st.kst entity
+      | CrgEntity _
+      | MetaEntity _     -> st
+
+(* extended lexer ***********************************************************)
+
+type 'token lexer = {
+   parse : Lexing.lexbuf -> 'token;
+   mutable tokbuf: 'token option;
+   mutable unget : bool
+}
+
+let initial_lexer parse = {
+   parse = parse; tokbuf = None; unget = false
+}
+
+let token xl lexbuf = match xl.tokbuf with
+   | Some token when xl.unget ->   
+      xl.unget <- false; token
+   | _                        ->
+      let token = xl.parse lexbuf in
+      xl.tokbuf <- Some token; token
+
+(* input related ************************************************************)
+
+type input = Text | Automath
+
+type input_entity = TxtEntity of Txt.command
+                  | AutEntity of Aut.command
+                 | NoEntity
+
+let type_of_input name =
+   if F.check_suffix name ".hln" then Text 
+   else if F.check_suffix name ".aut" then 
+      let _ = H.set_sorts 0 ["Set"; "Prop"] in
+      assert (H.set_graph "Z2");
+      Automath
+   else begin
+      L.warn (P.sprintf "Unknown file type: %s" name); exit 2
+   end
+
+let txt_xl = initial_lexer TxtLexer.token 
+
+let aut_xl = initial_lexer AutLexer.token 
+
+let parbuf = ref [] (* parser buffer *)
+
+let gen_text command = 
+   parbuf := TxtEntity command :: !parbuf
+
+let entity_of_input lexbuf i = match i, !parbuf with
+   | Automath, _    -> 
+      begin match AutParser.entry (token aut_xl) lexbuf with
+         | Some e -> aut_xl.unget <- true; AutEntity e
+         | None   -> NoEntity
+      end     
+   | Text, []       -> 
+      begin match TxtParser.entry (token txt_xl) lexbuf with
+         | Some e -> txt_xl.unget <- true; TxtEntity e
+         | None   -> NoEntity
+      end
+   | Text, hd :: tl ->
+      parbuf := tl; hd
+
+let process_input f st = function 
+   | AutEntity e     ->
+      let f ast e = f {st with ast = ast} (AutEntity e) in
+      AP.process_command f st.ast e
+   | xe              -> f st xe
+
+let count_input st = function
+   | AutEntity e -> {st with ac = AO.count_command C.start st.ac e}
+   | xe          -> st
+
+(****************************************************************************)
+
+let stage = ref 3
+let moch = ref None
+let meta = ref false
+let progress = ref false
+let preprocess = ref false
+let root = ref ""
+let cc = ref false
+let export = ref ""
+let old = ref false
+let st = ref (initial_status ())
+let streaming = ref false (* parsing style (temporary) *)
+
+let process_2 st entity =
+   let st = if !L.level > 2 then count_entity st entity else st in
+   if !export <> "" then export_entity !O.si !export !moch entity;
+   if !stage > 2 then type_check st entity else st
+           
+let process_1 st entity = 
+   if !progress then pp_progress entity;
+   let st = if !L.level > 2 then count_entity st entity else st in
+   if !export <> "" && !stage = 1 then export_entity !O.si !export !moch entity;
+   if !stage > 1 then process_2 st (xlate_entity entity) else st 
+
+let process_0 st entity = 
+   let f st entity =
+      if !stage = 0 then st else
+      match entity, !old with
+        | AutEntity e, true  ->
+            let frr mst = {st with mst = mst} in
+            let h mst e = process_1 {st with mst = mst} (MetaEntity e) in
+           MA.meta_of_aut frr h st.mst e 
+         | AutEntity e, false -> 
+            let err dst = {st with dst = dst} in
+            let g dst e = process_1 {st with dst = dst} (CrgEntity e) in
+           DA.crg_of_aut err g st.dst e
+         | TxtEntity e, _     -> 
+            let crr tst = {st with tst = tst} in
+            let d tst e = process_1 {st with tst = tst} (CrgEntity e) in
+           DT.crg_of_txt crr d gen_text st.tst e
+        | NoEntity, _        -> assert false
+   in
+   let st = if !L.level > 2 then count_input st entity else st in 
+   if !preprocess then process_input f st entity else f st entity
+
+let process_nostreaming st lexbuf input =
+   let rec aux1 book = match entity_of_input lexbuf input with
+      | NoEntity -> List.rev book
+      | e        -> aux1 (e :: book)   
+   in
+   let rec aux2 st = function
+      | []           -> st
+      | entity :: tl -> aux2 (process_0 st entity) tl
+   in
+   aux2 st (aux1 [])
+
+let rec process_streaming st lexbuf input = match entity_of_input lexbuf input with
+   | NoEntity -> st
+   | e        -> process_streaming (process_0 st e) lexbuf input   
+
+(****************************************************************************)
+
+let process st name =
+   let process = if !streaming then process_streaming else process_nostreaming in
+   let input = type_of_input name in
+   let ich = open_in name in
+   let lexbuf = Lexing.from_channel ich in 
+   let st = process st lexbuf input in
+   close_in ich; st, input
+
+let main =
+try 
+   let version_string = "Helena 0.8.1 M - August 2010" in
+   let print_version () = L.warn (version_string ^ "\n"); exit 0 in
+   let set_hierarchy s = 
+      if H.set_graph s then () else 
+         L.warn (P.sprintf "Unknown type hierarchy: %s" s)
+   in
+   let set_kernel = function
+      | "brg" -> kernel := Brg
+      | "bag" -> kernel := Bag
+      | s     -> L.warn (P.sprintf "Unknown kernel version: %s" s)
+   in
+   let set_summary i = L.level := i in
+   let set_stage i = stage := i in
+   let set_meta_file name =
+      let f och = moch := Some och in
+      ML.open_out f name
+   in
+   let set_xdir s = export := s in
+   let set_root s = root := s in
+   let close = function
+      | None     -> ()
+      | Some och -> ML.close_out C.start och
+   in
+   let clear_options () =
+      stage := 3; moch := None; meta := false; progress := false;
+      preprocess := false; root := ""; cc := false; export := "";
+      old := false; kernel := Brg; st := initial_status ();
+      L.clear (); O.clear (); H.clear (); Op.clear_reductions ();
+      streaming := false;
+   in
+   let process_file name =
+      if !L.level > 0 then T.gmtime version_string;      
+      if !L.level > 1 then
+         L.warn (P.sprintf "Processing file: %s" name);
+      if !L.level > 0 then T.utime_stamp "started";
+      let base_name = Filename.chop_extension (Filename.basename name) in
+      if !meta then set_meta_file base_name;
+      let mk_uri =
+         if !stage < 2 then Crg.mk_uri else
+        match !kernel with
+           | Brg -> Brg.mk_uri
+           | Bag -> Bag.mk_uri
+      in
+      let cover = F.concat !root base_name in
+      O.mk_uri := mk_uri; O.cover := cover;
+      let sst, input = process (refresh_status !st) name in
+      st := sst;
+      if !L.level > 0 then T.utime_stamp "processed";
+      if !L.level > 2 then begin
+         AO.print_counters C.start !st.ac;
+         if !preprocess then AO.print_process_counters C.start !st.ast;
+         if !stage > 0 then MO.print_counters C.start !st.mc;
+         if !stage > 1 then print_counters !st;
+         if !stage > 2 then Op.print_reductions ()
+      end
+   in
+   let exit () =
+      close !moch;
+      if !L.level > 0 then T.utime_stamp "at exit";
+      flush_all ()
+   in
+   let help = 
+      "Usage: helena [ -LPVXcgijmopqu1 | -Ss <number> | -x <dir> | -hkr <string> ]* [ <file> ]*\n\n" ^
+      "Summary levels: 0 just errors (default), 1 time stamps, 2 processed file names, \
+       3 data information, 4 typing information, 5 reduction information\n\n" ^
+       "Stages: 0 parsing, 1 to intermediate, 2 to untrusted, 3 to trusted (default)\n"
+   in
+   let help_L = " show lexer debug information" in 
+   let help_P = " show parser debug information" in 
+   let help_S = "<number>  set summary level (see above)" in
+   let help_V = " show version information" in
+   let help_X = " clear options" in
+   
+   let help_c = " output conversion constraints" in
+   let help_g = " always expand global definitions" in
+   let help_h = "<string>  set type hierarchy (default: Z1)" in
+   let help_i = " show local references by index" in
+   let help_j = " show URI of processed kernel objects" in
+   let help_k = "<string>  set kernel version (default: brg)" in
+   let help_m = " output intermediate representation (HAL)" in
+   let help_o = " use old abstract language instead of crg" in   
+   let help_p = " preprocess source" in
+   let help_q = " disable quotation of identifiers" in
+   let help_r = "<string>  set initial segment of URI hierarchy" in
+   let help_s = "<number>  set translation stage (see above)" in
+   let help_u = " activate sort inclusion" in
+   let help_x = "<dir>  export kernel entities (XML) to <dir>" in
+   
+   let help_1 = " parse files with streaming policy" in
+   L.box 0; L.box_err ();
+   at_exit exit;
+   Arg.parse [
+      ("-L", Arg.Set O.debug_lexer, help_L); 
+      ("-P", Arg.Set O.debug_parser, help_P); 
+      ("-S", Arg.Int set_summary, help_S);
+      ("-V", Arg.Unit print_version, help_V);
+      ("-X", Arg.Unit clear_options, help_X);
+      ("-c", Arg.Set cc, help_c);
+      ("-g", Arg.Set O.expand, help_g);
+      ("-h", Arg.String set_hierarchy, help_h);
+      ("-i", Arg.Set O.indexes, help_i);
+      ("-j", Arg.Set progress, help_j);      
+      ("-k", Arg.String set_kernel, help_k);
+      ("-m", Arg.Set meta, help_m); 
+      ("-o", Arg.Set old, help_o);      
+      ("-p", Arg.Set preprocess, help_p);
+      ("-q", Arg.Set O.unquote, help_q);      
+      ("-r", Arg.String set_root, help_r);
+      ("-s", Arg.Int set_stage, help_s);
+      ("-u", Arg.Set O.si, help_u);
+      ("-x", Arg.String set_xdir, help_x);
+      ("-1", Arg.Set streaming, help_1);      
+   ] process_file help;
+with BagT.TypeError msg -> bag_error "Type Error" msg