diff --git a/README b/README --- a/README +++ b/README @@ -13,10 +13,10 @@ module Main where import Distribution.Simple -import Distribution.Simple.UUAGC +import Distribution.Simple.UUAGC (uuagcLibUserHook) +import UU.UUAGC (uuagc) -compiler = "uuagc" -main = defaultMainWithHooks (uuagcUserHook' compiler) +main = defaultMainWithHooks (uuagcLibUserHook uuagc) -- Add extra-source-files: uuagc_options diff --git a/src-options/Options.hs b/src-options/Options.hs --- a/src-options/Options.hs +++ b/src-options/Options.hs @@ -119,10 +119,11 @@ , MyOpt [] ["reference"] (NoArg referenceOpt) (boolOpt reference) "Use reference attributes" , MyOpt [] ["monadic"] (NoArg monadicOpt) (boolOpt monadic) "Experimental: generate monadic code" , MyOpt [] ["ocaml"] (NoArg ocamlOpt) (boolOpt ocaml) "Generate Ocaml code" + , MyOpt [] ["cleanlang"] (NoArg cleanOpt) (boolOpt clean) "Generate Clean code" , MyOpt [] ["breadthfirst"] (NoArg breadthfirstOpt) (boolOpt breadthFirst)"Experimental: generate breadth-first code" , MyOpt [] ["breadthfirst-strict"] (NoArg breadthfirstStrictOpt) (boolOpt breadthFirstStrict) "Experimental: outermost breadth-first evaluator is strict instead of lazy" , MyOpt [] ["visitcode"] (NoArg visitorsOutputOpt) (boolOpt visitorsOutput) "Experimental: generate visitors code" - , MyOpt [] ["kennedywarren"] (NoArg kennedyWarrenOpt) (boolOpt kennedyWarren) "Experimental: use Kennedy-Warren's algorithm for ordering" + , MyOpt [] ["kennedywarren"] (NoArg kennedyWarrenOpt) (boolOpt kennedyWarren) "Use Kennedy-Warren's algorithm for ordering" , MyOpt [] ["statistics"] (ReqArg statisticsOpt "FILE to append to") (mbStringOpt statsFile) "Append statistics to FILE" , MyOpt [] ["checkParseRhs"] (NoArg parseHsRhsOpt) (boolOpt checkParseRhs) "Parse RHS of rules with Haskell parser" , MyOpt [] ["checkParseTys"] (NoArg parseHsTpOpt) (boolOpt checkParseTy) "Parse types of attrs with Haskell parser" @@ -213,6 +214,7 @@ , doubleColons :: Bool , monadic :: Bool , ocaml :: Bool + , clean :: Bool , visitorsOutput :: Bool , statsFile :: Maybe String , breadthFirst :: Bool @@ -308,6 +310,7 @@ , doubleColons = False , monadic = False , ocaml = False + , clean = False , visitorsOutput = False , statsFile = Nothing , breadthFirst = False @@ -358,7 +361,7 @@ Name s -> [nm++"="++s] Default -> [nm] -dataOpt, dataRecOpt, strictDataOpt, strictWrapOpt, cataOpt, semfunsOpt, signaturesOpt, prettyOpt,renameOpt, wrappersOpt, modcopyOpt, newtypesOpt, nestOpt, smacroOpt, verboseOpt, helpOpt, versionOpt, selfOpt, cycleOpt, visitOpt, seqOpt, unboxOpt, bangpatsOpt, casesOpt, strictCasesOpt, stricterCasesOpt, strictSemOpt, localCpsOpt, splitSemsOpt, werrorsOpt, wignoreOpt, dumpgrammarOpt, dumpcgrammarOpt, genTracesOpt, genUseTracesOpt, genCostCentresOpt, sepSemModsOpt, genFileDepsOpt, genLinePragmasOpt, genVisageOpt, genAspectAGOpt, dummyTokenVisitOpt, tupleAsDummyTokenOpt, stateAsDummyTokenOpt, strictDummyTokenOpt, noPerRuleTypeSigsOpt, noPerStateTypeSigsOpt, noEagerBlackholingOpt, noPerRuleCostCentresOpt, noPerVisitCostCentresOpt, helpInliningOpt, noInlinePragmasOpt, aggressiveInlinePragmasOpt, lateHigherOrderBindingOpt, monadicWrappersOpt, referenceOpt, genAttrListOpt, lcKeywordsOpt, doubleColonsOpt, haskellSyntaxOpt, monadicOpt, parallelOpt, ocamlOpt, visitorsOutputOpt, breadthfirstOpt, breadthfirstStrictOpt, parseHsRhsOpt, parseHsTpOpt, parseHsBlockOpt, parseHsOpt, kennedyWarrenOpt, noOptimizeOpt, allOpt, optimizeOpt, noIncludesOpt, beQuietOpt, condDisableOptimizations :: Options -> Options +dataOpt, dataRecOpt, strictDataOpt, strictWrapOpt, cataOpt, semfunsOpt, signaturesOpt, prettyOpt,renameOpt, wrappersOpt, modcopyOpt, newtypesOpt, nestOpt, smacroOpt, verboseOpt, helpOpt, versionOpt, selfOpt, cycleOpt, visitOpt, seqOpt, unboxOpt, bangpatsOpt, casesOpt, strictCasesOpt, stricterCasesOpt, strictSemOpt, localCpsOpt, splitSemsOpt, werrorsOpt, wignoreOpt, dumpgrammarOpt, dumpcgrammarOpt, genTracesOpt, genUseTracesOpt, genCostCentresOpt, sepSemModsOpt, genFileDepsOpt, genLinePragmasOpt, genVisageOpt, genAspectAGOpt, dummyTokenVisitOpt, tupleAsDummyTokenOpt, stateAsDummyTokenOpt, strictDummyTokenOpt, noPerRuleTypeSigsOpt, noPerStateTypeSigsOpt, noEagerBlackholingOpt, noPerRuleCostCentresOpt, noPerVisitCostCentresOpt, helpInliningOpt, noInlinePragmasOpt, aggressiveInlinePragmasOpt, lateHigherOrderBindingOpt, monadicWrappersOpt, referenceOpt, genAttrListOpt, lcKeywordsOpt, doubleColonsOpt, haskellSyntaxOpt, monadicOpt, parallelOpt, ocamlOpt, cleanOpt, visitorsOutputOpt, breadthfirstOpt, breadthfirstStrictOpt, parseHsRhsOpt, parseHsTpOpt, parseHsBlockOpt, parseHsOpt, kennedyWarrenOpt, noOptimizeOpt, allOpt, optimizeOpt, noIncludesOpt, beQuietOpt, condDisableOptimizations :: Options -> Options dataOpt opts = opts{dataTypes = True} dataRecOpt opts = opts{dataRecords = True} @@ -446,6 +449,7 @@ monadicOpt opts = opts { monadic = True } parallelOpt opts = opts { parallelInvoke = True } ocamlOpt opts = opts { ocaml = True, kennedyWarren = True, withCycle = True, visit = True } +cleanOpt opts = opts { clean = True } --TODO: More? visitorsOutputOpt opts = opts { visitorsOutput = True } statisticsOpt :: String -> Options -> Options statisticsOpt nm opts = opts { statsFile = Just nm } diff --git a/src/Distribution/Simple/UUAGC/UUAGC.hs b/src/Distribution/Simple/UUAGC/UUAGC.hs --- a/src/Distribution/Simple/UUAGC/UUAGC.hs +++ b/src/Distribution/Simple/UUAGC/UUAGC.hs @@ -137,29 +137,36 @@ -> IO () updateAGFile _ _ (_,(_,Nothing)) = return () updateAGFile uuagc newOptions (file,(opts,Just (gen,sp))) = do - (ec, files) <- uuagc (optionsToString $ opts { genFileDeps = True, searchPath = sp }) file - case ec of - ExitSuccess -> - do when ((not.null) files) $ do + hasGen <- doesFileExist gen + when hasGen $ do + (ec, files) <- uuagc (optionsToString $ opts { genFileDeps = True, searchPath = sp }) file + case ec of + ExitSuccess -> do + let newOpts :: Options + newOpts = maybe noOptions fst $ Map.lookup file newOptions + optRebuild = optionsToString newOpts /= optionsToString opts + modRebuild <- + if null files + then return False + else do flsmt <- mapM getModificationTime files let maxModified = maximum flsmt fmt <- getModificationTime gen - let newOpts :: Options - newOpts = maybe noOptions fst $ Map.lookup file newOptions - -- When some dependency is newer or options have changed, we should regenerate - when (maxModified > fmt || optionsToString newOpts /= optionsToString opts) $ removeFile gen - ex@(ExitFailure _) -> throwIO ex + return $ maxModified > fmt + -- When some dependency is newer or options have changed, we should regenerate + when (optRebuild || modRebuild) $ removeFile gen + ex@(ExitFailure _) -> throwIO ex getAGFileOptions :: [(String, String)] -> IO AGFileOptions getAGFileOptions extra = do + cabalOpts <- mapM (parseOptionAG . snd) $ filter ((== agModule) . fst) extra usesOptionsFile <- doesFileExist defUUAGCOptions if usesOptionsFile then do r <- parserAG' defUUAGCOptions case r of - Left e -> print e >> exitFailure - Right a -> return a - else mapM (parseOptionAG . snd) - $ filter ((== agModule) . fst) extra + Left e -> die (show e) + Right a -> return $ cabalOpts ++ a + else return cabalOpts getAGClasses :: [(String, String)] -> IO [AGOptionsClass] getAGClasses = mapM (parseClassAG . snd) . filter ((== agClass) . fst) @@ -267,14 +274,15 @@ PreProcessor { platformIndependent = True, runPreProcessor = mkSimplePreProcessor $ \ inFile outFile verbosity -> - do putStrLn $ "[UUAGC] processing: " ++ inFile ++ " generating: " ++ outFile + do notice verbosity $ "[UUAGC] processing: " ++ inFile ++ " generating: " ++ outFile let classesPath = buildDir lbi agClassesFile info verbosity $ "uuagc-preprocessor: Assuming AG classesPath: " ++ classesPath fileOpts <- readFileOptions classesPath - let opts = case Map.lookup inFile fileOpts of - Nothing -> noOptions - Just (opt,gen) -> opt - search = dropFileName inFile + opts <- case Map.lookup inFile fileOpts of + Nothing -> do warn verbosity $ "No options found for " ++ inFile + return noOptions + Just (opt,gen) -> return opt + let search = dropFileName inFile options = opts { searchPath = search : hsSourceDirs build ++ searchPath opts , outputFiles = outFile : (outputFiles opts) } (eCode,_) <- uuagc (optionsToString options) inFile diff --git a/uuagc-cabal.cabal b/uuagc-cabal.cabal --- a/uuagc-cabal.cabal +++ b/uuagc-cabal.cabal @@ -1,7 +1,7 @@ cabal-version: >=1.8 build-type: Simple name: uuagc-cabal -version: 1.0.4.0 +version: 1.0.5.0 license: BSD3 license-file: LICENSE maintainer: Jeroen Bransen