+coreTcon =
+ -- Special case is first so that (CoUnsafe .. ..) gets parsed as
+ -- a prim. coercion app and not a Tcon app.
+ -- But the whole thing is so bogus.
+ try (do
+ -- the "try"s are crucial; they force
+ -- backtracking
+ maybeCoercion <- choice [try symCo, try transCo, try unsafeCo,
+ try instCo, try leftCo, rightCo]
+ return $ case maybeCoercion of
+ TransC -> Trans (\ [x,y] -> TransCoercion x y)
+ SymC -> Sym (\ [x] -> SymCoercion x)
+ UnsafeC -> Unsafe (\ [x,y] -> UnsafeCoercion x y)
+ LeftC -> LeftCo (\ [x] -> LeftCoercion x)
+ RightC -> RightCo (\ [x] -> RightCoercion x)
+ InstC -> InstCo (\ [x,y] -> InstCoercion x y))
+ <|> (coreQualifiedCon >>= (return . ATy . Tcon))
+
+data CoercionTy = TransC | InstC | SymC | UnsafeC | LeftC | RightC
+
+symCo, transCo, unsafeCo, instCo, leftCo, rightCo :: Parser CoercionTy
+symCo = string "%sym" >> return SymC
+transCo = string "%trans" >> return TransC
+unsafeCo = string "%unsafe" >> return UnsafeC
+leftCo = string "%left" >> return LeftC
+rightCo = string "%right" >> return RightC
+instCo = string "%inst" >> return InstC