ext-core library: Parser fixes; make it build with the HEAD
authorTim Chevalier <chevalier@alum.wellesley.edu>
Thu, 18 Sep 2008 09:03:49 +0000 (09:03 +0000)
committerTim Chevalier <chevalier@alum.wellesley.edu>
Thu, 18 Sep 2008 09:03:49 +0000 (09:03 +0000)
In the ext-core parser I guess I never tested:
* existential type variable bindings in case alts
* empty data declarations

That'll learn me!

utils/ext-core/Language/Core/ParsecParser.hs
utils/ext-core/Language/Core/Printer.hs
utils/ext-core/Setup.lhs
utils/ext-core/extcore.cabal
utils/ext-core/lib/GHC_ExtCore/Makefile

index 40609e3..ff2333c 100644 (file)
@@ -132,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
@@ -472,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
index bbd8e48..4fef854 100644 (file)
@@ -1,4 +1,4 @@
-{-# OPTIONS -Werror -Wall -fno-warn-missing-signatures #-}
+{-# OPTIONS -Wall -fno-warn-missing-signatures #-}
 
 module Language.Core.Printer where
 
index f7706b8..12d5bc5 100644 (file)
@@ -2,8 +2,8 @@
 \begin{code}
 {-# OPTIONS -Wall #-}
 
+import Control.Exception
 import Control.Monad
-import Data.List
 import Distribution.PackageDescription
 import Distribution.Simple
 import Distribution.Simple.LocalBuildInfo
@@ -16,9 +16,9 @@ import Control.Exception (try)
 
 main :: IO ()
 main = do
-   let hooks = defaultUserHooks {
+   let hooks = simpleUserHooks {
                  buildHook = build_primitive_sources 
-                           $ buildHook defaultUserHooks
+                           $ buildHook simpleUserHooks
             }
    defaultMainWithHooks hooks
 \end{code}
@@ -58,7 +58,7 @@ maybeUpdateFile source target = do
   r <- rawSystem "cmp" ["-s" {-quiet-}, source, target]
   case r of
     ExitSuccess   -> removeFile source
-    ExitFailure _ -> do try (removeFile target); renameFile source target
+    ExitFailure _ -> do (try :: IO () -> IO (Either IOException ())) (removeFile target); renameFile source target
 
 
 \end{code}
\ No newline at end of file
index ea3b132..0b62cef 100644 (file)
@@ -8,10 +8,10 @@ license-file:        LICENSE
 author:              Andrew Tolmach, Tim Chevalier, The GHC Team
 maintainer:          chevalier@alum.wellesley.edu
 stability:           alpha
-build-depends:       base, containers, directory, filepath, mtl, parsec, pretty
+build-depends:       base, containers, directory, filepath, mtl, parsec, pretty, syb
 exposed-modules:     Language.Core.Check, Language.Core.Dependencies, Language.Core.Core, Language.Core.Interp, Language.Core.Overrides, Language.Core.ParsecParser, Language.Core.Prep, Language.Core.Prims, Language.Core.Printer, Language.Core.Merge, Language.Core.ElimDeadCode, Language.Core.Encoding, Language.Core.Env
 other-modules:       Language.Core.PrimCoercions, Language.Core.PrimEnv, Language.Core.Utils, Language.Core.CoreUtils, Language.Core.Environments
-extensions:          DeriveDataTypeable PatternGuards PatternSignatures
+extensions:          DeriveDataTypeable PatternGuards RankNTypes ScopedTypeVariables
 ghc-options:         -Wall -O2
 tested-with:         GHC ==6.8.2
 data-files:          README
index 5cf65c0..93b95a7 100644 (file)
@@ -1,5 +1,5 @@
 all:   Handle.hs IO.hs Unicode.hs
-       ../../../../compiler/ghc-inplace -c -fext-core -package-name base-extcore Handle.hs IO.hs Unicode.hs -cpp -i../
+       ghc -c -fext-core -package-name base-extcore Handle.hs IO.hs Unicode.hs -cpp -i../
 
 clean:
        rm -f *.hcr *.hi *.o