Change a use of xargs to "$(XARGS)" $(XARGS_OPTS)

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

diff --git a/utils/ext-core/Language/Core/ParsecParser.hs b/utils/ext-core/Language/Core/ParsecParser.hs
index 3fd3f17..ff2333c 100644 (file)
--- a/utils/ext-core/Language/Core/ParsecParser.hs
+++ b/utils/ext-core/Language/Core/ParsecParser.hs
@@ -1,6 +1,8 @@
 {-# OPTIONS -Wall -fno-warn-missing-signatures #-}
 
-module Language.Core.ParsecParser (parseCore) where
+module Language.Core.ParsecParser (parseCore, coreModuleName, coreTcon, 
+  coreQualifiedGen, upperName, identifier, coreType, coreKind,
+  coreTbinds, parens, braces, topVbind) where
 
 import Language.Core.Core
 import Language.Core.Check
@@ -130,7 +132,7 @@ coreTbindGen sep = (parens (do
                     (sep >> identifier >>= (return . (\ tv -> (tv,Klifted))))
 
 coreCdefs :: Parser [Cdef]
-coreCdefs = sepBy1 coreCdef (symbol ";")
+coreCdefs = sepBy coreCdef (symbol ";")
 
 coreCdef :: Parser Cdef
 coreCdef = do
@@ -470,14 +472,23 @@ coreAlt = conAlt <|> litAlt <|> defaultAlt
 conAlt :: Parser Alt
 conAlt = do
   conName <- coreQualifiedCon
-  tBinds  <- many (parens coreAtTbind)
-  whiteSpace -- necessary b/c otherwise we parse the next list as empty
-  vBinds  <- many (parens lambdaBind)
   whiteSpace
+  (tBinds, vBinds) <- caseVarBinds
   try (symbol "->")
   rhs     <- try coreFullExp
   return $ Acon conName tBinds vBinds rhs
 
+caseVarBinds :: Parser ([Tbind], [Vbind])
+caseVarBinds = do
+     maybeFirstTbind <- optionMaybe coreAtTbind
+     case maybeFirstTbind of
+        Just tb -> do
+           (tbs,vbs) <- caseVarBinds
+           return (tb:tbs, vbs)
+        Nothing -> do
+           vbs <- many (parens lambdaBind)
+           return ([], vbs)
+
 litAlt :: Parser Alt
 litAlt = do
   l <- parens coreLiteral