fay 0.14.4.0 → 0.14.5.0

raw patch · 15 files changed

+241/−141 lines, 15 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• fay.cabal +7/−9
• src/Fay/Compiler.hs +5/−3
• src/Fay/Compiler/CollectRecords.hs +0/−118
• src/Fay/Compiler/Config.hs +1/−0
• src/Fay/Compiler/Decl.hs +25/−0
• src/Fay/Compiler/Defaults.hs +1/−0
• src/Fay/Compiler/Exp.hs +13/−5
• src/Fay/Compiler/FFI.hs +24/−1
• src/Fay/Compiler/InitialPass.hs +117/−0
• src/Fay/Compiler/Misc.hs +19/−0
• src/Fay/Compiler/ModuleScope.hs +1/−1
• src/Fay/Compiler/Packages.hs +4/−1
• src/Fay/Compiler/Pattern.hs +10/−1
• src/Fay/Types.hs +11/−2
• src/Main.hs +3/−0

@@ -1,5 +1,5 @@ name:                fay-version:             0.14.4.0+version:             0.14.5.0 synopsis:            A compiler for Fay, a Haskell subset that compiles to JavaScript. description:         Fay is a proper subset of Haskell which is type-checked                      with GHC, and compiled to JavaScript. It is lazy, pure, has a Fay monad,@@ -20,21 +20,19 @@                      See <http://fay-lang.org/#examples>.                      .                      /Release Notes/-                     0.14.4.0:-                     .-                     * Fix record updates on IE <= 8.+                     * Support for newtypes (with no runtime cost!)                      .-                     * Import tweaks, will make compilation a lot faster (4x reported) when there are a lot of imports.+                     * --base-path flag to specify custom location for fay-base                      .-                     * Parse hs sources with base fixities.+                     * Fix a bug where imports shadowing local bindings would prevent the local binding from being exported                      .-                     See full history at: <https://github.com/faylang/fay/commits>+                     See full history at: <https://github.com/faylang/fay/wiki/Changelog> homepage:            http://fay-lang.org/ bug-reports:         https://github.com/faylang/fay/issues license:             BSD3 license-file:        LICENSE author:              Chris Done, Adam Bergmark-maintainer:          chrisdone@gmail.com, adam@edea.se+maintainer:          adam@edea.se copyright:           2012 Chris Done, Adam Bergmark category:            Development build-type:          Custom@@ -99,7 +97,7 @@ library   hs-source-dirs:    src   exposed-modules:   Fay, Fay.Types, Language.Fay.FFI, Fay.Convert, Fay.Compiler, Fay.Compiler.Debug, Fay.Compiler.Config-  other-modules:     Fay.Compiler.Print, Control.Monad.IO, System.Process.Extra, Data.List.Extra, Paths_fay, Fay.Compiler.Misc, Fay.Compiler.FFI, Fay.Compiler.Optimizer, Fay.Compiler.Packages, Fay.Compiler.ModuleScope, Control.Monad.Extra, Fay.Compiler.CollectRecords, Fay.Compiler.Decl, Fay.Compiler.Defaults, Fay.Compiler.Exp, Fay.Compiler.Pattern, Fay.Compiler.Typecheck+  other-modules:     Fay.Compiler.Print, Control.Monad.IO, System.Process.Extra, Data.List.Extra, Paths_fay, Fay.Compiler.Misc, Fay.Compiler.FFI, Fay.Compiler.Optimizer, Fay.Compiler.Packages, Fay.Compiler.ModuleScope, Control.Monad.Extra, Fay.Compiler.InitialPass, Fay.Compiler.Decl, Fay.Compiler.Defaults, Fay.Compiler.Exp, Fay.Compiler.Pattern, Fay.Compiler.Typecheck   ghc-options:       -O2 -Wall -fno-warn-name-shadowing   build-depends:     base >= 4 && < 5,                      aeson,

@@ -18,7 +18,7 @@   ,parseFay)   where -import           Fay.Compiler.CollectRecords (collectRecords)+import           Fay.Compiler.InitialPass (initialPass) import           Fay.Compiler.Config import           Fay.Compiler.Defaults import           Fay.Compiler.Exp@@ -82,7 +82,8 @@ -- compilation. compileForDocs :: Module -> Compile [JsStmt] compileForDocs mod = do-  collectRecords mod+  initialPass mod+  -- collectRecords mod   compileModule False mod  -- | Compile the top-level Fay module.@@ -93,7 +94,8 @@   when (configTypecheck cfg) $     typecheck (configPackageConf cfg) (configWall cfg) $       fromMaybe modulename $ configFilePath cfg-  collectRecords mod+  initialPass mod+  -- collectRecords mod   cs <- io defaultCompileState   modify $ \s -> s { stateImported = stateImported cs }   (stmts,CompileWriter{..}) <- listen $ compileModule True mod

@@ -1,118 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- | Initial pass-through collecting record definitions--module Fay.Compiler.CollectRecords where--import Fay.Compiler.Misc-import Fay.Types-import Fay.Compiler.Config--import Control.Applicative-import Control.Monad.Error-import Control.Monad.RWS-import Language.Haskell.Exts.Syntax-import Language.Haskell.Exts.Parser---- | Collect all the records and their fields before compiling.-collectRecords :: Module -> Compile ()-collectRecords (Module _ _ _ Nothing _ imports decls) = do-  mapM_ passImport imports-  mapM_ scanDecl decls-collectRecords m = throwError (UnsupportedModuleSyntax m)---- | Handle an import.-passImport :: ImportDecl -> Compile ()-passImport (ImportDecl _ _ _ _ Just{} _ _) = do-  return ()---  warn $ "import with package syntax ignored: " ++ prettyPrint i-passImport (ImportDecl _ name False _ Nothing Nothing _) = do-  void $ unlessImported name $ \filepath contents -> do-    state' <- get-    reader' <- ask-    result <- liftIO $ records filepath reader' state' collectRecords contents-    case result of-      Right ((),st,_) -> do-        -- Merges the state gotten from passing through an imported-        -- module with the current state. We can assume no duplicate-        -- records exist since GHC would pick that up.-        modify $ \s -> s { stateRecords = stateRecords st-                         , stateRecordTypes = stateRecordTypes st-                         , stateImported = stateImported st-                         }-      Left err -> throwError err-    return ()-passImport i = throwError $ UnsupportedImport i---- | Don't re-import the same modules.-unlessImported :: ModuleName-                           -> (FilePath -> String -> Compile ())-                           -> Compile ()-unlessImported name importIt = do-  imported <- gets stateImported-  case lookup name imported of-    Just _ -> return ()-    Nothing -> do-      dirs <- configDirectoryIncludePaths <$> config id-      (filepath,contents) <- findImport dirs name-      modify $ \s -> s { stateImported = (name,filepath) : imported }-      importIt filepath contents---- | Compile only for record generation.-records :: (Show from,Parseable from)-        => FilePath-        -> CompileReader-        -> CompileState-        -> (from -> Compile ())-        -> String-        -> IO (Either CompileError ((),CompileState,CompileWriter))-records filepath compileReader compileState with from =-  runCompile compileReader-             compileState-             (parseResult (throwError . uncurry ParseError)-                          with-                          (parseFay filepath from))---- | Handle a declaration.-scanDecl :: Decl -> Compile ()-scanDecl decl = do-  case decl of-    DataDecl _loc DataType _ctx name _tyvarb qualcondecls _deriv -> do-      let ns = flip map qualcondecls (\(QualConDecl _loc' _tyvarbinds _ctx' condecl) -> conDeclName condecl)-      addRecordTypeState name ns-    _ -> return ()---  case decl of-    DataDecl _ DataType _ _ _ constructors _ -> dataDecl constructors-    GDataDecl _ DataType _l _i _v _n decls _ -> dataDecl (map convertGADT decls)-    _ -> return ()--  where-    addRecordTypeState name cons = modify $ \s -> s-      { stateRecordTypes = (UnQual name, map UnQual cons) : stateRecordTypes s }--    conDeclName (ConDecl n _) = n-    conDeclName (InfixConDecl _ n _) = n-    conDeclName (RecDecl n _) = n----- | Collect record definitions and store record name and field names.--- A ConDecl will have fields named slot1..slotN-dataDecl :: [QualConDecl] -> Compile ()-dataDecl constructors = do-  forM_ constructors $ \(QualConDecl _ _ _ condecl) ->-    case condecl of-      ConDecl name types -> do-        let fields =  map (Ident . ("slot"++) . show . fst) . zip [1 :: Integer ..] $ types-        addRecordState name fields-      InfixConDecl _t1 name _t2 ->-        addRecordState name ["slot1", "slot2"]-      RecDecl name fields' -> do-        let fields = concatMap fst fields'-        addRecordState name fields--  where-    addRecordState :: Name -> [Name] -> Compile ()-    addRecordState name fields = modify $ \s -> s-      { stateRecords = (UnQual name,map UnQual fields) : stateRecords s }

@@ -62,4 +62,5 @@       , configGClosure           = False       , configPackageConf        = Nothing       , configPackages           = []+      , configBasePath           = Nothing       }

@@ -43,6 +43,7 @@     FunBind matches -> compileFunCase toplevel matches     DataDecl _ DataType _ _ _ constructors _ -> compileDataDecl toplevel decl constructors     GDataDecl _ DataType _l _i _v _n decls _ -> compileDataDecl toplevel decl (map convertGADT decls)+    DataDecl _ NewType  _ _ _ constructors _ -> compileNewtypeDecl constructors     -- Just ignore type aliases and signatures.     TypeDecl{} -> return []     TypeSig{} -> return []@@ -149,6 +150,30 @@                                []                                (Just (thunk (JsGetProp (force (JsName (JsNameVar "x")))                                                        (JsNameVar (UnQual name))))))++-- | Compile a newtype declaration.+compileNewtypeDecl :: [QualConDecl] -> Compile [JsStmt]+compileNewtypeDecl [QualConDecl _ _ _ condecl] = do+  case condecl of+      -- newtype declaration without destructor+    ConDecl name  [ty]            -> addNewtype name Nothing ty+    RecDecl cname [([dname], ty)] -> addNewtype cname (Just dname) ty+    x -> error $ "compileNewtypeDecl case: Should be impossible (this is a bug). Got: " ++ show x+  return []+  where+    getBangTy :: BangType -> Type+    getBangTy (BangedTy t)   = t+    getBangTy (UnBangedTy t) = t+    getBangTy (UnpackedTy t) = t++    addNewtype cname dname ty = do+      qcname <- qualify cname+      qdname <- case dname of+                  Nothing -> return Nothing+                  Just n  -> qualify n >>= return . Just+      modify (\cs@CompileState{stateNewtypes=nts} ->+               cs{stateNewtypes=(qcname,qdname,getBangTy ty):nts})+compileNewtypeDecl q = error $ "compileNewtypeDecl: Should be impossible (this is a bug). Got: " ++ show q  -- | Compile a function which pattern matches (causing a case analysis). compileFunCase :: Bool -> [Match] -> Compile [JsStmt]

@@ -34,6 +34,7 @@   , stateModuleName = ModuleName "Main"   , stateRecordTypes = []   , stateRecords = []+  , stateNewtypes = []   , stateImported = [("Fay.Types",types)]   , stateNameDepth = 1   , stateLocalScope = S.empty

@@ -77,14 +77,22 @@ compileApp :: Exp -> Exp -> Compile JsExp compileApp exp1 exp2 = do    flattenApps <- config configFlattenApps-   if flattenApps then method2 else method1+   jsexp1 <- compileExp exp1+   case jsexp1 of+     JsName (JsNameVar qname) -> do+       ntc <- lookupNewtypeConst qname+       ntd <- lookupNewtypeDest  qname+       if isJust ntc || isJust ntd+         then compileExp exp2+         else (if flattenApps then method2 else method1) jsexp1+     _ -> (if flattenApps then method2 else method1) jsexp1    where   -- Method 1:   -- In this approach code ends up looking like this:   -- a(a(a(a(a(a(a(a(a(a(L)(c))(b))(0))(0))(y))(t))(a(a(F)(3*a(a(d)+a(a(f)/20))))*a(a(f)/2)))(140+a(f)))(y))(t)})   -- Which might be OK for speed, but increases the JS stack a fair bit.-  method1 =-    JsApp <$> (forceFlatName <$> compileExp exp1)+  method1 exp1 =+    JsApp <$> (forceFlatName <$> return exp1)           <*> fmap return (compileExp exp2)   forceFlatName name = JsApp (JsName JsForce) [name] @@ -92,8 +100,8 @@   -- In this approach code ends up looking like this:   -- d(O,a,b,0,0,B,w,e(d(I,3*e(e(c)+e(e(g)/20))))*e(e(g)/2),140+e(g),B,w)}),d(K,g,e(c)+0.05))   -- Which should be much better for the stack and readability, but probably not great for speed.-  method2 = fmap flatten $-    JsApp <$> compileExp exp1+  method2 exp1 = fmap flatten $+    JsApp <$> return exp1           <*> fmap return (compileExp exp2)   flatten (JsApp op args) =    case op of

@@ -20,6 +20,7 @@  import Control.Monad.Error import Control.Monad.Writer+import Control.Applicative ((<$>), (<*>)) import Data.Char import Data.Generics.Schemes import Data.List@@ -38,7 +39,29 @@            -> String -- ^ The format string.            -> Type   -- ^ Type signature.            -> Compile [JsStmt]-compileFFI srcloc name formatstr sig = do+compileFFI srcloc name formatstr sig =+  -- substitute newtypes with their child types before calling+  -- real compileFFI+  compileFFI' srcloc name formatstr =<< rmNewtys sig++  where rmNewtys :: Type -> Compile Type+        rmNewtys (TyForall b c t) = TyForall b c <$> rmNewtys t+        rmNewtys (TyFun t1 t2)    = TyFun <$> rmNewtys t1 <*> rmNewtys t2+        rmNewtys (TyTuple b tl)   = TyTuple b <$> mapM rmNewtys tl+        rmNewtys (TyList t)       = TyList <$> rmNewtys t+        rmNewtys (TyApp t1 t2)    = TyApp <$> rmNewtys t1 <*> rmNewtys t2+        rmNewtys t@TyVar{}        = return t+        rmNewtys (TyCon qname)    = do+          newty <- lookupNewtypeConst =<< qualifyQName qname+          return $ case newty of+                     Nothing     -> TyCon qname+                     Just (_,ty) -> ty+        rmNewtys (TyParen t)      = TyParen <$> rmNewtys t+        rmNewtys (TyInfix t1 q t2)= flip TyInfix q <$> rmNewtys t1 <*> rmNewtys t2+        rmNewtys (TyKind t k)     = flip TyKind k <$> rmNewtys t++compileFFI' :: SrcLoc -> Name -> String -> Type -> Compile [JsStmt]+compileFFI' srcloc name formatstr sig = do   inner <- formatFFI srcloc formatstr (zip params funcFundamentalTypes)   case JS.parse JS.parseExpression (prettyPrint name) (printJSString (wrapReturn inner)) of     Left err -> throwError (FfiFormatInvalidJavaScript srcloc inner (show err))

@@ -0,0 +1,117 @@+{-# LANGUAGE OverloadedStrings #-}++module Fay.Compiler.InitialPass where++import Fay.Compiler.Misc+import Fay.Types+import Fay.Compiler.Config+import Fay.Compiler.Decl (compileNewtypeDecl)++import Control.Applicative+import Control.Monad.Error+import Control.Monad.RWS+import Language.Haskell.Exts.Syntax+import Language.Haskell.Exts.Parser++initialPass :: Module -> Compile ()+initialPass (Module _ _ _ Nothing _ imports decls) = do+  forM_ imports $ \imp ->+    case imp of+      ImportDecl _ _ _ _ Just{} _ _ -> return ()++      ImportDecl _ name False _ Nothing Nothing _ ->+        void $ unlessImported name $ \filepath contents -> do+          result <- compileWith filepath initialPass contents+          case result of+            Right ((),st,_) ->+              -- Merges the state gotten from passing through an imported+              -- module with the current state. We can assume no duplicate+              -- records exist since GHC would pick that up.+              modify $ \s -> s { stateRecords = stateRecords st+                               , stateRecordTypes = stateRecordTypes st+                               , stateImported = stateImported st+                               , stateNewtypes = stateNewtypes st+                               }+            Left err -> throwError err++      i -> throwError $ UnsupportedImport i++  forM_ decls scanRecordDecls+  forM_ decls scanNewtypeDecls++initialPass m = throwError (UnsupportedModuleSyntax m)++compileWith :: (Show from,Parseable from)+            => FilePath+            -> (from -> Compile ())+            -> String+            -> Compile (Either CompileError ((),CompileState,CompileWriter))+compileWith filepath with from = do+  compileReader <- ask+  compileState  <- get+  liftIO $ runCompile compileReader+                      compileState+                      (parseResult (throwError . uncurry ParseError)+                                   with+                                   (parseFay filepath from))++-- | Don't re-import the same modules.+unlessImported :: ModuleName+                           -> (FilePath -> String -> Compile ())+                           -> Compile ()+unlessImported name importIt = do+  imported <- gets stateImported+  case lookup name imported of+    Just _ -> return ()+    Nothing -> do+      dirs <- configDirectoryIncludePaths <$> config id+      (filepath,contents) <- findImport dirs name+      modify $ \s -> s { stateImported = (name,filepath) : imported }+      importIt filepath contents++scanNewtypeDecls :: Decl -> Compile ()+scanNewtypeDecls (DataDecl _ NewType _ _ _ constructors _) =+  void $ compileNewtypeDecl constructors+scanNewtypeDecls _ = return ()++scanRecordDecls :: Decl -> Compile ()+scanRecordDecls decl = do+  case decl of+    DataDecl _loc DataType _ctx name _tyvarb qualcondecls _deriv -> do+      let ns = flip map qualcondecls (\(QualConDecl _loc' _tyvarbinds _ctx' condecl) -> conDeclName condecl)+      addRecordTypeState name ns+    _ -> return ()+++  case decl of+    DataDecl _ DataType _ _ _ constructors _ -> dataDecl constructors+    GDataDecl _ DataType _l _i _v _n decls _ -> dataDecl (map convertGADT decls)+    _ -> return ()++  where+    addRecordTypeState name cons = modify $ \s -> s+      { stateRecordTypes = (UnQual name, map UnQual cons) : stateRecordTypes s }++    conDeclName (ConDecl n _) = n+    conDeclName (InfixConDecl _ n _) = n+    conDeclName (RecDecl n _) = n++    -- | Collect record definitions and store record name and field names.+    -- A ConDecl will have fields named slot1..slotN+    dataDecl :: [QualConDecl] -> Compile ()+    dataDecl constructors = do+      forM_ constructors $ \(QualConDecl _ _ _ condecl) ->+        case condecl of+          ConDecl name types -> do+            let fields =  map (Ident . ("slot"++) . show . fst) . zip [1 :: Integer ..] $ types+            addRecordState name fields+          InfixConDecl _t1 name _t2 ->+            addRecordState name ["slot1", "slot2"]+          RecDecl name fields' -> do+            let fields = concatMap fst fields'+            addRecordState name fields++      where+        addRecordState :: Name -> [Name] -> Compile ()+        addRecordState name fields = modify $ \s -> s+          { stateRecords = (UnQual name,map UnQual fields) : stateRecords s }

@@ -75,11 +75,30 @@     then return (UnQual name)     else maybe (qualify name) return (ModuleScope.resolveName u env) +lookupNewtypeConst :: QName -> Compile (Maybe (Maybe QName,Type))+lookupNewtypeConst name = do+  newtypes <- gets stateNewtypes+  case find (\(cname,_,_) -> cname == name) newtypes of+    Nothing -> return Nothing+    Just (_,dname,ty) -> return $ Just (dname,ty)++lookupNewtypeDest :: QName -> Compile (Maybe (QName,Type))+lookupNewtypeDest name = do+  newtypes <- gets stateNewtypes+  case find (\(_,dname,_) -> dname == Just name) newtypes of+    Nothing -> return Nothing+    Just (cname,_,ty) -> return $ Just (cname,ty)+ -- | Qualify a name for the current module. qualify :: Name -> Compile QName qualify name = do   modulename <- gets stateModuleName   return (Qual modulename name)++-- | Qualify a QName for the current module if unqualified.+qualifyQName :: QName -> Compile QName+qualifyQName (UnQual name) = qualify name+qualifyQName n             = return n  -- | Make a top-level binding. bindToplevel :: SrcLoc -> Bool -> Name -> JsExp -> Compile JsStmt

@@ -60,7 +60,7 @@ bindAsLocals :: [QName] -> ModuleScope -> ModuleScope bindAsLocals qs (ModuleScope binds) =   -- This needs to be changed to not use unqual to support qualified imports.-  ModuleScope $ M.fromList (map (unqual &&& id) qs) `M.union` binds+  ModuleScope $ binds `M.union` M.fromList (map (unqual &&& id) qs)     where unqual (Qual _ n) = (UnQual n)           unqual u@UnQual{} = u           unqual Special{}  = error "fay: ModuleScope.bindAsLocals: Special"

@@ -10,6 +10,7 @@ import Control.Applicative import Control.Monad import Control.Monad.Extra+import Data.Maybe import Data.List import Data.Version import GHC.Paths@@ -32,7 +33,9 @@     Nothing -> error $ "unable to find package version: " ++ name     Just ver -> do       let nameVer = name ++ "-" ++ ver-      shareDir <- fmap ($ nameVer) getShareGen+      shareDir <- if isJust (configBasePath config) && name == "fay-base"+                    then return . fromJust $ configBasePath config+                    else fmap ($ nameVer) getShareGen       let includes = [shareDir,shareDir </> "src"]       exists <- mapM doesSourceDirExist includes       if any id exists

@@ -20,7 +20,12 @@ compilePat exp pat body =   case pat of     PVar name       -> compilePVar name exp body-    PApp cons pats  -> compilePApp cons pats exp body+    PApp cons pats  -> do+      qcons <- qualifyQName cons+      newty <- lookupNewtypeConst qcons+      case newty of+        Nothing -> compilePApp cons pats exp body+        Just _  -> compileNewtypePat pats exp body     PLit literal    -> compilePLit exp literal body     PParen pat      -> compilePat exp pat body     PWildCard       -> return body@@ -99,6 +104,10 @@   bindVar name   x <- compilePat exp pat body   return ([JsVar (JsNameVar (UnQual name)) exp] ++ x)++compileNewtypePat :: [Pat] -> JsExp -> [JsStmt] -> Compile [JsStmt]+compileNewtypePat [pat] exp body = compilePat exp pat body+compileNewtypePat ps _ _ = error $ "compileNewtypePat: Should be impossible (this is a bug). Got: " ++ show ps  -- | Compile a pattern application. compilePApp :: QName -> [Pat] -> JsExp -> [JsStmt] -> Compile [JsStmt]

@@ -76,7 +76,8 @@   , configWall               :: Bool                       -- ^ Typecheck with -Wall.   , configGClosure           :: Bool                       -- ^ Run Google Closure on the produced JS.   , configPackageConf        :: Maybe FilePath             -- ^ The package config e.g. packages-6.12.3.-  , configPackages          :: [String]                    -- ^ Included Fay packages.+  , configPackages           :: [String]                   -- ^ Included Fay packages.+  , configBasePath           :: Maybe FilePath             -- ^ Custom source location for fay-base   } deriving (Show)  -- | State of the compiler.@@ -84,6 +85,7 @@   { _stateExports     :: Map ModuleName (Set QName) -- ^ Collects exports from modules   , stateRecordTypes  :: [(QName,[QName])]          -- ^ Map types to constructors   , stateRecords      :: [(QName,[QName])]          -- ^ Map constructors to fields+  , stateNewtypes     :: [(QName, Maybe QName, Type)] -- ^ Newtype constructor, destructor, wrapped type tuple   , stateImported     :: [(ModuleName,FilePath)]    -- ^ Map of all imported modules and their source locations.   , stateNameDepth    :: Integer                    -- ^ Depth of the current lexical scope.   , stateLocalScope   :: Set Name                   -- ^ Names in the current lexical scope.@@ -131,7 +133,14 @@  -- | Get all of the exported identifiers for the given module. getExportsFor :: ModuleName -> CompileState -> Set QName-getExportsFor mn cs = fromMaybe S.empty $ M.lookup mn (_stateExports cs)+getExportsFor mn cs = excludeNewtypes cs $ fromMaybe S.empty $ M.lookup mn (_stateExports cs)+  where+    excludeNewtypes :: CompileState -> Set QName -> Set QName+    excludeNewtypes cs' names =+      let newtypes = stateNewtypes cs'+          constrs = map (\(c, _, _) -> c) newtypes+          destrs  = map (\(_, d, _) -> fromJust d) . filter (\(_, d, _) -> isJust d) $ newtypes+       in names `S.difference` (S.fromList constrs `S.union` S.fromList destrs)  -- | Compile monad. newtype Compile a = Compile

@@ -49,6 +49,7 @@   , optDispatcher   :: Bool   , optStdlibOnly   :: Bool   , optNoBuiltins   :: Bool+  , optBasePath     :: Maybe FilePath   }  -- | Main entry point.@@ -81,6 +82,7 @@                    , configDispatchers      = not (optNoDispatcher opts)                    , configDispatcherOnly   = optDispatcher opts                    , configExportStdlibOnly = optStdlibOnly opts+                   , configBasePath         = optBasePath opts                    }            void $ incompatible htmlAndStdout opts "Html wrapping and stdout are incompatible"            case optFiles opts of@@ -127,6 +129,7 @@   <*> switch (long "dispatcher" <> help "Only output the type serialization dispatchers")   <*> switch (long "stdlib" <> help "Only output the stdlib")   <*> switch (long "no-builtins" <> help "Don't export no-builtins")+  <*> optional (strOption (long "base-path" <> help "If fay can't find the sources of fay-base you can use this to provide the path. Use --base-path ~/example instead of --base-path=~/example to make sure ~ is expanded properly"))    where strsOption m =           nullOption (m <> reader (Right . wordsBy (== ',')) <> value [])