type Decl = (Ident,(Ter,Ter))
data Decls = MutualDecls [Decl]
| OpaqueDecl Ident
- | VisibleDecl Ident
- | VisibleAllDecl
+ | TransparentDecl Ident
+ | TransparentAllDecl
deriving Eq
declIdents :: [Decl] -> [Ident]
def :: Decls -> Env -> Env
def (MutualDecls ds) (rho,vs,fs,Nameless os) = (Def ds rho,vs,fs,Nameless (os Set.\\ Set.fromList (declIdents ds)))
def (OpaqueDecl n) (rho,vs,fs,Nameless os) = (rho,vs,fs,Nameless (Set.insert n os))
-def (VisibleDecl n) (rho,vs,fs,Nameless os) = (rho,vs,fs,Nameless (Set.delete n os))
-def VisibleAllDecl (rho,vs,fs,Nameless os) = (rho,vs,fs,Nameless Set.empty)
+def (TransparentDecl n) (rho,vs,fs,Nameless os) = (rho,vs,fs,Nameless (Set.delete n os))
+def TransparentAllDecl (rho,vs,fs,Nameless os) = (rho,vs,fs,Nameless Set.empty)
defWhere :: Decls -> Env -> Env
defWhere (MutualDecls ds) (rho,vs,fs,Nameless os) = (Def ds rho,vs,fs,Nameless (os Set.\\ Set.fromList (declIdents ds)))
defWhere (OpaqueDecl _) rho = rho
-defWhere (VisibleDecl _) rho = rho
-defWhere VisibleAllDecl rho = rho
+defWhere (TransparentDecl _) rho = rho
+defWhere TransparentAllDecl rho = rho
sub :: (Name,Formula) -> Env -> Env
sub (i,phi) (rho,vs,fs,os) = (Sub i rho,vs,phi:fs,os)
AppFormula e phi -> showTer1 e <+> char '@' <+> showFormula phi
Comp e t ts -> text "comp" <+> showTers [e,t] <+> text (showSystem ts)
Fill e t ts -> text "fill" <+> showTers [e,t] <+> text (showSystem ts)
- Glue a ts -> text "glue" <+> showTer1 a <+> text (showSystem ts)
- GlueElem a ts -> text "glueElem" <+> showTer1 a <+> text (showSystem ts)
- UnGlueElem a ts -> text "unglueElem" <+> showTer1 a <+> text (showSystem ts)
+ Glue a ts -> text "Glue" <+> showTer1 a <+> text (showSystem ts)
+ GlueElem a ts -> text "glue" <+> showTer1 a <+> text (showSystem ts)
+ UnGlueElem a ts -> text "unglue" <+> showTer1 a <+> text (showSystem ts)
showTers :: [Ter] -> Doc
showTers = hsep . map showTer1
hsep $ punctuate comma
[ text x <+> equals <+> showTer d | (x,(_,d)) <- defs ]
showDecls (OpaqueDecl i) = text "opaque" <+> text i
-showDecls (VisibleDecl i) = text "visible" <+> text i
-showDecls VisibleAllDecl = text "visible_all"
+showDecls (TransparentDecl i) = text "transparent" <+> text i
+showDecls TransparentAllDecl = text "transparent_all"
instance Show Val where
show = render . showVal
VAppFormula v phi -> showVal v <+> char '@' <+> showFormula phi
VComp v0 v1 vs ->
text "comp" <+> showVals [v0,v1] <+> text (showSystem vs)
- VGlue a ts -> text "glue" <+> showVal1 a <+> text (showSystem ts)
- VGlueElem a ts -> text "glueElem" <+> showVal1 a <+> text (showSystem ts)
- VUnGlueElem a ts -> text "unglueElem" <+> showVal1 a <+> text (showSystem ts)
- VUnGlueElemU v b es -> text "unGlueElemU" <+> showVals [v,b]
+ VGlue a ts -> text "Glue" <+> showVal1 a <+> text (showSystem ts)
+ VGlueElem a ts -> text "glue" <+> showVal1 a <+> text (showSystem ts)
+ VUnGlueElem a ts -> text "unglue" <+> showVal1 a <+> text (showSystem ts)
+ VUnGlueElemU v b es -> text "unglue U" <+> showVals [v,b]
<+> text (showSystem es)
VCompU a ts -> text "comp (<_> U)" <+> showVal1 a <+> text (showSystem ts)
unGlue w b equivs | eps `member` equivs = app (equivFun (equivs ! eps)) w
| otherwise = case w of
VGlueElem v us -> v
- _ -> error ("unGlue: neutral" ++ show w)
+ _ -> error ("unglue: neutral" ++ show w)
isNeutralGlue :: Name -> System Val -> Val -> System Val -> Bool
isNeutralGlue i equivs u0 ts = (eps `notMember` equivsi0 && isNeutral u0) ||
Import. Imp ::= "import" AIdent ;
separator Imp ";" ;
-DeclDef. Decl ::= AIdent [Tele] ":" Exp "=" ExpWhere ;
-DeclData. Decl ::= "data" AIdent [Tele] "=" [Label] ;
-DeclHData. Decl ::= "hdata" AIdent [Tele] "=" [Label] ;
-DeclSplit. Decl ::= AIdent [Tele] ":" Exp "=" "split" "{" [Branch] "}" ;
-DeclUndef. Decl ::= AIdent [Tele] ":" Exp "=" "undefined" ;
-DeclMutual. Decl ::= "mutual" "{" [Decl] "}" ;
-DeclOpaque. Decl ::= "opaque" AIdent ;
-DeclVisible. Decl ::= "visible" AIdent ;
-DeclVisibleAll. Decl ::= "visible_all" ;
-separator Decl ";" ;
+DeclDef. Decl ::= AIdent [Tele] ":" Exp "=" ExpWhere ;
+DeclData. Decl ::= "data" AIdent [Tele] "=" [Label] ;
+DeclHData. Decl ::= "hdata" AIdent [Tele] "=" [Label] ;
+DeclSplit. Decl ::= AIdent [Tele] ":" Exp "=" "split" "{" [Branch] "}" ;
+DeclUndef. Decl ::= AIdent [Tele] ":" Exp "=" "undefined" ;
+DeclMutual. Decl ::= "mutual" "{" [Decl] "}" ;
+DeclOpaque. Decl ::= "opaque" AIdent ;
+DeclTransparent. Decl ::= "transparent" AIdent ;
+DeclTransparentAll. Decl ::= "transparent_all" ;
+separator Decl ";" ;
Where. ExpWhere ::= Exp "where" "{" [Decl] "}" ;
NoWhere. ExpWhere ::= Exp ;
DeclOpaque i -> do
resolveVar i
return (CTT.OpaqueDecl (unAIdent i), [])
- DeclVisible i -> do
+ DeclTransparent i -> do
resolveVar i
- return (CTT.VisibleDecl (unAIdent i), [])
- DeclVisibleAll -> return (CTT.VisibleAllDecl, [])
+ return (CTT.TransparentDecl (unAIdent i), [])
+ DeclTransparentAll -> return (CTT.TransparentAllDecl, [])
_ -> do let (f,typ,body,ns) = resolveNonMutualDecl d
a <- typ
d <- body
-- Check a list of declarations\r
checkDecls :: Decls -> Typing ()\r
checkDecls (MutualDecls []) = return ()\r
-checkDecls (MutualDecls d) = do\r
+checkDecls (MutualDecls d) = do\r
a <- asks env\r
let (idents,tele,ters) = (declIdents d,declTele d,declTers d)\r
ind <- asks indent\r
local (addDecls (MutualDecls d)) $ do\r
rho <- asks env\r
checks (tele,rho) ters\r
-checkDecls (OpaqueDecl _) = return ()\r
-checkDecls (VisibleDecl _) = return ()\r
-checkDecls VisibleAllDecl = return ()\r
+checkDecls (OpaqueDecl _) = return ()\r
+checkDecls (TransparentDecl _) = return ()\r
+checkDecls TransparentAllDecl = return ()\r
\r
-- Check a telescope\r
checkTele :: Tele -> Typing ()\r
let vus = evalSystem rho us\r
checkSystemsWith ts vus (\alpha vt vAlpha ->\r
unlessM (app (equivFun vt) vAlpha === (vu `face` alpha)) $\r
- throwError $ "Image of glueElem component " ++ show vAlpha ++\r
+ throwError $ "Image of glue component " ++ show vAlpha ++\r
" doesn't match " ++ show vu)\r
checkCompSystem vus\r
\r
(compBZ (decodeZ ZBZ (inr n)) loopZ) (decodeZ ZBZ (inr (suc n)))\r
(<i> compBZ (hole0 n @ i) loopZ)\r
(decodeLoop (inr n))\r
- visible decodeZ\r
+ transparent decodeZ\r
TEquiv''' : isEquiv Z (Path BZ ZBZ ZBZ) (action (Path BZ ZBZ ZBZ) (TShift ZBZ ZBZ) (<_> ZBZ))\r
= transport (<i> isEquiv Z loopBZ (\(y : Z) -> hole y @ -i)) (gradLemma Z loopBZ (decodeZ ZBZ) (encodeZ ZBZ) (decodeEncodeZ ZBZ) (encodeDecodeZ ZBZ))\r
TEquiv'' (b : BZSet B) (x : Path BZ ZBZ B) : isEquiv Z (Path BZ ZBZ B) (action (Path BZ ZBZ B) (TShift ZBZ B) x)\r
= BZNE A (isEquiv Z T (action T (TShift A B) x), propIsEquiv Z T (action T (TShift A B) x))\r
(\(a : BZSet A) -> BZNE B (isEquiv Z T (action T (TShift A B) x), propIsEquiv Z T (action T (TShift A B) x))\r
(\(b : BZSet B) -> TEquiv' a b x))\r
-visible decodeZ\r
+transparent decodeZ\r
\r
loopBZequalsZ : Path U loopBZ Z = isoPath loopBZ Z (encodeZ ZBZ) (decodeZ ZBZ) (encodeDecodeZ ZBZ) (decodeEncodeZ ZBZ)\r
\r
-- EVAL: inr (suc (suc zero))\r
-- Time: 0m25.191s\r
\r
--- > let visible_all in let doubleLoop : Path BZ (multZ ZBZ ZBZ) (multZ ZBZ ZBZ) = <i> multZ (loopZ@-i) (loopZ@i) in transport (<j> BZSet (transport (<i> BZSet (doubleLoop @ i)) (<_> ZBZ) @ j)) zeroZ\r
+-- > let transparent_all in let doubleLoop : Path BZ (multZ ZBZ ZBZ) (multZ ZBZ ZBZ) = <i> multZ (loopZ@-i) (loopZ@i) in transport (<j> BZSet (transport (<i> BZSet (doubleLoop @ i)) (<_> ZBZ) @ j)) zeroZ\r
-- too slow\r
\r
--- > let visible_all in transport (<j> BZSet (transport (<i> BZSet (multZ (loopZ@-i) (loopZ@i))) (<_> ZBZ) @ j)) zeroZ\r
+-- > let transparent_all in transport (<j> BZSet (transport (<i> BZSet (multZ (loopZ@-i) (loopZ@i))) (<_> ZBZ) @ j)) zeroZ\r
-- EVAL: inr (suc (suc zero))\r
\r
-- multS1 : S1 -> S1 -> S1 = transport (<i> S1equalsBZ@-i -> S1equalsBZ@-i -> S1equalsBZ@-i) multZ\r
\r
-visible_all\r
+transparent_all\r