Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Added getAllInductives

darcs-hash:20090228195206-228f4-fb8ad57a6929a01659abe8eb4094ce9860f69513.gz
  • Loading branch information...
commit 4ebcbecf8b0391a4aa317de9da41f469a20b17c3 1 parent 6b7a51b
authored February 28, 2009
11  Ivor/TT.lhs
@@ -35,7 +35,7 @@
35 35
 >               -- * Examining the Context
36 36
 >               eval, whnf, evalnew, evalCtxt, getDef, defined, getPatternDef,
37 37
 >               getAllTypes, getAllDefs, getAllPatternDefs, getConstructors,
38  
->               getInductive, getType,
  38
+>               getInductive, getAllInductives, getType,
39 39
 >               Rule(..), getElimRule, nameType, getConstructorTag,
40 40
 >               getConstructorArity,
41 41
 >               Ivor.TT.freeze,Ivor.TT.thaw,
@@ -850,6 +850,15 @@ Give a parseable but ugly representation of a term.
850 850
 >                          Just d -> (x,d):(getPD xs)
851 851
 >                          _ -> getPD xs
852 852
 
  853
+> -- |Get all the inductive type definitions in the context.
  854
+> getAllInductives :: Context -> [(Name,Inductive)]
  855
+> getAllInductives ctxt 
  856
+>        = getI (map fst (getAllTypes ctxt))
  857
+>   where getI [] = []
  858
+>         getI (x:xs) = case (getInductive ctxt x) of
  859
+>                          Just d -> (x,d):(getI xs)
  860
+>                          _ -> getI xs
  861
+
853 862
 > getAllDefs :: Context -> [(Name, Term)]
854 863
 > getAllDefs ctxt = let names = map fst (getAllTypes ctxt) in
855 864
 >                       map (\ x -> (x, unJust (getDef ctxt x))) names
2  Ivor/TTCore.lhs
@@ -483,7 +483,7 @@ Return all the names used in a scope
483 483
 >     p' (P x) = [x]
484 484
 >     p' (App f' a) = (p' f')++(p' a)
485 485
 >     p' (Bind n b (Sc sc))
486  
->      | scnames <- p' sc = (scnames \\ [n]) ++ pb' b
  486
+>      | scnames <- p' sc = ((nub scnames) \\ [n]) ++ pb' b
487 487
 >     p' (Proj _ i x) = p' x
488 488
 >     p' (Label t (Comp n cs)) = p' t ++ concat (map p' cs)
489 489
 >     p' (Call (Comp n cs) t) = concat (map p' cs) ++ p' t

0 notes on commit 4ebcbec

Please sign in to comment.
Something went wrong with that request. Please try again.