diff --git a/CTT.hs b/CTT.hs
new file mode 100644
--- /dev/null
+++ b/CTT.hs
@@ -0,0 +1,461 @@
+module CTT where
+
+
+import Data.List
+
+import qualified MTT as A
+import Pretty
+
+--------------------------------------------------------------------------------
+-- | Terms
+
+type Binder = String
+type Def    = (Binder,Ter)  -- without type annotations for now
+type Ident  = String
+
+data Ter = Var Binder
+         | Id Ter Ter Ter | Refl Ter
+         | Pi Ter Ter     | Lam Binder Ter | App Ter Ter
+         | Where Ter [Def]
+         | U
+
+         | Undef A.Prim
+
+           -- constructor c Ms
+         | Con Ident [Ter]
+
+           -- branches c1 xs1  -> M1,..., cn xsn -> Mn
+         | Branch A.Prim [(Ident, ([Binder],Ter))]
+
+           -- labelled sum c1 A1s,..., cn Ans (assumes terms are constructors)
+         | LSum A.Prim [(Ident, [(Binder,Ter)])]
+
+           -- (A B:U) -> Id U A B -> A -> B
+           -- For TransU we only need the eqproof and the element in A is needed
+         | TransU Ter Ter
+
+           -- (A:U) -> (a : A) -> Id A a (transport A (refl U A) a)
+           -- Argument is a
+         | TransURef Ter
+
+           -- The primitive J will have type:
+           -- J : (A : U) (u : A) (C : (v : A) -> Id A u v -> U)
+           --  (w : C u (refl A u)) (v : A) (p : Id A u v) -> C v p
+         | J Ter Ter Ter Ter Ter Ter
+
+           -- (A : U) (u : A) (C : (v:A) -> Id A u v -> U)
+           -- (w : C u (refl A u)) ->
+           -- Id (C u (refl A u)) w (J A u C w u (refl A u))
+         | JEq Ter Ter Ter Ter
+
+           -- Ext B f g p : Id (Pi A B) f g,
+           -- (p : (Pi x:A) Id (Bx) (fx,gx)); A not needed ??
+         | Ext Ter Ter Ter Ter
+
+           -- Inh A is an h-prop stating that A is inhabited.
+           -- Here we take h-prop A as (Pi x y : A) Id A x y.
+         | Inh Ter
+
+           -- Inc a : Inh A for a:A (A not needed ??)
+         | Inc Ter
+
+           -- Squash a b : Id (Inh A) a b
+         | Squash Ter Ter
+
+           -- InhRec B p phi a : B,
+           -- p : hprop(B), phi : A -> B, a : Inh A (cf. HoTT-book p.113)
+         | InhRec Ter Ter Ter Ter
+
+           -- EquivEq A B f s t where
+           -- A, B are types, f : A -> B,
+           -- s : (y : B) -> fiber f y, and
+           -- t : (y : B) (z : fiber f y) -> Id (fiber f y) (s y) z
+           -- where fiber f y is Sigma x : A. Id B (f x) z.
+         | EquivEq Ter Ter Ter Ter Ter
+
+           -- (A : U) -> (s : (y : A) -> pathTo A a) ->
+           -- (t : (y : B) -> (v : pathTo A a) -> Id (path To A a) (s y) v) ->
+           -- Id (Id U A A) (refl U A) (equivEq A A (id A) s t)
+         | EquivEqRef Ter Ter Ter
+
+           -- (A B : U) -> (f : A -> B) (s : (y : B) -> fiber A B f y) ->
+           -- (t : (y : B) -> (v : fiber A B f y) -> Id (fiber A B f y) (s y) v) ->
+           -- (a : A) -> Id B (f a) (transport A B (equivEq A B f s t) a)
+         | TransUEquivEq Ter Ter Ter Ter Ter Ter
+  deriving (Eq)
+
+instance Show Ter where
+  show = showTer
+
+--------------------------------------------------------------------------------
+-- | Names, dimension, and nominal type class
+
+type Name = Integer
+type Dim  = [Name]
+
+gensym :: Dim -> Name
+gensym [] = 0
+gensym xs = maximum xs + 1
+
+gensyms :: Dim -> [Name]
+gensyms d = let x = gensym d in x : gensyms (x : d)
+
+class Nominal a where
+  swap :: a -> Name -> Name -> a
+  support :: a -> [Name]
+
+fresh :: Nominal a => a -> Name
+fresh = gensym . support
+
+instance (Nominal a, Nominal b) => Nominal (a, b) where
+  support (a, b)  = support a `union` support b
+  swap (a, b) x y = (swap a x y, swap b x y)
+
+instance Nominal a => Nominal [a]  where
+  support vs  = unions (map support vs)
+  swap vs x y = [swap v x y | v <- vs]
+
+swapName :: Name -> Name -> Name -> Name
+swapName z x y | z == x    = y
+               | z == y    = x
+               | otherwise = z
+
+-- Make Name an instance of Nominal
+instance Nominal Integer where
+  support n = [n]
+  swap      = swapName
+
+--------------------------------------------------------------------------------
+-- | Boxes
+
+data Dir = Up | Down
+  deriving (Eq, Show)
+
+mirror :: Dir -> Dir
+mirror Up   = Down
+mirror Down = Up
+
+type Side = (Name,Dir)
+
+allDirs :: [Name] -> [Side]
+allDirs []     = []
+allDirs (n:ns) = (n,Down) : (n,Up) : allDirs ns
+
+data Box a = Box { dir   :: Dir
+                 , pname :: Name
+                 , pface :: a
+                 , sides :: [(Side,a)] }
+  deriving Eq
+
+instance Show a => Show (Box a) where
+  show (Box dir n f xs) = "Box" <+> show dir <+> show n <+> show f <+> show xs
+
+-- Showing boxes with parenthesis around
+showBox :: Show a => Box a -> String
+showBox = parens . show
+
+mapBox :: (a -> b) -> Box a -> Box b
+mapBox f (Box d n x xs) = Box d n (f x) [ (nnd,f v) | (nnd,v) <- xs ]
+
+instance Functor Box where
+  fmap = mapBox
+
+lookBox :: Show a => Side -> Box a -> a
+lookBox (y,dir) (Box d x v _)  | x == y && mirror d == dir = v
+lookBox xd box@(Box _ _ _ nvs) = case lookup xd nvs of
+  Just v  -> v
+  Nothing -> error $ "lookBox: box not defined on " ++
+                      show xd ++ "\nbox = " ++ show box
+
+nonPrincipal :: Box a -> [Name]
+nonPrincipal (Box _ _ _ nvs) = nub $ map (fst . fst) nvs
+
+defBox :: Box a -> [(Name, Dir)]
+defBox (Box d x _ nvs) = (x,mirror d) : [ zd | (zd,_) <- nvs ]
+
+fromBox :: Box a -> [(Side,a)]
+fromBox (Box d x v nvs) = ((x, mirror d),v) : nvs
+
+modBox :: (Side -> a -> b) -> Box a -> Box b
+modBox f (Box dir x v nvs) =
+  Box dir x (f (x,mirror dir) v) [ (nd,f nd v) | (nd,v) <- nvs ]
+
+-- Restricts the non-principal faces to np.
+subBox :: [Name] -> Box a -> Box a
+subBox np (Box dir x v nvs) =
+  Box dir x v [ nv | nv@((n,_),_) <- nvs, n `elem` np]
+
+shapeOfBox :: Box a -> Box ()
+shapeOfBox = mapBox (const ())
+
+-- fst is down, snd is up
+consBox :: (Name,(a,a)) -> Box a -> Box a
+consBox (n,(v0,v1)) (Box dir x v nvs) =
+  Box dir x v $ ((n,Down),v0) : ((n,Up),v1) : nvs
+
+appendBox :: [(Name,(a,a))] -> Box a -> Box a
+appendBox xs b = foldr consBox b xs
+
+appendSides :: [(Side, a)] -> Box a -> Box a
+appendSides sides (Box dir x v nvs) = Box dir x v (sides ++ nvs)
+
+transposeBox :: Box [a] -> [Box a]
+transposeBox b@(Box dir _ [] _)      = []
+transposeBox (Box dir x (v:vs) nvss) =
+  Box dir x v [ (nnd,head vs) | (nnd,vs) <- nvss ] :
+  transposeBox (Box dir x vs [ (nnd,tail vs) | (nnd,vs) <- nvss ])
+
+
+supportBox :: Nominal a => Box a -> [Name]
+supportBox (Box dir n v vns) = [n] `union` support v `union`
+  unions [ [y] `union` support v | ((y,dir'),v) <- vns ]
+
+-- Swap for boxes
+swapBox :: Nominal a => Box a -> Name -> Name -> Box a
+swapBox (Box dir z v nvs) x y =
+  let sw u = swap u x y
+  in Box dir (swap z x y) (sw v)
+         [ ((swap n x y,nd),sw v) | ((n,nd),v) <- nvs ]
+
+instance Nominal a => Nominal (Box a) where
+  swap    = swapBox
+  support = supportBox
+
+--------------------------------------------------------------------------------
+-- | Values
+
+data KanType = Fill | Com
+  deriving (Show, Eq)
+
+data Val = VU
+         | Ter Ter Env
+         | VPi Val Val
+         | VId Val Val Val
+
+           -- tag values which are paths
+         | Path Name Val
+         | VExt Name Val Val Val Val
+
+           -- inhabited
+         | VInh Val
+
+           -- inclusion into inhabited
+         | VInc Val
+
+           -- squash type - connects the two values along the name
+         | VSquash Name Val Val
+
+         | VCon Ident [Val]
+
+         | Kan KanType Val (Box Val)
+
+           -- of type U connecting a and b along x
+           -- VEquivEq x a b f s t
+         | VEquivEq Name Val Val Val Val Val
+
+           -- names x, y and values a, s, t
+         | VEquivSquare Name Name Val Val Val
+
+           -- of type VEquivEq
+         | VPair Name Val Val
+
+           -- of type VEquivSquare
+         | VSquare Name Name Val
+
+           -- a value of type Kan Com VU (Box (type of values))
+         | VComp (Box Val)
+
+           -- a value of type Kan Fill VU (Box (type of values minus name))
+           -- the name is bound
+         | VFill Name (Box Val)
+  deriving Eq
+
+instance Show Val where
+  show = showVal
+
+
+fstVal, sndVal, unSquare :: Val -> Val
+fstVal (VPair _ a _)     = a
+fstVal x                 = error $ "error fstVal: " ++ show x
+sndVal (VPair _ _ v)     = v
+sndVal x                 = error $ "error sndVal: " ++ show x
+unSquare (VSquare _ _ v) = v
+unSquare v               = error $ "unSquare bad input: " ++ show v
+
+unCon :: Val -> [Val]
+unCon (VCon _ vs) = vs
+unCon v           = error $ "unCon: not a constructor: " ++ show v
+
+unions :: Eq a => [[a]] -> [a]
+unions = foldr union []
+
+unionsMap :: Eq b => (a -> [b]) -> [a] -> [b]
+unionsMap f = unions . map f
+
+instance Nominal Val where
+  support VU                = []
+  support (Ter _ e)         = support e
+  support (VId a v0 v1)     = support [a,v0,v1]
+  support (Path x v)        = delete x $ support v
+  support (VInh v)          = support v
+  support (VInc v)          = support v
+  support (VPi v1 v2)       = support [v1,v2]
+  support (VCon _ vs)       = support vs
+  support (VSquash x v0 v1) = [x] `union` support [v0,v1]
+  support (VExt x b f g p)  = [x] `union` support [b,f,g,p]
+  support (Kan Fill a box)  = support a `union` support box
+  support (Kan Com a box@(Box _ n _ _)) =
+    delete n (support a `union` support box)
+  support (VEquivEq x a b f s t)    = [x] `union` support [a,b,f,s,t]
+  support (VPair x a v)             = [x] `union` support [a,v]
+  support (VComp box@(Box _ n _ _)) = delete n $ support box
+  support (VFill x box)             = delete x $ support box
+
+  swap u x y =
+    let sw u = swap u x y in case u of
+    VU          -> VU
+    Ter t e     -> Ter t (swap e x y)
+    VId a v0 v1 -> VId (sw a) (sw v0) (sw v1)
+    Path z v | z /= x && z /= y    -> Path z (sw v)
+             | otherwise -> let z' = gensym ([x] `union` [y] `union` support v)
+                                v' = swap v z z'
+                            in Path z' (sw v')
+    VExt z b f g p  -> VExt (swap z x y) (sw b) (sw f) (sw g) (sw p)
+    VPi a f         -> VPi (sw a) (sw f)
+    VInh v          -> VInh (sw v)
+    VInc v          -> VInc (sw v)
+    VSquash z v0 v1 -> VSquash (swap z x y) (sw v0) (sw v1)
+    VCon c us       -> VCon c (map sw us)
+    VEquivEq z a b f s t ->
+      VEquivEq (swap z x y) (sw a) (sw b) (sw f) (sw s) (sw t)
+    VPair z a v  -> VPair (swap z x y) (sw a) (sw v)
+    VEquivSquare z w a s t ->
+      VEquivSquare (swap z x y) (swap w x y) (sw a) (sw s) (sw t)
+    VSquare z w v -> VSquare (swap z x y) (swap w x y) (sw v)
+    Kan Fill a b  -> Kan Fill (sw a) (swap b x y)
+    Kan Com a b@(Box _ z _ _)
+      | z /= x && z /= y -> Kan Com (sw a) (swap b x y)
+      | otherwise -> let z' = gensym ([x] `union` [y] `union` support u)
+                         a' = swap a z z'
+                     in sw (Kan Com a' (swap b z z'))
+    VComp b@(Box _ z _ _)
+      | z /= x && z /= y -> VComp (swap b x y)
+      | otherwise -> let z' = gensym ([x] `union` [y] `union` support u)
+                     in sw (VComp (swap b z z'))
+    VFill z b@(Box dir n _ _)
+      | z /= x && z /= x -> VFill z (swap b x y)
+      | otherwise        -> let
+        z' = gensym ([x] `union` [y] `union` support b)
+        in sw (VFill z' (swap b z z'))
+
+--------------------------------------------------------------------------------
+-- | Environments
+
+data Env = Empty
+         | Pair Env (Binder,Val)
+         | PDef [(Binder,Ter)] Env
+  deriving Eq
+
+instance Show Env where
+  show = showEnv
+
+showEnv :: Env -> String
+showEnv Empty            = ""
+showEnv (Pair env (x,u)) = parens $ showEnv1 env ++ show u
+showEnv (PDef xas env)   = showEnv env
+
+showEnv1 :: Env -> String
+showEnv1 Empty            = ""
+showEnv1 (Pair env (x,u)) = showEnv1 env ++ show u ++ ", "
+showEnv1 (PDef xas env)   = show env
+
+supportEnv :: Env -> [Name]
+supportEnv Empty          = []
+supportEnv (Pair e (_,v)) = supportEnv e `union` support v
+supportEnv (PDef _ e)     = supportEnv e
+
+instance Nominal Env where
+  swap e x y = mapEnv (\u -> swap u x y) e
+  support    = supportEnv
+
+upds :: Env -> [(Binder,Val)] -> Env
+upds = foldl Pair
+
+mapEnv :: (Val -> Val) -> Env -> Env
+mapEnv _ Empty          = Empty
+mapEnv f (Pair e (x,v)) = Pair (mapEnv f e) (x,f v)
+mapEnv f (PDef ts e)    = PDef ts (mapEnv f e)
+
+
+--------------------------------------------------------------------------------
+-- | Pretty printing
+
+showTer :: Ter -> String
+showTer U                  = "U"
+showTer (Var x)            = "x"
+showTer (App e0 e1)        = showTer e0 <+> showTer1 e1
+showTer (Pi e0 e1)         = "Pi" <+> showTers [e0,e1]
+showTer (Lam x e)          = "\\" ++ x ++ "->" <+> showTer e
+showTer (LSum (_,str) _)   = str
+showTer (Branch (n,str) _) = str ++ show n
+showTer (Undef (n,str))    = str ++ show n
+showTer (Con ident ts)     = ident <+> showTers ts
+showTer (Id a t s)         = "Id" <+> showTers [a,t,s]
+showTer (TransU t s)       = "transport" <+> showTers [t,s]
+showTer (TransURef t)      = "transportRef" <+> showTer t
+showTer (Refl t)           = "refl" <+> showTer t
+showTer (J a b c d e f)    = "J" <+> showTers [a,b,c,d,e,f]
+showTer (JEq a b c d)      = "Jeq" <+> showTers [a,b,c,d]
+showTer (Ext b f g p)      = "funExt" <+> showTers [b,f,g,p]
+showTer (Inh t)            = "inh" <+> showTer t
+showTer (Inc t)            = "inc" <+> showTer t
+showTer (Squash a b)       = "squash" <+> showTers [a,b]
+showTer (InhRec a b c d)   = "inhrec" <+> showTers [a,b,c,d]
+showTer (EquivEq a b c d e) = "equivEq" <+> showTers [a,b,c,d,e]
+showTer (EquivEqRef a b c) = "equivEqRef" <+> showTers [a,b,c]
+showTer (TransUEquivEq a b c d e f) = "transpEquivEq" <+> showTers [a,b,c,d,e,f]
+showTer (Where t defs)     = showTer t <+> "where" <+> showDefs defs
+
+showDef :: Def -> String
+showDef (x,t) = x <+> "=" <+> showTer t
+
+showDefs :: [Def] -> String
+showDefs = ccat . map showDef
+
+showTers :: [Ter] -> String
+showTers = hcat . map showTer1
+
+showTer1 :: Ter -> String
+showTer1 U          = "U"
+showTer1 (Con c []) = c
+showTer1 (Var x)    = x
+showTer1 u          = parens $ showTer u
+
+
+showVal :: Val -> String
+showVal VU               = "U"
+showVal (Ter t env)      = showTer t <+> show env
+showVal (VId a u v)      = "Id" <+> showVal1 a <+> showVal1 u <+> showVal1 v
+showVal (Path n u)       = abrack (show n) <+> showVal u
+showVal (VExt n b f g p) = "funExt" <+> show n <+> showVals [b,f,g,p]
+showVal (VCon c us)      = c <+> showVals us
+showVal (VPi a f)        = "Pi" <+> showVals [a,f]
+showVal (VInh u)         = "inh" <+> showVal1 u
+showVal (VInc u)         = "inc" <+> showVal1 u
+showVal (VSquash n u v)  = "squash" <+> show n <+> showVals [u,v]
+showVal (Kan typ v box)  = "Kan" <+> show typ <+> showVal1 v <+> showBox box
+showVal (VPair n u v)    = "vpair" <+> show n <+> showVals [u,v]
+showVal (VSquare x y u)  = "vsquare" <+> show x <+> show y <+> showVal1 u
+showVal (VComp box)      = "vcomp" <+> showBox box
+showVal (VFill n box)    = "vfill" <+> show n <+> showBox box
+showVal (VEquivEq n a b f s t) = "equivEq" <+> show n <+> showVals [a,b,f,s,t]
+showVal (VEquivSquare x y a s t) =
+  "equivSquare" <+> show x <+> show y <+> showVals [a,s,t]
+
+showVals :: [Val] -> String
+showVals = hcat . map showVal1
+
+showVal1 :: Val -> String
+showVal1 VU          = "U"
+showVal1 (VCon c []) = c
+showVal1 u           = parens $ showVal u
diff --git a/Concrete.hs b/Concrete.hs
new file mode 100644
--- /dev/null
+++ b/Concrete.hs
@@ -0,0 +1,203 @@
+{-# LANGUAGE TupleSections #-}
+
+-- Convert the concrete syntax into the syntax of miniTT.
+module Concrete where
+
+import Exp.Abs
+import qualified MTT as A
+
+import Control.Arrow (first)
+import Control.Applicative
+import Control.Monad.Trans
+import Control.Monad.Trans.State
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Error hiding (throwError)
+import Control.Monad.Error (throwError)
+import Control.Monad (when)
+import Data.Functor.Identity
+import Data.List (union)
+
+type Tele = [VDecl]
+
+-- | Useful auxiliary functions
+unions :: Eq a => [[a]] -> [a]
+unions = foldr union []
+
+-- Applicative cons
+(<:>) :: Applicative f => f a -> f [a] -> f [a]
+a <:> b = (:) <$> a <*> b
+
+-- un-something functions
+unIdent :: AIdent -> String
+unIdent (AIdent (_,n)) = n
+
+unArg :: Arg -> String
+unArg (Arg n) = unIdent n
+unArg NoArg   = "_"
+
+unArgs :: [Arg] -> [String]
+unArgs = map unArg
+
+unBinder :: Binder -> Arg
+unBinder (Binder b) = b
+
+unArgBinder :: Binder -> String
+unArgBinder = unArg . unBinder
+
+unArgsBinder :: [Binder] -> [String]
+unArgsBinder = map unArgBinder
+
+unWhere :: ExpWhere -> Exp
+unWhere (Where e ds) = Let ds e
+unWhere (NoWhere e)  = e
+
+-- Flatten a telescope, e.g., flatten (a b : A) (c : C) into
+-- (a : A) (b : A) (c : C).
+flattenTele :: Tele -> [VDecl]
+flattenTele = concatMap (\(VDecl bs e) -> [VDecl [b] e | b <- bs])
+
+-- Note: It is important to only apply unApps to e1 as otherwise the
+-- structure of the application will be destroyed which leads to trouble
+-- for constructor disambiguation!
+unApps :: Exp -> [Exp]
+unApps (App e1 e2) = unApps e1 ++ [e2]
+unApps e           = [e]
+
+unVar :: Exp -> Arg
+unVar (Var b) = b
+unVar e       = error $ "unVar bad input: " ++ show e
+
+unVarBinder :: Exp -> String
+unVarBinder = unArg . unVar
+
+unPiDecl :: PiDecl -> VDecl
+unPiDecl (PiDecl e t) = VDecl (map (Binder . unVar) (unApps e)) t
+
+flattenTelePi :: [PiDecl] -> [VDecl]
+flattenTelePi = flattenTele . map unPiDecl
+
+namesTele :: Tele -> [String]
+namesTele vs = unions [ unArgsBinder args | VDecl args _ <- vs ]
+
+-------------------------------------------------------------------------------
+-- | Resolver and environment
+
+-- local environment for constructors
+data Env = Env { constrs :: [String] }
+         deriving (Eq, Show)
+
+type Resolver a = ReaderT Env (StateT A.Prim (ErrorT String Identity)) a
+
+emptyEnv :: Env
+emptyEnv = Env []
+
+runResolver :: Resolver a -> Either String a
+runResolver x = runIdentity $ runErrorT $ evalStateT (runReaderT x emptyEnv) (0,"")
+
+insertConstrs :: [String] -> Env -> Env
+insertConstrs cs (Env cs') = Env $ cs ++ cs'
+
+getEnv :: Resolver Env
+getEnv = ask
+
+getConstrs :: Resolver [String]
+getConstrs = constrs <$> getEnv
+
+genPrim :: Resolver A.Prim
+genPrim = do
+  prim <- lift get
+  lift (modify (first succ))
+  return prim
+
+updateName :: String -> Resolver ()
+updateName str = lift $ modify (\(g,_) -> (g,str))
+
+lam :: Arg -> Resolver A.Exp -> Resolver A.Exp
+lam a e = A.Lam (unArg a) <$> e
+
+lams :: [Arg] -> Resolver A.Exp -> Resolver A.Exp
+lams as e = foldr lam e as
+
+resolveExp :: Exp -> Resolver A.Exp
+resolveExp U            = return A.U
+resolveExp Undef        = A.Undef <$> genPrim
+resolveExp PN           = A.Undef <$> genPrim
+resolveExp e@(App t s)  = do
+  let x:xs = unApps e
+  cs <- getConstrs
+  if unVarBinder x `elem` cs
+    then A.Con (unVarBinder x) <$> mapM resolveExp xs
+    else A.App <$> resolveExp t <*> resolveExp s
+resolveExp (Pi tele b)  = resolveTelePi (flattenTelePi tele) (resolveExp b)
+resolveExp (Fun a b)    = A.Pi <$> resolveExp a <*> lam NoArg (resolveExp b)
+resolveExp (Lam bs t)   = lams (map unBinder bs) (resolveExp t)
+resolveExp (Split brs)  = A.Fun <$> genPrim <*> mapM resolveBranch brs
+resolveExp (Let defs e) = A.lets <$> resolveDefs defs <*> resolveExp e
+resolveExp (Var n)      = do
+  let x = unArg n
+  when (x == "_") (throwError "_ not a valid variable name")
+  Env cs <- getEnv
+  return (if x `elem` cs then A.Con x [] else A.Var x)
+
+resolveWhere :: ExpWhere -> Resolver A.Exp
+resolveWhere = resolveExp . unWhere
+
+resolveBranch :: Branch -> Resolver (String,([String],A.Exp))
+resolveBranch (Branch name args e) =
+  ((unIdent name,) . (unArgs args,)) <$> resolveWhere e
+
+-- Assumes a flattened telescope.
+resolveTele :: [VDecl] -> Resolver [(String,A.Exp)]
+resolveTele []                      = return []
+resolveTele (VDecl [Binder a] t:ds) =
+  ((unArg a,) <$> resolveExp t) <:> resolveTele ds
+resolveTele ds                      =
+  throwError $ "resolveTele: non flattened telescope " ++ show ds
+
+-- Assumes a flattened telescope.
+resolveTelePi :: [VDecl] -> Resolver A.Exp -> Resolver A.Exp
+resolveTelePi [] b                      = b
+resolveTelePi (VDecl [Binder x] a:as) b =
+  A.Pi <$> resolveExp a <*> lam x (resolveTelePi as b)
+resolveTelePi (t@(VDecl{}):as) _        =
+  throwError ("resolveTelePi: non flattened telescope " ++ show t)
+
+resolveLabel :: Sum -> Resolver (String,[(String,A.Exp)])
+resolveLabel (Sum n tele) = (unIdent n,) <$> resolveTele (flattenTele tele)
+
+resolveDefs :: [Def] -> Resolver [A.Def]
+resolveDefs [] = return []
+resolveDefs (DefTDecl n e:d:ds) = do
+  e' <- resolveExp e
+  xd <- checkDef (unIdent n,d)
+  rest <- resolveDefs ds
+  return $ ([(unIdent n, e')],[xd]) : rest
+-- resolveDefs (DefMutual defs:ds) = resolveMutual defs <:> resolveDefs ds
+resolveDefs (d:_) = error $ "Type declaration expected: " ++ show d
+
+checkDef :: (String,Def) -> Resolver (String,A.Exp)
+checkDef (n,Def (AIdent (_,m)) args body) | n == m = do
+  updateName n
+  (n,) <$> lams args (resolveWhere body)
+checkDef (n,DefData (AIdent (_,m)) args sums) | n == m = do
+  updateName n
+  (n,) <$> lams args (A.Sum <$> genPrim <*> mapM resolveLabel sums)
+checkDef (n,d) =
+  throwError ("Mismatching names in " ++ show n ++ " and " ++ show d)
+
+
+resolveMutual :: [Def] -> Resolver A.Def
+resolveMutual defs = do
+  tdecls' <- mapM resolveTDecl tdecls
+  let names = map fst tdecls'
+  when (length names /= length decls) $
+    throwError $ "Definitions missing in " ++ show defs
+  tdef' <- mapM checkDef (zip names decls)
+  return (tdecls',tdef')
+  where
+    (tdecls,decls) = span isTDecl defs
+    isTDecl d@(DefTDecl {}) = True
+    isTDecl _               = False
+    resolveTDecl (DefTDecl n e) = do e' <- resolveExp e
+                                     return (unIdent n, e')
+
diff --git a/Eval.hs b/Eval.hs
new file mode 100644
--- /dev/null
+++ b/Eval.hs
@@ -0,0 +1,469 @@
+module Eval where
+
+import Control.Arrow (second)
+import Data.List
+import Data.Maybe (fromMaybe)
+import Debug.Trace
+
+import CTT
+
+-- Switch to False to turn off debugging
+debug :: Bool
+debug = True
+
+traceb :: String -> a -> a
+traceb s x = if debug then trace s x else x
+
+evals :: Env -> [(Binder,Ter)] -> [(Binder,Val)]
+evals e = map (second (eval e))
+
+unCompAs :: Val -> Name -> Box Val
+unCompAs (VComp box) y = swap box (pname box) y
+unCompAs v           _ = error $ "unCompAs: " ++ show v ++ " is not a VComp"
+
+unFillAs :: Val -> Name -> Box Val
+unFillAs (VFill x box) y = swap box x y
+unFillAs v             _ = error $ "unFillAs: " ++ show v ++ " is not a VFill"
+
+appName :: Val -> Name -> Val
+appName (Path x u) y = swap u x y
+appName v _          = error $ "appName: " ++ show v ++ " should be a path"
+
+-- Compute the face of a value
+face :: Val -> Side -> Val
+face u xdir@(x,dir) =
+  let fc v = v `face` (x,dir) in case u of
+  VU          -> VU
+  Ter t e     -> eval (e `faceEnv` xdir) t
+  VId a v0 v1 -> VId (fc a) (fc v0) (fc v1)
+  Path y v | x == y    -> u
+           | otherwise -> Path y (fc v)
+  VExt y b f g p | x == y && dir == Down -> f
+                 | x == y && dir == Up   -> g
+                 | otherwise             -> VExt y (fc b) (fc f) (fc g) (fc p)
+  VPi a f    -> VPi (fc a) (fc f)
+  VInh v     -> VInh (fc v)
+  VInc v     -> VInc (fc v)
+  VSquash y v0 v1 | x == y && dir == Down -> v0
+                  | x == y && dir == Up   -> v1
+                  | otherwise             -> VSquash y (fc v0) (fc v1)
+  VCon c us -> VCon c (map fc us)
+  VEquivEq y a b f s t | x == y && dir == Down -> a
+                       | x == y && dir == Up   -> b
+                       | otherwise             ->
+                         VEquivEq y (fc a) (fc b) (fc f) (fc s) (fc t)
+  VPair y a v | x == y && dir == Down -> a
+              | x == y && dir == Up   -> fc v
+              | otherwise             -> VPair y (fc a) (fc v)
+  VEquivSquare y z a s t | x == y                -> a
+                         | x == z && dir == Down -> a
+                         | x == z && dir == Up   -> VEquivEq y a a idV s t
+                         | otherwise             ->
+                          VEquivSquare y z (fc a) (fc s) (fc t)
+  VSquare y z v | x == y                -> fc v
+                | x == z && dir == Down -> fc v
+                | x == z && dir == Up   -> idVPair y (fc v)
+                | otherwise             -> VSquare y z (fc v)
+  Kan Fill a b@(Box dir' y v nvs)
+    | x /= y && x `notElem` nonPrincipal b -> fill (fc a) (mapBox fc b)
+    | x `elem` nonPrincipal b              -> lookBox (x,dir) b
+    | x == y && dir == mirror dir'         -> v
+    | otherwise                            -> com a b
+  Kan Com a b@(Box dir' y v nvs)
+    | x == y                     -> u
+    | x `notElem` nonPrincipal b -> com (fc a) (mapBox fc b)
+    | x `elem` nonPrincipal b    -> lookBox (x,dir) b `face` (y,dir')
+  VComp b@(Box dir' y _ _)
+    | x == y                     -> u
+    | x `notElem` nonPrincipal b -> VComp (mapBox fc b)
+    | x `elem` nonPrincipal b    -> lookBox (x,dir) b `face` (y,dir')
+  VFill z b@(Box dir' y v nvs)
+    | x == z                               -> u
+    | x /= y && x `notElem` nonPrincipal b -> VFill z (mapBox fc b)
+    | (x,dir) `elem` defBox b              ->
+      lookBox (x,dir) (mapBox (`face` (z,Down)) b)
+    | x == y && dir == dir'                ->
+        VComp $ mapBox (`face` (z,Up)) b
+
+idV :: Val
+idV = Ter (Lam "x" (Var "x")) Empty
+
+idVPair :: Name -> Val -> Val
+idVPair x v = VPair x (v `face` (x,Down)) v
+
+-- Compute the face of an environment
+faceEnv :: Env -> Side -> Env
+faceEnv e xd = mapEnv (`face` xd) e
+
+look :: Binder -> Env -> Val
+look x (Pair s (y,u)) | x == y    = u
+                      | otherwise = look x s
+look x r@(PDef es r1)             = look x (upds r1 (evals r es))
+
+cubeToBox :: Val -> Box () -> Box Val
+cubeToBox v = modBox (\nd _ -> v `face` nd)
+
+eval :: Env -> Ter -> Val
+eval _ U             = VU
+eval e (Var i)       = look i e
+eval e (Id a a0 a1)  = VId (eval e a) (eval e a0) (eval e a1)
+eval e (Refl a)      = Path (fresh e) $ eval e a
+eval e (TransU p t) =
+  com pv box
+  where x   = fresh e
+        pv  = appName (eval e p) x
+        box = Box Up x (eval e t) []
+eval e (TransURef t) = Path (fresh e) (eval e t)
+eval e (TransUEquivEq a b f s t u) = Path x pv -- TODO: Check this!
+  where x   = fresh e
+        pv  = fill (eval e b) box
+        box = Box Up x (app (eval e f) (eval e u)) []
+eval e (J a u c w _ p) = com (app (app cv omega) sigma) box
+  where
+    x:y:_ = gensyms $ supportEnv e
+    uv    = eval e u
+    pv    = appName (eval e p) x
+    theta = fill (eval e a) (Box Up x uv [((y,Down),uv),((y,Up),pv)])
+    sigma = Path x theta
+    omega = theta `face` (x,Up)
+    cv    = eval e c
+    box   = Box Up y (eval e w) []
+eval e (JEq a u c w) = Path y $ fill (app (app cv omega) sigma) box
+  where
+    x:y:_ = gensyms $ supportEnv e
+    uv    = eval e u
+    theta = fill (eval e a) (Box Up x uv [((y,Down),uv),((y,Up),uv)])
+    sigma = Path x theta
+    omega = theta `face` (x,Up)
+    cv    = eval e c
+    box   = Box Up y (eval e w) []
+eval e (Ext b f g p) =
+  Path x $ VExt x (eval e b) (eval e f) (eval e g) (eval e p)
+    where x = fresh e
+eval e (Pi a b)      = VPi (eval e a) (eval e b)
+eval e (Lam x t)     = Ter (Lam x t) e -- stop at lambdas
+eval e (App r s)     = app (eval e r) (eval e s)
+eval e (Inh a)       = VInh (eval e a)
+eval e (Inc t)       = VInc (eval e t)
+eval e (Squash r s)  = Path x $ VSquash x (eval e r) (eval e s)
+  where x = fresh e
+eval e (InhRec b p phi a)  =
+  inhrec (eval e b) (eval e p) (eval e phi) (eval e a)
+eval e (Where t def)       = eval (PDef def e) t
+eval e (Con name ts)       = VCon name (map (eval e) ts)
+eval e (Branch pr alts)    = Ter (Branch pr alts) e
+eval e (LSum pr ntss)      = Ter (LSum pr ntss) e
+eval e (EquivEq a b f s t) =
+  Path x $ VEquivEq x (eval e a) (eval e b) (eval e f) (eval e s) (eval e t)
+    where x = fresh e
+eval e (EquivEqRef a s t)  =
+  Path y $ Path x $ VEquivSquare x y (eval e a) (eval e s) (eval e t)
+  where x:y:_ = gensyms (supportEnv e)
+
+inhrec :: Val -> Val -> Val -> Val -> Val
+inhrec _ _ phi (VInc a)          = app phi a
+inhrec b p phi (VSquash x a0 a1) = appName (app (app p b0) b1) x
+  where fc w d = w `face` (x,d)
+        b0     = inhrec (fc b Down) (fc p Down) (fc phi Down) a0
+        b1     = inhrec (fc b Up)   (fc p Up)   (fc phi Up)   a1
+inhrec b p phi (Kan ktype (VInh a) box@(Box dir x v nvs)) =
+  kan ktype b (modBox irec box)
+    where irec (j,dir) v = let fc v = v `face` (j,dir)
+                         in inhrec (fc b) (fc p) (fc phi) v
+inhrec b p phi v = error $ "inhrec : " ++ show v
+
+kan :: KanType -> Val -> Box Val -> Val
+kan Fill = fill
+kan Com  = com
+
+-- Kan filling
+fill :: Val -> Box Val -> Val
+fill vid@(VId a v0 v1) box@(Box dir i v nvs) = Path x $ fill a box'
+  where x    = gensym (support vid `union` support box)
+        box' = (x,(v0,v1)) `consBox` mapBox (`appName` x) box
+-- assumes cvs are constructor vals
+fill (Ter (LSum _ nass) env) box@(Box _ _ (VCon n _) _) = VCon n ws
+  where as = case lookup n nass of
+               Just as -> as
+               Nothing -> error $ "fill: missing constructor "
+                               ++ "in labelled sum " ++ n
+        boxes = transposeBox $ mapBox unCon box
+        -- fill boxes for each argument position of the constructor
+        ws    = fills as env boxes
+fill (VEquivSquare x y a s t) box@(Box dir x' vx' nvs) =
+  VSquare x y v
+  where v = fill a $ modBox unPack box
+
+        unPack :: (Name,Dir) -> Val -> Val
+        unPack (z,c) v | z /= x && z /= y  = unSquare v
+                       | z == y && c == Up = sndVal v
+                       | otherwise         = v
+
+-- a and b should be independent of x
+fill veq@(VEquivEq x a b f s t) box@(Box dir z vz nvs)
+  | x /= z && x `notElem` nonPrincipal box =
+    let ax0  = fill a (mapBox fstVal box)
+        bx0  = app f ax0
+        bx   = mapBox sndVal box
+        bx1  = fill b $ mapBox (`face` (x,Up)) bx
+        v    = fill b $ (x,(bx0,bx1)) `consBox` bx
+    in traceb "VEquivEq case 1" $ VPair x ax0 v
+  | x /= z && x `elem` nonPrincipal box =
+    let ax0 = lookBox (x,Down) box
+        bx  = modBox (\(ny,dy) vy -> if x /= ny then sndVal vy else
+                                       if dy == Down then app f ax0 else vy) box
+        v   = fill b bx
+    in traceb "VEquivEq case 2" $ VPair x ax0 v
+  | x == z && dir == Up =
+    let ax0  = vz
+        bx0  = app f ax0
+        v    = fill b $ Box dir z bx0 [ (nnd,sndVal v) | (nnd,v) <- nvs ]
+    in traceb "VEquivEq case 3" $ VPair x ax0 v
+  | x == z && dir == Down =
+     let y  = gensym (support veq `union` support box)
+         VCon "pair" [gb,sb] = app s vz
+         vy = appName sb x
+
+         vpTSq :: Name -> Dir -> Val -> (Val,Val)
+         vpTSq nz dz (VPair z a0 v0) =
+             let vp = VCon "pair" [a0, Path z v0]
+                 t0 = t `face` (nz,dz)
+                 b0 = vz `face` (nz,dz)
+                 VCon "pair" [l0,sq0] = appName (app (app t0 b0) vp) y
+             in (l0,appName sq0 x)  -- TODO: check the correctness of the square s0
+
+         -- TODO: Use modBox!
+         vsqs   = [ ((n,d),vpTSq n d v) | ((n,d),v) <- nvs]
+         box1   = Box Up y gb [ (nnd,v) | (nnd,(v,_)) <- vsqs ]
+         afill  = fill a box1
+
+         acom   = afill `face` (y,Up)
+         fafill = app f afill
+         box2   = Box Up y vy (((x,Down),fafill) : ((x,Up),vz) :
+                                      [ (nnd,v) | (nnd,(_,v)) <- vsqs ])
+         bcom   = com b box2
+     in traceb "VEquivEq case 4" $ VPair x acom bcom
+  | otherwise = error "fill EqEquiv"
+
+fill v@(Kan Com VU tbox') box@(Box dir x' vx' nvs')
+  | toAdd /= [] = -- W.l.o.g. assume that box contains faces for
+    let           -- the non-principal sides of tbox.
+      add :: Side -> Val  -- TODO: Is this correct? Do we have
+                          -- to consider the auxsides?
+      add yc = fill (lookBox yc tbox) (mapBox (`face` yc) box)
+      newBox = [ (n,(add (n,Down),add (n,Up)))| n <- toAdd ] `appendBox` box
+    in traceb "Kan Com 1" $ fill v newBox
+  | x' `notElem` nK =
+    let principal = fill tx (mapBox (pickout (x,tdir')) boxL)
+        nonprincipal =
+          [ let side = [((x,tdir),lookBox yc box)
+                       ,((x,tdir'),principal `face` yc)]
+            in (yc, fill (lookBox yc tbox)
+                    (side `appendSides` mapBox (pickout yc) boxL))
+          | yc <- allDirs nK ]
+        newBox = Box tdir x principal nonprincipal
+    in traceb ("Kan Com 2\nnewBox " ++ show newBox) VComp newBox
+  | x' `elem` nK =
+    let -- assumes zc in defBox tbox
+      auxsides zc = [ (yd,pickout zc (lookBox yd box)) | yd <- allDirs nL ]
+      -- extend input box along x with orientation tdir'; results
+      -- in the non-principal faces on the intersection of defBox
+      -- box and defBox tbox; note, that the intersection contains
+      -- (x',dir'), but not (x',dir) (and (x,_))
+      npintbox = modBox (\yc boxside -> fill (lookBox yc tbox)
+                                  (Box tdir' x boxside (auxsides yc)))
+                        (subBox (nK `intersect` nJ) box)
+      npint = fromBox npintbox
+      npintfacebox = mapBox (`face` (x,tdir')) npintbox
+      principal = fill tx (auxsides (x,tdir') `appendSides` npintfacebox)
+      nplp  = principal `face` (x',dir)
+      nplnp = auxsides (x',dir)
+              ++ map (\(yc,v) -> (yc,v `face` (x',dir))) (sides npintbox)
+      -- the missing non-principal face on side (x',dir)
+      nplast = ((x',dir),fill (lookBox (x',dir) tbox) (Box tdir x nplp nplnp))
+      newBox = Box tdir x principal (nplast:npint)
+    in traceb "Kan Com 3" $ VComp newBox
+  where nK    = nonPrincipal tbox
+        nJ    = nonPrincipal box
+        z     = gensym $ support tbox' ++ support box
+        -- x is z
+        tbox@(Box tdir x tx nvs) = swap tbox' (pname tbox') z
+        toAdd = nK \\ (x' : nJ)
+        nL    = nJ \\ nK
+        boxL  = subBox nL box
+        dir'  = mirror dir
+        tdir' = mirror tdir
+        -- asumes zd is in the sides of tbox
+        pickout zd vcomp = lookBox zd (unCompAs vcomp z)
+
+fill v@(Kan Fill VU tbox@(Box tdir x tx nvs)) box@(Box dir x' vx' nvs')
+  -- the cases should be (in order):
+  -- 1) W.l.o.g. K subset x', J
+  -- 2) x' = x &  dir = tdir
+  -- 3) x' = x &  dir = mirror tdir
+  -- 4) x `notElem` J (maybe combine with 1?)
+  -- 5) x' `notElem` K
+  -- 6) x' `elem` K
+
+  | toAdd /= [] =
+    let
+      add :: Side -> Val
+      add zc = fill (lookBox zc tbox) (mapBox (`face` zc) box)
+      newBox = [ (zc,add zc) | zc <- allDirs toAdd ] `appendSides` box
+    in traceb "Kan Fill VU Case 1" fill v newBox            -- W.l.o.g. nK subset x:nJ
+  | x == x' && dir == tdir = -- assumes K subset x',J
+    let
+      boxp = lookBox (x,dir') box  -- is vx'
+      principal = fill (lookBox (x',tdir') tbox) (Box Up z boxp (auxsides (x',tdir')))
+      nonprincipal =
+        [ (zc,
+           let principzc = lookBox zc box
+               sides = [((x,tdir'),principal `face` zc)
+                       ,((x,tdir),principzc)] -- "degenerate" along z!
+           in fill (lookBox zc tbox) (Box Up z principzc (sides ++ auxsides zc)))
+        | zc <- allDirs nK ]
+    in     traceb ("Kan Fill VU Case 2 v= " ++ show v ++ "\nbox= " ++ show box)
+     VFill z (Box tdir x' principal nonprincipal)
+
+  | x == x' && dir == mirror tdir = -- assumes K subset x',J
+    let      -- the principal side of box must be a VComp
+      upperbox = unCompAs (lookBox (x,dir') box) x
+      nonprincipal =
+        [ (zc,
+           let top    = lookBox zc upperbox
+               bottom = lookBox zc box
+               princ  = top `face` (x',tdir) -- same as: bottom `face` (x',tdir)
+               sides  = [((z,Down),bottom),((z,Up),top)]
+           in fill (lookBox zc tbox)
+                (Box tdir' x princ -- "degenerate" along z!
+                 (sides ++ auxsides zc)))
+        | zc <- allDirs nK ]
+      nonprincipalfaces =
+        map (\(zc,u) -> (zc,u `face` (x,dir))) nonprincipal
+      principal =
+        fill (lookBox (x,tdir') tbox) (Box Up z (lookBox (x,tdir') upperbox)
+                                       (nonprincipalfaces ++ auxsides (x,tdir')))
+    in    traceb "Kan Fill VU Case 3"
+     VFill z (Box tdir x' principal nonprincipal)
+  | x `notElem` nJ =  -- assume x /= x' and K subset x', J
+    let
+      comU   = v `face` (x,tdir) -- Kan Com VU (tbox (z=Up))
+      xsides = [((x,tdir), fill comU (mapBox (`face` (x,tdir)) box))
+               ,((x,tdir'),fill (lookBox (x,tdir') tbox)
+                            (mapBox (`face` (x,tdir)) box))]
+    in       traceb "Kan Fill VU Case 4"
+     fill v (xsides `appendSides` box)
+  | x' `notElem` nK =  -- assumes x,K subset x',J
+      let
+        xaux      = unCompAs (lookBox (x,tdir) box) x -- TODO: Do we need a fresh name?
+        boxprinc  = unFillAs (lookBox (x',dir') box) z
+        princnp   = [((z,Up),lookBox (x,tdir') xaux)
+                    ,((z,Down),lookBox (x,tdir') box)]
+                    ++ auxsides (x,tdir')
+        principal = fill (lookBox (x,tdir') tbox) -- tx
+                      (Box dir x' (lookBox (x,tdir') boxprinc) princnp)
+        nonprincipal =
+          [ let up = lookBox yc xaux
+                np = [((z,Up),up),((z,Down),lookBox yc box)
+                     ,((y,c), up `face` (x,tdir)) -- deg along z!
+                     ,((y,mirror c), principal `face` yc)]
+                     ++ auxsides yc
+            in (yc, fill (lookBox yc tbox)
+                      (Box dir x' (lookBox yc boxprinc) np))
+          | yc@(y,c) <- allDirs nK]
+      in     traceb "Kan Fill VU Case 5"
+             VFill z (Box tdir x' principal nonprincipal)
+
+  | x' `elem` nK =              -- assumes x,K subset x',J
+      let -- surprisingly close to the last case of the Kan-Com-VU filling
+        upperbox = unCompAs (lookBox (x,dir') box) x
+        npintbox =
+          modBox (\zc downside ->
+                   let bottom = lookBox zc box
+                       top    = lookBox zc upperbox
+                       princ  = downside -- same as bottom `face` (x',tdir) and
+                                         -- top `face` (x',tdir)
+                       sides  = [((z,Down),bottom),((z,Up),top)]
+                   in fill (lookBox zc tbox) (Box tdir' x princ -- deg along z!
+                                              (sides ++ auxsides zc)))
+                 (subBox (nK `intersect` nJ) box)
+        npint = fromBox npintbox
+        npintfacebox = mapBox (`face` (x,tdir)) npintbox
+        principalbox = ([((z,Down),lookBox (x,tdir') box)
+                       ,((z,Up)  ,lookBox (x,tdir')upperbox)] ++
+                       auxsides (x,tdir')) `appendSides` npintfacebox
+        principal = fill tx principalbox
+        nplp   = lookBox (x',dir) upperbox
+        nplnp  = [((x',dir), nplp `face` (x',dir)) -- deg along z!
+                 ,((x', dir'),principal `face` (x',dir))]
+                 ++ auxsides (x',dir)
+                 ++ map (\(zc,u) -> (zc,u `face` (x',dir))) (sides npintbox)
+        nplast = ((x',dir),fill (lookBox (x',dir) tbox) (Box Down z nplp nplnp))
+      in       traceb "Kan Fill VU Case 6"
+       VFill z (Box tdir x' principal (nplast:npint))
+
+  where z     = gensym $ support v ++ support box
+        nK    = nonPrincipal tbox
+        nJ    = nonPrincipal box
+        toAdd = nK \\ (x' : nJ)
+        nL    = nJ \\ nK
+        boxL  = subBox nL box
+        dir'  = mirror dir
+        tdir' = mirror tdir
+        -- asumes zc is in the sides of tbox
+        pickout zc vfill = lookBox zc (unFillAs vfill z)
+        -- asumes zc is in the sides of tbox
+        auxsides zc = [ (yd,pickout zc (lookBox yd box)) | yd <- allDirs nL ]
+
+fill v b = Kan Fill v b
+
+fills :: [(Binder,Ter)] -> Env -> [Box Val] -> [Val]
+fills []         _ []          = []
+fills ((x,a):as) e (box:boxes) = v : fills as (Pair e (x,v)) boxes
+  where v = fill (eval e a) box
+fills _ _ _ = error "fills: different lengths of types and values"
+
+-- Composition (ie., the face of fill which is created)
+com :: Val -> Box Val -> Val
+com vid@VId{} box@(Box dir i _ _)         = fill vid box `face` (i,dir)
+com ter@Ter{} box@(Box dir i _ _)         = fill ter box `face` (i,dir)
+com veq@VEquivEq{} box@(Box dir i _ _)    = fill veq box `face` (i,dir)
+com u@(Kan Com VU _) box@(Box dir i _ _)  = fill u box `face` (i,dir)
+com u@(Kan Fill VU _) box@(Box dir i _ _) = fill u box `face` (i,dir)
+com v box                                 = Kan Com v box
+
+appBox :: Box Val -> Box Val -> Box Val
+appBox (Box dir x v nvs) (Box _ _ u nus) = Box dir x (app v u) nvus
+  where nvus      = [ (nnd,app v (lookup' nnd nus)) | (nnd,v) <- nvs ]
+        lookup' x = fromMaybe (error "appBox") . lookup x
+
+app :: Val -> Val -> Val
+app (Ter (Lam x t) e) u                         = eval (Pair e (x,u)) t
+app (Kan Com (VPi a b) box@(Box dir x v nvs)) u =
+  traceb ("Pi Com:\nufill = " ++ show ufill ++ "\nbcu = " ++ show bcu)
+  com (app b ufill) (appBox box bcu)
+  where ufill = fill a (Box (mirror dir) x u [])
+        bcu   = cubeToBox ufill (shapeOfBox box)
+app kf@(Kan Fill (VPi a b) box@(Box dir i w nws)) v =
+  traceb "Pi fill" $ com (app b vfill) (Box Up x vx (((i,Down),vi0) : ((i,Up),vi1):nvs))
+  where x     = gensym (support kf `union` support v)
+        u     = v `face` (i,dir)
+        ufill = fill a (Box (mirror dir) i u [])
+        bcu   = cubeToBox ufill (shapeOfBox box)
+        vfill = fill a (Box (mirror dir) i u [((x,Down),ufill),((x,Up),v)])
+        vx    = fill (app b ufill) (appBox box bcu)
+        vi0   = app w (vfill `face` (i,Down))
+        vi1   = com (app b ufill) (appBox box bcu)
+        nvs   = [ ((n,d),app ws (vfill `face` (n,d))) | ((n,d),ws) <- nws ]
+app vext@(VExt x bv fv gv pv) w = com (app bv w) (Box Up y pvxw [((x,Down),left),((x,Up),right)])
+  -- NB: there are various choices how to construct this
+  where y     = gensym (support vext `union` support w)
+        w0    = w `face` (x,Down)
+        left  = app fv w0
+        right = app gv (swap w x y)
+        pvxw  = appName (app pv w0) x
+app (Ter (Branch _ nvs) e) (VCon name us) = case lookup name nvs of
+    Just (xs,t)  -> eval (upds e (zip xs us)) t
+    Nothing -> error $ "app: Branch with insufficient "
+               ++ "arguments; missing case for " ++ name
+app r s = error $ "app"  ++ show r ++ show s
diff --git a/Exp.cf b/Exp.cf
new file mode 100644
--- /dev/null
+++ b/Exp.cf
@@ -0,0 +1,64 @@
+entrypoints Module, Exp ;
+
+comment "--" ;
+comment "{-" "-}" ;
+
+layout "where", "let", "of", "split" ;
+layout stop "in" ;
+-- Do not use layout toplevel as it makes pExp fail!
+
+Module.   Module ::= "module" AIdent "where" "{" [Imp] [Def] "}" ;
+
+Import.   Imp ::= "import" AIdent ;
+separator Imp ";" ;
+
+Def.       Def ::= AIdent [Arg] "=" ExpWhere ;
+DefTDecl.  Def ::= AIdent ":" Exp ;
+DefData.   Def ::= "data" AIdent [Arg] "=" [Sum] ;
+-- TODO: Mutual not working.
+-- NB: No iterated mutuals allowed!
+-- DefMutual. Def ::= "mutual" "{" [Def] "}" "end" ;
+
+separator  Def ";" ;
+
+Where.    ExpWhere ::= Exp "where" "{" [Def] "}" ;
+NoWhere.  ExpWhere ::= Exp ;
+
+Let.      Exp  ::= "let" "{" [Def] "}" "in" Exp ;
+Lam.      Exp  ::= "\\" [Binder] "->" Exp ;
+Split.    Exp  ::= "split" "{" [Branch] "}" ;
+Fun.      Exp1 ::= Exp2 "->" Exp1 ;
+Pi.       Exp1 ::= [PiDecl] "->" Exp1 ;
+App.      Exp2 ::= Exp2 Exp3 ;
+Var.      Exp3 ::= Arg ;
+U.        Exp3 ::= "U" ;
+Undef.    Exp3 ::= "undefined" ;
+PN.       Exp3 ::= "PN" ;
+coercions Exp 3 ;
+
+Binder.   Binder ::= Arg ;
+separator nonempty Binder "" ;
+
+-- Like Binder, but may be empty
+Arg.       Arg ::= AIdent ;
+NoArg.     Arg ::= "_" ;
+terminator Arg "" ;
+
+-- Branches
+Branch.   Branch ::= AIdent [Arg] "->" ExpWhere ;
+separator Branch ";" ;
+
+-- Labelled sum alternatives
+Sum.      Sum   ::= AIdent [VDecl] ;
+separator Sum "|" ;
+
+-- Telescopes
+VDecl.     VDecl ::= "(" [Binder] ":" Exp ")" ;
+terminator VDecl "" ;
+
+-- Nonempty telescopes with Exp:s, this is hack to avoid ambiguities in the
+-- grammar when parsing Pi
+PiDecl.   PiDecl ::= "(" Exp ":" Exp ")" ;
+terminator nonempty PiDecl "" ;
+
+position token AIdent (letter(letter|digit|'\''|'_')*) ;
diff --git a/Exp/Lex.x b/Exp/Lex.x
new file mode 100644
--- /dev/null
+++ b/Exp/Lex.x
@@ -0,0 +1,172 @@
+-- -*- haskell -*-
+-- This Alex file was machine-generated by the BNF converter
+{
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module Exp.Lex where
+
+
+
+import qualified Data.Bits
+import Data.Word (Word8)
+}
+
+
+$l = [a-zA-Z\192 - \255] # [\215 \247]    -- isolatin1 letter FIXME
+$c = [A-Z\192-\221] # [\215]    -- capital isolatin1 letter FIXME
+$s = [a-z\222-\255] # [\247]    -- small isolatin1 letter FIXME
+$d = [0-9]                -- digit
+$i = [$l $d _ ']          -- identifier character
+$u = [\0-\255]          -- universal: any character
+
+@rsyms =    -- symbols and non-identifier-like reserved words
+   \{ | \} | \; | \= | \: | \\ | \- \> | \( | \) | \_ | \|
+
+:-
+"--" [.]* ; -- Toss single line comments
+"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ; 
+
+$white+ ;
+@rsyms { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
+$l ($l | $d | \' | \_)* { tok (\p s -> PT p (eitherResIdent (T_AIdent . share) s)) }
+
+$l $i*   { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
+
+
+
+
+
+{
+
+tok f p s = f p s
+
+share :: String -> String
+share = id
+
+data Tok =
+   TS !String !Int    -- reserved words and symbols
+ | TL !String         -- string literals
+ | TI !String         -- integer literals
+ | TV !String         -- identifiers
+ | TD !String         -- double precision float literals
+ | TC !String         -- character literals
+ | T_AIdent !String
+
+ deriving (Eq,Show,Ord)
+
+data Token = 
+   PT  Posn Tok
+ | Err Posn
+  deriving (Eq,Show,Ord)
+
+tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
+tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
+tokenPos _ = "end of file"
+
+tokenPosn (PT p _) = p
+tokenPosn (Err p) = p
+tokenLineCol = posLineCol . tokenPosn
+posLineCol (Pn _ l c) = (l,c)
+mkPosToken t@(PT p _) = (posLineCol p, prToken t)
+
+prToken t = case t of
+  PT _ (TS s _) -> s
+  PT _ (TL s)   -> s
+  PT _ (TI s)   -> s
+  PT _ (TV s)   -> s
+  PT _ (TD s)   -> s
+  PT _ (TC s)   -> s
+  PT _ (T_AIdent s) -> s
+
+
+data BTree = N | B String Tok BTree BTree deriving (Show)
+
+eitherResIdent :: (String -> Tok) -> String -> Tok
+eitherResIdent tv s = treeFind resWords
+  where
+  treeFind N = tv s
+  treeFind (B a t left right) | s < a  = treeFind left
+                              | s > a  = treeFind right
+                              | s == a = t
+
+resWords = b "data" 11 (b "=" 6 (b "->" 3 (b ")" 2 (b "(" 1 N N) N) (b ";" 5 (b ":" 4 N N) N)) (b "\\" 9 (b "U" 8 (b "PN" 7 N N) N) (b "_" 10 N N))) (b "undefined" 17 (b "let" 14 (b "in" 13 (b "import" 12 N N) N) (b "split" 16 (b "module" 15 N N) N)) (b "|" 20 (b "{" 19 (b "where" 18 N N) N) (b "}" 21 N N)))
+   where b s n = let bs = id s
+                  in B bs (TS bs n)
+
+unescapeInitTail :: String -> String
+unescapeInitTail = id . unesc . tail . id where
+  unesc s = case s of
+    '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
+    '\\':'n':cs  -> '\n' : unesc cs
+    '\\':'t':cs  -> '\t' : unesc cs
+    '"':[]    -> []
+    c:cs      -> c : unesc cs
+    _         -> []
+
+-------------------------------------------------------------------
+-- Alex wrapper code.
+-- A modified "posn" wrapper.
+-------------------------------------------------------------------
+
+data Posn = Pn !Int !Int !Int
+      deriving (Eq, Show,Ord)
+
+alexStartPos :: Posn
+alexStartPos = Pn 0 1 1
+
+alexMove :: Posn -> Char -> Posn
+alexMove (Pn a l c) '\t' = Pn (a+1)  l     (((c+7) `div` 8)*8+1)
+alexMove (Pn a l c) '\n' = Pn (a+1) (l+1)   1
+alexMove (Pn a l c) _    = Pn (a+1)  l     (c+1)
+
+type Byte = Word8
+
+type AlexInput = (Posn,     -- current position,
+                  Char,     -- previous char
+                  [Byte],   -- pending bytes on the current char
+                  String)   -- current input string
+
+tokens :: String -> [Token]
+tokens str = go (alexStartPos, '\n', [], str)
+    where
+      go :: AlexInput -> [Token]
+      go inp@(pos, _, _, str) =
+               case alexScan inp 0 of
+                AlexEOF                   -> []
+                AlexError (pos, _, _, _)  -> [Err pos]
+                AlexSkip  inp' len        -> go inp'
+                AlexToken inp' len act    -> act pos (take len str) : (go inp')
+
+alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)
+alexGetByte (p, c, (b:bs), s) = Just (b, (p, c, bs, s))
+alexGetByte (p, _, [], s) =
+  case  s of
+    []  -> Nothing
+    (c:s) ->
+             let p'     = alexMove p c
+                 (b:bs) = utf8Encode c
+              in p' `seq` Just (b, (p', c, bs, s))
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar (p, c, bs, s) = c
+
+  -- | Encode a Haskell String to a list of Word8 values, in UTF8 format.
+utf8Encode :: Char -> [Word8]
+utf8Encode = map fromIntegral . go . ord
+ where
+  go oc
+   | oc <= 0x7f       = [oc]
+
+   | oc <= 0x7ff      = [ 0xc0 + (oc `Data.Bits.shiftR` 6)
+                        , 0x80 + oc Data.Bits..&. 0x3f
+                        ]
+
+   | oc <= 0xffff     = [ 0xe0 + (oc `Data.Bits.shiftR` 12)
+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)
+                        , 0x80 + oc Data.Bits..&. 0x3f
+                        ]
+   | otherwise        = [ 0xf0 + (oc `Data.Bits.shiftR` 18)
+                        , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)
+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)
+                        , 0x80 + oc Data.Bits..&. 0x3f
+                        ]
+}
diff --git a/Exp/Par.y b/Exp/Par.y
new file mode 100644
--- /dev/null
+++ b/Exp/Par.y
@@ -0,0 +1,182 @@
+-- This Happy file was machine-generated by the BNF converter
+{
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
+module Exp.Par where
+import Exp.Abs
+import Exp.Lex
+import Exp.ErrM
+
+}
+
+%name pModule Module
+%name pExp Exp
+
+-- no lexer declaration
+%monad { Err } { thenM } { returnM }
+%tokentype { Token }
+
+%token 
+ '(' { PT _ (TS _ 1) }
+ ')' { PT _ (TS _ 2) }
+ '->' { PT _ (TS _ 3) }
+ ':' { PT _ (TS _ 4) }
+ ';' { PT _ (TS _ 5) }
+ '=' { PT _ (TS _ 6) }
+ 'PN' { PT _ (TS _ 7) }
+ 'U' { PT _ (TS _ 8) }
+ '\\' { PT _ (TS _ 9) }
+ '_' { PT _ (TS _ 10) }
+ 'data' { PT _ (TS _ 11) }
+ 'import' { PT _ (TS _ 12) }
+ 'in' { PT _ (TS _ 13) }
+ 'let' { PT _ (TS _ 14) }
+ 'module' { PT _ (TS _ 15) }
+ 'split' { PT _ (TS _ 16) }
+ 'undefined' { PT _ (TS _ 17) }
+ 'where' { PT _ (TS _ 18) }
+ '{' { PT _ (TS _ 19) }
+ '|' { PT _ (TS _ 20) }
+ '}' { PT _ (TS _ 21) }
+
+L_AIdent { PT _ (T_AIdent _) }
+L_err    { _ }
+
+
+%%
+
+AIdent    :: { AIdent} : L_AIdent { AIdent (mkPosToken $1)}
+
+Module :: { Module }
+Module : 'module' AIdent 'where' '{' ListImp ListDef '}' { Module $2 $5 $6 } 
+
+
+Imp :: { Imp }
+Imp : 'import' AIdent { Import $2 } 
+
+
+ListImp :: { [Imp] }
+ListImp : {- empty -} { [] } 
+  | Imp { (:[]) $1 }
+  | Imp ';' ListImp { (:) $1 $3 }
+
+
+Def :: { Def }
+Def : AIdent ListArg '=' ExpWhere { Def $1 (reverse $2) $4 } 
+  | AIdent ':' Exp { DefTDecl $1 $3 }
+  | 'data' AIdent ListArg '=' ListSum { DefData $2 (reverse $3) $5 }
+
+
+ListDef :: { [Def] }
+ListDef : {- empty -} { [] } 
+  | Def { (:[]) $1 }
+  | Def ';' ListDef { (:) $1 $3 }
+
+
+ExpWhere :: { ExpWhere }
+ExpWhere : Exp 'where' '{' ListDef '}' { Where $1 $4 } 
+  | Exp { NoWhere $1 }
+
+
+Exp :: { Exp }
+Exp : 'let' '{' ListDef '}' 'in' Exp { Let $3 $6 } 
+  | '\\' ListBinder '->' Exp { Lam $2 $4 }
+  | 'split' '{' ListBranch '}' { Split $3 }
+  | Exp1 { $1 }
+
+
+Exp1 :: { Exp }
+Exp1 : Exp2 '->' Exp1 { Fun $1 $3 } 
+  | ListPiDecl '->' Exp1 { Pi $1 $3 }
+  | Exp2 { $1 }
+
+
+Exp2 :: { Exp }
+Exp2 : Exp2 Exp3 { App $1 $2 } 
+  | Exp3 { $1 }
+
+
+Exp3 :: { Exp }
+Exp3 : Arg { Var $1 } 
+  | 'U' { U }
+  | 'undefined' { Undef }
+  | 'PN' { PN }
+  | '(' Exp ')' { $2 }
+
+
+Binder :: { Binder }
+Binder : Arg { Binder $1 } 
+
+
+ListBinder :: { [Binder] }
+ListBinder : Binder { (:[]) $1 } 
+  | Binder ListBinder { (:) $1 $2 }
+
+
+Arg :: { Arg }
+Arg : AIdent { Arg $1 } 
+  | '_' { NoArg }
+
+
+ListArg :: { [Arg] }
+ListArg : {- empty -} { [] } 
+  | ListArg Arg { flip (:) $1 $2 }
+
+
+Branch :: { Branch }
+Branch : AIdent ListArg '->' ExpWhere { Branch $1 (reverse $2) $4 } 
+
+
+ListBranch :: { [Branch] }
+ListBranch : {- empty -} { [] } 
+  | Branch { (:[]) $1 }
+  | Branch ';' ListBranch { (:) $1 $3 }
+
+
+Sum :: { Sum }
+Sum : AIdent ListVDecl { Sum $1 (reverse $2) } 
+
+
+ListSum :: { [Sum] }
+ListSum : {- empty -} { [] } 
+  | Sum { (:[]) $1 }
+  | Sum '|' ListSum { (:) $1 $3 }
+
+
+VDecl :: { VDecl }
+VDecl : '(' ListBinder ':' Exp ')' { VDecl $2 $4 } 
+
+
+ListVDecl :: { [VDecl] }
+ListVDecl : {- empty -} { [] } 
+  | ListVDecl VDecl { flip (:) $1 $2 }
+
+
+PiDecl :: { PiDecl }
+PiDecl : '(' Exp ':' Exp ')' { PiDecl $2 $4 } 
+
+
+ListPiDecl :: { [PiDecl] }
+ListPiDecl : PiDecl { (:[]) $1 } 
+  | PiDecl ListPiDecl { (:) $1 $2 }
+
+
+
+{
+
+returnM :: a -> Err a
+returnM = return
+
+thenM :: Err a -> (a -> Err b) -> Err b
+thenM = (>>=)
+
+happyError :: [Token] -> Err a
+happyError ts =
+  Bad $ "syntax error at " ++ tokenPos ts ++ 
+  case ts of
+    [] -> []
+    [Err _] -> " due to lexer error"
+    _ -> " before " ++ unwords (map (id . prToken) (take 4 ts))
+
+myLexer = tokens
+}
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,21 @@
+Copyright (c) 2013 Cyril Cohen, Thierry Coquand, Simon Huber, Anders
+Mörtberg
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/MTT.hs b/MTT.hs
new file mode 100644
--- /dev/null
+++ b/MTT.hs
@@ -0,0 +1,334 @@
+-- miniTT, with recursive definitions
+module MTT where
+
+import Data.Either
+import Data.List
+import Data.Maybe
+import Control.Monad
+import Debug.Trace
+import Control.Monad.Trans.Error hiding (throwError)
+import Control.Monad.Trans.Reader
+import Control.Monad.Identity
+import Control.Monad.Error (throwError)
+import Control.Applicative
+
+import Pretty
+
+type Label  = String
+
+-- Branch of the form: c x1 .. xn -> e
+type Brc    = (Label,([String],Exp))
+
+-- Telescope (x1 : A1) .. (xn : An)
+type Tele   = [(String,Exp)]
+
+-- Labelled sum: c (x1 : A1) .. (xn : An)
+type LblSum = [(Label,Tele)]
+
+-- Mix values and expressions
+type Val = Exp
+
+-- Context gives type values to identifiers
+type Ctxt = [(String,Val)]
+
+-- Mutual recursive definitions: (x1 : A1) .. (xn : An) and x1 = e1 .. xn = en
+type Def = (Tele,[(String,Exp)])
+
+-- De Bruijn levels
+mkVar :: Int -> Exp
+mkVar k = Var (genName k)
+
+genName :: Int -> String
+genName n = 'X' : show n
+
+type Prim = (Integer,String)
+
+data Exp = Comp Exp Env         -- for closures
+         | App Exp Exp
+         | Pi Exp Exp
+         | Lam String Exp
+         | Def Exp Def
+         | Var String
+         | U
+         | Con String [Exp]
+         | Fun Prim [Brc]
+         | Sum Prim LblSum
+         | Undef Prim
+         | EPrim Prim [Exp]     -- used for reification
+  deriving (Eq)
+
+instance Show Exp where
+ show = showExp
+
+data Env = Empty
+         | Pair Env (String,Val)
+         | PDef Def Env         -- for handling recursive definitions,
+                                -- see getE
+  deriving (Eq)
+
+instance Show Env where
+  show = showEnv
+
+lets :: [Def] -> Exp -> Exp
+lets []     e = e
+lets (d:ds) e = Def (lets ds e) d
+
+defs :: Env -> Exp -> Exp
+defs Empty        e = e
+defs (PDef d env) e = defs env (Def e d)
+defs env          _ =
+  error $ "defs: environment should a list of definitions " ++ show env
+
+upds :: Env -> [(String,Val)] -> Env
+upds = foldl Pair
+
+eval :: Exp -> Env -> Val
+eval (Def e d)   s = eval e (PDef d s)
+eval (App t1 t2) s = app (eval t1 s) (eval t2 s)
+eval (Pi a b)    s = Pi (eval a s) (eval b s)
+eval (Con c ts)  s = Con c (map (`eval` s) ts)
+eval (Var k)     s = getE k s
+eval U           _ = U
+eval t           s = Comp t s
+
+evals :: [(String,Exp)] -> Env -> [(String,Val)]
+evals es r = map (\(x,e) -> (x,eval e r)) es
+
+app :: Val -> Val -> Val
+app (Comp (Lam x b) s)     u            = eval b (Pair s (x,u))
+app a@(Comp (Fun _ ces) r) b@(Con c us) = case lookup c ces of
+  Just (xs,e) -> eval e (upds r (zip xs us))
+  Nothing     -> error $ "app: " ++ show a ++ " " ++ show b
+app f                      u            = App f u
+
+getE :: String -> Env -> Exp
+getE x (Pair _ (y,u)) | x == y = u
+getE x (Pair s _)              = getE x s
+getE x r@(PDef d r1)           = getE x (upds r1 (evals (snd d) r))
+
+addC :: Ctxt -> (Tele,Env) -> [(String,Val)] -> Ctxt
+addC gam _             []          = gam
+addC gam ((y,a):as,nu) ((x,u):xus) =
+  addC ((x,eval a nu):gam) (as,Pair nu (y,u)) xus
+
+-- Extract the type of a label as a closure
+getLblType :: String -> Exp -> Typing (Tele, Env)
+getLblType c (Comp (Sum _ cas) r) = case lookup c cas of
+  Just as -> return (as,r)
+  Nothing -> throwError ("getLblType " ++ show c)
+getLblType c u = throwError ("expected a data type for the constructor "
+                             ++ c ++ " but got " ++ show u)
+
+-- Environment for type checker
+data TEnv = TEnv { index :: Int   -- for de Bruijn levels
+                 , env   :: Env
+                 , ctxt  :: Ctxt }
+          deriving Eq
+
+tEmpty :: TEnv
+tEmpty = TEnv 0 Empty []
+
+-- Type checking monad
+type Typing a = ReaderT TEnv (ErrorT String Identity) a
+
+runTyping :: Typing a -> TEnv -> ErrorT String Identity a
+runTyping = runReaderT
+
+-- Used in the interaction loop
+runDef :: TEnv -> Def -> Either String TEnv
+runDef lenv d = do
+  runIdentity $ runErrorT $ runTyping (checkDef d) lenv
+  return $ addDef d lenv
+
+runDefs :: TEnv -> [Def] -> Either String TEnv
+runDefs = foldM runDef
+
+runInfer :: TEnv -> Exp -> Either String Exp
+runInfer lenv e = runIdentity $ runErrorT $ runTyping (checkInfer e) lenv
+
+addTypeVal :: (String,Val) -> TEnv -> TEnv
+addTypeVal p@(x,_) (TEnv k rho gam) = TEnv (k+1) (Pair rho (x,mkVar k)) (p:gam)
+
+addType :: (String,Exp) -> TEnv -> TEnv
+addType (x,a) tenv@(TEnv _ rho _) = addTypeVal (x,eval a rho) tenv
+
+addBranch :: [(String,Val)] -> (Tele,Env) -> TEnv -> TEnv
+addBranch nvs (tele,env) (TEnv k rho gam) =
+  TEnv (k + length nvs) (upds rho nvs) (addC gam (tele,env) nvs)
+
+addDef :: Def -> TEnv -> TEnv
+addDef d@(ts,es) (TEnv k rho gam) =
+  let rho1 = PDef d rho
+  in TEnv k rho1 (addC gam (ts,rho) (evals es rho1))
+
+addTele :: Tele -> TEnv -> TEnv
+addTele xas lenv = foldl (flip addType) lenv xas
+
+getIndex :: Typing Int
+getIndex = index <$> ask
+
+getFresh :: Typing Exp
+getFresh = mkVar <$> getIndex
+
+getEnv :: Typing Env
+getEnv = env <$> ask
+
+getCtxt :: Typing Ctxt
+getCtxt = ctxt <$> ask
+
+(=?=) :: Typing Exp -> Exp -> Typing ()
+m =?= s2 = do
+  s1 <- m
+  unless (s1 == s2) $ throwError (show s1 ++ " =/= " ++ show s2)
+
+checkDef :: Def -> Typing ()
+checkDef (xas,xes) = trace ("checking definition " ++ show (map fst xes)) $ do
+  checkTele xas
+  rho <- getEnv
+  local (addTele xas) $ checks (xas,rho) (map snd xes)
+
+checkTele :: Tele -> Typing ()
+checkTele []          = return ()
+checkTele ((x,a):xas) = do
+  check U a
+  local (addType (x,a)) $ checkTele xas
+
+check :: Val -> Exp -> Typing ()
+check a t = case (a,t) of
+  (_,Con c es) -> do
+    (bs,nu) <- getLblType c a
+    checks (bs,nu) es
+  (U,Pi a (Lam x b)) -> do
+    check U a
+    local (addType (x,a)) $ check U b
+  (U,Sum _ bs) -> sequence_ [checkTele as | (_,as) <- bs]
+  (Pi (Comp (Sum _ cas) nu) f,Fun _ ces) ->
+    if map fst ces == map fst cas
+       then sequence_ [ checkBranch (as,nu) f brc
+                      | (brc, (_,as)) <- zip ces cas ]
+       else throwError "case branches does not match the data type"
+  (Pi a f,Lam x t)  -> do
+    var <- getFresh
+    local (addTypeVal (x,a)) $ check (app f var) t
+  (_,Def e d) -> do
+    checkDef d
+    local (addDef d) $ check a e
+  (_,Undef _) -> return ()
+  _ -> do
+    k <- getIndex
+    (reifyExp k <$> checkInfer t) =?= reifyExp k a
+
+checkBranch :: (Tele,Env) -> Val -> Brc -> Typing ()
+checkBranch (xas,nu) f (c,(xs,e)) = do
+  k <- getIndex
+  let l  = length xas
+  let us = map mkVar [k..k+l-1]
+  local (addBranch (zip xs us) (xas,nu)) $ check (app f (Con c us)) e
+
+checkInfer :: Exp -> Typing Exp
+checkInfer e = case e of
+  U -> return U                 -- U : U
+  Var n -> do
+    gam <- getCtxt
+    case lookup n gam of
+      Just v  -> return v
+      Nothing -> throwError $ show n ++ " is not declared!"
+  App t u -> do
+    c <- checkInfer t
+    case c of
+      Pi a f -> do
+        check a u
+        rho <- getEnv
+        return (app f (eval u rho))
+      _      ->  throwError $ show c ++ " is not a product"
+  Def t d -> do
+    checkDef d
+    local (addDef d) $ checkInfer t
+  _ -> throwError ("checkInfer " ++ show e)
+
+checks :: (Tele,Env) -> [Exp] -> Typing ()
+checks _              []     = return ()
+checks ((x,a):xas,nu) (e:es) = do
+  check (eval a nu) e
+  rho <- getEnv
+  checks (xas,Pair nu (x,eval e rho)) es
+checks _              _      = throwError "checks"
+
+-- Reification of a value to an expression
+reifyExp :: Int -> Val -> Exp
+reifyExp _ U                     = U
+reifyExp k (Comp (Lam x t) r)    =
+  Lam (genName k) $ reifyExp (k+1) (eval t (Pair r (x,mkVar k)))
+reifyExp k v@(Var l)             = v
+reifyExp k (App u v)             = App (reifyExp k u) (reifyExp k v)
+reifyExp k (Pi a f)              = Pi (reifyExp k a) (reifyExp k f)
+reifyExp k (Con n ts)            = Con n (map (reifyExp k) ts)
+reifyExp k (Comp (Fun prim _) r) = EPrim prim (reifyEnv k r)
+reifyExp k (Comp (Sum prim _) r) = EPrim prim (reifyEnv k r)
+reifyExp k (Comp (Undef prim) r) = EPrim prim (reifyEnv k r)
+
+reifyEnv :: Int -> Env -> [Exp]
+reifyEnv _ Empty          = []
+reifyEnv k (Pair r (_,u)) = reifyEnv k r ++ [reifyExp k u]
+reifyEnv k (PDef ts r)    = reifyEnv k r
+
+-- Not used since we have U : U
+-- checkTs :: [(String,Exp)] -> Typing ()
+-- checkTs [] = return ()
+-- checkTs ((x,a):xas) = do
+--   checkType a
+--   local (addType (x,a)) (checkTs xas)
+--
+-- checkType :: Exp -> Typing ()
+-- checkType t = case t of
+--   U              -> return ()
+--   Pi a (Lam x b) -> do
+--     checkType a
+--     local (addType (x,a)) (checkType b)
+--   _ -> checkInfer t =?= U
+
+-- a show function
+
+showExp :: Exp -> String
+showExp1 :: Exp -> String
+
+showExps :: [Exp] -> String
+showExps = hcat . map showExp1
+
+showExp1 U = "U"
+showExp1 (Con c []) = c
+showExp1 (Var x) = x
+showExp1 u@(Fun {}) = showExp u
+showExp1 u@(Sum {}) = showExp u
+showExp1 u@(Undef {}) = showExp u
+showExp1 u@(EPrim {}) = showExp u
+showExp1 u@(Comp {}) = showExp u
+showExp1 u = parens $ showExp u
+
+showEnv :: Env -> String
+showEnv Empty            = ""
+showEnv (Pair env (x,u)) = parens $ showEnv1 env ++ show u
+showEnv (PDef xas env)   = showEnv env
+
+showEnv1 Empty            = ""
+showEnv1 (Pair env (x,u)) = showEnv1 env ++ showExp u ++ ", "
+showEnv1 (PDef xas env)   = showEnv env
+
+
+showExp e = case e of
+ App e0 e1 -> showExp e0 <+> showExp1 e1
+ Pi e0 e1 -> "Pi" <+> showExps [e0,e1]
+ Lam x e -> "\\" ++ x ++ "->" <+> showExp e
+ Def e d -> showExp e <+> "where" <+> showDef d
+ Var x -> x
+ U -> "U"
+ Con c es -> c <+> showExps es
+ Fun (n,str) _ -> str ++ show n
+ Sum (_,str) _ -> str
+ Undef (n,str) -> str ++ show n
+ EPrim (n,str) es -> str ++ show n <+> showExps es
+ Comp e env -> showExp1 e <+> showEnv env
+
+showDef :: Def -> String
+showDef (_,xts) = ccat (map (\(x,t) -> x <+> "=" <+> showExp t) xts)
+
diff --git a/MTTtoCTT.hs b/MTTtoCTT.hs
new file mode 100644
--- /dev/null
+++ b/MTTtoCTT.hs
@@ -0,0 +1,136 @@
+{-# LANGUAGE TupleSections #-}
+-- Tranlates the terms of MiniTT into the cubical syntax.
+module MTTtoCTT where
+
+import qualified CTT as I
+import Control.Monad.Error
+import Control.Applicative
+import Control.Arrow
+import MTT
+
+-- For an expression t, returns (u,ts) where u is no application
+-- and t = u ts
+unApps :: Exp -> (Exp,[Exp])
+unApps (App r s) = let (t,ts) = unApps r in (t, ts ++ [s])
+unApps t         = (t,[])
+
+apps :: I.Ter -> [I.Ter] -> I.Ter
+apps = foldl I.App
+
+lams :: [String] -> I.Ter -> I.Ter
+lams bs t = foldr I.Lam t bs
+
+translate :: Exp -> Either String I.Ter
+translate U              = return I.U
+translate (Undef prim)   = return $ I.Undef prim
+translate (Lam x t)      = I.Lam x <$> translate t
+translate (Pi a f)       = I.Pi <$> translate a <*> translate f
+translate t@(App _ _)    =
+  let (hd,rest) = unApps t
+  in case hd of
+    Var n | n `elem` reservedNames -> translatePrimitive n rest
+    _ -> apps <$> translate hd <*> mapM translate rest
+translate (Def e (_,ts)) = -- ignores types for now
+  I.Where <$> translate e <*> mapM (\(n,e') -> (n,) <$> translate e') ts
+translate (Var n) | n `elem` reservedNames = translatePrimitive n []
+                  | otherwise              = return (I.Var n)
+translate (Con n ts)     = I.Con n <$> mapM translate ts
+translate (Fun pr bs)    =
+  I.Branch pr <$> mapM (\(n,(ns,b)) -> (n,) <$> (ns,) <$> translate b) bs
+translate (Sum pr lbs)   =
+  I.LSum pr <$> sequence [ (n,) <$> mapM (\(n',e') -> (n',) <$> translate e') tl
+                         | (n,tl) <- lbs ]
+translate t              = throwError $ "translate: can not handle " ++ show t
+
+-- Gets a name for a primitive notion, a list of arguments which might be too
+-- long and returns the corresponding concept in the internal syntax. Applies
+-- the rest of the terms if the list of terms is longer than the arity.
+translatePrimitive :: String -> [Exp] -> Either String I.Ter
+translatePrimitive n ts = case lookup n primHandle of
+  Just (arity,_) | length ts < arity ->
+    let r       = arity - length ts
+        binders = map (\n -> '_' : show n) [1..r]
+        vars    = map Var binders
+    in lams binders <$> translatePrimitive n (ts ++ vars)
+  Just (arity,handler)               ->
+    let (args,rest) = splitAt arity ts
+    in apps <$> handler args <*> mapM translate rest
+  Nothing                            ->
+    throwError ("unknown primitive: " ++ show n)
+
+-- | Primitive notions
+
+-- name, (arity for Exp, handler)
+type PrimHandle = [(String, (Int, [Exp] -> Either String I.Ter))]
+
+primHandle :: PrimHandle
+primHandle =
+  [ ("Id",            (3, primId))
+  , ("refl",          (2, primRefl))
+  , ("funExt",        (5, primExt))
+  , ("J",             (6, primJ))
+  , ("Jeq",           (4, primJeq))
+  , ("inh",           (1, primInh))
+  , ("inc",           (2, primInc))
+  , ("squash",        (3, primSquash))
+  , ("inhrec",        (5, primInhRec))
+  , ("equivEq",       (5, primEquivEq))
+  , ("transport",     (4, primTransport))
+  , ("transportRef",  (2, primTransportRef))
+  , ("equivEqRef",    (3, primEquivEqRef))
+  , ("transpEquivEq", (6, primTransUEquivEq))
+  ]
+
+reservedNames :: [String]
+reservedNames = map fst primHandle
+
+primId :: [Exp] -> Either String I.Ter
+primId [a,x,y] = I.Id <$> translate a <*> translate x <*> translate y
+
+primRefl :: [Exp] -> Either String I.Ter
+primRefl [a,x] = I.Refl <$> translate x
+
+primExt :: [Exp] -> Either String I.Ter
+primExt [a,b,f,g,ptwise] =
+  I.Ext <$> translate b <*> translate f <*> translate g <*> translate ptwise
+
+primJ :: [Exp] -> Either String I.Ter
+primJ [a,u,c,w,v,p] =
+  I.J <$> translate a <*> translate u <*> translate c
+      <*> translate w <*> translate v <*> translate p
+
+primJeq :: [Exp] -> Either String I.Ter
+primJeq [a,u,c,w] =
+  I.JEq <$> translate a <*> translate u <*> translate c <*> translate w
+
+primInh :: [Exp] -> Either String I.Ter
+primInh [a] = I.Inh <$> translate a
+
+primInc :: [Exp] -> Either String I.Ter
+primInc [a,x] = I.Inc <$> translate x
+
+primSquash :: [Exp] -> Either String I.Ter
+primSquash [a,x,y] = I.Squash <$> translate x <*> translate y
+
+primInhRec :: [Exp] -> Either String I.Ter
+primInhRec [a,b,p,f,x] =
+  I.InhRec <$> translate b <*> translate p <*> translate f <*> translate x
+
+primEquivEq :: [Exp] -> Either String I.Ter
+primEquivEq [a,b,f,s,t] =
+  I.EquivEq <$> translate a <*> translate b <*> translate f
+            <*> translate s <*> translate t
+
+primTransport :: [Exp] -> Either String I.Ter
+primTransport [a,b,p,x] = I.TransU <$> translate p <*> translate x
+
+primTransportRef :: [Exp] -> Either String I.Ter
+primTransportRef [a,x] = I.TransURef <$> translate x
+
+primEquivEqRef :: [Exp] -> Either String I.Ter
+primEquivEqRef [a,s,t] = I.EquivEqRef <$> translate a <*> translate s <*> translate t
+
+primTransUEquivEq :: [Exp] -> Either String I.Ter
+primTransUEquivEq [a,b,f,s,t,x] =
+  I.TransUEquivEq <$> translate a <*> translate b <*> translate f
+                  <*> translate s <*> translate t <*> translate x
diff --git a/Main.hs b/Main.hs
new file mode 100644
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,105 @@
+module Main where
+
+import Control.Monad.Trans.Reader
+import Control.Monad.Error
+import Data.List
+import System.Environment
+import System.Console.Haskeline
+import System.Directory
+
+import Exp.Lex
+import Exp.Par
+import Exp.Print
+import Exp.Abs
+import Exp.Layout
+import Exp.ErrM
+import MTTtoCTT
+import Concrete
+import qualified MTT  as A
+import qualified CTT as C
+import qualified Eval as E
+
+type Interpreter a = InputT IO a
+
+defaultPrompt :: String
+defaultPrompt = "> "
+
+lexer :: String -> [Token]
+lexer = resolveLayout True . myLexer
+
+showTree :: (Show a, Print a) => a -> IO ()
+showTree tree = do
+  putStrLn $ "\n[Abstract Syntax]\n\n" ++ show tree
+  putStrLn $ "\n[Linearized tree]\n\n" ++ printTree tree
+
+main :: IO ()
+main = getArgs >>= runInputT defaultSettings . runInterpreter
+
+-- (not ok,loaded,already loaded defs) -> to load  -> (newnotok, newloaded, newdefs)
+imports :: ([String],[String],[Def])  -> String-> Interpreter ([String],[String],[Def])
+imports st@(notok,loaded,defs) f
+  | f `elem` notok  = fail ("Looping imports in " ++ f)
+  | f `elem` loaded = return st
+  | otherwise       = do
+    s <- lift $ readFile f
+    let ts = lexer s
+    case pModule ts of
+      Bad s  -> fail $ "Parse Failed in file " ++ show f ++ "\n" ++ show s
+      Ok mod@(Module _ imps defs') -> do
+        let imps' = [ unIdent s ++ ".cub" | Import s <- imps ]
+        (notok1,loaded1,def1) <- foldM imports (f:notok,loaded,defs) imps'
+        outputStrLn $ "Parsed file " ++ show f ++ " successfully!"
+        return (notok,f:loaded1,def1 ++ defs')
+
+runInterpreter :: [FilePath] -> Interpreter ()
+runInterpreter fs = case fs of
+  [f] -> do
+    -- parse and type-check files
+    (_,_,defs) <- imports ([],[],[]) f
+    -- Compute all constructors
+    let cs = concat [ [ unIdent n | Sum n _ <- lbls] | DefData _ _ lbls <- defs ]
+    let res = runResolver (local (insertConstrs cs) (resolveDefs defs))
+    case res of
+      Left err    -> outputStrLn $ "Resolver failed: " ++ err
+      Right adefs -> case A.runDefs A.tEmpty adefs of
+        Left err   -> outputStrLn $ "Type checking failed: " ++ err
+        Right tenv -> do
+          outputStrLn "File loaded."
+          loop cs tenv
+  _   -> do outputStrLn $ "Exactly one file expected: " ++ show fs
+            loop [] A.tEmpty
+  where
+    loop :: [String] -> A.TEnv -> Interpreter ()
+    loop cs tenv@(A.TEnv _ rho _) = do
+      input <- getInputLine defaultPrompt
+      case input of
+        Nothing    -> outputStrLn help >> loop cs tenv
+        Just ":q"  -> return ()
+        Just ":r"  -> runInterpreter fs
+        Just (':':'l':' ':str) -> runInterpreter (words str)
+        Just (':':'c':'d':' ':str) -> lift (setCurrentDirectory str) >> loop cs tenv
+        Just ":h"  -> outputStrLn help >> loop cs tenv
+        Just str   -> let ts = lexer str in
+          case pExp ts of
+            Bad err -> outputStrLn ("Parse error: " ++ err) >> loop cs tenv
+            Ok exp  ->
+              case runResolver (local (const (Env cs)) (resolveExp exp)) of
+                Left err   -> outputStrLn ("Resolver failed: " ++ err) >> loop cs tenv
+                Right body ->
+                  case A.runInfer tenv body of
+                    Left err -> outputStrLn ("Could not type-check: " ++ err) >> loop cs tenv
+                    Right _  ->
+                      case translate (A.defs rho body) of
+                        Left err -> outputStrLn ("Could not translate to internal syntax: " ++ err) >>
+                                    loop cs tenv
+                        Right t  -> let value = E.eval C.Empty t in
+                          outputStrLn ("EVAL: " ++ show value) >> loop cs tenv
+
+help :: String
+help = "\nAvailable commands:\n" ++
+       "  <statement>     infer type and evaluate statement\n" ++
+       "  :q              quit\n" ++
+       "  :l <filename>   loads filename (and resets environment before)\n" ++
+       "  :cd <path>      change directory to path\n" ++
+       "  :r              reload\n" ++
+       "  :h              display this message\n"
diff --git a/Makefile b/Makefile
new file mode 100644
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,11 @@
+all: 
+	ghc --make -O2 -o cubigle Main.hs
+bnfc:
+	bnfc -d Exp.cf
+	happy -gca Exp/Par.y
+	alex -g Exp/Lex.x
+	ghc --make Exp/Test.hs -o Exp/Test
+clean:
+	rm -f *.log *.aux *.hi *.o cubigle
+	cd Exp && rm -f ParExp.y LexExp.x LexhExp.hs \
+                        ParExp.hs PrintExp.hs AbsExp.hs *.o *.hi
diff --git a/Pretty.hs b/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/Pretty.hs
@@ -0,0 +1,28 @@
+-- Common functions used for pretty printing.
+module Pretty where
+
+--------------------------------------------------------------------------------
+-- | Pretty printing combinators. Use the same names as in the pretty library.
+(<+>) :: String -> String -> String
+[] <+> y  = y
+x  <+> [] = x
+x  <+> y  = x ++ " " ++ y
+
+infixl 6 <+>
+
+hcat :: [String] -> String
+hcat []     = []
+hcat [x]    = x
+hcat (x:xs) = x <+> hcat xs
+
+ccat :: [String] -> String
+ccat []     = []
+ccat [x]    = x
+ccat (x:xs) = x <+> ", " <+> ccat xs
+
+parens :: String -> String
+parens p = "(" ++ p ++ ")"
+
+-- Angled brackets, not present in pretty library.
+abrack :: String -> String
+abrack p = "<" ++ p ++ ">"
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,234 @@
+CUBICAL
+=======
+
+Cubical implements an experimental simple type-checker for type theory
+with univalence with an evaluator for closed terms.
+
+
+INSTALL
+-------
+
+To install cubical a working Haskell and cabal installation are
+required.  To build cubical go to the main directory and do
+
+  `cabal install`
+
+To only build cubical do
+
+  `cabal configure`
+
+  `cabal build`
+
+
+USAGE
+-----
+
+To run cubical type
+
+  `cubical <filename>`
+
+In the interaction loop type :h to get a list of available commands.
+Note that the current directory will be taken as the search path for
+the imports.
+
+
+OVERVIEW
+--------
+
+The program is organized as follows:
+
+ * the files are parsed and produce a list of definitions; the syntax
+   is described in the file Exp/Doc.txt or Exp/Doc.tex (auto generated
+   by bnfc);
+
+ * this list of definitions is type-checked;
+
+ * if successful, we can then write an expression which is
+   type-checked w.r.t. these definitions;
+
+ * if the expression is well-typed it is translated to the cubical
+   syntax and evaluated by a "cubical abstract machine", which
+   computes its semantics in cubical sets; the result is shown after
+   "EVAL:" (to disable the trace of the evaluation set the boolean
+   "debug" to False in Eval.hs);
+
+During type-checking, we consider the primitives listed in
+examples/primitive.cub as non interpreted constants.  The type-checker
+is in the file MTT.hs and is rudimentary (300 lines), without good
+error messages.
+
+These primitives however have a meaning in cubical sets, and the
+evaluation function computes this meaning.  This semantics/evaluation
+is described in the file Eval.hs, which is the main file. The most
+complex part corresponds to the computations witnessing that the
+universe has Kan filling operations.
+
+For writing this semantics, it was convenient to use the alternative
+presentation of cubical sets as nominal sets with 01-substitutions
+(see A. Pitts' note, references listed below).
+
+
+DESCRIPTION OF THE LANGUAGE
+---------------------------
+
+We have
+
+ * dependent function types `(x:A) -> B`; non-dependent function types
+   can be written as `A -> B`
+
+ * abstraction `\x -> e`
+
+ * named/labelled sum `c1 (x1:A1)...(xn:An) | c2 ... | ...`
+   a data type is a recursively defined named sum
+
+ * function defined by case
+   `f = split c1 x1 ... xn -> e1 | c2 ... -> ... | ...`
+
+ * a universe `U` and assume `U:U` for simplicity
+
+ * let/where: `let D in e` where D is a list of definitions an
+   alternative syntax is `e where D`
+
+The syntax allows Landin's offside rule similar to Haskell.
+
+The basic (untyped) language has a direct simple denotational
+semantics Type theory works with the total part of this language (it
+is possible to define totality at the denotational semantics level).
+Our evaluator works in a nominal version of this semantics.  The
+type-checker assumes that we work in this total part, in particular,
+there is no termination check.
+
+
+DESCRIPTION OF THE SEMANTICS/EVALUATION
+---------------------------------------
+
+The values depend on a new class of names, also called directions,
+which can be thought of as varying over the unit interval [0,1].  A
+path connecting a0 and a1 in the direction x is a value p(x) such that
+p(0) = a0 and p(1) = a1.  An element in the identity type a0 = a1 is
+then of the form <x>p(x) where the name x is bound.  An identity proof
+in an identity type will then be interpreted as a "square" of the form
+<x><y>p(x,y).  See examples/hedberg.cub and the example test3 (in the
+current implementation directions/names are represented by numbers).
+ 
+Operationally, a type is explained by giving what are its Kan filling
+operation.  For instance, we have to explain what are the Kan filling
+for the dependent product.
+
+The main step for interpreting univalence is to transform an
+equivalence A -> B to a path in any direction x connecting A and B.
+This is a new basic element of the universe, called VEquivEq in the
+file Eval.hs which takes a name and arguments A,B,f and the proof that
+f is an equivalence.  The main part of the work is then to explain the
+Kan filling operation for this new type.
+
+The Kan filling for the universe can be seen as a generalization of
+the operation of composition of relation.
+
+
+DESCRIPTION OF THE EXAMPLES
+---------------------------
+
+The directory examples contains some examples of proofs. The file
+examples/primitive.cub list the new primitives that have cubical set
+semantics. These primitive notions imply the axiom of univalence.  The
+file examples/primitive.cub should be the basis of any development
+using univalence.
+
+Most of the example files contain simple test examples of
+computations:
+
+ * the file hedberg.cub contains a test computation of a square in
+   Nat; the example is test. In the type Nat or Bool, any square
+   (proof of identity of two identity proofs) is constant.
+
+ * The file nIso.cub contains a non trivial example of a transport of
+   a section of a dependent type along the isomorphism between N and
+   N+1; the examples are testSN, testSN1, testSN2, testSN3.
+
+ * The file testInh.cub contains examples of computation for the
+   propositional reflection.  It gives an example test which produces
+   a (surprisingly complex) composition of squares in the universe.
+
+ * The file quotient.cub contains an example of a computation from an
+   equivalence class.  The relation R over Nat is to have the same
+   parity, and the map is Nat/R -> Bool which returns true if the
+   equivalence class contains even number. The examples are test5 and
+   test8 which computes the value of this map on the equivalence class
+   of five and eight respectively. This uses the file description.cub
+   which justifies the axiom of description.
+
+ * The file Kraus.cub contains the example of Nicolai Kraus of the
+   myst function, which also shows that we can extract computational
+   information from propositions; the example is testMyst zero; the
+   computation does not create higher dimensional objects.
+
+ * The file swap.cub contains examples of transport along the
+   isomorphism between A x B and B x A; the examples are test14,
+   test15.
+
+
+
+FURTHER WORK (non-exhaustive)
+------------
+
+ * The Kan filling operations should be formally proved correct and
+   tested on higher inductive types.
+
+ * Some constants have a direct cubical semantics having better
+   behavior w.r.t. equality.  For instance the constant
+
+    `cong : (A B : U) (f : A -> B) (a b : A) (p : Id A a b) -> Id B (f a) (f b)`
+
+   has a semantics which satisfies the definitional equalities:
+
+    `cong (id A)       = id A`
+
+    `cong (g o f)      = (cong g) o (cong f)`
+
+    `cong f (refl A a) = refl B (f a)`
+
+   The evaluation should be used for conversion during type-checking,
+   and then we shall get these equalities as definitional.
+
+   Some proofs are then much simpler, e.g. the proof of the Graduate
+   Lemma.
+
+ * Similarly we should have eta conversion and surjective pairing;
+   this can be obtained by normalization by evaluation.
+
+ * For higher inductive types, like the circle or the sphere, it would
+   be appropriate to *extend* the syntax of type theory, in order to
+   get natural elimination rules (see the paper on cubical sets).
+
+ * To explore the termination of the resizing rule.  Computationally
+   the resizing rule does not do anything, but the termination seems
+   to be an interesting proof-theoretical problem.
+
+
+REFERENCES
+----------
+
+ * Voevodsky's home page on univalent foundation
+
+ * HoTT book 
+
+ * Type Theory in Color, J.P. Bernardy, G. Moulin
+
+ * A simple type-theoretic language: Mini-TT, Th. Coquand,
+   Y. Kinoshita, B. Nordstrom and M. Takeyama
+
+ * A cubical set model of type theory, M. Bezem, Th. Coquand and
+   S. Huber available at www.cse.chalmers.se/~coquand/model1.pdf
+
+ * A property of contractible types, Th. Coquand available at
+   www.cse.chalmers.se/~coquand/contr.pdf
+
+ * An equivalent presentation of the Bezem-Coquand-Huber category of
+   cubical sets, A. Pitts
+
+
+AUTHORS
+-------
+
+Cyril Cohen, Thierry Coquand, Simon Huber, Anders Mörtberg
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,8 @@
+import Distribution.Simple
+import System.Process
+import System.Exit
+main = do
+  ret <- system "bnfc -d Exp.cf"
+  case ret of
+    ExitSuccess   -> defaultMain
+    ExitFailure n -> error $ "bnfc command not found or error" ++ show n
diff --git a/cubical.cabal b/cubical.cabal
new file mode 100644
--- /dev/null
+++ b/cubical.cabal
@@ -0,0 +1,27 @@
+name:                cubical
+version:             0.1.0
+synopsis:            Implementation of Univalence in Cubical Sets
+description:         Cubical implements an experimental simple type checker
+                     for type theory with univalence with an evaluator for closed terms.
+homepage:            https://github.com/simhu/cubical
+extra-source-files:  Makefile, README.md, Exp.cf, examples/*.cub
+license:             MIT
+license-file:        LICENSE
+author:              Cyril Cohen, Thierry Coquand, Simon Huber, Anders Mörtberg
+maintainer:          mortberg@chalmers.se
+-- copyright:           
+category:            Dependent Types
+build-type:          Custom
+-- extra-source-files:  
+cabal-version:       >=1.10
+
+executable cubical
+  main-is:             Main.hs
+  other-modules:       Exp.Lex, Exp.Par
+  other-extensions:    TupleSections, CPP, MagicHash
+  build-depends:       base >=4.5 && < 5, transformers >=0.3, mtl >=2.1, haskeline >=0.7, directory >=1.2, array >=0.4, BNFC >= 2.6
+  -- hs-source-dirs:      
+  build-tools:         alex, happy
+  default-language:    Haskell2010
+  hs-source-dirs:      .
+  other-modules:       CTT, Concrete, Eval, MTT, MTTtoCTT, Pretty
diff --git a/dist/build/cubical/cubical-tmp/Exp/Lex.hs b/dist/build/cubical/cubical-tmp/Exp/Lex.hs
new file mode 100644
--- /dev/null
+++ b/dist/build/cubical/cubical-tmp/Exp/Lex.hs
@@ -0,0 +1,351 @@
+{-# LANGUAGE CPP,MagicHash #-}
+{-# LINE 3 "Exp/Lex.x" #-}
+
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module Exp.Lex where
+
+
+
+import qualified Data.Bits
+import Data.Word (Word8)
+
+#if __GLASGOW_HASKELL__ >= 603
+#include "ghcconfig.h"
+#elif defined(__GLASGOW_HASKELL__)
+#include "config.h"
+#endif
+#if __GLASGOW_HASKELL__ >= 503
+import Data.Array
+import Data.Char (ord)
+import Data.Array.Base (unsafeAt)
+#else
+import Array
+import Char (ord)
+#endif
+#if __GLASGOW_HASKELL__ >= 503
+import GHC.Exts
+#else
+import GlaExts
+#endif
+alex_base :: AlexAddr
+alex_base = AlexA# "\xf8\xff\xff\xff\xd9\xff\xff\xff\x49\x00\x00\x00\x1c\x01\x00\x00\x9c\x01\x00\x00\x6f\x02\x00\x00\xef\x02\x00\x00\xef\x03\x00\x00\xb7\xff\xff\xff\x00\x00\x00\x00\xe0\x03\x00\x00\x00\x00\x00\x00\x8b\x00\x00\x00\x1d\x02\x00\x00\xe0\x04\x00\x00\xa0\x04\x00\x00\x00\x00\x00\x00\x96\x05\x00\x00\x69\x06\x00\x00\x00\x00\x00\x00\xfe\xff\xff\xff\xdf\xff\xff\xff\x00\x00\x00\x00\x42\x07\x00\x00"#
+
+alex_table :: AlexAddr
+alex_table = AlexA# "\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x11\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x16\x00\x16\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x16\x00\x00\x00\x16\x00\x00\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x16\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x15\x00\x16\x00\x16\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x0f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x02\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x04\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x0f\x00\x04\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0c\x00\x06\x00\x09\x00\x09\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+alex_check :: AlexAddr
+alex_check = AlexA# "\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x28\x00\x29\x00\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\x3b\x00\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x2d\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xc3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7d\x00\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2d\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7d\x00\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2d\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xff\xff\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+alex_deflt :: AlexAddr
+alex_deflt = AlexA# "\xff\xff\xff\xff\x05\x00\x05\x00\xff\xff\x05\x00\xff\xff\x05\x00\x05\x00\x0b\x00\x0b\x00\x10\x00\x10\x00\xff\xff\x11\x00\x11\x00\x11\x00\x11\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+alex_accept = listArray (0::Int,23) [AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccSkip,AlexAccSkip,AlexAccSkip,AlexAccSkip,AlexAcc (alex_action_3),AlexAcc (alex_action_3),AlexAcc (alex_action_4)]
+{-# LINE 38 "Exp/Lex.x" #-}
+
+
+tok f p s = f p s
+
+share :: String -> String
+share = id
+
+data Tok =
+   TS !String !Int    -- reserved words and symbols
+ | TL !String         -- string literals
+ | TI !String         -- integer literals
+ | TV !String         -- identifiers
+ | TD !String         -- double precision float literals
+ | TC !String         -- character literals
+ | T_AIdent !String
+
+ deriving (Eq,Show,Ord)
+
+data Token = 
+   PT  Posn Tok
+ | Err Posn
+  deriving (Eq,Show,Ord)
+
+tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
+tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
+tokenPos _ = "end of file"
+
+tokenPosn (PT p _) = p
+tokenPosn (Err p) = p
+tokenLineCol = posLineCol . tokenPosn
+posLineCol (Pn _ l c) = (l,c)
+mkPosToken t@(PT p _) = (posLineCol p, prToken t)
+
+prToken t = case t of
+  PT _ (TS s _) -> s
+  PT _ (TL s)   -> s
+  PT _ (TI s)   -> s
+  PT _ (TV s)   -> s
+  PT _ (TD s)   -> s
+  PT _ (TC s)   -> s
+  PT _ (T_AIdent s) -> s
+
+
+data BTree = N | B String Tok BTree BTree deriving (Show)
+
+eitherResIdent :: (String -> Tok) -> String -> Tok
+eitherResIdent tv s = treeFind resWords
+  where
+  treeFind N = tv s
+  treeFind (B a t left right) | s < a  = treeFind left
+                              | s > a  = treeFind right
+                              | s == a = t
+
+resWords = b "data" 11 (b "=" 6 (b "->" 3 (b ")" 2 (b "(" 1 N N) N) (b ";" 5 (b ":" 4 N N) N)) (b "\\" 9 (b "U" 8 (b "PN" 7 N N) N) (b "_" 10 N N))) (b "undefined" 17 (b "let" 14 (b "in" 13 (b "import" 12 N N) N) (b "split" 16 (b "module" 15 N N) N)) (b "|" 20 (b "{" 19 (b "where" 18 N N) N) (b "}" 21 N N)))
+   where b s n = let bs = id s
+                  in B bs (TS bs n)
+
+unescapeInitTail :: String -> String
+unescapeInitTail = id . unesc . tail . id where
+  unesc s = case s of
+    '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
+    '\\':'n':cs  -> '\n' : unesc cs
+    '\\':'t':cs  -> '\t' : unesc cs
+    '"':[]    -> []
+    c:cs      -> c : unesc cs
+    _         -> []
+
+-------------------------------------------------------------------
+-- Alex wrapper code.
+-- A modified "posn" wrapper.
+-------------------------------------------------------------------
+
+data Posn = Pn !Int !Int !Int
+      deriving (Eq, Show,Ord)
+
+alexStartPos :: Posn
+alexStartPos = Pn 0 1 1
+
+alexMove :: Posn -> Char -> Posn
+alexMove (Pn a l c) '\t' = Pn (a+1)  l     (((c+7) `div` 8)*8+1)
+alexMove (Pn a l c) '\n' = Pn (a+1) (l+1)   1
+alexMove (Pn a l c) _    = Pn (a+1)  l     (c+1)
+
+type Byte = Word8
+
+type AlexInput = (Posn,     -- current position,
+                  Char,     -- previous char
+                  [Byte],   -- pending bytes on the current char
+                  String)   -- current input string
+
+tokens :: String -> [Token]
+tokens str = go (alexStartPos, '\n', [], str)
+    where
+      go :: AlexInput -> [Token]
+      go inp@(pos, _, _, str) =
+               case alexScan inp 0 of
+                AlexEOF                   -> []
+                AlexError (pos, _, _, _)  -> [Err pos]
+                AlexSkip  inp' len        -> go inp'
+                AlexToken inp' len act    -> act pos (take len str) : (go inp')
+
+alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)
+alexGetByte (p, c, (b:bs), s) = Just (b, (p, c, bs, s))
+alexGetByte (p, _, [], s) =
+  case  s of
+    []  -> Nothing
+    (c:s) ->
+             let p'     = alexMove p c
+                 (b:bs) = utf8Encode c
+              in p' `seq` Just (b, (p', c, bs, s))
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar (p, c, bs, s) = c
+
+  -- | Encode a Haskell String to a list of Word8 values, in UTF8 format.
+utf8Encode :: Char -> [Word8]
+utf8Encode = map fromIntegral . go . ord
+ where
+  go oc
+   | oc <= 0x7f       = [oc]
+
+   | oc <= 0x7ff      = [ 0xc0 + (oc `Data.Bits.shiftR` 6)
+                        , 0x80 + oc Data.Bits..&. 0x3f
+                        ]
+
+   | oc <= 0xffff     = [ 0xe0 + (oc `Data.Bits.shiftR` 12)
+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)
+                        , 0x80 + oc Data.Bits..&. 0x3f
+                        ]
+   | otherwise        = [ 0xf0 + (oc `Data.Bits.shiftR` 18)
+                        , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)
+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)
+                        , 0x80 + oc Data.Bits..&. 0x3f
+                        ]
+
+alex_action_3 =  tok (\p s -> PT p (eitherResIdent (TV . share) s)) 
+alex_action_4 =  tok (\p s -> PT p (eitherResIdent (T_AIdent . share) s)) 
+alex_action_5 =  tok (\p s -> PT p (eitherResIdent (TV . share) s)) 
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+{-# LINE 1 "<command-line>" #-}
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+-- -----------------------------------------------------------------------------
+-- ALEX TEMPLATE
+--
+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use
+-- it for any purpose whatsoever.
+
+-- -----------------------------------------------------------------------------
+-- INTERNALS and main scanner engine
+
+{-# LINE 35 "templates/GenericTemplate.hs" #-}
+
+{-# LINE 45 "templates/GenericTemplate.hs" #-}
+
+
+data AlexAddr = AlexA# Addr#
+
+#if __GLASGOW_HASKELL__ < 503
+uncheckedShiftL# = shiftL#
+#endif
+
+{-# INLINE alexIndexInt16OffAddr #-}
+alexIndexInt16OffAddr (AlexA# arr) off =
+#ifdef WORDS_BIGENDIAN
+  narrow16Int# i
+  where
+        i    = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)
+        high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
+        low  = int2Word# (ord# (indexCharOffAddr# arr off'))
+        off' = off *# 2#
+#else
+  indexInt16OffAddr# arr off
+#endif
+
+
+
+
+
+{-# INLINE alexIndexInt32OffAddr #-}
+alexIndexInt32OffAddr (AlexA# arr) off = 
+#ifdef WORDS_BIGENDIAN
+  narrow32Int# i
+  where
+   i    = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`
+		     (b2 `uncheckedShiftL#` 16#) `or#`
+		     (b1 `uncheckedShiftL#` 8#) `or#` b0)
+   b3   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))
+   b2   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))
+   b1   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
+   b0   = int2Word# (ord# (indexCharOffAddr# arr off'))
+   off' = off *# 4#
+#else
+  indexInt32OffAddr# arr off
+#endif
+
+
+
+
+
+#if __GLASGOW_HASKELL__ < 503
+quickIndex arr i = arr ! i
+#else
+-- GHC >= 503, unsafeAt is available from Data.Array.Base.
+quickIndex = unsafeAt
+#endif
+
+
+
+
+-- -----------------------------------------------------------------------------
+-- Main lexing routines
+
+data AlexReturn a
+  = AlexEOF
+  | AlexError  !AlexInput
+  | AlexSkip   !AlexInput !Int
+  | AlexToken  !AlexInput !Int a
+
+-- alexScan :: AlexInput -> StartCode -> AlexReturn a
+alexScan input (I# (sc))
+  = alexScanUser undefined input (I# (sc))
+
+alexScanUser user input (I# (sc))
+  = case alex_scan_tkn user input 0# input sc AlexNone of
+	(AlexNone, input') ->
+		case alexGetByte input of
+			Nothing -> 
+
+
+
+				   AlexEOF
+			Just _ ->
+
+
+
+				   AlexError input'
+
+	(AlexLastSkip input'' len, _) ->
+
+
+
+		AlexSkip input'' len
+
+	(AlexLastAcc k input''' len, _) ->
+
+
+
+		AlexToken input''' len k
+
+
+-- Push the input through the DFA, remembering the most recent accepting
+-- state it encountered.
+
+alex_scan_tkn user orig_input len input s last_acc =
+  input `seq` -- strict in the input
+  let 
+	new_acc = (check_accs (alex_accept `quickIndex` (I# (s))))
+  in
+  new_acc `seq`
+  case alexGetByte input of
+     Nothing -> (new_acc, input)
+     Just (c, new_input) -> 
+
+
+
+      case fromIntegral c of { (I# (ord_c)) ->
+        let
+                base   = alexIndexInt32OffAddr alex_base s
+                offset = (base +# ord_c)
+                check  = alexIndexInt16OffAddr alex_check offset
+		
+                new_s = if (offset >=# 0#) && (check ==# ord_c)
+			  then alexIndexInt16OffAddr alex_table offset
+			  else alexIndexInt16OffAddr alex_deflt s
+	in
+        case new_s of
+	    -1# -> (new_acc, input)
+		-- on an error, we want to keep the input *before* the
+		-- character that failed, not after.
+    	    _ -> alex_scan_tkn user orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len)
+                                                -- note that the length is increased ONLY if this is the 1st byte in a char encoding)
+			new_input new_s new_acc
+      }
+  where
+	check_accs (AlexAccNone) = last_acc
+	check_accs (AlexAcc a  ) = AlexLastAcc a input (I# (len))
+	check_accs (AlexAccSkip) = AlexLastSkip  input (I# (len))
+{-# LINE 191 "templates/GenericTemplate.hs" #-}
+
+data AlexLastAcc a
+  = AlexNone
+  | AlexLastAcc a !AlexInput !Int
+  | AlexLastSkip  !AlexInput !Int
+
+instance Functor AlexLastAcc where
+    fmap f AlexNone = AlexNone
+    fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z
+    fmap f (AlexLastSkip x y) = AlexLastSkip x y
+
+data AlexAcc a user
+  = AlexAccNone
+  | AlexAcc a
+  | AlexAccSkip
+{-# LINE 235 "templates/GenericTemplate.hs" #-}
+
+-- used by wrappers
+iUnbox (I# (i)) = i
diff --git a/dist/build/cubical/cubical-tmp/Exp/Par.hs b/dist/build/cubical/cubical-tmp/Exp/Par.hs
new file mode 100644
--- /dev/null
+++ b/dist/build/cubical/cubical-tmp/Exp/Par.hs
@@ -0,0 +1,985 @@
+{-# OPTIONS_GHC -w #-}
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
+module Exp.Par where
+import Exp.Abs
+import Exp.Lex
+import Exp.ErrM
+import qualified Data.Array as Happy_Data_Array
+import qualified GHC.Exts as Happy_GHC_Exts
+
+-- parser produced by Happy Version 1.18.8
+
+newtype HappyAbsSyn  = HappyAbsSyn HappyAny
+#if __GLASGOW_HASKELL__ >= 607
+type HappyAny = Happy_GHC_Exts.Any
+#else
+type HappyAny = forall a . a
+#endif
+happyIn5 :: (AIdent) -> (HappyAbsSyn )
+happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn5 #-}
+happyOut5 :: (HappyAbsSyn ) -> (AIdent)
+happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut5 #-}
+happyIn6 :: (Module) -> (HappyAbsSyn )
+happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn6 #-}
+happyOut6 :: (HappyAbsSyn ) -> (Module)
+happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut6 #-}
+happyIn7 :: (Imp) -> (HappyAbsSyn )
+happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn7 #-}
+happyOut7 :: (HappyAbsSyn ) -> (Imp)
+happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut7 #-}
+happyIn8 :: ([Imp]) -> (HappyAbsSyn )
+happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn8 #-}
+happyOut8 :: (HappyAbsSyn ) -> ([Imp])
+happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut8 #-}
+happyIn9 :: (Def) -> (HappyAbsSyn )
+happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn9 #-}
+happyOut9 :: (HappyAbsSyn ) -> (Def)
+happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut9 #-}
+happyIn10 :: ([Def]) -> (HappyAbsSyn )
+happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn10 #-}
+happyOut10 :: (HappyAbsSyn ) -> ([Def])
+happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut10 #-}
+happyIn11 :: (ExpWhere) -> (HappyAbsSyn )
+happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn11 #-}
+happyOut11 :: (HappyAbsSyn ) -> (ExpWhere)
+happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut11 #-}
+happyIn12 :: (Exp) -> (HappyAbsSyn )
+happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn12 #-}
+happyOut12 :: (HappyAbsSyn ) -> (Exp)
+happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut12 #-}
+happyIn13 :: (Exp) -> (HappyAbsSyn )
+happyIn13 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn13 #-}
+happyOut13 :: (HappyAbsSyn ) -> (Exp)
+happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut13 #-}
+happyIn14 :: (Exp) -> (HappyAbsSyn )
+happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn14 #-}
+happyOut14 :: (HappyAbsSyn ) -> (Exp)
+happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut14 #-}
+happyIn15 :: (Exp) -> (HappyAbsSyn )
+happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn15 #-}
+happyOut15 :: (HappyAbsSyn ) -> (Exp)
+happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut15 #-}
+happyIn16 :: (Binder) -> (HappyAbsSyn )
+happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn16 #-}
+happyOut16 :: (HappyAbsSyn ) -> (Binder)
+happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut16 #-}
+happyIn17 :: ([Binder]) -> (HappyAbsSyn )
+happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn17 #-}
+happyOut17 :: (HappyAbsSyn ) -> ([Binder])
+happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut17 #-}
+happyIn18 :: (Arg) -> (HappyAbsSyn )
+happyIn18 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn18 #-}
+happyOut18 :: (HappyAbsSyn ) -> (Arg)
+happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut18 #-}
+happyIn19 :: ([Arg]) -> (HappyAbsSyn )
+happyIn19 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn19 #-}
+happyOut19 :: (HappyAbsSyn ) -> ([Arg])
+happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut19 #-}
+happyIn20 :: (Branch) -> (HappyAbsSyn )
+happyIn20 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn20 #-}
+happyOut20 :: (HappyAbsSyn ) -> (Branch)
+happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut20 #-}
+happyIn21 :: ([Branch]) -> (HappyAbsSyn )
+happyIn21 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn21 #-}
+happyOut21 :: (HappyAbsSyn ) -> ([Branch])
+happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut21 #-}
+happyIn22 :: (Sum) -> (HappyAbsSyn )
+happyIn22 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn22 #-}
+happyOut22 :: (HappyAbsSyn ) -> (Sum)
+happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut22 #-}
+happyIn23 :: ([Sum]) -> (HappyAbsSyn )
+happyIn23 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn23 #-}
+happyOut23 :: (HappyAbsSyn ) -> ([Sum])
+happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut23 #-}
+happyIn24 :: (VDecl) -> (HappyAbsSyn )
+happyIn24 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn24 #-}
+happyOut24 :: (HappyAbsSyn ) -> (VDecl)
+happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut24 #-}
+happyIn25 :: ([VDecl]) -> (HappyAbsSyn )
+happyIn25 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn25 #-}
+happyOut25 :: (HappyAbsSyn ) -> ([VDecl])
+happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut25 #-}
+happyIn26 :: (PiDecl) -> (HappyAbsSyn )
+happyIn26 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn26 #-}
+happyOut26 :: (HappyAbsSyn ) -> (PiDecl)
+happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut26 #-}
+happyIn27 :: ([PiDecl]) -> (HappyAbsSyn )
+happyIn27 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn27 #-}
+happyOut27 :: (HappyAbsSyn ) -> ([PiDecl])
+happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut27 #-}
+happyInTok :: (Token) -> (HappyAbsSyn )
+happyInTok x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyInTok #-}
+happyOutTok :: (HappyAbsSyn ) -> (Token)
+happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOutTok #-}
+
+
+happyActOffsets :: HappyAddr
+happyActOffsets = HappyA# "\xd7\x00\xca\x00\xce\x00\x00\x00\x00\x00\xc9\x00\x00\x00\xdb\x00\x00\x00\x00\x00\xde\x00\xcd\x00\xca\x00\x00\x00\x00\x00\x4b\x00\x00\x00\xc4\x00\xbb\x00\x00\x00\xb7\x00\xc3\x00\xba\x00\xaf\x00\x18\x00\x4b\x00\xc1\x00\x00\x00\x41\x00\x9c\x00\x00\x00\xca\x00\x00\x00\xca\x00\x9c\x00\x00\x00\xbd\x00\xb9\x00\x00\x00\x00\x00\xca\x00\xca\x00\x00\x00\xb8\x00\xae\x00\x8c\x00\x98\x00\x00\x00\xa0\x00\x89\x00\x8d\x00\x8a\x00\x00\x00\x7d\x00\x0a\x00\x00\x00\x84\x00\x18\x00\x3a\x00\xca\x00\x00\x00\x8b\x00\x00\x00\x00\x00\x00\x00\xca\x00\x00\x00\xca\x00\x37\x00\xca\x00\x00\x00\x81\x00\x18\x00\x78\x00\x00\x00\x61\x00\x77\x00\x00\x00\x6f\x00\x68\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x18\x00\x5b\x00\x65\x00\x00\x00\x4b\x00\x00\x00\x59\x00\x00\x00\x60\x00\xca\x00\x6b\x00\x00\x00\x00\x00"#
+
+happyGotoOffsets :: HappyAddr
+happyGotoOffsets = HappyA# "\x64\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x00\x00\x00\x00\x00\xed\xff\x00\x00\x92\x00\x00\x00\x00\x00\xdd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x00\x00\x26\x00\xb0\x00\xb6\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x00\x00\x82\x00\x00\x00\x72\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x52\x00\x00\x00\x48\x00\x00\x00\x00\x00\x54\x00\x40\x00\x00\x00\x00\x00\x00\x00\x31\x00\x00\x00\x21\x00\x51\x00\x38\x00\x00\x00\x90\x00\x51\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x32\x00\x51\x00\x01\x00\x00\x00\x00\x00\x80\x00\x3e\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x00\x0c\x00\x02\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x00\x00"#
+
+happyDefActions :: HappyAddr
+happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\xfd\xff\xde\xff\x00\x00\xec\xff\xe9\xff\xe7\xff\xe6\xff\xce\xff\x00\x00\x00\x00\xe3\xff\xe5\xff\x00\x00\xdd\xff\x00\x00\x00\x00\xe4\xff\x00\x00\x00\x00\x00\x00\xd9\xff\xf4\xff\xe0\xff\x00\x00\xe1\xff\x00\x00\x00\x00\xcd\xff\x00\x00\xe8\xff\x00\x00\x00\x00\xeb\xff\x00\x00\x00\x00\xea\xff\xe2\xff\x00\x00\x00\x00\xdf\xff\xdc\xff\xf3\xff\x00\x00\x00\x00\xdc\xff\xd8\xff\x00\x00\x00\x00\xfa\xff\xed\xff\xd9\xff\x00\x00\xdc\xff\x00\x00\xf4\xff\x00\x00\x00\x00\xee\xff\x00\x00\xcf\xff\xf6\xff\xdb\xff\x00\x00\xf2\xff\x00\x00\x00\x00\x00\x00\xd7\xff\xf9\xff\xf4\xff\x00\x00\xfb\xff\x00\x00\xfa\xff\xda\xff\xf0\xff\xd5\xff\xef\xff\xf7\xff\xd1\xff\xd4\xff\xf5\xff\x00\x00\xf8\xff\xfc\xff\xf4\xff\xd5\xff\xd6\xff\xd0\xff\x00\x00\xd3\xff\x00\x00\xf1\xff\x00\x00\x00\x00\x00\x00\xd2\xff"#
+
+happyCheck :: HappyAddr
+happyCheck = HappyA# "\xff\xff\x00\x00\x15\x00\x16\x00\x00\x00\x02\x00\x03\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x03\x00\x0d\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x00\x00\x0a\x00\x13\x00\x15\x00\x16\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x11\x00\x12\x00\x0d\x00\x16\x00\x00\x00\x00\x00\x0b\x00\x11\x00\x12\x00\x00\x00\x15\x00\x16\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x14\x00\x16\x00\x0d\x00\x0f\x00\x10\x00\x00\x00\x02\x00\x03\x00\x0f\x00\x10\x00\x15\x00\x16\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x06\x00\x00\x00\x0d\x00\x06\x00\x0a\x00\x00\x00\x02\x00\x0a\x00\x04\x00\x0e\x00\x15\x00\x16\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x16\x00\x0e\x00\x0d\x00\x16\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0e\x00\x15\x00\x16\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0a\x00\x0d\x00\x0d\x00\x0d\x00\x16\x00\x00\x00\x00\x00\x04\x00\x01\x00\x01\x00\x15\x00\x16\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x02\x00\x15\x00\x0d\x00\x00\x00\x16\x00\x00\x00\x14\x00\x04\x00\x05\x00\x15\x00\x15\x00\x16\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x13\x00\x16\x00\x0d\x00\x00\x00\x12\x00\x00\x00\x0c\x00\x04\x00\x05\x00\x05\x00\x15\x00\x16\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x02\x00\x16\x00\x0d\x00\x00\x00\x0d\x00\x00\x00\x16\x00\x04\x00\x05\x00\x0c\x00\x15\x00\x16\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x01\x00\x15\x00\x0d\x00\x13\x00\x15\x00\x00\x00\x07\x00\x08\x00\x05\x00\x0a\x00\x15\x00\x16\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x11\x00\x16\x00\x0d\x00\x00\x00\x00\x00\x16\x00\x05\x00\x04\x00\x05\x00\x00\x00\x15\x00\x16\x00\x08\x00\x09\x00\x0a\x00\x04\x00\x04\x00\x0d\x00\x02\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x03\x00\x16\x00\x15\x00\x16\x00\x08\x00\x09\x00\x0a\x00\x01\x00\x12\x00\x0d\x00\x13\x00\x18\x00\x03\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x15\x00\x16\x00\x13\x00\x0e\x00\x16\x00\x10\x00\x11\x00\x01\x00\x00\x00\x03\x00\x01\x00\x16\x00\x18\x00\x07\x00\x08\x00\x16\x00\x0a\x00\x0f\x00\xff\xff\x0b\x00\x0c\x00\x0d\x00\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+happyTable :: HappyAddr
+happyTable = HappyA# "\x00\x00\x04\x00\x0a\x00\x1e\x00\x04\x00\x47\x00\x56\x00\x4d\x00\x4e\x00\x06\x00\x07\x00\x08\x00\x52\x00\x46\x00\x09\x00\x19\x00\x60\x00\x1b\x00\x04\x00\x52\x00\x11\x00\x5b\x00\x0a\x00\x0b\x00\x51\x00\x4e\x00\x06\x00\x07\x00\x08\x00\x53\x00\x5d\x00\x09\x00\x04\x00\x2f\x00\x04\x00\x2f\x00\x53\x00\x54\x00\x2f\x00\x0a\x00\x0b\x00\x62\x00\x06\x00\x07\x00\x08\x00\x5a\x00\x04\x00\x09\x00\x30\x00\x46\x00\x04\x00\x47\x00\x48\x00\x30\x00\x31\x00\x0a\x00\x0b\x00\x50\x00\x06\x00\x07\x00\x08\x00\x50\x00\x4a\x00\x09\x00\x42\x00\x11\x00\x04\x00\x28\x00\x11\x00\x29\x00\x44\x00\x0a\x00\x0b\x00\x3f\x00\x06\x00\x07\x00\x08\x00\x04\x00\x36\x00\x09\x00\x04\x00\x04\x00\x04\x00\x04\x00\x37\x00\x11\x00\x3a\x00\x0a\x00\x0b\x00\x3c\x00\x06\x00\x07\x00\x08\x00\x20\x00\x40\x00\x09\x00\x09\x00\x04\x00\x04\x00\x16\x00\x62\x00\x14\x00\x5d\x00\x0a\x00\x0b\x00\x3d\x00\x06\x00\x07\x00\x08\x00\x64\x00\x60\x00\x09\x00\x2b\x00\x04\x00\x04\x00\x5a\x00\x2c\x00\x5e\x00\x58\x00\x0a\x00\x0b\x00\x24\x00\x06\x00\x07\x00\x08\x00\x59\x00\x04\x00\x09\x00\x2b\x00\x56\x00\x04\x00\x4a\x00\x2c\x00\x4b\x00\x4d\x00\x0a\x00\x0b\x00\x25\x00\x06\x00\x07\x00\x08\x00\x3f\x00\x04\x00\x09\x00\x2b\x00\x44\x00\x04\x00\x04\x00\x2c\x00\x42\x00\x4a\x00\x0a\x00\x0b\x00\x1c\x00\x06\x00\x07\x00\x08\x00\x0d\x00\x35\x00\x09\x00\x34\x00\x39\x00\x04\x00\x0e\x00\x0f\x00\x36\x00\x11\x00\x0a\x00\x0b\x00\x05\x00\x06\x00\x07\x00\x08\x00\x14\x00\x04\x00\x09\x00\x2b\x00\x04\x00\x04\x00\x3a\x00\x2c\x00\x2d\x00\x04\x00\x0a\x00\x0b\x00\x23\x00\x07\x00\x08\x00\x3c\x00\x29\x00\x09\x00\x28\x00\x04\x00\x19\x00\x2a\x00\x1b\x00\x2a\x00\x04\x00\x0a\x00\x0b\x00\x26\x00\x07\x00\x08\x00\x0d\x00\x33\x00\x09\x00\x18\x00\xff\xff\x1e\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x0a\x00\x0b\x00\x19\x00\x12\x00\x04\x00\x13\x00\x14\x00\x22\x00\x04\x00\x23\x00\x20\x00\x04\x00\xff\xff\x0e\x00\x0f\x00\x04\x00\x11\x00\x16\x00\x00\x00\x19\x00\x1a\x00\x1b\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+happyReduceArr = Happy_Data_Array.array (2, 50) [
+	(2 , happyReduce_2),
+	(3 , happyReduce_3),
+	(4 , happyReduce_4),
+	(5 , happyReduce_5),
+	(6 , happyReduce_6),
+	(7 , happyReduce_7),
+	(8 , happyReduce_8),
+	(9 , happyReduce_9),
+	(10 , happyReduce_10),
+	(11 , happyReduce_11),
+	(12 , happyReduce_12),
+	(13 , happyReduce_13),
+	(14 , happyReduce_14),
+	(15 , happyReduce_15),
+	(16 , happyReduce_16),
+	(17 , happyReduce_17),
+	(18 , happyReduce_18),
+	(19 , happyReduce_19),
+	(20 , happyReduce_20),
+	(21 , happyReduce_21),
+	(22 , happyReduce_22),
+	(23 , happyReduce_23),
+	(24 , happyReduce_24),
+	(25 , happyReduce_25),
+	(26 , happyReduce_26),
+	(27 , happyReduce_27),
+	(28 , happyReduce_28),
+	(29 , happyReduce_29),
+	(30 , happyReduce_30),
+	(31 , happyReduce_31),
+	(32 , happyReduce_32),
+	(33 , happyReduce_33),
+	(34 , happyReduce_34),
+	(35 , happyReduce_35),
+	(36 , happyReduce_36),
+	(37 , happyReduce_37),
+	(38 , happyReduce_38),
+	(39 , happyReduce_39),
+	(40 , happyReduce_40),
+	(41 , happyReduce_41),
+	(42 , happyReduce_42),
+	(43 , happyReduce_43),
+	(44 , happyReduce_44),
+	(45 , happyReduce_45),
+	(46 , happyReduce_46),
+	(47 , happyReduce_47),
+	(48 , happyReduce_48),
+	(49 , happyReduce_49),
+	(50 , happyReduce_50)
+	]
+
+happy_n_terms = 25 :: Int
+happy_n_nonterms = 23 :: Int
+
+happyReduce_2 = happySpecReduce_1  0# happyReduction_2
+happyReduction_2 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn5
+		 (AIdent (mkPosToken happy_var_1)
+	)}
+
+happyReduce_3 = happyReduce 7# 1# happyReduction_3
+happyReduction_3 (happy_x_7 `HappyStk`
+	happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut5 happy_x_2 of { happy_var_2 -> 
+	case happyOut8 happy_x_5 of { happy_var_5 -> 
+	case happyOut10 happy_x_6 of { happy_var_6 -> 
+	happyIn6
+		 (Module happy_var_2 happy_var_5 happy_var_6
+	) `HappyStk` happyRest}}}
+
+happyReduce_4 = happySpecReduce_2  2# happyReduction_4
+happyReduction_4 happy_x_2
+	happy_x_1
+	 =  case happyOut5 happy_x_2 of { happy_var_2 -> 
+	happyIn7
+		 (Import happy_var_2
+	)}
+
+happyReduce_5 = happySpecReduce_0  3# happyReduction_5
+happyReduction_5  =  happyIn8
+		 ([]
+	)
+
+happyReduce_6 = happySpecReduce_1  3# happyReduction_6
+happyReduction_6 happy_x_1
+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
+	happyIn8
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_7 = happySpecReduce_3  3# happyReduction_7
+happyReduction_7 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
+	case happyOut8 happy_x_3 of { happy_var_3 -> 
+	happyIn8
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_8 = happyReduce 4# 4# happyReduction_8
+happyReduction_8 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut5 happy_x_1 of { happy_var_1 -> 
+	case happyOut19 happy_x_2 of { happy_var_2 -> 
+	case happyOut11 happy_x_4 of { happy_var_4 -> 
+	happyIn9
+		 (Def happy_var_1 (reverse happy_var_2) happy_var_4
+	) `HappyStk` happyRest}}}
+
+happyReduce_9 = happySpecReduce_3  4# happyReduction_9
+happyReduction_9 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	case happyOut12 happy_x_3 of { happy_var_3 -> 
+	happyIn9
+		 (DefTDecl happy_var_1 happy_var_3
+	)}}
+
+happyReduce_10 = happyReduce 5# 4# happyReduction_10
+happyReduction_10 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut5 happy_x_2 of { happy_var_2 -> 
+	case happyOut19 happy_x_3 of { happy_var_3 -> 
+	case happyOut23 happy_x_5 of { happy_var_5 -> 
+	happyIn9
+		 (DefData happy_var_2 (reverse happy_var_3) happy_var_5
+	) `HappyStk` happyRest}}}
+
+happyReduce_11 = happySpecReduce_0  5# happyReduction_11
+happyReduction_11  =  happyIn10
+		 ([]
+	)
+
+happyReduce_12 = happySpecReduce_1  5# happyReduction_12
+happyReduction_12 happy_x_1
+	 =  case happyOut9 happy_x_1 of { happy_var_1 -> 
+	happyIn10
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_13 = happySpecReduce_3  5# happyReduction_13
+happyReduction_13 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut9 happy_x_1 of { happy_var_1 -> 
+	case happyOut10 happy_x_3 of { happy_var_3 -> 
+	happyIn10
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_14 = happyReduce 5# 6# happyReduction_14
+happyReduction_14 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut12 happy_x_1 of { happy_var_1 -> 
+	case happyOut10 happy_x_4 of { happy_var_4 -> 
+	happyIn11
+		 (Where happy_var_1 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_15 = happySpecReduce_1  6# happyReduction_15
+happyReduction_15 happy_x_1
+	 =  case happyOut12 happy_x_1 of { happy_var_1 -> 
+	happyIn11
+		 (NoWhere happy_var_1
+	)}
+
+happyReduce_16 = happyReduce 6# 7# happyReduction_16
+happyReduction_16 (happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_3 of { happy_var_3 -> 
+	case happyOut12 happy_x_6 of { happy_var_6 -> 
+	happyIn12
+		 (Let happy_var_3 happy_var_6
+	) `HappyStk` happyRest}}
+
+happyReduce_17 = happyReduce 4# 7# happyReduction_17
+happyReduction_17 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut17 happy_x_2 of { happy_var_2 -> 
+	case happyOut12 happy_x_4 of { happy_var_4 -> 
+	happyIn12
+		 (Lam happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_18 = happyReduce 4# 7# happyReduction_18
+happyReduction_18 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut21 happy_x_3 of { happy_var_3 -> 
+	happyIn12
+		 (Split happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_19 = happySpecReduce_1  7# happyReduction_19
+happyReduction_19 happy_x_1
+	 =  case happyOut13 happy_x_1 of { happy_var_1 -> 
+	happyIn12
+		 (happy_var_1
+	)}
+
+happyReduce_20 = happySpecReduce_3  8# happyReduction_20
+happyReduction_20 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut14 happy_x_1 of { happy_var_1 -> 
+	case happyOut13 happy_x_3 of { happy_var_3 -> 
+	happyIn13
+		 (Fun happy_var_1 happy_var_3
+	)}}
+
+happyReduce_21 = happySpecReduce_3  8# happyReduction_21
+happyReduction_21 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> 
+	case happyOut13 happy_x_3 of { happy_var_3 -> 
+	happyIn13
+		 (Pi happy_var_1 happy_var_3
+	)}}
+
+happyReduce_22 = happySpecReduce_1  8# happyReduction_22
+happyReduction_22 happy_x_1
+	 =  case happyOut14 happy_x_1 of { happy_var_1 -> 
+	happyIn13
+		 (happy_var_1
+	)}
+
+happyReduce_23 = happySpecReduce_2  9# happyReduction_23
+happyReduction_23 happy_x_2
+	happy_x_1
+	 =  case happyOut14 happy_x_1 of { happy_var_1 -> 
+	case happyOut15 happy_x_2 of { happy_var_2 -> 
+	happyIn14
+		 (App happy_var_1 happy_var_2
+	)}}
+
+happyReduce_24 = happySpecReduce_1  9# happyReduction_24
+happyReduction_24 happy_x_1
+	 =  case happyOut15 happy_x_1 of { happy_var_1 -> 
+	happyIn14
+		 (happy_var_1
+	)}
+
+happyReduce_25 = happySpecReduce_1  10# happyReduction_25
+happyReduction_25 happy_x_1
+	 =  case happyOut18 happy_x_1 of { happy_var_1 -> 
+	happyIn15
+		 (Var happy_var_1
+	)}
+
+happyReduce_26 = happySpecReduce_1  10# happyReduction_26
+happyReduction_26 happy_x_1
+	 =  happyIn15
+		 (U
+	)
+
+happyReduce_27 = happySpecReduce_1  10# happyReduction_27
+happyReduction_27 happy_x_1
+	 =  happyIn15
+		 (Undef
+	)
+
+happyReduce_28 = happySpecReduce_1  10# happyReduction_28
+happyReduction_28 happy_x_1
+	 =  happyIn15
+		 (PN
+	)
+
+happyReduce_29 = happySpecReduce_3  10# happyReduction_29
+happyReduction_29 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut12 happy_x_2 of { happy_var_2 -> 
+	happyIn15
+		 (happy_var_2
+	)}
+
+happyReduce_30 = happySpecReduce_1  11# happyReduction_30
+happyReduction_30 happy_x_1
+	 =  case happyOut18 happy_x_1 of { happy_var_1 -> 
+	happyIn16
+		 (Binder happy_var_1
+	)}
+
+happyReduce_31 = happySpecReduce_1  12# happyReduction_31
+happyReduction_31 happy_x_1
+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> 
+	happyIn17
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_32 = happySpecReduce_2  12# happyReduction_32
+happyReduction_32 happy_x_2
+	happy_x_1
+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> 
+	case happyOut17 happy_x_2 of { happy_var_2 -> 
+	happyIn17
+		 ((:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_33 = happySpecReduce_1  13# happyReduction_33
+happyReduction_33 happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	happyIn18
+		 (Arg happy_var_1
+	)}
+
+happyReduce_34 = happySpecReduce_1  13# happyReduction_34
+happyReduction_34 happy_x_1
+	 =  happyIn18
+		 (NoArg
+	)
+
+happyReduce_35 = happySpecReduce_0  14# happyReduction_35
+happyReduction_35  =  happyIn19
+		 ([]
+	)
+
+happyReduce_36 = happySpecReduce_2  14# happyReduction_36
+happyReduction_36 happy_x_2
+	happy_x_1
+	 =  case happyOut19 happy_x_1 of { happy_var_1 -> 
+	case happyOut18 happy_x_2 of { happy_var_2 -> 
+	happyIn19
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_37 = happyReduce 4# 15# happyReduction_37
+happyReduction_37 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut5 happy_x_1 of { happy_var_1 -> 
+	case happyOut19 happy_x_2 of { happy_var_2 -> 
+	case happyOut11 happy_x_4 of { happy_var_4 -> 
+	happyIn20
+		 (Branch happy_var_1 (reverse happy_var_2) happy_var_4
+	) `HappyStk` happyRest}}}
+
+happyReduce_38 = happySpecReduce_0  16# happyReduction_38
+happyReduction_38  =  happyIn21
+		 ([]
+	)
+
+happyReduce_39 = happySpecReduce_1  16# happyReduction_39
+happyReduction_39 happy_x_1
+	 =  case happyOut20 happy_x_1 of { happy_var_1 -> 
+	happyIn21
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_40 = happySpecReduce_3  16# happyReduction_40
+happyReduction_40 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut20 happy_x_1 of { happy_var_1 -> 
+	case happyOut21 happy_x_3 of { happy_var_3 -> 
+	happyIn21
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_41 = happySpecReduce_2  17# happyReduction_41
+happyReduction_41 happy_x_2
+	happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	case happyOut25 happy_x_2 of { happy_var_2 -> 
+	happyIn22
+		 (Sum happy_var_1 (reverse happy_var_2)
+	)}}
+
+happyReduce_42 = happySpecReduce_0  18# happyReduction_42
+happyReduction_42  =  happyIn23
+		 ([]
+	)
+
+happyReduce_43 = happySpecReduce_1  18# happyReduction_43
+happyReduction_43 happy_x_1
+	 =  case happyOut22 happy_x_1 of { happy_var_1 -> 
+	happyIn23
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_44 = happySpecReduce_3  18# happyReduction_44
+happyReduction_44 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut22 happy_x_1 of { happy_var_1 -> 
+	case happyOut23 happy_x_3 of { happy_var_3 -> 
+	happyIn23
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_45 = happyReduce 5# 19# happyReduction_45
+happyReduction_45 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut17 happy_x_2 of { happy_var_2 -> 
+	case happyOut12 happy_x_4 of { happy_var_4 -> 
+	happyIn24
+		 (VDecl happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_46 = happySpecReduce_0  20# happyReduction_46
+happyReduction_46  =  happyIn25
+		 ([]
+	)
+
+happyReduce_47 = happySpecReduce_2  20# happyReduction_47
+happyReduction_47 happy_x_2
+	happy_x_1
+	 =  case happyOut25 happy_x_1 of { happy_var_1 -> 
+	case happyOut24 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_48 = happyReduce 5# 21# happyReduction_48
+happyReduction_48 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut12 happy_x_2 of { happy_var_2 -> 
+	case happyOut12 happy_x_4 of { happy_var_4 -> 
+	happyIn26
+		 (PiDecl happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_49 = happySpecReduce_1  22# happyReduction_49
+happyReduction_49 happy_x_1
+	 =  case happyOut26 happy_x_1 of { happy_var_1 -> 
+	happyIn27
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_50 = happySpecReduce_2  22# happyReduction_50
+happyReduction_50 happy_x_2
+	happy_x_1
+	 =  case happyOut26 happy_x_1 of { happy_var_1 -> 
+	case happyOut27 happy_x_2 of { happy_var_2 -> 
+	happyIn27
+		 ((:) happy_var_1 happy_var_2
+	)}}
+
+happyNewToken action sts stk [] =
+	happyDoAction 24# notHappyAtAll action sts stk []
+
+happyNewToken action sts stk (tk:tks) =
+	let cont i = happyDoAction i tk action sts stk tks in
+	case tk of {
+	PT _ (TS _ 1) -> cont 1#;
+	PT _ (TS _ 2) -> cont 2#;
+	PT _ (TS _ 3) -> cont 3#;
+	PT _ (TS _ 4) -> cont 4#;
+	PT _ (TS _ 5) -> cont 5#;
+	PT _ (TS _ 6) -> cont 6#;
+	PT _ (TS _ 7) -> cont 7#;
+	PT _ (TS _ 8) -> cont 8#;
+	PT _ (TS _ 9) -> cont 9#;
+	PT _ (TS _ 10) -> cont 10#;
+	PT _ (TS _ 11) -> cont 11#;
+	PT _ (TS _ 12) -> cont 12#;
+	PT _ (TS _ 13) -> cont 13#;
+	PT _ (TS _ 14) -> cont 14#;
+	PT _ (TS _ 15) -> cont 15#;
+	PT _ (TS _ 16) -> cont 16#;
+	PT _ (TS _ 17) -> cont 17#;
+	PT _ (TS _ 18) -> cont 18#;
+	PT _ (TS _ 19) -> cont 19#;
+	PT _ (TS _ 20) -> cont 20#;
+	PT _ (TS _ 21) -> cont 21#;
+	PT _ (T_AIdent _) -> cont 22#;
+	_ -> cont 23#;
+	_ -> happyError' (tk:tks)
+	}
+
+happyError_ 24# tk tks = happyError' tks
+happyError_ _ tk tks = happyError' (tk:tks)
+
+happyThen :: () => Err a -> (a -> Err b) -> Err b
+happyThen = (thenM)
+happyReturn :: () => a -> Err a
+happyReturn = (returnM)
+happyThen1 m k tks = (thenM) m (\a -> k a tks)
+happyReturn1 :: () => a -> b -> Err a
+happyReturn1 = \a tks -> (returnM) a
+happyError' :: () => [(Token)] -> Err a
+happyError' = happyError
+
+pModule tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut6 x))
+
+pExp tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut12 x))
+
+happySeq = happyDontSeq
+
+
+returnM :: a -> Err a
+returnM = return
+
+thenM :: Err a -> (a -> Err b) -> Err b
+thenM = (>>=)
+
+happyError :: [Token] -> Err a
+happyError ts =
+  Bad $ "syntax error at " ++ tokenPos ts ++ 
+  case ts of
+    [] -> []
+    [Err _] -> " due to lexer error"
+    _ -> " before " ++ unwords (map (id . prToken) (take 4 ts))
+
+myLexer = tokens
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+{-# LINE 1 "<built-in>" #-}
+{-# LINE 1 "<command-line>" #-}
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp 
+
+{-# LINE 30 "templates/GenericTemplate.hs" #-}
+
+
+data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList
+
+
+
+
+
+{-# LINE 51 "templates/GenericTemplate.hs" #-}
+
+{-# LINE 61 "templates/GenericTemplate.hs" #-}
+
+{-# LINE 70 "templates/GenericTemplate.hs" #-}
+
+infixr 9 `HappyStk`
+data HappyStk a = HappyStk a (HappyStk a)
+
+-----------------------------------------------------------------------------
+-- starting the parse
+
+happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll
+
+-----------------------------------------------------------------------------
+-- Accepting the parse
+
+-- If the current token is 0#, it means we've just accepted a partial
+-- parse (a %partial parser).  We must ignore the saved token on the top of
+-- the stack in this case.
+happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =
+	happyReturn1 ans
+happyAccept j tk st sts (HappyStk ans _) = 
+	(happyTcHack j (happyTcHack st)) (happyReturn1 ans)
+
+-----------------------------------------------------------------------------
+-- Arrays only: do the next action
+
+
+
+happyDoAction i tk st
+	= {- nothing -}
+
+
+	  case action of
+		0#		  -> {- nothing -}
+				     happyFail i tk st
+		-1# 	  -> {- nothing -}
+				     happyAccept i tk st
+		n | (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}
+
+				     (happyReduceArr Happy_Data_Array.! rule) i tk st
+				     where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))
+		n		  -> {- nothing -}
+
+
+				     happyShift new_state i tk st
+				     where (new_state) = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))
+   where (off)    = indexShortOffAddr happyActOffsets st
+         (off_i)  = (off Happy_GHC_Exts.+# i)
+	 check  = if (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#))
+			then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==#  i)
+			else False
+         (action)
+          | check     = indexShortOffAddr happyTable off_i
+          | otherwise = indexShortOffAddr happyDefActions st
+
+{-# LINE 130 "templates/GenericTemplate.hs" #-}
+
+
+indexShortOffAddr (HappyA# arr) off =
+	Happy_GHC_Exts.narrow16Int# i
+  where
+        i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low)
+        high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))
+        low  = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off'))
+        off' = off Happy_GHC_Exts.*# 2#
+
+
+
+
+
+data HappyAddr = HappyA# Happy_GHC_Exts.Addr#
+
+
+
+
+-----------------------------------------------------------------------------
+-- HappyState data type (not arrays)
+
+{-# LINE 163 "templates/GenericTemplate.hs" #-}
+
+-----------------------------------------------------------------------------
+-- Shifting a token
+
+happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =
+     let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in
+--     trace "shifting the error token" $
+     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)
+
+happyShift new_state i tk st sts stk =
+     happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)
+
+-- happyReduce is specialised for the common cases.
+
+happySpecReduce_0 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_0 nt fn j tk st@((action)) sts stk
+     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)
+
+happySpecReduce_1 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')
+     = let r = fn v1 in
+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
+
+happySpecReduce_2 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')
+     = let r = fn v1 v2 in
+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
+
+happySpecReduce_3 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')
+     = let r = fn v1 v2 v3 in
+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
+
+happyReduce k i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happyReduce k nt fn j tk st sts stk
+     = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of
+	 sts1@((HappyCons (st1@(action)) (_))) ->
+        	let r = fn stk in  -- it doesn't hurt to always seq here...
+       		happyDoSeq r (happyGoto nt j tk st1 sts1 r)
+
+happyMonadReduce k nt fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happyMonadReduce k nt fn j tk st sts stk =
+        happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))
+       where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts))
+             drop_stk = happyDropStk k stk
+
+happyMonad2Reduce k nt fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happyMonad2Reduce k nt fn j tk st sts stk =
+       happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))
+       where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts))
+             drop_stk = happyDropStk k stk
+
+             (off) = indexShortOffAddr happyGotoOffsets st1
+             (off_i) = (off Happy_GHC_Exts.+# nt)
+             (new_state) = indexShortOffAddr happyTable off_i
+
+
+
+
+happyDrop 0# l = l
+happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t
+
+happyDropStk 0# l = l
+happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs
+
+-----------------------------------------------------------------------------
+-- Moving to a new state after a reduction
+
+
+happyGoto nt j tk st = 
+   {- nothing -}
+   happyDoAction j tk new_state
+   where (off) = indexShortOffAddr happyGotoOffsets st
+         (off_i) = (off Happy_GHC_Exts.+# nt)
+         (new_state) = indexShortOffAddr happyTable off_i
+
+
+
+
+-----------------------------------------------------------------------------
+-- Error recovery (0# is the error token)
+
+-- parse error if we are in recovery and we fail again
+happyFail 0# tk old_st _ stk@(x `HappyStk` _) =
+     let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in
+--	trace "failing" $ 
+        happyError_ i tk
+
+{-  We don't need state discarding for our restricted implementation of
+    "error".  In fact, it can cause some bogus parses, so I've disabled it
+    for now --SDM
+
+-- discard a state
+happyFail  0# tk old_st (HappyCons ((action)) (sts)) 
+						(saved_tok `HappyStk` _ `HappyStk` stk) =
+--	trace ("discarding state, depth " ++ show (length stk))  $
+	happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
+-}
+
+-- Enter error recovery: generate an error token,
+--                       save the old token and carry on.
+happyFail  i tk (action) sts stk =
+--      trace "entering error recovery" $
+	happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)
+
+-- Internal happy errors:
+
+notHappyAtAll :: a
+notHappyAtAll = error "Internal Happy error\n"
+
+-----------------------------------------------------------------------------
+-- Hack to get the typechecker to accept our action functions
+
+
+happyTcHack :: Happy_GHC_Exts.Int# -> a -> a
+happyTcHack x y = y
+{-# INLINE happyTcHack #-}
+
+
+-----------------------------------------------------------------------------
+-- Seq-ing.  If the --strict flag is given, then Happy emits 
+--	happySeq = happyDoSeq
+-- otherwise it emits
+-- 	happySeq = happyDontSeq
+
+happyDoSeq, happyDontSeq :: a -> b -> b
+happyDoSeq   a b = a `seq` b
+happyDontSeq a b = b
+
+-----------------------------------------------------------------------------
+-- Don't inline any functions from the template.  GHC has a nasty habit
+-- of deciding to inline happyGoto everywhere, which increases the size of
+-- the generated parser quite a bit.
+
+
+{-# NOINLINE happyDoAction #-}
+{-# NOINLINE happyTable #-}
+{-# NOINLINE happyCheck #-}
+{-# NOINLINE happyActOffsets #-}
+{-# NOINLINE happyGotoOffsets #-}
+{-# NOINLINE happyDefActions #-}
+
+{-# NOINLINE happyShift #-}
+{-# NOINLINE happySpecReduce_0 #-}
+{-# NOINLINE happySpecReduce_1 #-}
+{-# NOINLINE happySpecReduce_2 #-}
+{-# NOINLINE happySpecReduce_3 #-}
+{-# NOINLINE happyReduce #-}
+{-# NOINLINE happyMonadReduce #-}
+{-# NOINLINE happyGoto #-}
+{-# NOINLINE happyFail #-}
+
+-- end of Happy Template.
diff --git a/examples/BoolEqBool.cub b/examples/BoolEqBool.cub
new file mode 100644
--- /dev/null
+++ b/examples/BoolEqBool.cub
@@ -0,0 +1,147 @@
+module BoolEqBool where
+
+import equivSet
+import hedberg
+
+notInj : (x y : Bool) -> Id Bool (not x) (not y) -> Id Bool x y
+notInj x y p = compUp Bool (not (not x)) x (not (not y)) y (notK x) (notK y) rem
+  where
+  rem : Id Bool (not (not x)) (not (not y))
+  rem = cong Bool Bool not (not x) (not y) p
+
+notFiber : Bool -> U
+notFiber b = fiber Bool Bool not b
+
+fstNotFiber : (b : Bool) -> notFiber b -> Bool
+fstNotFiber b = fst Bool (\x -> Id Bool (not x) b)
+
+eqNotFiber : (b : Bool) -> (v v' : notFiber b) ->
+  Id Bool (fstNotFiber b v) (fstNotFiber b v') -> Id (notFiber b) v v'
+eqNotFiber b = eqPropFam Bool (\x -> Id Bool (not x) b) rem
+  where
+  rem : propFam Bool (\x -> Id Bool (not x) b)
+  rem = \x -> boolIsSet (not x) b
+
+sNot : (b : Bool) -> notFiber b
+sNot b = pair (not b) (notK b)
+
+tNot : (b : Bool) (v : notFiber b) -> Id (notFiber b) (sNot b) v
+tNot b v = eqNotFiber b (sNot b) v rem
+  where
+  b' : Bool
+  b' = fstNotFiber b v
+
+  rem1 : Id Bool (not (not b)) (not b')
+  rem1 = comp Bool (not (not b)) b (not b') (notK b)
+         (inv Bool (not b') b (snd Bool (\x -> Id Bool (not x) b) v))
+
+  rem : Id Bool (not b) b'
+  rem = notInj (not b) b' rem1
+
+eqBoolBool : Id U Bool Bool
+eqBoolBool = equivEq Bool Bool not sNot tNot
+
+transportInv : (A B : U) -> Id U A B -> B -> A
+transportInv = substInv U (\x -> x)
+
+notEqBool : Bool -> Bool
+notEqBool = transport Bool Bool eqBoolBool
+
+testBool : Bool
+testBool = notEqBool (true)
+
+compEqBool : Id U Bool Bool
+compEqBool = comp U Bool Bool Bool eqBoolBool eqBoolBool
+
+transport' : (A B : U) -> Id U A B -> A -> B
+transport' = subst U (\x -> x)
+
+funCompEqBool : Bool -> Bool
+funCompEqBool = transport' Bool Bool compEqBool
+
+newTestBool : Bool
+newTestBool = funCompEqBool (true)
+
+newCompEqBool : Id U Bool Bool
+newCompEqBool = comp U Bool Bool Bool eqBoolBool (refl U Bool)
+
+test2Bool : Bool
+test2Bool = transport' Bool Bool newCompEqBool (true)
+
+monoid : U -> U
+monoid A = and A (A -> A -> A)
+
+zm : (A : U) (m : monoid A) -> A
+zm A m = fst A (\x -> A -> A -> A) m
+
+opm : (A : U) (m : monoid A) -> (A -> A -> A)
+opm A m = snd A (\x -> A -> A -> A) m
+
+transm : (A B : U) -> Id U A B -> monoid A -> monoid B
+transm = subst U monoid 
+
+transun : (A B : U) -> Id U A B -> (A -> A) -> (B -> B)
+transun = subst U (\X -> (X -> X))
+
+transid : Bool -> Bool
+transid = transun Bool Bool eqBoolBool (\x -> x)
+
+True : Bool
+True = true
+
+False : Bool
+False = false
+
+testT : Bool
+testT = transid True
+
+testT' : Bool
+testT' = transun Bool Bool (refl U Bool) (\x -> x) True
+
+testF : Bool
+testF = transid False
+
+monoidAndBool : monoid Bool
+monoidAndBool = pair (true) andBool
+
+mBool2 : monoid Bool
+mBool2 = transm Bool Bool eqBoolBool monoidAndBool
+
+opBool2 : Bool -> Bool -> Bool
+opBool2 = opm Bool mBool2
+
+testTF : Bool
+testTF = opBool2 True False
+
+testFT : Bool
+testFT = opBool2 False True
+
+testFF : Bool
+testFF = opBool2 False False
+
+testTT : Bool
+testTT = opBool2 True True
+
+-- Bool tests:
+
+equivBool : Id U Bool Bool
+equivBool = equivSet Bool Bool not not notK notInj boolIsSet
+
+mBool3 : monoid Bool
+mBool3 = transm Bool Bool equivBool monoidAndBool
+
+opBool3 : Bool -> Bool -> Bool
+opBool3 = opm Bool mBool3
+
+testTF3 : Bool
+testTF3 = opBool3 True False
+
+testFT3 : Bool
+testFT3 = opBool3 False True
+
+testFF3 : Bool
+testFF3 = opBool3 False False
+
+testTT3 : Bool
+testTT3 = opBool3 True True
+
diff --git a/examples/Kraus.cub b/examples/Kraus.cub
new file mode 100644
--- /dev/null
+++ b/examples/Kraus.cub
@@ -0,0 +1,82 @@
+module Kraus where
+
+import swapDisc
+import testInh
+import idempotent
+import contr
+import elimEquiv
+
+-- we encode the example of Nicolai Kraus
+-- for this we need the impredicative encoding of propositional truncation
+
+-- the type of pointed types
+
+ptU : U
+ptU = Sigma U (id U)
+
+-- if f : A -> B is an equivalence and f a = b then (A,a) and (B,b) are equal in ptU
+
+lemPtEquiv : (A B : U) (f: A -> B) (ef: isEquiv A B f) -> (a:A) -> (b:B) -> (eab: Id B (f a) b) -> Id ptU (pair A a) (pair B b)
+lemPtEquiv A = elimIsEquiv A P rem
+  where
+   P : (B:U) -> (A->B) -> U
+   P B f = (a:A) -> (b:B) -> (eab: Id B (f a) b) -> Id ptU (pair A a) (pair B b)
+
+   rem : P A (id A)
+   rem = cong A ptU (\ x -> pair A x) 
+
+-- swap with zero
+
+swZero : N -> N -> N
+swZero = swapDisc N natDec zero
+
+lemSwZero : (x:N) -> neg (Id N zero x) -> Id N (swZero x x) zero
+lemSwZero x neqzx = idSwapDisc1 N natDec zero x neqzx
+
+lem1SwZero : (x:N) -> neg (Id N zero x) -> isEquiv N N (swZero x)
+lem1SwZero x neqzx = idemIsEquiv N (swZero x) (idemSwapDisc N natDec zero x neqzx)
+
+-- we deduce that (N,x) is equal to (N,0) for any x in N
+
+homogeneous : (x:N) -> Id ptU (pair N x) (pair N zero)
+homogeneous x = orElim (Id N zero x) (neg (Id N zero x)) (G x) rem1 rem (natDec zero x)
+ where
+   G : N -> U
+   G y = Id ptU (pair N y) (pair N zero)
+
+   rem0 : G zero
+   rem0 = refl ptU (pair N zero)
+
+   rem : neg (Id N zero x) -> G x
+   rem neqzx = lemPtEquiv N N (swZero x) (lem1SwZero x neqzx) x zero (lemSwZero x neqzx)
+
+   rem1 : Id N zero x -> G x
+   rem1 eqzx = subst N G zero x eqzx rem0
+
+-- the following type is a contractible, hence a proposition
+
+sNzero : U
+sNzero = singl ptU (pair N zero)  -- Sigma (Sigma U (id U)) (\ v -> Id ptU u (pair N zero))
+
+propSNzero : prop sNzero
+propSNzero = singlIsProp ptU (pair N zero)
+
+-- we have a map inhI N -> sNzero, with the notation of Nicolai Kraus
+
+flifted : inhI N -> sNzero
+flifted = inhrecI N sNzero propSNzero (\ x -> pair (pair N x) (homogeneous x))
+
+Tmyst : inhI N -> U
+Tmyst x = fst U (id U) (fst ptU (\ v -> Id ptU v (pair N zero)) (flifted x))
+
+myst : (x: inhI N) -> Tmyst x
+myst x = snd U (id U) (fst ptU (\ v -> Id ptU v (pair N zero)) (flifted x))
+
+mystN : (n: N) -> Tmyst (incI N n)
+mystN n = myst (incI N n)
+
+propMyst : (n:N) -> Id N (myst (incI N n)) n
+propMyst n = refl N n
+
+testMyst : N -> N
+testMyst n = myst (incI N n)
diff --git a/examples/UnotSet.cub b/examples/UnotSet.cub
new file mode 100644
--- /dev/null
+++ b/examples/UnotSet.cub
@@ -0,0 +1,34 @@
+module UnotSet where
+
+import BoolEqBool
+
+-- proves that U is not a set
+
+negUIP : neg (set U)
+negUIP uipU = tnotf lem5
+  where
+  eqreflnot : Id (Id U Bool Bool) (refl U Bool) eqBoolBool
+  eqreflnot = uipU Bool Bool (refl U Bool) eqBoolBool
+
+  frefl : Bool -> Bool
+  frefl = transport Bool Bool (refl U Bool)
+
+  fnot : Bool -> Bool
+  fnot = transport Bool Bool eqBoolBool
+
+  lem1 : Id (Bool -> Bool) frefl fnot
+  lem1 = cong (Id U Bool Bool) (Bool -> Bool) (transport Bool Bool) 
+              (refl U Bool) eqBoolBool eqreflnot
+
+  lem2 : Id Bool true (frefl true)
+  lem2 = transportRef Bool true
+
+  lem3 : Id Bool false (fnot true)
+  lem3 = transpEquivEq Bool Bool not sNot tNot true
+
+  lem4 : Id Bool (frefl true) (fnot true)
+  lem4 = cong (Bool -> Bool) Bool (\f -> f true) frefl fnot lem1
+
+  lem5 : Id Bool true false
+  lem5 = compDown Bool true (frefl true) false (fnot true) lem2 lem3 lem4
+
diff --git a/examples/axChoice.cub b/examples/axChoice.cub
new file mode 100644
--- /dev/null
+++ b/examples/axChoice.cub
@@ -0,0 +1,52 @@
+module axChoice where
+
+import contr
+
+-- an interesting isomorphism/equality
+
+idTelProp : (A:U) (B:A -> U) (C:(x:A) -> B x -> U) -> 
+              Id U ((x:A) -> Sigma (B x) (C x)) (Sigma ((x:A) -> B x) (\ f -> (x:A) -> C x (f x)))
+idTelProp A B C = isoId T0 T1 f g sfg rfg 
+ where
+  T0 : U 
+  T0 = (x:A) -> Sigma (B x) (C x) 
+
+  T1 : U 
+  T1 = Sigma ((x:A) -> B x) (\ f -> (x:A) -> C x (f x))
+
+  f : T0 -> T1
+  f = \ s -> pair (\ x -> fst (B x) (C x) (s x)) (\ x -> snd (B x) (C x) (s x))
+
+  g : T1 -> T0
+  g = split
+       pair u v -> \ x -> pair (u x) (v x)
+
+  sfg : (y:T1) -> Id T1 (f (g y)) y
+  sfg = split
+         pair u v -> rem u v 
+           where
+             rem2 : (u:Pi A B) (v:(x:A) -> C x (u x)) -> Id T1 (pair (\ x -> u x) (\ x -> v x)) (pair (\ x -> u x) (\ x -> v x))
+             rem2 u v = refl T1 (pair (\ x -> u x) (\ x -> v x))
+
+             rem1 : (u:Pi A B) (v:(x:A) -> C x (u x)) -> Id T1 (pair (\ x -> u x) (\ x -> v x)) (pair (\ x -> u x) v)
+             rem1 u = funSplit A (\ x -> C x (u x)) (\ v -> Id T1 (pair (\ x -> u x) (\ x -> v x)) (pair (\ x -> u x) v)) (rem2 u)
+
+             rem : (u:Pi A B) (v:(x:A) -> C x (u x)) -> Id T1 (pair (\ x -> u x) (\ x -> v x)) (pair u v)
+             rem = funSplit A B (\ u -> (v:(x:A) -> C x (u x)) -> Id T1 (pair (\ x -> u x) (\ x -> v x)) (pair u v)) rem1
+
+  rfg : (s:T0) -> Id T0 (g (f s)) s
+  rfg s = funExt A (\ x ->  Sigma (B x) (C x)) (g (f s)) s rem
+    where
+      rem : (x:A) -> Id (Sigma (B x) (C x)) (pair (fst (B x) (C x) (s x)) (snd (B x) (C x) (s x))) (s x)
+      rem x = surjPair (B x) (C x) (s x)
+
+-- we deduce from this equality that isEquiv f is a proposition
+
+propIsEquiv : (A B : U) -> (f : A -> B) -> prop (isEquiv A B f)
+propIsEquiv A B f = subst U prop ((y:B) -> contr' (fiber A B f y)) (isEquiv A B f) rem rem1
+ where 
+   rem : Id U ((y:B) -> contr' (fiber A B f y)) (isEquiv A B f) 
+   rem = idTelProp B (fiber A B f) (\ y -> \ s -> (v :fiber A B f y) -> Id (fiber A B f y) s v)
+
+   rem1 : prop ((y:B) -> contr' (fiber A B f y))
+   rem1 = isPropProd B (\ y -> contr' (fiber A B f y)) (\ y -> contr'IsProp (fiber A B f y))
diff --git a/examples/commutative.cub b/examples/commutative.cub
new file mode 100644
--- /dev/null
+++ b/examples/commutative.cub
@@ -0,0 +1,6 @@
+module weq where
+
+import univ
+
+com : U -> U
+com = pair (A -> A -> A) (
diff --git a/examples/cong.cub b/examples/cong.cub
new file mode 100644
--- /dev/null
+++ b/examples/cong.cub
@@ -0,0 +1,82 @@
+module cong where
+
+import set
+import function
+
+-- All of these lemmas on cong will be trivial with definitional equalities
+
+congRefl : (A B : U) (f : A -> B) (a : A) -> 
+           Id (Id B (f a) (f a)) (refl B (f a)) (cong A B f a a (refl A a))
+congRefl A B f a = Jeq A a (\v p -> Id B (f a) (f v)) (refl B (f a))
+
+congId : (A : U) (a0 a1 : A) -> 
+         Id (Id A a0 a1 -> Id A a0 a1) (id (Id A a0 a1)) (cong A A (id A) a0 a1)
+congId A a0 a1 = funExt (Id A a0 a1) (\_ -> Id A a0 a1) (id (Id A a0 a1)) 
+                        (cong A A (id A) a0 a1) (rem a0 a1)
+  where
+  rem1 : (u : A) -> Id (Id A u u) (refl A u) (cong A A (id A) u u (refl A u))
+  rem1 = congRefl A A (id A)
+
+  rem : (u0 u1 : A) -> (p : Id A u0 u1) -> Id (Id A u0 u1) p (cong A A (id A) u0 u1 p) 
+  rem u0 = J A u0 (\u1 p -> Id (Id A u0 u1) p (cong A A (id A) u0 u1 p)) (rem1 u0)
+
+congComp : (A B C : U) (f : A -> B) (g : B -> C) (a0 a1 : A) -> 
+           Id (Id A a0 a1 -> Id C (g (f a0)) (g (f a1))) 
+              (cong A C (\x -> g (f x)) a0 a1)
+              (\p -> cong B C g (f a0) (f a1) (cong A B f a0 a1 p))
+congComp A B C f g a0 a1 = funExt (Id A a0 a1) (\_ -> Tgf a0 a1)
+                                  (conggf a0 a1) (\p -> congg a0 a1 (congf a0 a1 p)) (rem a0 a1)
+  where
+  Tgf : (a0 a1 : A) -> U 
+  Tgf a0 a1 = Id C (g (f a0)) (g (f a1))
+
+  congf : (a0 a1 : A) -> Id A a0 a1 -> Id B (f a0) (f a1)
+  congf = cong A B f
+  
+  congg : (a0 a1 : A) -> Id B (f a0) (f a1) -> Tgf a0 a1
+  congg a0 a1 = cong B C g (f a0) (f a1)
+
+  conggf : (a0 a1 : A) -> Id A a0 a1 -> Tgf a0 a1
+  conggf = cong A C (\x -> g (f x))
+
+  rem : (a0 a1 : A) (p : Id A a0 a1) -> 
+        Id (Tgf a0 a1) (conggf a0 a1 p) (congg a0 a1 (congf a0 a1 p))
+  rem a = J A a (\a1 p -> Id (Tgf a a1) (conggf a a1 p) (congg a a1 (congf a a1 p)))
+             rem1
+    where
+    rem2 : Id (Tgf a a) (refl C (g (f a))) (conggf a a (refl A a))
+    rem2 = congRefl A C (\x -> g (f x)) a
+
+    rem4 : Id (Id B (f a) (f a)) (refl B (f a)) (congf a a (refl A a))
+    rem4 = congRefl A B f a
+
+    rem3 : Id (Tgf a a) (congg a a (refl B (f a))) (congg a a (congf a a (refl A a)))
+    rem3 = cong (Id B (f a) (f a)) (Tgf a a) (congg a a) (refl B (f a)) 
+                (congf a a (refl A a)) rem4
+
+    rem5 : Id (Tgf a a) (refl C (g (f a))) (congg a a (refl B (f a)))
+    rem5 = congRefl B C g (f a)
+
+    rem1 : Id (Tgf a a) (conggf a a (refl A a)) (congg a a (congf a a (refl A a)))
+    rem1 = compUp (Tgf a a) (refl C (g (f a))) (conggf a a (refl A a))
+                              (congg a a (refl B (f a))) (congg a a (congf a a (refl A a)))
+                    rem2 rem3 rem5
+
+-- a lemma about injective function
+
+lemInj : (A B : U) (f : A -> B) -> (injf : injective A B f)
+              -> ((x:A) -> Id (Id A x x) (refl A x) (injf x x (refl B (f x))))
+              -> (x y : A) -> (p:Id A x y) -> Id (Id A x y) p (injf x y (cong A B f x y p))
+lemInj A B f injf h x = 
+ J A x (\ y p -> Id (Id A x y) p (injf x y (cong A B f x y p))) rem
+ where
+  rem1 : Id (Id A x x) (refl A x) (injf x x (refl B (f x)))
+  rem1 = h x
+
+  rem2 : Id (Id A x x) (injf x x (refl B (f x))) (injf x x (cong A B f x x (refl A x)))
+  rem2 = cong (Id B (f x) (f x)) (Id A x x) (injf x x) (refl B (f x)) (cong A B f x x (refl A x)) (congRefl A B f x)
+
+  rem : Id (Id A x x) (refl A x) (injf x x (cong A B f x x (refl A x)))
+  rem = comp (Id A x x) (refl A x) (injf x x (refl B (f x))) (injf x x (cong A B f x x (refl A x)))
+             rem1 rem2
+
diff --git a/examples/contr.cub b/examples/contr.cub
new file mode 100644
--- /dev/null
+++ b/examples/contr.cub
@@ -0,0 +1,157 @@
+module contr where
+
+import gradLemma
+
+-- a product of contractibles is contractible
+
+contr : U -> U
+contr A = Id U Unit A
+
+contrIsProp : (A:U) -> contr A -> prop A
+contrIsProp A cA = subst U prop Unit A cA propUnit
+
+propContr : (A : U) -> A -> prop A -> contr A
+propContr A a pA = propExt Unit A propUnit pA (\_ -> a) (\_ -> tt)
+
+-- a singleton is a proposition
+
+singlIsProp : (A:U) (a:A) -> prop (singl A a)
+singlIsProp A a v0 v1 =
+ comp (singl A a) v0 (sId A a) v1 (inv (singl A a) (sId A a) v0 (tId A a v0)) (tId A a v1)
+
+-- another definition of contr
+
+contr' : U -> U
+contr' A = Sigma A (\ a -> (x:A) -> Id A a x)
+
+-- this implies the other definition
+
+isContr : (A:U) -> contr' A -> contr A
+isContr A = split
+             pair a f -> rem a f
+               where 
+                  rem : (a:A) -> ((x:A) -> Id A a x) -> contr A
+                  rem a f = propContr A a (\ a0 a1 -> compInv A a a0 a1 (f a0) (f a1))
+
+isContrProd : (A:U) (B:A->U) -> ((x:A) -> contr (B x)) -> contr (Pi A B)
+isContrProd A B pB = subst U contr (A->Unit) (Pi A B) rem1 rem2
+ where
+   rem : Id (A -> U) (\ _ -> Unit) B
+   rem = funExt A (\ _ -> U) (\ _ -> Unit) B pB
+
+   rem1 : Id U (A -> Unit) (Pi A B)
+   rem1 = cong (A -> U) U (Pi A)  (\ _ -> Unit) B rem
+
+   f : Unit -> A -> Unit
+   f z a = tt
+
+   g : (A -> Unit) -> Unit
+   g _ = tt
+
+   sfg : (z : A -> Unit) -> Id (A -> Unit) (f (g z)) z
+   sfg z = funExt A (\ _ -> Unit) (f (g z)) z (\ x -> propUnit (f (g z) x) (z x))
+
+   rfg : (z:Unit) -> Id Unit (g (f z)) z
+   rfg z = propUnit (g (f z)) z
+
+   rem2 : Id U Unit (A -> Unit)
+   rem2 = isoId Unit (A -> Unit) f g sfg rfg
+
+-- a sigma of props over a prop is a prop
+
+sigIsProp : (A:U) (B:A->U) (pB : (x:A) -> prop (B x)) -> prop A -> prop (Sigma A B)
+sigIsProp A B pB pA =
+ split
+  pair a0 b0 -> split
+                 pair a1 b1 -> eqSigma A B a0 a1 (pA a0 a1) b0 b1 (pB a1 (subst A B a0 a1 (pA a0 a1) b0) b1)
+
+contr'IsProp : (A : U) -> prop (contr' A)
+contr'IsProp A = lemProp1 (contr' A) rem
+ where rem : contr' A -> prop (contr' A)
+       rem = split
+              pair a p -> sigIsProp A (\ a0 -> (x:A) -> Id A a0 x) rem3 rem1 
+                where
+                 rem1 : prop A
+                 rem1 a0 a1 = compInv A a a0 a1 (p a0) (p a1)
+
+                 rem2 : (a0 a1:A) -> prop (Id A a0 a1)
+                 rem2 = propUIP A rem1
+
+                 rem3 : (a0:A) -> prop ((x:A) -> Id A a0 x)
+                 rem3 a0 = isPropProd A (Id A a0) (rem2 a0) 
+
+-- Voevodsky's definition of propositions
+
+propIsContr : (A:U) -> prop A -> (a0 a1:A) -> contr (Id A a0 a1)
+propIsContr A pA a0 a1 = propContr (Id A a0 a1) (pA a0 a1) (propUIP A pA a0 a1)
+
+-- if A is contractible and a:A then Sigma A P is equal to P a
+
+hasContrSig : U -> U
+hasContrSig A =  (P : A -> U) -> (x: A) -> Id U (Sigma A P) (P x)
+
+lemUnitSig : hasContrSig Unit
+lemUnitSig P = 
+ split
+  tt -> isoId T F f g rfg sfg
+   where 
+    T : U
+    T = Sigma Unit P
+
+    F : U
+    F = P tt
+
+    f : T -> F
+    f = split
+         pair x u -> rem x u
+          where rem : (x:Unit) -> P x -> P tt
+                rem = split
+                       tt -> \ u -> u
+
+    g : F -> T
+    g u = pair tt u
+
+    rfg : (v:F) -> Id F (f (g v)) v
+    rfg v = refl F v
+
+    sfg : (v:T) -> Id T (g (f v)) v
+    sfg = split
+           pair x u -> rem x u
+            where rem : (x:Unit) -> (u : P x) -> Id T (g (f (pair x u))) (pair x u)
+                  rem = split
+                         tt -> \ u -> refl T (pair tt u)
+
+lemContrSig : (A:U) -> contr A -> hasContrSig A
+lemContrSig A p = subst U hasContrSig Unit A p lemUnitSig
+
+singContr : (A:U) (a:A) -> contr (singl A a)
+singContr A a = isContr T (pair (pair a (refl A a)) f)
+ where T : U 
+       T = singl A a 
+ 
+       f : (z:T) -> Id T (pair a (refl A a)) z
+       f = split
+            pair b p -> rem b a p
+             where 
+               rem : (b:A) (a:A) (p:Id A b a) -> Id (singl A a) (pair a (refl A a)) (pair b p)
+               rem b = J A b (\ a p ->  Id (singl A a) (pair a (refl A a)) (pair b p)) (refl (singl A b) (pair b (refl A b)))
+ 
+
+-- any function between two contractible types is an equivalence
+
+equivUnit : (f : Unit -> Unit) -> isEquiv Unit Unit f
+equivUnit f = subst (Unit -> Unit) (isEquiv Unit Unit) (id Unit) f rem (idIsEquiv Unit)
+ where
+  rem : Id (Unit->Unit) (id Unit) f
+  rem = funExt Unit (\ _ -> Unit)  (id Unit) f (\ x -> propUnit x (f x))
+
+-- an elimination principle for Contr
+
+elimContr : (P : U -> U) -> P Unit -> (A : U) -> contr A -> P A
+elimContr P d A cA = subst U P Unit A cA d
+
+equivContr : (A : U) -> contr A -> (B : U) -> contr B -> (f : A -> B) -> isEquiv A B f
+equivContr = elimContr (\ A ->  (B : U) -> contr B -> (f : A -> B) -> isEquiv A B f) rem
+ where rem :  (B : U) -> contr B -> (f : Unit -> B) -> isEquiv Unit B f
+       rem = elimContr (\ X ->  (f : Unit -> X) -> isEquiv Unit X f) equivUnit
+
diff --git a/examples/description.cub b/examples/description.cub
new file mode 100644
--- /dev/null
+++ b/examples/description.cub
@@ -0,0 +1,29 @@
+module description where
+
+import exists
+import set
+
+exAtOne : (A : U) (B : A -> U) -> exactOne A B -> atmostOne A B
+exAtOne A B = split
+  pair g h' -> h'
+
+propSig : (A : U) (B : A -> U) -> propFam A B -> atmostOne A B ->
+          prop (Sigma A B)
+propSig A B h h' au bv =
+  eqPropFam A B h au bv (h' (fst A B au) (fst A B bv) (snd A B au) (snd A B bv))
+
+descrAx : (A : U) (B : A -> U) -> propFam A B -> exactOne A B -> Sigma A B
+descrAx A B h = split
+  pair g h' -> lemInh (Sigma A B) rem g
+  where rem : prop (Sigma A B)
+        rem = propSig A B h h'
+
+iota : (A : U) (B : A -> U) (h : propFam A B) (h' : exactOne A B) -> A
+iota A B h h' = fst A B (descrAx A B h h')
+
+iotaSound : (A : U) (B : A -> U) (h : propFam A B) (h' : exactOne A B) -> B (iota A B h h')
+iotaSound A B h h' = snd A B (descrAx A B h h')
+
+iotaLem : (A : U) (B : A -> U) (h : propFam A B) (h' : exactOne A B) ->
+          (a : A) -> B a -> Id A a (iota A B h h')
+iotaLem A B h h' a p = exAtOne A B h' a (iota A B h h') p (iotaSound A B h h')
diff --git a/examples/elimEquiv.cub b/examples/elimEquiv.cub
new file mode 100644
--- /dev/null
+++ b/examples/elimEquiv.cub
@@ -0,0 +1,27 @@
+module elimEquiv where
+
+import univalence
+
+-- a corollary of equivalence
+
+allTransp : (A B : U) -> hasSection (Id U A B) (Equiv A B) (IdToEquiv A B)
+allTransp A B = equivSec (Id U A B) (Equiv A B)  (IdToEquiv A B) (univAx A B)
+
+-- an induction principle for isEquiv
+
+transpRef : (A : U) -> Id (A->A) (id A) (transport A A (refl U A))
+transpRef A = funExt A (\ _ -> A) (id A) (transport A A (refl U A)) (transportRef A)
+
+elimIsEquiv : (A:U) -> (P : (B:U) -> (A->B) -> U) -> P A (id A) -> 
+              (B :U) -> (f : A -> B) -> isEquiv A B f -> P B f
+elimIsEquiv A P d = \ B f if -> rem2 B (pair f if)
+ where 
+  rem1 : P A (transport A A (refl U A))
+  rem1 = subst (A->A) (P A) (id A) (transport A A (refl U A)) (transpRef A) d
+
+  rem : (B:U) -> (p:Id U A B) -> P B (transport A B p)
+  rem = J U A (\ B p ->  P B (transport A B p)) rem1
+
+  rem2 : (B:U) -> (p:Equiv A B) -> P B (funEquiv A B p)
+  rem2 B = allSection (Id U A B) (Equiv A B) (IdToEquiv A B) (allTransp A B) (\ p -> P B (funEquiv A B p)) (rem B)
+
diff --git a/examples/epi.cub b/examples/epi.cub
new file mode 100644
--- /dev/null
+++ b/examples/epi.cub
@@ -0,0 +1,75 @@
+-- the notion of surjection functions
+
+module epi where
+
+import omega
+
+-- surjective and epi maps
+
+isEpi : (A B: U) -> (A -> B) -> U
+isEpi A B f = (X:U) -> set X -> (g h:B->X) -> Id (A->X) (\ a -> g (f a)) (\ a -> h (f a)) -> Id (B->X) g h
+
+isSurj : (A B:U) -> (A->B) -> U
+isSurj A B f = (y:B) -> exist A (\ x -> Id B (f x) y)
+
+-- these properties should be equivalent
+
+surjIsEpi : (A B : U) (f : A -> B) -> isSurj A B f -> isEpi A B f
+surjIsEpi A B f sf X sX g h egh = funExt B (\ _ -> X) g h rem
+ where
+  rem : (y:B) -> Id X (g y) (h y)
+  rem y = rem6
+    where
+     G : U
+     G = Id X (g y) (h y)
+
+     rem1 : prop G
+     rem1 = sX (g y) (h y)
+
+     rem2 : exist A (\ x -> Id B (f x) y)
+     rem2 = sf y
+
+     rem4 : (x:A) -> Id X (g (f x)) (h (f x))
+     rem4 a = appId A X a (\ x -> g (f x)) (\ x -> h (f x)) egh
+
+     rem3 : (x:A) -> Id B (f x) y -> G
+     rem3 x p = subst B (\ z -> Id X (g z) (h z)) (f x) y p (rem4 x)
+
+     rem5 : (Sigma A (\ x -> Id B (f x) y)) -> G
+     rem5 = split
+             pair x p -> rem3 x p
+
+     rem6 : G
+     rem6 = exElim A (\ x -> Id B (f x) y) G rem1 rem5 rem2
+
+-- the converse is interesting
+
+epiIsSurj : (A B : U) (f : A -> B) -> isEpi A B f -> isSurj A B f
+epiIsSurj A B f ef = rem6
+ where 
+   rem : (g h : B -> Omega) -> Id (A -> Omega) (\ x -> g (f x)) (\ x -> h (f x)) -> Id (B -> Omega) g h
+   rem = ef Omega omegaIsSet
+
+   g : B -> Omega
+   g y = pair Unit propUnit
+
+   h : B -> Omega
+   h y = pair (exist A (\ x -> Id B (f x) y)) (squash (Sigma A (\ x -> Id B (f x) y)))
+
+   rem1 : (x:A) -> isTrue (h (f x))
+   rem1 x = inc (Sigma A (\ z -> Id B (f z) (f x))) (pair x (refl B (f x)))
+
+   rem2 : (x:A) -> Id Omega (g (f x)) (h (f x))
+   rem2 x = lemIsTrue (g (f x)) (h (f x)) (\ _ -> rem1 x) (\ _ -> tt)
+
+   rem3 : Id (A -> Omega) (\ x -> g (f x)) (\ x -> h (f x))
+   rem3 = funExt A (\ _ -> Omega)  (\ x -> g (f x)) (\ x -> h (f x)) rem2
+
+   rem4 : Id (B -> Omega) g h 
+   rem4 = rem g h rem3
+
+   rem5 : (y:B) -> Id Omega (g y) (h y)
+   rem5 y = appId B Omega y g h rem4
+
+   rem6 : (y:B) -> isTrue (h y)
+   rem6 y = subst Omega isTrue (g y) (h y) (rem5 y) tt
diff --git a/examples/equivProp.cub b/examples/equivProp.cub
new file mode 100644
--- /dev/null
+++ b/examples/equivProp.cub
@@ -0,0 +1,17 @@
+module equivProp where
+
+import equivSet
+
+-- The goal is to prove that equivalent propositions are equal
+
+propExt : (A B : U) -> (prop A) -> (prop B) -> (A -> B) -> (B -> A) -> Id U A B
+propExt A B pA pB f g = equivSet A B f g sfg injf setB
+  where
+  sfg : section A B f g
+  sfg b = pB (f (g b)) b
+
+  injf : injective A B f
+  injf a0 a1 _ = pA a0 a1
+
+  setB : set B
+  setB = propUIP B pB
diff --git a/examples/equivSet.cub b/examples/equivSet.cub
new file mode 100644
--- /dev/null
+++ b/examples/equivSet.cub
@@ -0,0 +1,38 @@
+module equivSet where
+
+import function
+import set
+
+-- a sufficient condition for two sets being equal
+-- this is implied by the gradlemma, which has however a more complex proof
+
+equivSet : (A B : U) (f : A -> B) (g : B -> A) -> (section A B f g) 
+           -> (injective A B f) -> (set B) -> Id U A B
+equivSet A B f g sfg injf setB = equivEq A B f sf tf
+  where
+  fFiber : B -> U
+  fFiber b = fiber A B f b
+
+  fstfFiber : (b : B) -> fFiber b -> A
+  fstfFiber b = fst A (\x -> Id B (f x) b)
+
+  eqfFiber : (b : B) -> (v v' : fFiber b) ->
+             Id A (fstfFiber b v) (fstfFiber b v') -> Id (fFiber b) v v'
+  eqfFiber b = eqPropFam A (\x -> Id B (f x) b) (\x -> setB (f x) b)
+
+  sf : (b : B) -> fFiber b
+  sf b = pair (g b) (sfg b)
+
+  tf : (b : B) (v : fFiber b) -> Id (fFiber b) (sf b) v
+  tf b v = eqfFiber b (sf b) v rem
+    where
+    a' : A
+    a' = fstfFiber b v
+
+    rem1 : Id B (f (g b)) (f a')
+    rem1 = comp B (f (g b)) b (f a') (sfg b)
+           (inv B (f a') b (snd A (\x -> Id B (f x) b) v))
+
+    rem : Id A (g b) a'
+    rem = injf (g b) a' rem1
+
diff --git a/examples/equivTotal.cub b/examples/equivTotal.cub
new file mode 100644
--- /dev/null
+++ b/examples/equivTotal.cub
@@ -0,0 +1,167 @@
+module equivTotal where
+
+import elimEquiv
+
+-- equivalence on total space
+
+lem3Sub : (A:U) (P: A -> U) (a:A) -> Id U (Sigma (singl A a) (\ z -> P (fst A (\ x -> Id A x a) z))) (P a)
+lem3Sub A P a = lemContrSig (singl A a) (singContr A a) Q (pair a (refl A a))
+ where
+   Q : singl A a -> U
+   Q z = P (fst A (\ x -> Id A x a) z)
+
+lem1Sub : (A:U) (P: A -> U) (a:A) -> Id U (fiber (Sigma A P) A (fst A P) a) (P a)
+lem1Sub A P a =
+ comp U (fiber (Sigma A P) A (fst A P) a) (Sigma (singl A a) (\ z -> P (fst A (\ x -> Id A x a) z))) (P a)
+     (lem2Sub A P a) (lem3Sub A P a)
+
+retsub : (A:U) -> (P : subset2 A) -> Id (subset2 A) (sub12 A (sub21 A P)) P
+retsub A P = funExt A (\ _ -> U) (fiber (Sigma A P) A (fst A P)) P (lem1Sub A P)
+
+-- a corollary of equivalence
+
+allTransp : (A B : U) -> hasSection (Id U A B) (Equiv A B) (IdToEquiv A B)
+allTransp A B = equivSec (Id U A B) (Equiv A B)  (IdToEquiv A B) (univAx A B)
+
+-- an induction principle for isEquiv
+
+transpRef : (A : U) -> Id (A->A) (id A) (transport A A (refl U A))
+transpRef A = funExt A (\ _ -> A) (id A) (transport A A (refl U A)) (transportRef A)
+
+elimIsEquiv : (A:U) -> (P : (B:U) -> (A->B) -> U) -> P A (id A) -> 
+              (B :U) -> (f : A -> B) -> isEquiv A B f -> P B f
+elimIsEquiv A P d = \ B f if -> rem2 B (pair f if)
+ where 
+  rem1 : P A (transport A A (refl U A))
+  rem1 = subst (A->A) (P A) (id A) (transport A A (refl U A)) (transpRef A) d
+
+  rem : (B:U) -> (p:Id U A B) -> P B (transport A B p)
+  rem = J U A (\ B p ->  P B (transport A B p)) rem1
+
+  rem2 : (B:U) -> (p:Equiv A B) -> P B (funEquiv A B p)
+  rem2 B = allSection (Id U A B) (Equiv A B) (IdToEquiv A B) (allTransp A B) (\ p -> P B (funEquiv A B p)) (rem B)
+
+-- a simple application; with yet another problem with eta conversion
+
+equivSigId : (A B :U) -> (f:A -> B) -> isEquiv A B f -> (Q : B -> U) -> Id U (Sigma A (\ x -> Q (f x))) (Sigma B Q)
+equivSigId A = elimIsEquiv A P d
+ where 
+   P : (B:U) -> (A-> B) -> U
+   P B f =  (Q : B -> U) -> Id U (Sigma A (\ x -> Q (f x))) (Sigma B Q)
+
+   d : P A (id A)
+   d Q = rem
+      where
+         rem : Id U (Sigma A (\ x -> Q x)) (Sigma A Q)
+         rem = cong (A -> U) U (Sigma A) (\ x -> Q x) Q (funExt A (\ _ -> U) (\ x -> Q x) Q (\ x -> refl U (Q x)))
+
+-- application to equivalences between total spaces
+
+liftTot :  (A:U) (P Q : A -> U) (g : (x:A) -> P x -> Q x) -> Sigma A P -> Sigma A Q
+liftTot A P Q g = split
+                  pair a u -> pair a (g a u)
+
+equivTot : (A:U) (P Q : A -> U) (g : (x:A) -> P x -> Q x) ->
+           isEquiv (Sigma A P) (Sigma A Q) (liftTot A P Q g) -> (a:A) -> Id U (P a) (Q a)
+equivTot A P Q g igl a = rem5
+ where
+  F : Sigma A P -> U
+  F z = Id A (fst A P z) a
+
+  T : U
+  T = Sigma (Sigma A P) F
+
+  G : Sigma A Q -> U
+  G z = Id A (fst A Q z) a
+
+  V : U
+  V = Sigma (Sigma A Q) G
+
+  rem : Id U T (P a)
+  rem = lem1Sub A P a
+
+  rem1 : Id U V (Q a)
+  rem1 = lem1Sub A Q a
+
+  F1 : Sigma A P -> U
+  F1 z = G (liftTot A P Q g z)
+
+  T1 : U
+  T1 = Sigma (Sigma A P) F1
+
+  rem2 : Id U T1 V
+  rem2 = equivSigId (Sigma A P) (Sigma A Q) (liftTot A P Q g) igl G
+
+  rem3 : Id U T T1
+  rem3 = cong (Sigma A P -> U) U (Sigma (Sigma A P)) F F1 eFF1
+      where fFF1 : (z : Sigma A P) -> Id U (F z) (F1 z)
+            fFF1 = split
+                    pair x u -> refl U (Id A x a)
+
+            eFF1 : Id (Sigma A P -> U) F F1
+            eFF1 = funExt (Sigma A P) (\ _ -> U) F F1 fFF1
+
+  rem4 : Id U T V
+  rem4 = comp U T T1 V rem3 rem2
+
+  rem5 : Id U (P a) (Q a)
+  rem5 = compUp U T (P a) V (Q a) rem rem1 rem4
+
+-- now we should be able to show that any map Id (Pi A B) f g -> (x:A) -> Id (B x) (f x) (g x)
+-- is an equivalence
+
+singlPi : (A:U) (B:A->U) -> Pi A B -> Pi A B -> U
+singlPi A B g f = (x:A) -> Id (B x) (f x) (g x)
+
+singlPiContr : (A:U) (B:A->U) (g:Pi A B) -> contr (Sigma (Pi A B) (singlPi A B g))
+singlPiContr A B g = subst U contr  ((x:A) -> Sigma (B x) (C x)) (Sigma (Pi A B) (\ z -> (x:A) -> C x (z x))) rem1 rem
+ where
+  C : (x:A) -> B x -> U
+  C x y = Id (B x) y (g x)
+
+  rem : contr ((x:A) -> Sigma (B x) (C x))
+  rem = isContrProd A (\ x -> Sigma (B x) (C x)) (\ x -> singContr (B x) (g x))
+
+  rem1 : Id U ((x:A) -> Sigma (B x) (C x)) (Sigma (Pi A B) (\ z -> (x:A) -> C x (z x)))
+  rem1 = idTelProp A B C
+
+-- we have enough to deduce that Id (Pi A B) f g and (x:A) -> Id (B x) (f x) (g x) are equal
+eqIdProd : (A:U) (B:A->U) -> (f g : Pi A B) -> Id U (Id (Pi A B) f g) ((x:A) -> Id (B x) (f x) (g x))
+eqIdProd A B f g = equivTot T P Q G rem f
+ where 
+  P : (Pi A B) -> U
+  P z = Id (Pi A B) z g
+
+  Q : (Pi A B) -> U
+  Q z = (x:A) -> Id (B x) (z x) (g x)
+
+  T : U
+  T = Pi A B
+
+  G : (z:Pi A B) -> P z -> Q z
+  G z ez x = cong (Pi A B) (B x) (\ u -> u x) z g ez
+
+  rem1 : contr (Sigma T P)
+  rem1 = singContr (Pi A B) g
+
+  rem2 : contr (Sigma T Q)
+  rem2 = singlPiContr A B g
+
+  rem : isEquiv (Sigma T P) (Sigma T Q) (liftTot T P Q G)
+  rem = equivContr (Sigma T P) rem1 (Sigma T Q) rem2 (liftTot T P Q G)
+
+-- it follows from this that a product of sets is a set
+
+isSetProd : (A:U) (B:A->U) (pB : (x:A) -> set (B x)) -> set (Pi A B)
+isSetProd A B pB f g = substInv U prop  (Id (Pi A B) f g) ((x:A) -> Id (B x) (f x) (g x)) rem2 rem1
+ where
+  rem : (x:A) -> prop (Id (B x) (f x) (g x))
+  rem x = pB x (f x) (g x)
+
+  rem1 : prop ((x:A) -> Id (B x) (f x) (g x))
+  rem1 = isPropProd A (\ x -> Id (B x) (f x) (g x)) rem
+
+  rem2 : Id U (Id (Pi A B) f g) ((x:A) -> Id (B x) (f x) (g x))
+  rem2 = eqIdProd A B f g
+
+
diff --git a/examples/exists.cub b/examples/exists.cub
new file mode 100644
--- /dev/null
+++ b/examples/exists.cub
@@ -0,0 +1,22 @@
+module exists where
+
+import prelude
+
+-- existence: a new modality
+
+exists : (A : U) (B : A -> U) -> U
+exists A B = inh (Sigma A B)
+
+exElim : (A : U) (B : A -> U) (C : U) -> prop C -> (Sigma A B -> C) ->
+         exists A B -> C
+exElim A B C p f = inhrec (Sigma A B) C p f
+
+atmostOne : (A : U) (B : A -> U) -> U
+atmostOne A B = (a b : A) -> B a -> B b -> Id A a b
+
+exactOne : (A : U) (B : A -> U) -> U
+exactOne A B = and (exists A B) (atmostOne A B)
+
+lemInh : (A : U) -> prop A -> inh A -> A
+lemInh A h = inhrec A A h (\x -> x)
+
diff --git a/examples/function.cub b/examples/function.cub
new file mode 100644
--- /dev/null
+++ b/examples/function.cub
@@ -0,0 +1,79 @@
+module function where
+
+import lemId
+
+-- some general facts about functions
+
+-- g is a section of f 
+section : (A B : U) (f : A -> B) (g : B -> A) -> U
+section A B f g = (b : B) -> Id B (f (g b)) b
+
+injective : (A B : U) (f : A -> B) -> U
+injective A B f = (a0 a1 : A) -> Id B (f a0) (f a1) -> Id A a0 a1
+
+retract : (A B : U) (f : A -> B) (g : B -> A) -> U
+retract A B f g = section B A g f
+
+retractInj : (A B : U) (f : A -> B) (g : B -> A) -> 
+             retract A B f g -> injective A B f
+retractInj A B f g h a0 a1 h' = compUp A (g (f a0)) a0 (g (f a1)) a1 rem1 rem2 rem3
+  where
+  rem1 : Id A (g (f a0)) a0
+  rem1 = h a0
+
+  rem2 : Id A (g (f a1)) a1
+  rem2 = h a1
+
+  rem3 : Id A (g (f a0)) (g (f a1))
+  rem3 = cong B A g (f a0) (f a1) h'
+
+
+
+hasSection : (A B : U) -> (A -> B) -> U
+hasSection A B f = Sigma (B->A) (section A B f) 
+
+-- an equivalence has a section
+
+equivSec : (A B :U) -> (f:A->B) -> isEquiv A B f -> hasSection A B f
+equivSec A B f = 
+ split 
+  pair s t -> pair g rem
+    where g : B -> A
+          g y = fst A (\ x -> Id B (f x) y) (s y)
+
+          rem : (y:B) -> Id B (f (g y)) y
+          rem y = snd A (\ x -> Id B (f x) y) (s y)
+
+allSection : (A B : U) (f:A->B) -> hasSection A B f -> (Q : B->U) -> ((x:A) -> Q (f x)) -> Pi B Q
+allSection A B f =
+ split
+  pair g sfg -> rem 
+     where rem : (Q : B->U) -> ((x:A) -> Q (f x)) -> Pi B Q
+           rem Q h y = rem2
+                  where rem1 : Q (f (g y))
+                        rem1 = h (g y)
+
+                        rem2 : Q y
+                        rem2 = subst B Q (f (g y)) y (sfg y) rem1
+
+
+isEquivSection : (A B : U) (f : A -> B) (g : B -> A) -> section A B f g -> 
+                 ((b : B) -> prop (fiber A B f b)) -> isEquiv A B f
+isEquivSection A B f g sfg h = pair s t
+  where
+  s : (y : B) -> fiber A B f y
+  s y = pair (g y) (sfg y)
+
+  t : (y : B) -> (v : fiber A B f y) -> Id (fiber A B f y) (s y) v
+  t y v = h y (s y) v
+
+injProp : (A B : U) (f : A -> B) -> injective A B f -> prop B -> prop A
+injProp A B f injf pB a0 a1 = injf a0 a1 (pB (f a0) (f a1))
+
+injId : (X : U) -> injective X X (id X)
+injId X a0 a1 h = h
+
+
+idempotent : (A:U) -> (A->A) -> U
+idempotent A f = section A A f f 
+
diff --git a/examples/gradLemma.cub b/examples/gradLemma.cub
new file mode 100644
--- /dev/null
+++ b/examples/gradLemma.cub
@@ -0,0 +1,145 @@
+module gradLemma where
+
+import equivProp
+import BoolEqBool
+import cong
+
+corrstId : (A : U) (a : A) -> prop (fiber A A (id A) a)
+corrstId A a v0 v1 = compInv (pathTo A a) (sId A a) v0 v1 (tId A a v0) (tId A a v1) 
+
+corr2stId : (A : U) (h : A -> A) (ph : (x : A) -> Id A (h x) x) (a : A) -> 
+            prop (fiber A A h a)
+corr2stId A h ph a = substInv (A -> A) (\h -> prop (fiber A A h a)) h (id A) rem (corrstId A a)
+  where 
+  rem : Id (A -> A) h (id A)
+  rem = funExt A (\_ -> A) h (id A) ph 
+
+gradLemma : (A B : U) (f : A -> B) (g : B -> A) -> section A B f g -> retract A B f g -> 
+            isEquiv A B f
+gradLemma A B f g sfg rfg = isEquivSection A B f g sfg rem
+  where
+  injf : injective A B f
+  injf = retractInj A B f g rfg
+
+  rem : (b : B) -> prop (Sigma A (\a -> Id B (f a) b))
+  rem b = split
+    pair a0 e0 -> 
+      split
+       pair a1 e1 -> rem19
+        where
+         E : A -> U
+         E a = Id B (f a) b
+         F : A -> U
+         F a = Id A (g (f a)) (g b)
+         G : A -> U
+         G a = Id B (f (g (f a))) (f (g b))
+
+         z0 : Sigma A E
+         z0 = pair a0 e0
+         z1 : Sigma A E
+         z1 = pair a1 e1
+        
+         cg : (a:A) -> E a -> F a
+         cg a = cong B A g (f a) b
+
+         cf : (a:A) -> F a -> G a
+         cf a = cong A B f (g (f a)) (g b)
+
+         cfg : (a:A) -> E a -> G a
+         cfg a = cong B B (\ x -> f (g x)) (f a) b
+
+         pcg : Sigma A E -> Sigma A F
+         pcg = split
+                pair a e -> pair a (cg a e)
+
+         pcf : Sigma A F -> Sigma A G
+         pcf = split
+                pair a e -> pair a (cf a e)
+
+         fg : B -> B
+         fg y = f (g y)
+
+         pc : (u:B -> B) -> Sigma A E -> Sigma A (\ a -> Id B (u (f a)) (u b))
+         pc u = split
+                pair a e -> pair a (cong B B u (f a) b e)
+
+         rem1 : prop (Sigma A F)
+         rem1 = corr2stId A (\ x -> g (f x)) rfg (g b)         
+
+         rem2 : Id (Sigma A F) (pcg z0) (pcg z1)
+         rem2 = rem1 (pcg z0) (pcg z1)
+
+         rem3 : Id (Sigma A G) (pcf (pcg z0)) (pcf (pcg z1))
+         rem3 = cong (Sigma A F) (Sigma A G) pcf (pcg z0) (pcg z1) rem2
+
+         rem4 : Id (E a0 -> G a0) (cfg a0) (\ e -> cf a0 (cg a0 e))
+         rem4 = congComp B A B g f (f a0) b 
+
+         rem5 : Id (G a0) (cfg a0 e0) (cf a0 (cg a0 e0))
+         rem5 = appId (E a0) (G a0) e0 (cfg a0) (\ e -> cf a0 (cg a0 e)) rem4
+
+         rem6 : Id (Sigma A G) (pc fg z0) (pcf (pcg z0))
+         rem6 = cong (G a0) (Sigma A G) (\ e -> pair a0 e)  (cfg a0 e0) (cf a0 (cg a0 e0)) rem5
+
+         rem7 : Id (E a1 -> G a1) (cfg a1) (\ e -> cf a1 (cg a1 e))
+         rem7 = congComp B A B g f (f a1) b 
+
+         rem8 : Id (G a1) (cfg a1 e1) (cf a1 (cg a1 e1))
+         rem8 = appId (E a1) (G a1) e1 (cfg a1) (\ e -> cf a1 (cg a1 e)) rem7
+
+         rem9 : Id (Sigma A G) (pc fg z1) (pcf (pcg z1))
+         rem9 = cong (G a1) (Sigma A G) (\ e -> pair a1 e)  (cfg a1 e1) (cf a1 (cg a1 e1)) rem8
+
+         rem10 : Id (Sigma A G) (pc fg z0) (pc fg z1)
+         rem10 = compDown (Sigma A G) (pc fg z0) (pcf (pcg z0)) (pc fg z1) (pcf (pcg z1)) rem6 rem9 rem3
+
+         rem11 : Id (B -> B) fg (id B)
+         rem11 = funExt B (\ _ -> B)  fg (id B) sfg
+
+         rem12 : Id (Sigma A E) (pc (id B) z0) (pc (id B) z1)
+         rem12 = subst (B->B) (\ u -> Id (Sigma A (\ x -> Id B (u (f x)) (u b))) (pc u z0) (pc u z1)) fg (id B) rem11 rem10
+
+         c1 : (a:A) -> E a -> E a
+         c1 a = cong B B (id B) (f a) b
+
+         rem13 : Id (E a0 -> E a0) (id (E a0)) (c1 a0) 
+         rem13 = congId B (f a0) b
+
+         rem14 : Id (E a0) e0 (c1 a0 e0) 
+         rem14 = appId (E a0) (E a0) e0  (id (E a0)) (c1 a0) rem13
+
+         rem15 : Id (Sigma A E) z0 (pc (id B) z0)
+         rem15 = cong (E a0) (Sigma A E) (\ e -> pair a0 e) e0 (c1 a0 e0) rem14
+
+         rem16 : Id (E a1 -> E a1) (id (E a1)) (c1 a1) 
+         rem16 = congId B (f a1) b
+
+         rem17 : Id (E a1) e1 (c1 a1 e1) 
+         rem17 = appId (E a1) (E a1) e1  (id (E a1)) (c1 a1) rem16
+
+         rem18 : Id (Sigma A E) z1 (pc (id B) z1)
+         rem18 = cong (E a1) (Sigma A E) (\ e -> pair a1 e) e1 (c1 a1 e1) rem17
+
+         rem19 : Id (Sigma A E) z0 z1
+         rem19 = compDown (Sigma A E) z0 (pc (id B) z0) z1 (pc (id B) z1) rem15 rem18 rem12
+
+-- isomorphic types are equal
+
+isoId : (A B:U) ->  (f : A -> B) (g : B -> A) -> section A B f g -> retract A B f g -> 
+            Id U A B
+isoId A B f g sfg rfg = isEquivEq A B f (gradLemma A B f g sfg rfg)
+
+-- some applications of the gradlemma
+
+propId : (A B:U) ->  prop A -> prop B ->  (f : A -> B) (g : B -> A) -> 
+            Id U A B
+propId A B pA pB f g = isEquivEq A B f (gradLemma A B f g sfg rfg)
+ where
+  sfg : (b:B) -> Id B (f (g b)) b
+  sfg b = pB (f (g b)) b
+ 
+  rfg : (a:A) -> Id A (g (f a)) a
+  rfg a = pA (g (f a)) a
+
+
+
diff --git a/examples/hedberg.cub b/examples/hedberg.cub
new file mode 100644
--- /dev/null
+++ b/examples/hedberg.cub
@@ -0,0 +1,61 @@
+module hedberg where
+
+import set
+
+-- proves that a type with decidable equality is a set
+-- in particular both N and Bool are sets
+
+const : (A : U) (f : A -> A) -> U
+const A f = (x y : A) -> Id A (f x) (f y)
+
+exConst : (A : U) -> U
+exConst A = Sigma (A -> A) (const A)
+
+decConst : (A : U) -> dec A -> exConst A
+decConst A = split
+  inl a -> pair (\x -> a) (\ x y -> refl A a)
+  inr h -> pair (\x -> x) (\ x y -> efq (Id A x y) (h x))
+
+hedbergLemma : (A: U) (f : (a b : A) -> Id A a b -> Id A a b) (a b : A)
+            (p : Id A a b) ->
+            Id (Id A a b) (comp A a a b (f a a (refl A a)) p) (f a b p)
+hedbergLemma A f a = J A a (\ b p -> Id (Id A a b) (comp A a a b (f a a (refl A a)) p) (f a b p)) rem
+  where rem : Id (Id A a a) (comp A a a a (f a a (refl A a)) (refl A a)) (f a a (refl A a))
+        rem = compIdr A a a (f a a (refl A a))
+
+hedberg : (A : U) -> discrete A -> set A
+hedberg A h a b p q = lemSimpl A a a b r p q rem5
+  where
+    rem1 : (x y : A) -> exConst (Id A x y)
+    rem1 x y = decConst (Id A x y) (h x y)
+
+    f : (x y : A) -> Id A x y -> Id A x y
+    f x y = fst (Id A x y -> Id A x y) (const (Id A x y)) (rem1 x y)
+
+    fIsConst : (x y : A) -> const (Id A x y) (f x y)
+    fIsConst x y = snd (Id A x y -> Id A x y) (const (Id A x y)) (rem1 x y)
+
+    r : Id A a a
+    r = f a a (refl A a)
+
+    rem2 : Id (Id A a b) (comp A a a b r p) (f a b p)
+    rem2 = hedbergLemma A f a b p
+
+    rem3 : Id (Id A a b) (comp A a a b r q) (f a b q)
+    rem3 = hedbergLemma A f a b q
+
+    rem4 : Id (Id A a b) (f a b p) (f a b q)
+    rem4 = fIsConst a b p q
+
+    rem5 : Id (Id A a b) (comp A a a b r p) (comp A a a b r q)
+    rem5 = compDown (Id A a b) (comp A a a b r p) (f a b p) (comp A a a b r q) (f a b q) rem2 rem3 rem4
+
+NIsSet : set N
+NIsSet = hedberg N natDec
+
+test3 : Id (Id N zero zero) (refl N zero) (refl N zero)
+test3 = NIsSet zero zero (refl N zero) (refl N zero)
+
+boolIsSet : set Bool
+boolIsSet = hedberg Bool boolDec
+
diff --git a/examples/idempotent.cub b/examples/idempotent.cub
new file mode 100644
--- /dev/null
+++ b/examples/idempotent.cub
@@ -0,0 +1,74 @@
+module idempotent where
+
+import gradLemma
+
+-- any idempotent function defines an equality 
+
+idemIsEquiv : (A:U) -> (f : A -> A) -> idempotent A f -> isEquiv A A f
+idemIsEquiv A f if = gradLemma A A f f if if
+
+idemEq : (A:U) -> (f : A -> A) -> idempotent A f -> Id U A A
+idemEq A f if = isEquivEq A A f (idemIsEquiv A f if)
+
+remIdFunEq : (A:U) -> (f:A -> A) -> (x:A) -> Id A x (f x) -> Id A x (f (f x))
+remIdFunEq A f x p = subst A (\ y -> Id A x (f y)) x (f x) p p
+
+invInvEq : (A:U) -> (a b :A) -> (p : Id A a b) -> Id (Id A a b) p (inv A b a (inv A a b p))
+invInvEq A a = J A a (\ b p -> Id (Id A a b) p (inv A b a (inv A a b p))) rem
+ where rem : Id (Id A a a) (refl A a) (inv A a a (inv A a a (refl A a)))
+       rem = remIdFunEq (Id A a a) (inv A a a) (refl A a) (invRefl A a)
+
+idemInv : (A:U) -> (a:A) -> idempotent (Id A a a) (inv A a a)
+idemInv A a = rem 
+ where 
+      T : U
+      T = Id A a a
+      g : T -> T
+      g = inv A a a 
+      rem : (p: T) -> Id T (g (g p)) p
+      rem p = inv T p (g (g p)) (invInvEq A a a p)
+
+-- type of all loops 
+
+aLoop : U -> U
+aLoop A = Sigma A (\ a -> Id A a a)
+
+invALoop : (A:U) -> aLoop A -> aLoop A
+invALoop A = split
+              pair a l -> pair a (inv A a a l)
+
+idemInvALoop : (A:U) -> idempotent (aLoop A) (invALoop A)
+idemInvALoop A = split
+                  pair a l -> cong (Id A a a) (aLoop A) (\ x -> pair a x) (inv A a a (inv A a a l)) l (idemInv A a l)
+
+-- equality associated to this idempotent map
+
+eqInvALoop : (A:U) -> Id U (aLoop A) (aLoop A)
+eqInvALoop A = idemEq (aLoop A) (invALoop A) (idemInvALoop A)
+
+-- type of types with automorphisms
+
+autoM : U
+autoM = aLoop U
+
+-- this type is equal to itself
+
+eqAutoM : Id U autoM autoM
+eqAutoM = eqInvALoop U
+
+-- a particular element of autoM
+
+boolAuto : autoM
+boolAuto = pair Bool eqBoolBool
+
+-- by transport we deduce another type and another equality
+
+boolAuto' : autoM
+boolAuto' = subst U (\ X -> X) autoM autoM eqAutoM boolAuto
+
+bool' : U
+bool' = fst U (\ X -> Id U X X) boolAuto'
+
+eqBool' : Id U bool' bool'
+eqBool' = snd  U (\ X -> Id U X X) boolAuto'
+
diff --git a/examples/lemId.cub b/examples/lemId.cub
new file mode 100644
--- /dev/null
+++ b/examples/lemId.cub
@@ -0,0 +1,121 @@
+module lemId where
+
+import prelude
+
+-- general lemmas about Identity type
+
+comp : (A : U) -> (a b c : A) -> Id A a b -> Id A b c -> Id A a c
+comp A a b c p q = subst A (Id A a) b c q p
+
+compInvIdr : (A : U) -> (a b : A) -> (p : Id A a b) -> Id (Id A a b) p (comp A a b b p (refl A b))
+compInvIdr A a b p = substeq A (\x -> Id A a x) b p
+
+inv : (A : U) -> (a b :A) -> Id A a b -> Id A b a
+inv A a b p = subst A (\ x -> Id A x a) a b p (refl A a)
+
+invRefl : (A:U) -> (a:A) -> Id (Id A a a) (refl A a) (inv A a a (refl A a))
+invRefl A a = substeq A  (\ x -> Id A x a) a (refl A a)
+
+compIdr : (A : U) -> (a b : A) -> (p : Id A a b) -> Id (Id A a b) (comp A a b b p (refl A b)) p
+compIdr A a b p = inv (Id A a b) p (comp A a b b p (refl A b)) (compInvIdr A a b p)
+
+compInvIdl : (A : U) -> (b c : A) -> (q : Id A b c) ->
+          Id (Id A b c) q (comp A b b c (refl A b) q)
+compInvIdl A b c q = J A b (\c q -> Id (Id A b c) q (comp A b b c (refl A b) q)) rem c q
+  where
+    rem : Id (Id A b b) (refl A b) (comp A b b b (refl A b) (refl A b))
+    rem = compInvIdr A b b (refl A b)
+
+compIdl : (A : U) -> (b c : A) -> (q : Id A b c) ->
+             Id (Id A b c) (comp A b b c (refl A b) q) q
+compIdl A b c q = inv (Id A b c) q (comp A b b c (refl A b) q) (compInvIdl A b c q)
+
+compInv : (A : U) -> (a b c : A) -> Id A a b -> Id A a c -> Id A b c
+compInv A a b c p r = subst A (\ x -> Id A x c) a b p r
+
+compInvIdl' : (A : U) (a b : A) (p : Id A a b) ->
+               Id (Id A a b) p (compInv A a a b (refl A a) p)
+compInvIdl' A a b p = substeq A (\x -> Id A x b) a p
+
+idEuclid : (A : U) -> euclidean A (Id A)
+idEuclid A a b c p r = comp A a c b p (inv A b c r)
+
+compUp : (A:U) -> (a a' b b':A) -> Id A a a' -> Id A b b' -> Id A a b -> Id A a' b'
+compUp A a a' b b' p q r =
+ subst A (\ x -> Id A x b') a a' p rem
+ where
+  rem : Id A a b'
+  rem = comp A a b b' r q
+
+compDown : (A:U) -> (a a' b b':A) -> Id A a a' -> Id A b b' -> Id A a' b' -> Id A a b
+compDown A a a' b b' p q r =
+ subst A (\ x -> Id A a x) b' b (inv A b b' q) rem
+ where
+  rem : Id A a b'
+  rem = comp A a a' b' p r
+
+lemInv : (A:U) -> (a b c : A) -> (p : Id A a b) -> (q : Id A b c) ->
+         Id (Id A b c) q (compInv A a b c p (comp A a b c p q))
+lemInv A a b c p q =
+ J A a (\ b p -> (c : A) (q : Id A b c) ->
+        Id (Id A b c) q (compInv A a b c p (comp A a b c p q))) rem b p c q
+ where
+  rem1 : (c : A) (q : Id A a c) ->
+          Id (Id A a c) (comp A a a c (refl A a) q)
+                        (compInv A a a c (refl A a) (comp A a a c (refl A a) q))
+  rem1 c q = compInvIdl' A a c (comp A a a c (refl A a) q)
+
+  rem2 : (c : A) (q : Id A a c) -> Id (Id A a c) q (comp A a a c (refl A a) q)
+  rem2 c q = compInvIdl A a c q
+
+  rem : (c : A) (q : Id A a c) ->
+          Id (Id A a c) q (compInv A a a c (refl A a) (comp A a a c (refl A a) q))
+  rem c q = comp (Id A a c) q
+                        (comp A a a c (refl A a) q)
+                        (compInv A a a c (refl A a) (comp A a a c (refl A a) q))
+                        (rem2 c q)
+                        (rem1 c q)
+
+lemSimpl : (A:U) -> (a b c : A) -> (p : Id A a b) -> (q q' : Id A b c) ->
+   Id (Id A a c) (comp A a b c p q) (comp A a b c p q') -> Id (Id A b c) q q'
+lemSimpl A a b c p q q' h =
+ compDown (Id A b c)
+           q (compInv A a b c p (comp A a b c p q)) q' (compInv A a b c p (comp A a b c p q'))
+           rem rem1 rem2
+ where
+   rem : Id (Id A b c) q (compInv A a b c p (comp A a b c p q))
+   rem = lemInv A a b c p q
+
+   rem1 : Id (Id A b c) q' (compInv A a b c p (comp A a b c p q'))
+   rem1 = lemInv A a b c p q'
+
+   rem2 : Id (Id A b c) (compInv A a b c p (comp A a b c p q))
+                        (compInv A a b c p (comp A a b c p q'))
+   rem2 = cong (Id A a c) (Id A b c) (compInv A a b c p)
+               (comp A a b c p q) (comp A a b c p q') h
+
+eqSigma : (A : U) (B : A -> U) (a b : A) (p : Id A a b)
+          (u : B a) (v : B b) (q : Id (B b) (subst A B a b p u) v) ->
+          Id (Sigma A B) (pair a u) (pair b v)
+eqSigma A B a =
+  J A a (\b p -> (u : B a) (v : B b) (q : Id (B b) (subst A B a b p u) v) ->
+         Id (Sigma A B) (pair a u) (pair b v)) rem2
+  where
+    rem1 : (u v : B a) -> Id (B a) u v ->
+           Id (Sigma A B) (pair a u) (pair a v)
+    rem1 = cong (B a) (Sigma A B) (\x -> pair a x)
+
+    rem2 : (u v : B a) -> Id (B a) (subst A B a a (refl A a) u) v ->
+           Id (Sigma A B) (pair a u) (pair a v)
+    rem2 u v q = rem1 u v q'
+      where q' : Id (B a) u v
+            q' = comp (B a) u (subst A B a a (refl A a) u) v (substeq A B a u) q
+
+eqPropFam : (A : U) (B : A -> U) (h : propFam A B) (au bv : Sigma A B) ->
+            Id A (fst A B au) (fst A B bv) -> Id (Sigma A B) au bv
+eqPropFam A B h = split
+  pair a u -> split
+    pair b v -> \p -> eqSigma A B a b p u v (h b (subst A B a b p u) v)
+
+
+
diff --git a/examples/nIso.cub b/examples/nIso.cub
new file mode 100644
--- /dev/null
+++ b/examples/nIso.cub
@@ -0,0 +1,153 @@
+module nIso where
+
+import univalence
+
+-- an example with N and 1 + N isomorphic
+
+NToOr : N -> or N Unit
+NToOr = split
+           zero -> inr tt
+           suc n -> inl n
+
+OrToN : or N Unit -> N
+OrToN = split
+            inl n -> suc n
+            inr _ -> zero
+
+secNO : (x:N) -> Id N (OrToN (NToOr x)) x
+secNO = split
+         zero -> refl N zero
+         suc n -> refl N (suc n)
+
+retNO : (z:or N Unit) -> Id (or N Unit) (NToOr (OrToN z)) z
+retNO = split
+         inl n -> refl (or N Unit) (inl n)
+         inr y -> lem y
+              where lem : (y:Unit) -> Id (or N Unit) (inr tt) (inr y)
+                    lem = split
+                            tt -> refl (or N Unit) (inr tt)
+
+isoNO : Id U N (or N Unit)
+isoNO = isoId N (or N Unit) NToOr OrToN retNO secNO
+
+-- trying to build an example which involves Kan filling for product
+
+vect : U -> N -> U
+vect A = split
+          zero -> A 
+          suc n -> and A (vect A n)
+
+pBool : N -> U
+pBool = vect Bool
+
+notSN : (x:N) -> pBool x -> pBool x
+notSN = split
+         zero -> not
+         suc n -> split
+                    pair b u -> pair (not b) (notSN n u)
+
+sBool : (x:N) -> pBool x
+sBool = split
+        zero -> true
+        suc n -> pair false (sBool n)
+
+stBool : (x:N) -> pBool x -> Bool
+stBool = split
+           zero -> \ z -> z
+           suc n -> split
+                      pair b u -> andBool b (stBool n u)
+
+hasSec : U -> U
+hasSec X = Sigma (X->U) (\ P -> (x:X) -> and (P x) (P x -> Bool))
+
+hSN : hasSec N
+hSN = pair pBool (\ n -> pair (sBool n) (stBool n))
+
+hSN' : hasSec (or N Unit)
+hSN' = subst U hasSec N (or N Unit) isoNO hSN
+
+pB' : (or N Unit) -> U
+pB' = fst ((or N Unit) -> U)  (\ P -> (x:or N Unit) -> and (P x) (P x -> Bool)) hSN'
+
+sB' : (z: or N Unit) -> and (pB' z) (pB' z -> Bool)
+sB' = snd ((or N Unit) -> U)  (\ P -> (x:or N Unit) -> and (P x) (P x -> Bool)) hSN'
+
+appBool : (A : U) -> and A (A -> Bool) -> Bool
+appBool A = split
+             pair a f -> f a
+
+pred' : or N Unit -> or N Unit
+pred' = subst U (\ X -> X -> X) N (or N Unit) isoNO pred
+
+testPred : or N Unit
+testPred = pred' (inr tt)
+
+saB' : or N Unit -> Bool
+saB' z = appBool (pB' z) (sB' z)
+
+testSN : Bool
+testSN = saB' (inr tt)
+
+testSN1 : Bool
+testSN1 = saB' (inl zero)
+
+testSN2 : Bool
+testSN2 = saB' (inl (suc zero))
+
+testSN3 : Bool
+testSN3 = saB' (inl (suc (suc zero)))
+
+add : N -> N -> N
+add x = split 
+         zero -> x
+         suc y -> suc (add x y)
+
+-- add' : (or N Unit) -> (or N Unit) -> or N Unit
+-- add' = subst U (\ X -> X -> X -> X) N (or N Unit) isoNO add
+
+
+-- a property that we can transport
+
+propAdd : (x:N) -> Id N (add zero x) x
+propAdd = split
+           zero -> refl N zero
+           suc n -> cong N N (\ x -> suc x) (add zero n) n (propAdd n)
+-- propAdd' : (z:or N Unit) 
+
+
+
+
+-- a property of N
+
+aZero : U -> U
+aZero X = Sigma X (\ z -> Sigma (X -> X -> X) (\ f -> (x:X) -> Id X (f z x) x))
+
+aZN : aZero N
+aZN = pair zero (pair add propAdd)
+
+aZN' : aZero (or N Unit)
+aZN' = subst U aZero N (or N Unit) isoNO aZN
+
+zero' : or N Unit
+zero' = fst (or N Unit) (\ z -> Sigma ((or N Unit) -> (or N Unit) -> (or N Unit)) 
+                                 (\ f -> (x:(or N Unit)) -> Id (or N Unit) (f z x) x)) aZN'
+
+sndaZN' : Sigma ((or N Unit) -> (or N Unit) -> (or N Unit)) 
+                                 (\ f -> (x:(or N Unit)) -> Id (or N Unit) (f zero' x) x)
+sndaZN' = snd (or N Unit) (\ z -> Sigma ((or N Unit) -> (or N Unit) -> (or N Unit)) 
+                                 (\ f -> (x:(or N Unit)) -> Id (or N Unit) (f z x) x)) aZN'
+
+add' : (or N Unit) -> (or N Unit) -> or N Unit
+add' = fst ((or N Unit) -> (or N Unit) -> (or N Unit)) 
+                                 (\ f -> (x:(or N Unit)) -> Id (or N Unit) (f zero' x) x) sndaZN'
+
+propAdd' : (x:or N Unit) -> Id (or N Unit) (add' zero' x) x
+propAdd' = snd ((or N Unit) -> (or N Unit) -> (or N Unit)) 
+                                 (\ f -> (x:(or N Unit)) -> Id (or N Unit) (f zero' x) x) sndaZN'
+
+
+testNO : or N Unit
+testNO = add' (inl zero) (inl (suc zero))
+
+testNO1 : Id (or N Unit) (add' zero' zero') zero'
+testNO1 = propAdd' zero'
diff --git a/examples/omega.cub b/examples/omega.cub
new file mode 100644
--- /dev/null
+++ b/examples/omega.cub
@@ -0,0 +1,130 @@
+module omega where
+
+import univalence
+
+Omega : U
+Omega = Sigma U prop
+
+-- Omega is the -set- of truth values
+-- not trivial and needs the following Lemmas
+
+-- if B is a family of proposition over A then Sigma A B -> A is injective
+
+lemPInj1 :  (A : U) (B : A -> U) -> ((x:A) -> prop (B x)) -> (a0 a1:A) -> (p:Id A a0 a1) ->
+            (b0:B a0) -> (b1:B a1) -> Id (Sigma A B) (pair a0 b0) (pair a1 b1)
+lemPInj1 A B pB a0 =  J A a0 C rem
+ where
+  C : (a1:A) -> Id A a0 a1 -> U
+  C a1 p = (b0:B a0) -> (b1:B a1) -> Id (Sigma A B) (pair a0 b0) (pair a1 b1)
+
+  rem : C a0 (refl A a0)
+  rem b0 b1 = cong (B a0) (Sigma A B) (\ b -> pair a0 b) b0 b1 (pB a0 b0 b1)
+
+lemPropInj : (A : U) (B : A -> U) -> ((x:A) -> prop (B x)) -> injective (Sigma A B) A (fst A B)
+lemPropInj A B pB =
+ split 
+  pair a0 b0 -> split
+                 pair a1 b1 -> \ p -> lemPInj1 A B pB a0 a1 p b0 b1
+
+lemPInj2 :  (A : U) (B : A -> U) -> (pB: (x:A) -> prop (B x)) -> (z:Sigma A B) ->
+            Id (Id (Sigma A B) z z) (refl (Sigma A B) z) (lemPropInj A B pB z z (refl A (fst A B z)))
+lemPInj2 A B pB = 
+ split 
+  pair a b -> rem
+   where
+    T : U
+    T = Sigma A B 
+
+    L : U
+    L = Id T (pair a b) (pair a b)
+
+    C : (a1:A) -> Id A a a1 -> U
+    C a1 p = (b0 : B a) ->  (b1:B a1) -> Id T (pair a b0) (pair a1 b1)
+
+    rem2 : C a (refl A a)
+    rem2 b0 b1 = cong (B a) T (\ b -> pair a b) b0 b1 (pB a b0 b1)
+
+    rem1 : Id (C a (refl A a)) rem2 (lemPInj1 A B pB a a (refl A a))
+    rem1 = Jeq A a C rem2
+             
+    Lb : U
+    Lb = Id (B a) b b
+
+    rem4 : Id Lb  (refl (B a) b) (pB a b b)
+    rem4 = propUIP (B a) (pB a) b b (refl (B a) b) (pB a b b)
+
+    rem3 : Id L (cong (B a) T (\ b -> pair a b) b b (refl (B a) b)) (rem2 b b)
+    rem3 = cong Lb L (cong (B a) T (\ b -> pair a b) b b) (refl (B a) b) (pB a b b) rem4
+        
+    rem5 : Id ((b1 : B a) -> Id T (pair a b) (pair a b1)) (rem2 b) (lemPInj1 A B pB a a (refl A a) b)
+    rem5 = appEq (B a) (\ b0 -> (b1 : B a) -> Id T (pair a b0) (pair a b1)) b rem2 (lemPInj1 A B pB a a (refl A a)) rem1
+     
+    rem6 : Id L (rem2 b b) (lemPInj1 A B pB a a (refl A a) b b)
+    rem6 = appEq (B a) (\ b1 -> Id T (pair a b) (pair a b1)) b (rem2 b) (lemPInj1 A B pB a a (refl A a) b) rem5
+
+    rem7 : Id L (refl T (pair a b)) (cong (B a) T (\ b -> pair a b) b b (refl (B a) b))
+    rem7 = congRefl (B a) T (\ b -> pair a b) b
+
+    rem8 : Id L (refl T (pair a b)) (rem2 b b)
+    rem8 = comp L (refl T (pair a b)) (cong (B a) T (\ b -> pair a b) b b (refl (B a) b)) (rem2 b b) rem7 rem3
+
+    rem : Id L (refl T (pair a b)) (lemPInj1 A B pB a a (refl A a) b b)
+    rem = comp L (refl T (pair a b)) (rem2 b b) (lemPInj1 A B pB a a (refl A a) b b) rem8 rem6
+
+-- we should be able to deduce from all this that Omega is a set
+
+isTrue : Omega -> U
+isTrue = fst U prop
+
+lemIsTrue : (x y : Omega) -> (isTrue x -> isTrue y) -> (isTrue y -> isTrue x) -> Id Omega x y
+lemIsTrue x y f g = injf x y rem
+ where 
+   G : (x:Omega) -> prop (isTrue x)
+   G = snd U prop
+
+   injf : injective Omega U isTrue
+   injf = lemPropInj U prop propIsProp
+
+   rem : Id U (isTrue x) (isTrue y)
+   rem = propId (isTrue x) (isTrue y) (G x) (G y) f g 
+
+
+omegaIsSet : set Omega
+omegaIsSet = rem4
+ where
+   rem : (A:U) -> prop (prop A)
+   rem = propIsProp
+
+   g : (x:Omega) -> prop (isTrue x)
+   g = snd U prop
+
+   injf : injective Omega U isTrue
+   injf = lemPropInj U prop rem 
+
+   rem1 : (z:Omega) -> Id (Id Omega z z) (refl Omega z) (injf z z (refl U (isTrue z)))
+   rem1 = lemPInj2 U prop rem
+   
+   rem2 : (x y : Omega) -> (p : Id Omega x y) -> Id (Id Omega x y) p (injf x y (cong Omega U isTrue x y p))
+   rem2 = lemInj Omega U isTrue injf rem1
+
+   rem3 : (x y : Omega) -> prop (Id U (isTrue x) (isTrue y))
+   rem3 x y = idPropIsProp (isTrue x) (isTrue y) (g x) (g y)
+
+   rem4 : (x y : Omega) -> (p q : Id Omega x y) -> Id (Id Omega x y) p q
+   rem4 x y p q = compDown (Id Omega x y) p (injf x y (h p)) q (injf x y (h q)) rem6 rem7 rem8
+     where
+        h : Id Omega x y -> Id U (isTrue x) (isTrue y)
+        h = cong Omega U isTrue x y
+
+        rem5 : Id (Id U (isTrue x) (isTrue y)) (h p) (h q)
+        rem5 = rem3 x y (h p) (h q)
+
+        rem6 : Id (Id Omega x y) p (injf x y (h p))
+        rem6 = rem2 x y p
+
+        rem7 : Id (Id Omega x y) q (injf x y (h q))
+        rem7 = rem2 x y q
+
+        rem8 : Id (Id Omega x y) (injf x y (h p)) (injf x y (h q))
+        rem8 = cong (Id U (isTrue x) (isTrue y)) (Id Omega x y) (injf x y) (h p) (h q) rem5
+
diff --git a/examples/prelude.cub b/examples/prelude.cub
new file mode 100644
--- /dev/null
+++ b/examples/prelude.cub
@@ -0,0 +1,291 @@
+-- some basic data types and functions
+
+module prelude where
+
+import primitive
+
+rel : U -> U
+rel A = A -> A -> U
+
+euclidean : (A : U) -> rel A -> U
+euclidean A R = (a b c : A) -> R a c -> R b c -> R a b
+
+and : (A B : U) -> U
+and A B = Sigma A (\_ -> B)
+
+Pi : (A:U) -> (A -> U) -> U
+Pi A B = (x:A) -> B x
+
+fst : (A : U) (B : A -> U) -> Sigma A B -> A
+fst A B = split
+  pair a b -> a
+
+snd : (A : U) (B : A -> U) (p : Sigma A B) -> B (fst A B p)
+snd A B = split
+  pair a b -> b
+
+-- some data types
+
+Unit : U
+data Unit = tt
+
+N : U
+data N = zero | suc (n : N)
+
+Bool : U
+data Bool = true | false
+
+andBool : Bool -> Bool -> Bool
+andBool = split
+  true -> \x -> x
+  false -> \x -> false
+
+not : Bool -> Bool
+not = split
+  true -> false
+  false -> true
+
+isEven : N -> Bool
+isEven = split
+  zero -> true
+  suc n -> not (isEven n)
+
+pred : N -> N
+pred = split
+        zero -> zero
+        suc n -> n
+
+subst : (A : U) (P : A -> U) (a x : A) (p : Id A a x) -> P a -> P x
+subst A P a x p d = J A a (\ x q -> P x) d x p
+
+substInv : (A : U) (P : A -> U) (a x : A) (p : Id A a x) -> P x -> P a
+substInv A P a x p = subst A (\ y -> P y -> P a) a x p (\ h -> h)
+
+substeq : (A : U) (P : A -> U) (a : A) (d : P a) ->
+          Id (P a) d (subst A P a a (refl A a) d)
+substeq A P a d = Jeq A a (\ x q -> P x) d
+
+cong : (A B : U) (f : A -> B) (a b : A) (p : Id A a b) -> Id B (f a) (f b)
+cong A B f a b p = subst A (\x -> Id B (f a) (f x)) a b p (refl B (f a))
+
+N0 : U
+data N0 =
+
+efq : (A : U) -> N0 -> A
+efq A = split {}
+
+neg : U -> U
+neg A = A -> N0
+
+or : U -> U -> U
+data or A B = inl (a : A) | inr (b : B)
+
+orElim : (A B C:U) -> (A->C) -> (B -> C) -> or A B -> C
+orElim A B C f g = 
+ split
+  inl a -> f a
+  inr b -> g b
+
+dec : U -> U
+dec A = or A (neg A)
+
+discrete : U -> U
+discrete A = (a b : A) -> dec (Id A a b)
+
+tnotf : neg (Id Bool (true) (false))
+tnotf h =
+  let
+    T : Bool -> U
+    T = split
+          true  -> N
+          false -> N0
+  in subst Bool T (true) (false) h (zero)
+
+fnott : neg (Id Bool false true)
+fnott h = substInv Bool T false  true h zero
+  where
+    T : Bool -> U
+    T = split
+          true  -> N
+          false -> N0
+
+boolDec : discrete Bool
+boolDec = split
+  true -> split
+    true -> inl (refl Bool (true))
+    false -> inr tnotf
+  false -> split
+    true -> inr fnott
+    false -> inl (refl Bool (false))
+
+notK : (x : Bool) -> Id Bool (not (not x)) x
+notK = split
+  true  -> refl Bool (true)
+  false -> refl Bool (false)
+
+appId : (A B : U) (a : A) (f0 f1 : A -> B) -> Id (A -> B) f0 f1 -> Id B (f0 a) (f1 a)
+appId A B a = cong (A->B) B (\ f -> f a) 
+
+appEq : (A :U) (B : A -> U) (a : A) (f0 f1 : Pi A B) -> Id (Pi A B) f0 f1 -> Id (B a) (f0 a) (f1 a)
+appEq A B a = cong (Pi A B) (B a) (\ f -> f a) 
+
+sId : (A : U) (a : A) -> pathTo A a
+sId A a = pair a (refl A a)
+
+tId : (A : U) (a : A) (v : pathTo A a) -> Id (pathTo A a) (sId A a) v
+tId A a = split 
+  pair x p -> rem x a p 
+  where 
+  rem : (x y : A) (p : Id A x y) -> Id (pathTo A y) (sId A y) (pair x p)
+  rem x = J A x (\y p -> Id (pathTo A y) (sId A y) (pair x p)) (refl (pathTo A x) (sId A x))
+
+typEquivS : (A B : U) -> (f : A -> B) -> U
+typEquivS A B f = (y : B) -> fiber A B f y
+
+typEquivT : (A B : U) -> (f : A -> B) -> (typEquivS A B f) -> U
+typEquivT A B f s =  (y : B) -> (v : fiber A B f y) -> Id (fiber A B f y) (s y) v
+
+isEquiv : (A B : U) (f : A -> B) -> U
+isEquiv A B f = Sigma (typEquivS A B f) (typEquivT A B f)
+
+isEquivEq : (A B : U) (f : A -> B) -> isEquiv A B f -> Id U A B
+isEquivEq A B f = split 
+  pair s t -> equivEq A B f s t
+
+-- not needed if we have eta
+
+etaId : (A:U) (B:A -> U) -> (f:Pi A B) -> Id (Pi A B) (\ x -> f x) f
+etaId A B f = funExt A B (\ x -> f x) f (\ x -> refl (B x) (f x))
+
+funSplit : (A:U) (B:A->U) (C: (Pi A B) -> U) -> ((f:Pi A B) -> C (\ x -> f x)) -> Pi (Pi A B) C
+funSplit A B C eC f = subst (Pi A B) C (\ x -> f x) f (etaId A B f) (eC f)
+
+surjPair : (A:U) (B:A -> U) -> (s:Sigma A B) -> Id (Sigma A B) (pair (fst A B s) (snd A B s)) s
+surjPair A B = split
+                pair a b -> refl (Sigma A B) (pair a b)
+
+lemProp1 : (A : U) -> (A -> prop A) -> prop A
+lemProp1 A h a0 = h a0 a0
+
+propN0 : prop N0
+propN0 a b = efq (Id N0 a b) a
+
+-- a product of propositions is a proposition
+
+isPropProd : (A:U) (B:A->U) (pB : (x:A) -> prop (B x)) -> prop (Pi A B)
+isPropProd A B pB f0 f1 = funExt A B f0 f1 (\ x -> pB x (f0 x) (f1 x))
+
+propNeg : (A:U) -> prop (neg A)
+propNeg A = isPropProd A (\ _ -> N0) (\ _ -> propN0)
+
+lemProp2 : (A : U) -> prop A -> prop (dec A)
+lemProp2 A pA  = split
+ inl a -> split 
+           inl b -> cong A (dec A) (\ x -> inl x) a b (pA a b)
+           inr nb -> efq (Id (dec A) (inl a) (inr nb)) (nb a)
+ inr na -> split 
+           inl b -> efq (Id (dec A) (inr na) (inl b)) (na b)
+           inr nb -> cong (neg A) (dec A) (\ x -> inr x) na nb (propNeg A na nb)
+
+singl : (A:U) -> A -> U
+singl = pathTo
+-- singl = Sigma A (\ x -> Id A x a)
+
+idIsEquiv : (A:U) -> isEquiv A A (id A)
+idIsEquiv A = pair (sId A) (tId A)
+
+propUnit : prop Unit
+propUnit = split
+  tt -> split
+     tt -> refl Unit (tt)
+
+sucInj : (n m : N) -> Id N (suc n) (suc m) -> Id N n m
+sucInj n m h = cong N N pred (suc n) (suc m) h
+
+decEqCong : (A B : U) (f : A -> B) (g : B -> A) -> dec A -> dec B
+decEqCong A B f g = split
+  inl a -> inl (f a)
+  inr h -> inr (\b -> h (g b))
+
+znots : (n : N) -> neg (Id N (zero) (suc n))
+znots n h = subst N T zero (suc n) h zero
+  where
+    T : N -> U
+    T = split
+          zero -> N
+          suc n -> N0
+
+snotz : (n : N) -> neg (Id N (suc n) zero)
+snotz n h = substInv N T (suc n) zero h zero
+  where
+    T : N -> U
+    T = split
+          zero -> N
+          suc n -> N0
+
+natDec : discrete N
+natDec = split
+  zero  -> split
+    zero -> inl (refl N zero)
+    suc m -> inr (znots m)
+  suc n -> split
+    zero -> inr (snotz n)
+    suc m -> decEqCong (Id N n m) (Id N (suc n) (suc m))
+                       (cong N N (\ x -> suc x) n m) (sucInj n m) (natDec n m)
+
+propPi : (A : U) (B : A -> U) -> ((x : A) -> prop (B x)) -> prop ((x : A) -> B x)
+propPi A B h f0 f1 = funExt A B f0 f1 (\x -> h x (f0 x) (f1 x)) 
+
+propImply : (A B : U) -> (A -> prop B) -> prop (A -> B)
+propImply A B h = propPi A (\_ -> B) h
+
+propFam : (A : U) (B : A -> U) -> U
+propFam A B = (a : A) -> prop (B a)
+
+reflexive : (A : U) -> rel A -> U
+reflexive A R = (a : A) -> R a a
+
+symmetry : (A : U) -> rel A -> U
+symmetry A R = (a b : A) -> R a b -> R b a
+
+equivalence : (A : U) -> rel A -> U
+equivalence A R = and (reflexive A R) (euclidean A R)
+
+eqToRefl : (A : U) (R : rel A) -> equivalence A R -> reflexive A R
+eqToRefl A R = split
+  pair r _ -> r
+
+eqToEucl : (A : U) (R : rel A) -> equivalence A R -> euclidean A R
+eqToEucl A R = split
+  pair _ e -> e
+
+eqToSym : (A : U) (R : rel A) -> equivalence A R -> symmetry A R
+eqToSym A R = split
+  pair r e -> \a b -> e b a b (r b)
+
+eqToInvEucl : (A : U) (R : rel A) -> equivalence A R ->
+              (a b c : A) -> R c a -> R c b -> R a b
+eqToInvEucl A R eq a b c p q =
+  eqToEucl A R eq a b c (eqToSym A R eq c a p) (eqToSym A R eq c b q)
+
+-- definition by case on a decidable equality
+-- needed for Nicolai Kraus example
+
+defCase : (A X:U) -> X -> X -> dec A -> X
+defCase A X x0 x1 = 
+ split
+  inl _ -> x0
+  inr _ -> x1
+
+IdDefCasel : (A X:U) (x0 x1 : X) (p : dec A)  -> A -> 
+             Id X (defCase A X x0 x1 p) x0
+IdDefCasel A X x0 x1 = split
+ inl _ -> \ _ -> refl X x0
+ inr v -> \ u -> efq (Id X (defCase A X x0 x1 (inr v)) x0) (v u)
+
+IdDefCaser : (A X:U) (x0 x1 : X) (p : dec A)  -> (neg A) -> 
+             Id X (defCase A X x0 x1 p) x1
+IdDefCaser A X x0 x1 = split
+ inl u -> \ v -> efq (Id X (defCase A X x0 x1 (inl u)) x1) (v u)
+ inr _ -> \ _ -> refl X x1
+
diff --git a/examples/primitive.cub b/examples/primitive.cub
new file mode 100644
--- /dev/null
+++ b/examples/primitive.cub
@@ -0,0 +1,68 @@
+module primitive where
+
+Id   : (A : U) (a b : A) -> U
+Id = PN
+
+refl : (A : U) (a : A) -> Id A a a
+refl = PN
+funExt : (A : U) (B : (a : A) -> U) (f g : (a : A) -> B a)
+         (p : ((x : A) -> (Id (B x) (f x) (g x)))) -> Id ((y : A) -> B y) f g
+funExt = PN
+
+J : (A : U) (a : A) -> (C : (x : A) -> Id A a x -> U) -> C a (refl A a) ->
+      (x : A) -> (p : Id A a x) -> C x p
+J = PN
+
+Jeq : (A : U) (a : A) -> (C : (x : A) -> Id A a x -> U) -> (d : C a (refl A a)) ->
+        Id (C a (refl A a)) d (J A a C d a (refl A a))
+Jeq = PN
+
+inh : U -> U
+inh = PN
+
+inc : (A : U) -> A -> inh A
+inc = PN
+
+prop : U -> U
+prop A = (a b : A) -> Id A a b
+
+squash : (A : U) -> prop (inh A)
+squash = PN
+
+inhrec : (A : U) (B : U) (p : prop B) (f : A -> B) (a : inh A) -> B
+inhrec = PN
+
+Sigma : (A : U) (B : A -> U) -> U
+data Sigma A B = pair (x : A) (y : B x)
+
+fiber : (A B : U) (f : A -> B) (y : B) -> U
+fiber A B f y = Sigma A (\x -> Id B (f x) y)
+
+id : (A : U) -> A -> A
+id A a = a
+
+pathTo : (A:U) -> A -> U
+pathTo A = fiber A A (id A)
+
+equivEq : (A B : U) (f : A -> B) (s : (y : B) -> fiber A B f y)
+            (t : (y : B) -> (v : fiber A B f y) -> Id (fiber A B f y) (s y) v) ->
+            Id U A B
+equivEq = PN
+
+transport : (A B : U) -> Id U A B -> A -> B
+transport = PN
+
+transportRef : (A : U) -> (a : A) -> Id A a (transport A A (refl U A) a)
+transportRef = PN
+
+equivEqRef : (A : U) -> (s : (y : A) -> pathTo A y) -> 
+             (t : (y : A) -> (v : pathTo A y) -> Id (pathTo A y) (s y) v) ->
+             Id (Id U A A) (refl U A) (equivEq A A (id A) s t)
+equivEqRef = PN	       
+
+transpEquivEq : (A B : U) -> (f : A -> B) (s : (y : B) -> fiber A B f y) -> 
+                (t : (y : B) -> (v : fiber A B f y) -> Id (fiber A B f y) (s y) v) ->
+                (a : A) -> Id B (f a) (transport A B (equivEq A B f s t) a)
+transpEquivEq = PN
+
+
diff --git a/examples/quotient.cub b/examples/quotient.cub
new file mode 100644
--- /dev/null
+++ b/examples/quotient.cub
@@ -0,0 +1,153 @@
+module quotient where
+
+import description
+import exists
+import hedberg
+
+Quot : (A : U) (R : rel A) -> U
+data Quot A R =
+  class (P : A -> U)
+        (un : (a b : A) -> P a -> P b -> R a b)
+        (cp : (a b : A) -> P a -> R a b -> P b)
+        (ex : exists A P)
+        (pr : propFam A P)
+
+propRel : (A : U) (R : rel A) -> U
+propRel A R = (a b : A) -> prop (R a b)
+
+canSurj : (A : U) (R : rel A) -> equivalence A R -> propRel A R ->
+            A -> Quot A R
+canSurj A R h h' c = class (R c) un cp ex pr
+  where un : (a b : A) -> R c a -> R c b -> R a b
+        un a b p q = eqToInvEucl A R h a b c p q
+
+        cp : (a b : A) -> R c a -> R a b -> R c b
+        cp a b p q = eqToEucl A R h c b a p (eqToSym A R h a b q)
+        ex : exists A (R c)
+        ex = inc (Sigma A (R c)) (pair c (eqToRefl A R h c))
+        pr : propFam A (R c)
+        pr a = h' c a
+
+resp : (A B : U) (R : rel A) (f : A -> B) -> U
+resp A B R f = (x y : A) -> R x y -> Id B (f x) (f y)
+
+image : (A B : U) (f : A -> B) (P : A -> U) -> B -> U
+image A B f P b = exists A (\a -> and (P a) (Id B (f a) b))
+
+propAnd : (A B : U) -> prop A -> prop B -> prop (and A B)
+propAnd A B p q = propSig A F rem (\a a' _ _ -> p a a')
+  where F : A -> U
+        F a = B
+        rem : propFam A F
+        rem a = q
+
+-- should also contain the proof that Quot A R is a set and that
+-- the equivalence class of two related elements are equal
+-- but what we have is enough to test that we can compute with the axiom 
+-- of description
+
+univQuot : (A B : U) (R : rel A) (f : A -> B) ->
+           set B -> resp A B R f -> (eqR : equivalence A R) (pR : propRel A R)
+                 (_ : Quot A R) -> B
+univQuot A B R f uip fresp eqR pR = g -- pair g rem
+  where
+    g : Quot A R -> B
+    g = split
+      class P un cp ex pr -> iota B imfP rem1 rem2
+        where
+          imfP : B -> U
+          imfP = image A B f P
+          rem1 : propFam B imfP
+          rem1 b = squash (Sigma A (\a -> and (P a) (Id B (f a) b)))
+          S : B -> A -> U
+          S b a = and (P a) (Id B (f a) b)
+
+          rem3 : Sigma A P -> exists B imfP
+          rem3 = split
+            pair a p -> inc (Sigma B imfP)
+                        (pair (f a) (inc (Sigma A (S (f a))) (pair a (pair p (refl B (f a))))))
+          rem4 : exists B imfP
+          rem4 = inhrec (Sigma A P) (exists B imfP) (squash (Sigma B imfP)) rem3 ex
+
+          rem6 : (b b' : B) (a a' : A) (_ : and (P a) (Id B (f a) b))
+             (_ : and (P a') (Id B (f a') b')) -> Id B b b'
+          rem6 b b' a a' = split
+            pair p ea -> split
+              pair p' ea' -> compUp B (f a) b (f a') b' ea ea' rem7
+                where rem8 : R a a'
+                      rem8 = un a a' p p'
+                      rem7 : Id B (f a) (f a')
+                      rem7 = fresp a a' rem8
+                     
+          rem7 : (b b' : B)  (_ : Sigma A (S b)) (_ : Sigma A (S b'))
+             -> Id B b b'
+          rem7 b b' = split
+            pair a p -> split
+              pair a' p' -> rem6 b b' a a' p p'
+
+          rem8 : (b b' : B) -> Sigma A (S b) -> exists A (S b') -> Id B b b'
+          rem8 b b' h = exElim A (S b') (Id B b b') (uip b b') (rem7 b b' h)
+
+          rem9 : (b b' : B) -> exists A (S b) -> exists A (S b') -> Id B b b'
+          rem9 b b' h h' = exElim A (S b) (Id B b b') (uip b b')
+                        (\h'' -> rem8 b b' h'' h') h
+
+          rem5 : atmostOne B imfP
+          rem5 = rem9
+
+          rem2 : exactOne B imfP
+          rem2 = pair rem4 rem5
+
+
+kernel : (A B : U) (f : A -> B) -> rel A
+kernel A B f a a' = Id B (f a) (f a')
+
+kerRef : (A B : U) (f : A -> B) -> reflexive A (kernel A B f)
+kerRef A B f a = refl B (f a)
+
+kerEucl : (A B : U) (f : A -> B) -> euclidean A (kernel A B f)
+kerEucl A B f a b c p q = compInv B (f c) (f a) (f b) rem rem1
+ where rem : Id B (f c) (f a)
+       rem = inv B (f a) (f c) p
+       rem1 : Id B (f c) (f b)
+       rem1 = inv B (f b) (f c) q
+
+kerEquiv : (A B : U) (f : A -> B) -> equivalence A (kernel A B f)
+kerEquiv A B f = pair (kerRef A B f) (kerEucl A B f)
+
+
+mod2 : rel N
+mod2 = kernel N Bool isEven
+
+propMod2 : propRel N mod2
+propMod2 n m = boolIsSet (isEven n) (isEven m)
+
+Z2 : U
+Z2 = Quot N mod2
+
+respIsEven : resp N Bool mod2 isEven
+respIsEven n m h = h
+
+barIsEven : Z2 -> Bool
+barIsEven = univQuot N Bool mod2 isEven boolIsSet respIsEven (kerEquiv N Bool isEven) propMod2
+
+
+five : N
+five = suc (suc (suc (suc  (suc (zero)))))
+
+eigth : N
+eigth = suc (suc (suc five))
+
+fiveBar : Z2
+fiveBar = canSurj N mod2 (kerEquiv N Bool isEven) propMod2 five
+
+eigthBar : Z2
+eigthBar = canSurj N mod2 (kerEquiv N Bool isEven) propMod2 eigth
+
+test5 : Bool
+test5 = barIsEven fiveBar
+
+test8 : Bool
+test8 = barIsEven eigthBar
+
+
diff --git a/examples/set.cub b/examples/set.cub
new file mode 100644
--- /dev/null
+++ b/examples/set.cub
@@ -0,0 +1,54 @@
+module set where
+
+import lemId
+
+UIP : U -> U
+UIP A = (a b : A) -> prop (Id A a b)
+
+set : U -> U
+set = UIP
+
+lem1 : (A :U) -> (a:A) -> (h : (x:A) -> Id A a x) ->
+       (x y : A) -> (p : Id A x y) -> Id (Id A a y) (comp A a x y (h x) p) (h y)
+lem1 A a h x =
+  J A x (\ y p -> Id (Id A a y) (comp A a x y (h x) p) (h y)) rem
+ where
+   rem : Id (Id A a x) (comp A a x x (h x) (refl A x)) (h x)
+   rem = compIdr A a x (h x)
+
+lem2 : (A :U) -> (a:A) -> ((x:A) -> Id A a x) -> UIP A
+lem2 A a h x y p q =
+ lemSimpl A a x y (h x) p q rem
+   where
+     remp : Id (Id A a y) (comp A a x y (h x) p) (h y)
+     remp = lem1 A a h x y p
+     remq : Id (Id A a y) (comp A a x y (h x) q) (h y)
+     remq = lem1 A a h x y q
+     rem : Id (Id A a y) (comp A a x y (h x) p) (comp A a x y (h x) q)
+     rem = compDown (Id A a y) (comp A a x y (h x) p) (h y) (comp A a x y (h x) q) (h y)
+               remp remq (refl (Id A a y) (h y))
+
+propUIP : (A:U) -> prop A -> UIP A
+propUIP A h a = lem2 A a (h a) a
+
+propIsProp : (A : U) -> prop (prop A)
+propIsProp A = lemProp1 (prop A) rem
+  where
+   rem : prop A -> prop (prop A)
+   rem pA = rem3 
+    where
+      rem1 : UIP A
+      rem1 = propUIP A pA
+
+      rem2 : (a0:A) -> (f g : Pi A (Id A a0)) -> Id (Pi A (Id A a0)) f g
+      rem2 a0 f g = funExt A (\ a1 -> Id A a0 a1) f g (\ a1 -> rem1 a0 a1 (f a1) (g a1))
+
+      rem3 : (f g : (a0 a1 :A) -> Id A a0 a1) -> Id ((a0 a1:A) -> Id A a0 a1) f g
+      rem3 f g = funExt A (\ a0 -> (Pi A (Id A a0))) f g (\ a0 -> rem2 a0 (f a0) (g a0))
+
+lemunit : set Unit
+lemunit = propUIP Unit propUnit
+
+test2 : Id (Id Unit tt tt) (refl Unit tt) (refl Unit tt)
+test2 = lemunit tt tt (refl Unit tt) (refl Unit tt)
+
diff --git a/examples/subset.cub b/examples/subset.cub
new file mode 100644
--- /dev/null
+++ b/examples/subset.cub
@@ -0,0 +1,61 @@
+module subset where
+
+import univalence
+
+-- a non trivial equivalence: two different ways to represent subsets
+-- this is not finished
+-- it should provide a non trivial equivalence
+
+subset1 : U -> U
+subset1 A = Sigma U (\ X -> X -> A)
+
+subset2 : U -> U
+subset2 A = A -> U
+
+-- map in both directions
+
+sub12 : (A:U) -> subset1 A -> subset2 A
+sub12 A = split
+           pair X f -> fiber X A f
+
+sub21 : (A:U) -> subset2 A -> subset1 A
+sub21 A P = pair (Sigma A P) (fst A P)
+
+lem2Sub : (A:U) (P: A -> U) (a:A) -> Id U (fiber (Sigma A P) A (fst A P) a) 
+                                          (Sigma (Sigma A (\ x -> Id A x a)) (\ z -> P (fst A (\ x -> Id A x a) z)))
+lem2Sub A P a = isoId F T f g sfg rfg
+ where
+   T : U
+   T = Sigma (Sigma A (\ x -> Id A x a)) (\ z -> P (fst A (\ x -> Id A x a) z))
+
+   F : U
+   F = fiber (Sigma A P) A (fst A P) a
+
+   f : F -> T
+   f = split
+        pair z p -> rem z p 
+          where rem : (z : Sigma A P) (p : Id A (fst A P z) a) -> T
+                rem = split
+                      pair x u -> \ p -> pair (pair x p) u
+
+   g : T -> F
+   g = split
+        pair z u -> rem z u
+          where rem : (z: Sigma A (\x -> Id A x a)) -> (u: P (fst A (\ x -> Id A x a) z)) -> fiber (Sigma A P) A (fst A P) a
+                rem = split
+                        pair x p -> \ u -> pair (pair x u) p
+
+   rfg : (v :F) -> Id F (g (f v)) v
+   rfg = split
+          pair z p -> rem z p
+           where rem : (z : Sigma A P) (p : Id A (fst A P z) a) -> Id (fiber (Sigma A P) A (fst A P) a) (g (f (pair z p))) (pair z p)
+                 rem = split
+                        pair x u -> \ p -> refl F (pair (pair x u) p)
+
+   sfg : (v:T) -> Id T (f (g v)) v
+   sfg = split
+          pair z u -> rem z u
+            where rem : (z: Sigma A (\x -> Id A x a)) -> (u: P (fst A (\ x -> Id A x a) z)) -> Id T (f (g (pair z u))) (pair z u)
+                  rem = split
+                        pair x p -> \ u -> refl T (pair (pair x p) u)
+
diff --git a/examples/swap.cub b/examples/swap.cub
new file mode 100644
--- /dev/null
+++ b/examples/swap.cub
@@ -0,0 +1,147 @@
+module swap where
+
+import gradLemma
+
+-- the swap function defines an equality
+
+swap : (A B :U) -> and A B -> and B A
+swap A B = split
+            pair a b -> pair b a
+
+lemSwap : (A B:U) -> (z: and A B) -> Id (and A B) (swap B A (swap A B z)) z
+lemSwap A B = split
+               pair a b -> refl (and A B) (pair a b)
+
+eqSwap : (A B :U) -> Id U (and A B) (and B A)
+eqSwap A B = isEquivEq (and A B) (and B A) (swap A B) rem
+ where
+  rem : isEquiv (and A B) (and B A) (swap A B)
+  rem = gradLemma (and A B) (and B A) (swap A B) (swap B A) (lemSwap B A) (lemSwap A B)
+
+-- a simple test example
+
+incr : and Bool N -> and Bool N
+incr = split
+     pair b n -> pair b (suc n)
+
+incr' : and N Bool -> and N Bool
+incr' = subst U (\ X -> X -> X) (and Bool N) (and N Bool) (eqSwap Bool N) incr
+
+test6 : and N Bool
+test6 = incr' (pair zero true)
+
+test7 : and N Bool
+test7 = incr' (pair (suc zero) true)
+
+-- what happens if we compose eqSwap with itself?
+
+eqSwap2 : (A B : U) -> Id U (and A B) (and A B)
+eqSwap2 A B = comp U (and A B) (and B A) (and A B) (eqSwap A B) (eqSwap B A)
+
+incr2 : and Bool N -> and Bool N
+incr2 = subst U (\ X -> X -> X) (and Bool N) (and Bool N) (eqSwap2 Bool N) incr
+
+test8 : and Bool N
+test8 = incr2 (pair true zero)
+
+test9 : and Bool N
+test9 = incr2 (pair true (suc zero))
+
+-- what happens if we compose eqSwap with its inverse?
+
+eqSwap3 : (A B : U) -> Id U (and A B) (and A B)
+eqSwap3 A B = comp U (and A B) (and B A) (and A B) (eqSwap A B) (inv U (and A B) (and B A) (eqSwap A B))
+
+incr3 : and Bool N -> and Bool N
+incr3 = subst U (\ X -> X -> X) (and Bool N) (and Bool N) (eqSwap2 Bool N) incr
+
+test10 : and Bool N
+test10 = incr3 (pair true zero)
+
+test11 : and Bool N
+test11 = incr3 (pair true (suc zero))
+
+
+-- simple example with swap and product
+
+eqPi : (A:U) -> (B0 B1 : A -> U) -> ((x:A)  -> Id U (B0 x) (B1 x)) -> Id U (Pi A B0) (Pi A B1)
+eqPi A B0 B1 eB = cong (A->U) U (Pi A) B0 B1 rem
+ where rem : Id (A -> U) B0 B1
+       rem = funExt A (\ _ -> U) B0 B1 eB
+
+eqSig : (A:U) -> (B0 B1 : A -> U) -> ((x:A)  -> Id U (B0 x) (B1 x)) -> Id U (Sigma A B0) (Sigma A B1)
+eqSig A B0 B1 eB = cong (A->U) U (Sigma A) B0 B1 rem
+ where rem : Id (A -> U) B0 B1
+       rem = funExt A (\ _ -> U) B0 B1 eB
+
+eqPiTest : Id U (Pi U (\ X -> X -> and X Bool)) (Pi U (\ X -> X -> and Bool X))
+eqPiTest = eqPi U (\ X -> X -> and X Bool) (\ X -> X -> and Bool X) rem1
+ where rem : (X:U) -> Id U (and X Bool) (and Bool X)
+       rem X = eqSwap X Bool
+
+       rem1 : (X:U) -> Id U (X -> and X Bool) (X -> and Bool X)
+       rem1 X = eqPi X (\ _ -> and X Bool) (\ _ -> and Bool X) (\ _ -> rem X)
+
+       
+transPiTest : ((X:U) -> X -> and X Bool) -> (X:U) -> X -> and Bool X
+transPiTest = transport  (Pi U (\ X -> X -> and X Bool)) (Pi U (\ X -> X -> and Bool X)) eqPiTest
+
+test12 : and Bool N
+test12 = transPiTest (\ X -> \ x -> pair x true) N zero
+
+eqSigTest : Id U (Sigma U (\ X -> and X Bool)) (Sigma U (\ X -> and Bool X))
+eqSigTest = eqSig U (\ X -> and X Bool) (\ X -> and Bool X) rem1
+ where rem1 : (X:U) -> Id U (and X Bool) (and Bool X)
+       rem1 X = eqSwap X Bool
+
+transSigTest : (Sigma U (\ X -> and X Bool)) -> Sigma U (and Bool)
+transSigTest = transport (Sigma U (\ X -> and X Bool)) (Sigma U (\ X -> and Bool X)) eqSigTest
+
+test13 : U
+test13 = fst U (and Bool) (transSigTest (pair Bool (pair false true)))
+
+test14 : and Bool test13
+test14 = snd U (and Bool) (transSigTest (pair Bool (pair false true)))
+
+test15 : Bool
+test15 = fst Bool (\ _ -> test13) test14
+
+eqSig1Test : Id U (Sigma U (\ X -> and N Bool)) (Sigma U (\ X -> and Bool N))
+eqSig1Test = eqSig U (\ X -> and N Bool) (\ X -> and Bool N) rem1
+ where rem1 : (X:U) -> Id U (and N Bool) (and Bool N)
+       rem1 X = eqSwap N Bool
+
+transSig1Test : (and U (and N Bool)) -> and U (and Bool N)
+transSig1Test = transport (and U (and N Bool)) (and U (and Bool N)) eqSig1Test
+
+eqSig2Test : Id U (Sigma N (\ _ -> and N Bool)) (Sigma N (\ _ -> and Bool N))
+eqSig2Test = eqSig N (\ _ -> and N Bool) (\ _ -> and Bool N) rem1
+ where rem1 : N -> Id U (and N Bool) (and Bool N)
+       rem1 n = eqSwap N Bool
+
+transSig2Test : (Sigma N (\ X -> and N Bool)) -> Sigma N (\ _ -> and Bool N)
+transSig2Test = transport (Sigma N (\ _ -> and N Bool)) (Sigma N (\ _ -> and Bool N)) eqSig2Test
+
+test213 : N
+test213 = fst N (\ _ -> and Bool N) (transSig2Test (pair zero (pair zero true)))
+
+test214 : and Bool N
+test214 = snd N (\ _ -> and Bool N) (transSig2Test (pair zero (pair zero true)))
+
+test215 : Bool
+test215 = fst Bool (\ _ -> N) test214
+
+--- simple test
+
+eqNN : Id U (and N N) (and N N)
+eqNN = eqSwap N N
+
+testNN : and N N
+testNN = transport (and N N) (and N N) eqNN (pair zero (suc zero))
+
+eqUU : Id U (U -> and U U) (U -> and U U)
+eqUU = eqPi U (\ _ -> and U U) (\ _ -> and U U) (\ _ -> eqSwap U U)
+
+testUU : U
+testUU = fst U (\ _ -> U) (transport (U -> and U U) (U -> and U U) eqUU (\ X -> pair X X) Bool)
+
diff --git a/examples/swapDisc.cub b/examples/swapDisc.cub
new file mode 100644
--- /dev/null
+++ b/examples/swapDisc.cub
@@ -0,0 +1,123 @@
+module swapDisc where
+
+import lemId
+
+-- defines the swap function over a discrete type and proves that this is an idempotent map
+-- needed for Nicolai Kraus example
+
+-- intermediate function
+
+auxSwapD : (X:U) -> discrete X -> X -> X -> X -> X
+auxSwapD X dX x0 x1 x = defCase (Id X x1 x) X x0 x (dX x1 x)
+
+swapDisc : (X:U) -> discrete X -> X -> X -> X -> X
+swapDisc X dX x0 x1 x = defCase (Id X x0 x) X x1 (auxSwapD X dX x0 x1 x) (dX x0 x)
+
+idSwapDisc0 : (X:U) (dX: discrete X) -> (x0 x1 : X) -> (x:X) -> Id X x0 x -> 
+     Id X (swapDisc X dX x0 x1 x) x1
+idSwapDisc0 X dX x0 x1 x eqx0x =
+ IdDefCasel (Id X x0 x) X x1 (auxSwapD X dX x0 x1 x) (dX x0 x) eqx0x
+
+idSwapDiscn0 : (X:U) (dX: discrete X) -> (x0 x1 : X) -> (x:X) -> neg (Id X x0 x) -> 
+              Id X (swapDisc X dX x0 x1 x) (auxSwapD X dX x0 x1 x)
+idSwapDiscn0 X dX x0 x1 x neqx0x =
+ IdDefCaser (Id X x0 x) X x1 (defCase (Id X x1 x) X x0 x (dX x1 x)) (dX x0 x) neqx0x
+
+idAuxSwap1 :  (X:U) (dX: discrete X) -> (x0 x1 : X) -> (x:X) -> Id X x1 x -> 
+              Id X (auxSwapD X dX x0 x1 x) x0
+idAuxSwap1 X dX x0 x1 x eqx1x =
+ IdDefCasel (Id X x1 x) X x0 x (dX x1 x) eqx1x
+
+idAuxSwapn1 :  (X:U) (dX: discrete X) -> (x0 x1 : X) -> (x:X) -> neg (Id X x1 x) -> 
+            Id X (auxSwapD X dX x0 x1 x) x
+idAuxSwapn1 X dX x0 x1 x neqx1x = 
+ IdDefCaser (Id X x1 x) X x0 x (dX x1 x) neqx1x
+
+idSwapDisc1 : (X:U) (dX: discrete X) -> (x0 x1 : X) -> neg (Id X x0 x1) -> Id X (swapDisc X dX x0 x1 x1) x0
+idSwapDisc1 X dX x0 x1 neqx0x1 = 
+ comp X (swapDisc X dX x0 x1 x1) (defCase (Id X x0 x1) X x1 x0 (dX x0 x1)) x0 rem2 rem1
+ where
+  rem : Id X (defCase (Id X x1 x1) X x0 x1 (dX x1 x1)) x0
+  rem = IdDefCasel (Id X x1 x1) X x0 x1 (dX x1 x1) (refl X x1)
+
+  rem1 : Id X (defCase (Id X x0 x1) X x1 x0 (dX x0 x1)) x0
+  rem1 = IdDefCaser (Id X x0 x1) X x1 x0 (dX x0 x1) neqx0x1
+
+  rem2 : Id X (swapDisc X dX x0 x1 x1) (defCase (Id X x0 x1) X x1 x0 (dX x0 x1))
+  rem2 = cong X X (\ y -> defCase (Id X x0 x1) X x1 y (dX x0 x1)) (defCase (Id X x1 x1) X x0 x1 (dX x1 x1)) x0 rem
+
+-- can we show that swapDisc is idempotent??
+
+idemSwapDisc : (X:U) (dX: discrete X) -> (x0 x1 : X) -> neg (Id X x0 x1) -> (x:X) -> 
+               Id X (swapDisc X dX x0 x1 (swapDisc X dX x0 x1 x)) x 
+idemSwapDisc X dX x0 x1 neqx0x1 x = orElim (Id X x0 x) (neg (Id X x0 x)) G rem9 rem11 (dX x0 x)
+ where
+   sD : X -> X
+   sD = swapDisc X dX x0 x1 
+
+   G : U
+   G = Id X (sD (sD x)) x
+
+   aD : X -> X
+   aD = auxSwapD X dX x0 x1 
+
+   rem : Id X x0 x -> Id X (sD x) x1
+   rem = idSwapDisc0 X dX x0 x1 x  
+
+   rem1 : neg (Id X x0 x) -> Id X (sD x) (aD x)
+   rem1 = idSwapDiscn0 X dX x0 x1 x
+
+   rem2 : Id X x1 x -> Id X (aD x) x0
+   rem2 = idAuxSwap1 X dX x0 x1 x
+
+   rem3 : neg (Id X x1 x) -> Id X (aD x) x
+   rem3 = idAuxSwapn1 X dX x0 x1 x
+
+   rem4 : Id X (aD x1) x0
+   rem4 = idAuxSwap1 X dX x0 x1 x1 (refl X x1)
+
+   rem5 : Id X (sD x1) (aD x1)
+   rem5 = idSwapDiscn0 X dX x0 x1 x1 neqx0x1
+
+   rem6 : Id X (sD x1) x0
+   rem6 = comp X (sD x1) (aD x1) x0 rem5 rem4
+
+   rem7 : Id X x0 x -> Id X (sD (sD x)) (sD x1)
+   rem7 p = cong X X sD (sD x) x1 (rem p)
+
+   rem8 : Id X x0 x -> Id X (sD (sD x)) x0
+   rem8 p = comp X (sD (sD x)) (sD x1) x0 (rem7 p) rem6
+
+   rem9 : Id X x0 x -> G
+   rem9 p = comp X (sD (sD x)) x0 x (rem8 p) p
+
+   rem10 : Id X (sD x0) x1
+   rem10 = idSwapDisc0 X dX x0 x1 x0 (refl X x0)
+
+   rem11 : neg (Id X x0 x) -> G
+   rem11 neqx0x = orElim (Id X x1 x) (neg (Id X x1 x)) G rem14 rem15 (dX x1 x)
+      where
+        rem12 : Id X (sD x) (aD x)
+        rem12 = rem1 neqx0x
+
+        rem13 : Id X x1 x -> Id X (sD (aD x)) x1
+        rem13 p = comp X (sD (aD x)) (sD x0) x1 (cong X X sD (aD x) x0 (rem2 p)) rem10
+
+        rem14 : Id X x1 x -> G
+        rem14 p = comp X (sD (sD x)) (sD (aD x)) x (cong X X sD (sD x) (aD x) rem12) (comp X (sD (aD x)) x1 x (rem13 p) p)
+
+        rem15 : neg (Id X x1 x) -> G
+        rem15 neqx1x = comp X (sD (sD x)) (sD x) x rem17 rem18
+            where
+             rem16 : Id X (aD x) x
+             rem16 = rem3 neqx1x
+
+             rem17 : Id X (sD (sD x)) (sD x)
+             rem17 = comp X (sD (sD x)) (sD (aD x)) (sD x) (cong X X sD (sD x) (aD x) rem12) (cong X X sD (aD x) x rem16)
+
+             rem18 : Id X (sD x) x
+             rem18 = comp X (sD x) (aD x) x rem12 rem16
+
+        
+
+
diff --git a/examples/testInh.cub b/examples/testInh.cub
new file mode 100644
--- /dev/null
+++ b/examples/testInh.cub
@@ -0,0 +1,55 @@
+module testInh where
+
+import set
+
+-- test the inh and squash functions
+
+zz : inh N
+zz = inc N zero
+
+eq1 : Id (inh N) zz zz
+eq1 = refl (inh N) zz
+
+eq2 : Id (inh N) zz zz
+eq2 = squash N zz zz
+
+inhUIP : (A : U) -> set (inh A)
+inhUIP A = propUIP (inh A) (squash A)
+
+test : Id (Id (inh N) zz zz) eq1 eq2
+test = inhUIP N zz zz eq1 eq2
+
+-- impredicative encoding
+
+inhI : U -> U
+inhI A = (X : U) -> prop X -> (A -> X) -> X
+
+incI : (A : U) -> A -> inhI A
+incI A a = \X h f -> f a
+
+squashI : (A : U) -> prop (inhI A)
+squashI A = propPi U (\X -> prop X -> (A -> X) -> X) rem
+  where
+  rem1 : (X : U) -> prop X -> prop ((A -> X) -> X)
+  rem1 X h = propImply (A -> X) X (\_ -> h)
+
+  rem : (X : U) -> prop (prop X -> (A -> X) -> X)
+  rem X =  propImply (prop X) ((A -> X) -> X) (rem1 X)
+
+inhrecI : (A : U) (B : U) (p : prop B) (f : A -> B) (h : inhI A) -> B
+inhrecI A B p f h = h B p f
+
+inhUIPI : (A : U) -> UIP (inhI A)
+inhUIPI A = propUIP (inhI A) (squashI A)
+
+zzI : inhI N
+zzI = incI N zero
+
+eq1I : Id (inhI N) zzI zzI
+eq1I = refl (inhI N) zzI
+
+eq2I : Id (inhI N) zzI zzI
+eq2I = squashI N zzI zzI
+
+testI : Id (Id (inhI N) zzI zzI) eq1I eq2I
+testI = inhUIPI N zzI zzI eq1I eq2I
diff --git a/examples/univalence.cub b/examples/univalence.cub
new file mode 100644
--- /dev/null
+++ b/examples/univalence.cub
@@ -0,0 +1,116 @@
+module univalence where
+
+import axChoice
+
+-- now we try to prove univalence
+-- the identity is an equivalence
+
+-- the transport of the reflexity is equal to the identity function
+
+transpReflId : (A:U) -> Id (A->A) (id A) (transport A A (refl U A))
+transpReflId A = funExt A (\ _ -> A)  (id A) (transport A A (refl U A)) (transportRef A)
+
+-- the transport of any equality proof is an equivalence
+
+transpIsEquiv : (A B:U) -> (p:Id U A B) -> isEquiv A B (transport A B p)
+transpIsEquiv A = J U A (\ B p -> isEquiv A B (transport A B p)) rem
+ where rem : isEquiv A A (transport A A (refl U A))
+       rem = subst (A -> A) (isEquiv A A)  (id A) (transport A A (refl U A)) (transpReflId A) (idIsEquiv A)
+
+Equiv : U -> U -> U
+Equiv A B = Sigma (A->B) (isEquiv A B)
+
+funEquiv : (A B : U) -> Equiv A B -> A -> B
+funEquiv A B = fst (A->B) (isEquiv A B)
+
+eqEquiv : (A B : U) (e0 e1:Equiv A B) -> Id (A -> B) (funEquiv A B e0) (funEquiv A B e1) -> Id (Equiv A B) e0 e1
+eqEquiv A B = eqPropFam (A->B) (isEquiv A B) (propIsEquiv A B)
+
+IdToEquiv : (A B:U) -> Id U A B -> Equiv A B
+IdToEquiv A B p = pair (transport A B p) (transpIsEquiv A B p)
+
+EquivToId : (A B:U) -> Equiv A B -> Id U A B
+EquivToId A B = split
+                  pair f ef -> isEquivEq A B f ef
+
+lemSecIdEquiv : (A:U) -> (eid : isEquiv A A (id A)) -> Id (Id U A A) (refl U A) (EquivToId A A (pair (id A) eid))
+lemSecIdEquiv A = 
+  split
+   pair s t -> equivEqRef A s t
+
+lem1SecIdEquiv : (A:U) -> (f:A -> A) -> Id (A->A) (id A) f -> (eid : isEquiv A A f) -> 
+      Id (Id U A A) (refl U A) (EquivToId A A (pair f eid))
+lem1SecIdEquiv A f if eid = 
+  comp (Id U A A)  (refl U A)  (EquivToId A A (pair (id A) (idIsEquiv A))) (EquivToId A A (pair f eid)) rem2 rem1
+  where
+    rem : Id (Equiv A A) (pair (id A) (idIsEquiv A)) (pair f eid)
+    rem = eqEquiv A A (pair (id A) (idIsEquiv A)) (pair f eid) if
+
+    rem1 : Id (Id U A A) (EquivToId A A (pair (id A) (idIsEquiv A))) (EquivToId A A (pair f eid))
+    rem1 = cong (Equiv A A) (Id U A A) (EquivToId A A) (pair (id A) (idIsEquiv A)) (pair f eid) rem
+
+    rem2 : Id (Id U A A) (refl U A)  (EquivToId A A (pair (id A) (idIsEquiv A)))
+    rem2 = lemSecIdEquiv A (idIsEquiv A)
+
+secIdEquiv : (A B :U) -> (p : Id U A B) -> Id (Id U A B) (EquivToId A B (IdToEquiv A B p)) p
+secIdEquiv A B p = inv (Id U A B)  p (EquivToId A B (IdToEquiv A B p)) (rem A B p)
+ where 
+  rem1 : (A:U) -> Id (Id U A A) (refl U A) (EquivToId A A (IdToEquiv A A (refl U A)))
+  rem1 A = lem1SecIdEquiv A tA rem3 rem2
+       where
+         tA : A -> A
+         tA = transport A A (refl U A)
+
+         rem2 : isEquiv A A tA
+         rem2 = transpIsEquiv A A (refl U A)
+
+         rem3 : Id (A -> A) (id A) tA
+         rem3 = transpReflId A
+
+  rem : (A B :U) -> (p : Id U A B) -> Id (Id U A B) p (EquivToId A B (IdToEquiv A B p))
+  rem A = J U A (\ B p ->  Id (Id U A B) p (EquivToId A B (IdToEquiv A B p))) (rem1 A)
+
+retIdEquiv : (A B :U) (s : Equiv A B) -> Id (Equiv A B) (IdToEquiv A B (EquivToId A B s)) s
+retIdEquiv A B s = inv (Equiv A B) s (IdToEquiv A B (EquivToId A B s)) (rem s)
+ where
+   rem : (s : Equiv A B) -> Id (Equiv A B) s (IdToEquiv A B (EquivToId A B s))
+   rem = 
+     split
+       pair f ef -> 
+          rem1 ef
+            where
+              p : Id U A B 
+              p = isEquivEq A B f ef
+
+              rem1 : (ef : isEquiv A B f) -> 
+                      Id (Equiv A B) (pair f ef) (pair (transport A B (isEquivEq A B f ef)) (transpIsEquiv A B (isEquivEq A B f ef)))
+              rem1 = 
+                split
+                 pair s t -> rem2
+                  where
+                    rem3 : Id (A->B) f (transport A B (equivEq A B f s t))
+                    rem3 = funExt A (\ _ -> B) f (transport A B (equivEq A B f s t)) (transpEquivEq A B f s t)
+                    rem2 : Id (Equiv A B) (pair f (pair s t))
+                                          (pair (transport A B (equivEq A B f s t)) (transpIsEquiv A B (equivEq A B f s t)))
+                    rem2 = eqEquiv A B (pair f (pair s t))
+                                       (pair (transport A B (equivEq A B f s t)) (transpIsEquiv A B (equivEq A B f s t)))
+                                       rem3
+
+-- and now univalence
+
+univAx : (A B:U) -> isEquiv (Id U A B) (Equiv A B) (IdToEquiv A B)
+univAx A B = gradLemma (Id U A B) (Equiv A B) (IdToEquiv A B) (EquivToId A B) (retIdEquiv A B) (secIdEquiv A B)
+
+-- in particular Id U A B and Equiv A B are equal
+
+corUnivAx : (A B : U) -> Id U (Id U A B) (Equiv A B)
+corUnivAx A B = isEquivEq (Id U A B) (Equiv A B) (IdToEquiv A B) (univAx A B)
+
+-- a simple application
+
+idPropIsProp : (A B : U) -> prop A -> prop B -> prop (Id U A B)
+idPropIsProp A B pA pB = substInv U prop (Id U A B) (Equiv A B) (corUnivAx A B) rem
+ where
+  rem : prop (Equiv A B)
+  rem = sigIsProp (A->B) (isEquiv A B) (propIsEquiv A B) (isPropProd A (\ _ -> B) (\ _ -> pB))
+
