External Core tools: track new syntax for newtypes

[ghc-hetmet.git] / utils / ext-core / ParsecParser.hs

diff --git a/utils/ext-core/ParsecParser.hs b/utils/ext-core/ParsecParser.hs
index 42e21e9..41a18a5 100644 (file)
--- a/utils/ext-core/ParsecParser.hs
+++ b/utils/ext-core/ParsecParser.hs
@@ -36,8 +36,7 @@ coreModuleName = do
 
 corePackageName :: Parser Pname
 -- Package names can be lowercase or uppercase!
--- TODO: update docs
-corePackageName = identifier <|> upperName
+corePackageName = (identifier <|> upperName) >>= (return . P)
 
 coreHierModuleNames :: Parser ([Id], Id)
 coreHierModuleNames = do
@@ -81,11 +80,11 @@ coreNewtypeDecl = do
   reserved "newtype"
   tyCon  <- coreQualifiedCon
   whiteSpace
+  coercionName <- coreQualifiedCon
+  whiteSpace
   tBinds <- coreTbinds
-  symbol "^"
-  axiom <- coreAxiom
   tyRep  <- try coreTRep
-  return $ Newtype tyCon tBinds axiom tyRep
+  return $ Newtype tyCon coercionName tBinds tyRep
 
 coreQualifiedCon :: Parser (Mname, Id)
 coreQualifiedCon = coreQualifiedGen upperName
@@ -109,17 +108,6 @@ coreQualifiedGen p = (try (do
    -- unqualified name
    (p >>= (\ res -> return (Nothing, res)))
 
-coreAxiom :: Parser Axiom
-coreAxiom = parens (do
-              coercionName <- coreQualifiedCon
-              whiteSpace
-              tbs <- coreTbinds
-              whiteSpace
-              symbol "::"
-              whiteSpace
-              coercionK <- try equalityKind <|> parens equalityKind
-              return (coercionName, tbs, coercionK))
-
 coreTbinds :: Parser [Tbind]
 coreTbinds = many coreTbind 
 
@@ -153,12 +141,10 @@ coreCdef = do
   tys         <- sepBy coreAtySaturated whiteSpace
   return $ Constr dataConName tBinds tys
 
-coreTRep :: Parser (Maybe Ty)
+coreTRep :: Parser Ty
 -- note that the "=" is inside here since if there's
 -- no rhs for the newtype, there's no "="
-coreTRep = optionMaybe (do
-              symbol "=" 
-              try coreType)
+coreTRep = symbol "=" >> try coreType
 
 coreType :: Parser Ty
 coreType = coreForallTy <|> (do
@@ -234,13 +220,12 @@ coreTcon =
 data CoercionTy = TransC | InstC | SymC | UnsafeC | LeftC | RightC
 
 symCo, transCo, unsafeCo, instCo, leftCo, rightCo :: Parser CoercionTy
--- Would be better not to wire these in quite this way. Sigh
-symCo    = string "ghczmprim:GHCziPrim.sym"      >> return SymC
-transCo  = string "ghczmprim:GHCziPrim.trans"    >> return TransC 
-unsafeCo = string "ghczmprim:GHCziPrim.CoUnsafe" >> return UnsafeC
-leftCo   = string "ghczmprim:GHCziPrim.left"     >> return LeftC
-rightCo  = string "ghczmprim:GHCziPrim.right"    >> return RightC
-instCo   = string "ghczmprim:GHCziPrim.inst"    >> return InstC
+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
 
 coreForallTy :: Parser Ty
 coreForallTy = do
@@ -322,7 +307,7 @@ coreVdef = do
 coreAtomicExp :: Parser Exp
 coreAtomicExp = do
 -- For stupid reasons, the whiteSpace is necessary.
--- Without it, (pt coreAppExp "w ^a:B.C ") doesn't work.
+-- Without it, (pt coreAppExp "w a:B.C ") doesn't work.
   whiteSpace
   res <- choice [try coreDconOrVar,
                     try coreLit,