packages feed

purescript 0.2.10.2 → 0.2.11

raw patch · 8 files changed

+402/−72 lines, 8 files

Files

+ libraries/prelude/prelude.purs view
@@ -0,0 +1,329 @@+module Prelude where++  id :: forall a. a -> a+  id = \x -> x++  flip :: forall a b c. (a -> b -> c) -> b -> a -> c+  flip = \f -> \b -> \a -> f a b++  konst :: forall a b. a -> b -> a+  konst = \a -> \b -> a++  (|>) :: forall a b c. (a -> b) -> (b -> c) -> a -> c+  (|>) = \f -> \g -> \a -> g (f a)++  infixr 5 |>++  (<|) :: forall a b c. (b -> c) -> (a -> b) -> a -> c+  (<|) = flip (|>)++  infixr 5 <|++  ($) :: forall a b. (a -> b) -> a -> b+  ($) f x = f x++  infixr 1000 $++module Maybe where++  data Maybe a = Nothing | Just a++  maybe :: forall a b. b -> (a -> b) -> Maybe a -> b+  maybe b _ Nothing = b+  maybe _ f (Just a) = f a++  fromMaybe :: forall a. a -> Maybe a -> a+  fromMaybe a = maybe a Prelude.id++  bindMaybe :: forall a b. Maybe a -> (a -> Maybe b) -> Maybe b+  bindMaybe m f = maybe Nothing f m++module Either where++  data Either a b = Left a | Right b++  either :: forall a b c. (a -> c) -> (b -> c) -> Either a b -> c+  either f _ (Left a) = f a+  either _ g (Right b) = g b ++  bindEither :: forall e a b. Either e a -> (a -> Either e b) -> Either e b+  bindEither = either (\e _ -> Left e) (\a f -> f a) ++module Arrays where++  import Maybe++  head :: forall a. [a] -> a+  head (x : _) = x++  headSafe :: forall a. [a] -> Maybe a+  headSafe (x : _) = Just x+  headSafe _ = Nothing++  tail :: forall a. [a] -> [a]+  tail (_ : xs) = xs++  tailSafe :: forall a. [a] -> Maybe [a]+  tailSafe (_ : xs) = Just xs+  tailSafe _ = Nothing++  map :: forall a b. (a -> b) -> [a] -> [b]+  map _ [] = []+  map f (x:xs) = f x : map f xs  ++  foldr :: forall a b. (a -> b -> a) -> a -> [b] -> a+  foldr f a (b : bs) = f (foldr f a bs) b+  foldr _ a [] = a++  foldl :: forall a b. (a -> b -> b) -> b -> [a] -> b+  foldl _ b [] = b+  foldl f b (a:as) = foldl f (f a b) as++  foreign import length "function length(xs) { \+                        \  return xs.length; \+                        \}" :: forall a. [a] -> Number++  foreign import indexOf :: forall a. [a] -> a -> Number++  foreign import lastIndexOf :: forall a. [a] -> a -> Number++  foreign import concat :: forall a. [a] -> [a] -> [a]++  foreign import join :: [String] -> String++  foreign import joinWith :: [String] -> String -> String++  foreign import push :: forall a. [a] -> a -> [a]++  foreign import reverse :: forall a. [a] -> [a]++  foreign import shift :: forall a. [a] -> [a]++  foreign import slice :: forall a. Number -> Number -> [a] -> [a]++  foreign import sort :: forall a. [a] -> [a]++  foreign import splice :: forall a. Number -> Number -> [a] -> [a] -> [a]++  infixr 6 :++  (:) :: forall a. a -> [a] -> [a]+  (:) a = concat [a]++  concatMap :: forall a b. [a] -> (a -> [b]) -> [b]+  concatMap [] f = []+  concatMap (a:as) f = f a `concat` concatMap as f++  filter :: forall a. (a -> Boolean) -> [a] -> [a]+  filter _ [] = []+  filter p (x:xs) | p x = x : filter p xs+  filter p (_:xs) = filter p xs++  empty :: forall a. [a] -> Boolean+  empty [] = true+  empty _ = false ++  range :: Number -> Number -> [Number]+  range lo hi = {+      var ns = [];+      for (n <- lo until hi) {+	ns = push ns n;+      }+      return ns;+    }++  zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]+  zipWith f (a:as) (b:bs) = f a b : zipWith f as bs+  zipWith _ _ _ = []++  any :: forall a. (a -> Boolean) -> [a] -> Boolean+  any _ [] = false+  any p (a:as) = p a || any p as++  all :: forall a. (a -> Boolean) -> [a] -> Boolean+  all _ [] = true+  all p (a:as) = p a && all p as++module Tuple where++  import Arrays++  type Tuple a b = { fst :: a, snd :: b }++  curry :: forall a b c. (Tuple a b -> c) -> a -> b -> c+  curry f a b = f { fst: a, snd: b }++  uncurry :: forall a b c. (a -> b -> c) -> Tuple a b -> c+  uncurry f t = f t.fst t.snd++  tuple :: forall a b. a -> b -> Tuple a b+  tuple = curry Prelude.id++  zip :: forall a b. [a] -> [b] -> [Tuple a b]+  zip = zipWith tuple++  unzip :: forall a b. [Tuple a b] -> Tuple [a] [b]+  unzip (t:ts) = case unzip ts of+      { fst = as, snd = bs } -> tuple (t.fst : as) (t.snd : bs)+  unzip [] = tuple [] []++module String where++  foreign import lengthS "function lengthS(s) {\+                         \  return s.length;\+                         \}" :: String -> Number++  foreign import charAt :: Number -> String -> String++  foreign import indexOfS :: String -> String -> Number++  foreign import lastIndexOfS :: String -> String -> Number++  foreign import localeCompare :: String -> String -> Number++  foreign import replace :: String -> String -> String -> String++  foreign import sliceS :: Number -> Number -> String -> String++  foreign import split :: String -> String -> [String]++  foreign import substr :: Number -> Number -> String -> String++  foreign import substring :: Number -> Number -> String -> String++  foreign import toLower :: String -> String++  foreign import toUpper :: String -> String++  foreign import trim :: String -> String++module Regex where++  foreign import data Regex :: *++  foreign import regex :: String -> String -> Regex++  foreign import test :: Regex -> String -> Boolean++  foreign import match :: Regex -> String -> [String]++  foreign import replaceR :: Regex -> String -> String -> String++  foreign import search :: Regex -> String -> Number++module Global where++  foreign import nan :: Number++  foreign import infinity :: Number++  foreign import toExponential :: Number -> String++  foreign import toFixed :: Number -> Number -> String++  foreign import toPrecision :: Number -> Number -> String++  foreign import numberToString :: Number -> String++  foreign import isNaN :: Number -> Boolean++  foreign import isFinite :: Number -> Boolean++  foreign import parseFloat :: String -> Number++  foreign import parseInt :: String -> Number++  foreign import encodeURIComponent :: String -> String++  foreign import decodeURIComponent :: String -> String++  foreign import encodeURI :: String -> String++  foreign import decodeURI :: String -> String++module Math where++  type Math = +    { abs :: Number -> Number+    , acos :: Number -> Number+    , asin :: Number -> Number+    , atan :: Number -> Number+    , atan2 :: (Number, Number) -> Number+    , aceil :: Number -> Number+    , cos :: Number -> Number+    , exp :: Number -> Number+    , floor :: Number -> Number+    , log :: Number -> Number+    , max :: (Number, Number) -> Number+    , pow :: (Number, Number) -> Number+    , random :: () -> Number+    , round :: Number -> Number+    , sin :: Number -> Number+    , sqrt :: Number -> Number+    , tan :: Number -> Number+    }++  foreign import math :: Math+  +module Eff where++  foreign import data Eff :: # ! -> * -> *++  foreign import retEff "function retEff(a) { return function() { return a; }; }" :: forall e a. a -> Eff e a++  foreign import bindEff "function bindEff(a) { return function(f) { return function() { return f(a())(); }; }; }" :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b ++  type Pure a = forall e. Eff e a++  foreign import runPure :: forall a. Pure a -> a++  eff = { ret: retEff, bind: bindEff }++module Errors where++  import Eff++  foreign import data Error :: * -> !++  foreign import throwError "function throwError(e) { return function() { throw e; }; }" :: forall a e r. e -> Eff (err :: Error e | r) a++  foreign import catchError "function catchError(c) { return function(t) { return function() { try { return t(); } catch(e) { return c(e)(); } }; }; }" :: forall e r a. (e -> Eff r a) -> Eff (err :: Error e | r) a -> Eff r a++module IORef where++  import Eff+  +  foreign import data Ref :: !+  +  foreign import data IORef :: * -> *+  +  foreign import newIORef :: forall s r. s -> Eff (ref :: Ref | r) (IORef s)++  foreign import readIORef :: forall s r. IORef s -> Eff (ref :: Ref | r) s++  foreign import writeIORef :: forall s r. IORef s -> s -> Eff (ref :: Ref | r) {}++module Trace where++  import Eff+  +  foreign import data Trace :: !+  +  foreign import trace "function trace(s) { return function() { console.log(s); return {}; }; }" :: forall r. String -> Eff (trace :: Trace | r) {}++module ST where++  import Eff++  foreign import data ST :: * -> !++  foreign import data STRef :: * -> * -> *++  foreign import newSTRef :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)++  foreign import readSTRef :: forall a h r. STRef h a -> Eff (st :: ST h | r) a++  foreign import modifySTRef :: forall a h r. (a -> a) -> STRef h a -> Eff (st :: ST h | r) {}++  foreign import runST :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a+
purescript.cabal view
@@ -1,5 +1,5 @@ name: purescript-version: 0.2.10.2+version: 0.2.11 cabal-version: >=1.8 build-type: Simple license: MIT@@ -12,6 +12,7 @@ category: Language author: Phil Freeman <paf31@cantab.net> data-dir: ""+data-files: libraries/prelude/prelude.purs  library     build-depends: base >=4 && <5, cmdtheline -any, containers -any,
src/Language/PureScript/CodeGen/JS.hs view
@@ -86,7 +86,7 @@     _ -> JSVar . Ident . runProperName $ name valueToJs _ _ _ (Constructor name) = qualifiedToJS runProperName name valueToJs opts m e (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs opts m e) sts))) []-valueToJs opts m e (Case values binders) = runGen (bindersToJs opts m e binders (map (valueToJs opts m e) values))+valueToJs opts m e (Case values binders) = bindersToJs opts m e binders (map (valueToJs opts m e) values) valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e cond) (valueToJs opts m e th) (valueToJs opts m e el) valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val) valueToJs opts m e (Indexer index val) = JSIndexer (valueToJs opts m e index) (valueToJs opts m e val)@@ -144,15 +144,14 @@ qualifiedToJS f (Qualified (Just (ModuleName (ProperName m))) a) = JSAccessor (f a) (JSVar (Ident m)) qualifiedToJS f (Qualified Nothing a) = JSVar (Ident (f a)) -bindersToJs :: Options -> ModuleName -> Environment -> [([Binder], Maybe Guard, Value)] -> [JS] -> Gen JS-bindersToJs opts m e binders vals = do-  setNextName $ firstUnusedName (binders, vals)+bindersToJs :: Options -> ModuleName -> Environment -> [([Binder], Maybe Guard, Value)] -> [JS] -> JS+bindersToJs opts m e binders vals = runGen (unusedNames (binders, vals)) $ do   valNames <- replicateM (length vals) fresh   jss <- forM binders $ \(bs, grd, result) -> go valNames [JSReturn (valueToJs opts m e result)] bs grd-  return $ JSApp (JSFunction Nothing (map Ident valNames) (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))+  return $ JSApp (JSFunction Nothing valNames (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))                  vals   where-    go :: [String] -> [JS] -> [Binder] -> Maybe Guard -> Gen [JS]+    go :: [Ident] -> [JS] -> [Binder] -> Maybe Guard -> Gen [JS]     go _ done [] Nothing = return done     go _ done [] (Just cond) = return [JSIfElse (valueToJs opts m e cond) (JSBlock done) Nothing]     go (v:vs) done' (b:bs) grd = do@@ -160,24 +159,24 @@       binderToJs m e v done'' b     go _ _ _ _ = error "Invalid arguments to bindersToJs" -binderToJs :: ModuleName -> Environment -> String -> [JS] -> Binder -> Gen [JS]+binderToJs :: ModuleName -> Environment -> Ident -> [JS] -> Binder -> Gen [JS] binderToJs _ _ _ done NullBinder = return done binderToJs _ _ varName done (StringBinder str) =-  return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSStringLiteral str)) (JSBlock done) Nothing]+  return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral str)) (JSBlock done) Nothing] binderToJs _ _ varName done (NumberBinder num) =-  return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSNumericLiteral num)) (JSBlock done) Nothing]+  return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSNumericLiteral num)) (JSBlock done) Nothing] binderToJs _ _ varName done (BooleanBinder True) =-  return [JSIfElse (JSVar (Ident varName)) (JSBlock done) Nothing]+  return [JSIfElse (JSVar varName) (JSBlock done) Nothing] binderToJs _ _ varName done (BooleanBinder False) =-  return [JSIfElse (JSUnary Not (JSVar (Ident varName))) (JSBlock done) Nothing]+  return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing] binderToJs _ _ varName done (VarBinder ident) =-  return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : done)+  return (JSVariableIntroduction ident (Just (JSVar varName)) : done) binderToJs m _ varName done (NullaryBinder ctor) =-  return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar (Ident varName))) (JSStringLiteral (show ((\(mp, nm) -> Qualified (Just mp) nm) $ qualify m ctor)))) (JSBlock done) Nothing]+  return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar varName)) (JSStringLiteral (show ((\(mp, nm) -> Qualified (Just mp) nm) $ qualify m ctor)))) (JSBlock done) Nothing] binderToJs m e varName done (UnaryBinder ctor b) = do   value <- fresh   js <- binderToJs m e value done b-  return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar (Ident varName))) (JSStringLiteral (show ((\(mp, nm) -> Qualified (Just mp) nm) $ qualify m ctor)))) (JSBlock (JSVariableIntroduction (Ident value) (Just (JSAccessor "value" (JSVar (Ident varName)))) : js)) Nothing]+  return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar varName)) (JSStringLiteral (show ((\(mp, nm) -> Qualified (Just mp) nm) $ qualify m ctor)))) (JSBlock (JSVariableIntroduction value (Just (JSAccessor "value" (JSVar varName))) : js)) Nothing] binderToJs m e varName done (ObjectBinder bs) = go done bs   where   go :: [JS] -> [(String, Binder)] -> Gen [JS]@@ -186,10 +185,10 @@     propVar <- fresh     done'' <- go done' bs'     js <- binderToJs m e propVar done'' binder-    return (JSVariableIntroduction (Ident propVar) (Just (JSAccessor prop (JSVar (Ident varName)))) : js)+    return (JSVariableIntroduction propVar (Just (JSAccessor prop (JSVar varName))) : js) binderToJs m e varName done (ArrayBinder bs) = do   js <- go done 0 bs-  return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]+  return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]   where   go :: [JS] -> Integer -> [Binder] -> Gen [JS]   go done' _ [] = return done'@@ -197,20 +196,20 @@     elVar <- fresh     done'' <- go done' (index + 1) bs'     js <- binderToJs m e elVar done'' binder-    return (JSVariableIntroduction (Ident elVar) (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar (Ident varName)))) : js)+    return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js) binderToJs m e varName done (ConsBinder headBinder tailBinder) = do   headVar <- fresh   tailVar <- fresh   js1 <- binderToJs m e headVar done headBinder   js2 <- binderToJs m e tailVar js1 tailBinder-  return [JSIfElse (JSBinary GreaterThan (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left 0))) (JSBlock-    ( JSVariableIntroduction (Ident headVar) (Just (JSIndexer (JSNumericLiteral (Left 0)) (JSVar (Ident varName)))) :-      JSVariableIntroduction (Ident tailVar) (Just (JSApp (JSAccessor "slice" (JSVar (Ident varName))) [JSNumericLiteral (Left 1)])) :+  return [JSIfElse (JSBinary GreaterThan (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left 0))) (JSBlock+    ( JSVariableIntroduction headVar (Just (JSIndexer (JSNumericLiteral (Left 0)) (JSVar varName))) :+      JSVariableIntroduction tailVar (Just (JSApp (JSAccessor "slice" (JSVar varName)) [JSNumericLiteral (Left 1)])) :       js2     )) Nothing] binderToJs m e varName done (NamedBinder ident binder) = do   js <- binderToJs m e varName done binder-  return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : js)+  return (JSVariableIntroduction ident (Just (JSVar varName)) : js)  statementToJs :: Options -> ModuleName -> Environment -> Statement -> JS statementToJs opts m e (VariableIntroduction ident value) = JSVariableIntroduction ident (Just (valueToJs opts m e value))
src/Language/PureScript/CodeGen/Monad.hs view
@@ -18,20 +18,15 @@  import Control.Monad.State import Control.Applicative+import Language.PureScript.Names -newtype Gen a = Gen { unGen :: State Int a } deriving (Functor, Applicative, Monad, MonadState Int, MonadFix)+newtype Gen a = Gen { unGen :: State [Ident] a } deriving (Functor, Applicative, Monad, MonadState [Ident]) -runGen :: Gen a -> a-runGen = flip evalState 0 . unGen+runGen :: [Ident] -> Gen a -> a+runGen names = flip evalState names . unGen -fresh :: Gen String+fresh :: Gen Ident fresh = do-  n <- get-  modify (+ 1)-  return $ '_' : show n--getNextName :: Gen Int-getNextName = get--setNextName :: Int -> Gen ()-setNextName = put+  (s:ss) <- get+  put ss+  return s
src/Language/PureScript/CodeGen/Optimize.hs view
@@ -49,9 +49,17 @@ isReassigned var1 = everything (||) (mkQ False check)   where   check :: JS -> Bool-  check (JSAssignment (JSAssignVariable var2) _) | var1 == var2 = True+  check (JSFunction _ args _) | var1 `elem` args = True   check _ = False +isRebound :: (Data d) => JS -> d -> Bool+isRebound (JSVar var1) = everything (||) (mkQ False check)+  where+  check :: JS -> Bool+  check (JSFunction _ args _) | var1 `elem` args = True+  check _ = False+isRebound _ = const False+ isUsed :: (Data d) => Ident -> d -> Bool isUsed var1 = everything (||) (mkQ False check)   where@@ -80,7 +88,7 @@   removeFromBlock js = js   go :: [JS] -> [JS]   go [] = []-  go (JSVariableIntroduction var (Just js) : sts) | shouldInline js && not (isReassigned var sts) = go (replaceIdent var js sts)+  go (JSVariableIntroduction var (Just js) : sts) | shouldInline js && not (isReassigned var sts) && not (isRebound js sts) = go (replaceIdent var js sts)   go (s:sts) = s : go sts  removeUnusedVariables :: JS -> JS@@ -98,8 +106,8 @@ etaConvert = everywhere (mkT convert)   where   convert :: JS -> JS-  convert (JSBlock [JSReturn (JSApp (JSFunction Nothing idents (JSBlock body)) args)])-    | all shouldInline args = JSBlock (replaceIdents (zip idents args) body)+  convert (JSBlock [JSReturn (JSApp (JSFunction Nothing idents block@(JSBlock body)) args)])+    | all shouldInline args && not (or (map (flip isRebound block) args)) = JSBlock (replaceIdents (zip idents args) body)   convert js = js  unThunk :: JS -> JS
src/Language/PureScript/Scope.hs view
@@ -14,8 +14,7 @@  module Language.PureScript.Scope (     usedNames,-    unusedNames,-    firstUnusedName+    unusedNames ) where  import Data.Data@@ -25,7 +24,6 @@ import Language.PureScript.Values import Language.PureScript.Names import Language.PureScript.CodeGen.JS.AST-import Data.Maybe (mapMaybe)  usedNames :: (Data d) => d -> [Ident] usedNames val = nub $ everything (++) (mkQ [] namesV `extQ` namesS `extQ` namesB `extQ` namesJS) val@@ -56,20 +54,3 @@     varNames = map (Ident . ('_' :) . show) ([1..] :: [Int])   in     varNames \\ allNames--firstUnusedName :: (Data d) => d -> Int-firstUnusedName val =-  let-    allNames = usedNames val-    varNames = mapMaybe toUnknown allNames-  in-    1 + maximum (0 : varNames)-  where-  toUnknown :: Ident -> Maybe Int-  toUnknown (Ident ('_' : s)) = readMaybe s-  toUnknown _ = Nothing--readMaybe :: String -> Maybe Int-readMaybe s = case reads s of-                [(n, "")] -> Just n-                _ -> Nothing
src/Language/PureScript/TypeChecker.hs view
@@ -155,22 +155,27 @@        moduleExists env = not (null (filterModule (names env))) || not (null (filterModule (types env)))        shadowIdents idents' env =          forM_ idents' $ \ident -> do-           guardWith (show currentModule ++ "." ++ show ident ++ " is already defined") $ (currentModule, ident) `M.notMember` names env            case (moduleName, ident) `M.lookup` names env of-             Just (pt, _) -> modifyEnv (\e -> e { names = M.insert (currentModule, ident) (pt, Alias moduleName ident) (names e) })+             Just (_, Alias _ _) -> return ()+             Just (pt, _) -> do+               guardWith (show currentModule ++ "." ++ show ident ++ " is already defined") $ (currentModule, ident) `M.notMember` names env+               modifyEnv (\e -> e { names = M.insert (currentModule, ident) (pt, Alias moduleName ident) (names e) })              Nothing -> throwError (show moduleName ++ "." ++ show ident ++ " is undefined")        shadowTypes pns env =          forM_ pns $ \pn -> do-           guardWith (show currentModule ++ "." ++ show pn ++ " is already defined") $ (currentModule, pn) `M.notMember` types env            case (moduleName, pn) `M.lookup` types env of              Nothing -> throwError (show moduleName ++ "." ++ show pn ++ " is undefined")+             Just (_, DataAlias _ _) -> return ()              Just (k, _) -> do+               guardWith (show currentModule ++ "." ++ show pn ++ " is already defined") $ (currentModule, pn) `M.notMember` types env                modifyEnv (\e -> e { types = M.insert (currentModule, pn) (k, DataAlias moduleName pn) (types e) })                let keys = map (snd . fst) . filter (\(_, (fn, _)) -> fn `constructs` pn) . M.toList . dataConstructors $ env                forM_ keys $ \dctor -> do-                 guardWith (show currentModule ++ "." ++ show dctor ++ " is already defined") $ (currentModule, dctor) `M.notMember` dataConstructors env                  case (moduleName, dctor) `M.lookup` dataConstructors env of-                   Just (ctorTy, _) -> modifyEnv (\e -> e { dataConstructors = M.insert (currentModule, dctor) (ctorTy, Alias moduleName (Ident (runProperName dctor))) (dataConstructors e) })+                   Just (_, Alias _ _) -> return ()+                   Just (ctorTy, _) -> do+                     guardWith (show currentModule ++ "." ++ show dctor ++ " is already defined") $ (currentModule, dctor) `M.notMember` dataConstructors env+                     modifyEnv (\e -> e { dataConstructors = M.insert (currentModule, dctor) (ctorTy, Alias moduleName (Ident (runProperName dctor))) (dataConstructors e) })                    Nothing -> throwError (show moduleName ++ "." ++ show dctor ++ " is undefined")        constructs (TypeConstructor (Qualified (Just mn) pn')) pn          = mn == moduleName && pn' == pn
src/Main.hs view
@@ -21,7 +21,12 @@ import System.Exit (exitSuccess, exitFailure) import qualified System.IO.UTF8 as U import Text.Parsec (ParseError)+import qualified Paths_purescript as Paths+import Data.Version (showVersion) +preludeFilename :: IO FilePath+preludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"+ readInput :: Maybe [FilePath] -> IO (Either ParseError [P.Module]) readInput Nothing = getContents >>= return . P.runIndentParser P.parseModules readInput (Just input) = fmap (fmap concat . sequence) $ forM input $ \inputFile -> do@@ -73,24 +78,31 @@ performRuntimeTypeChecks = value $ flag $ (optInfo [ "runtime-type-checks" ])      { optDoc = "Generate runtime type checks" } +noPrelude :: Term Bool+noPrelude = value $ flag $ (optInfo [ "no-prelude" ])+     { optDoc = "Omit the Prelude" }+ options :: Term P.Options options = P.Options <$> tco <*> performRuntimeTypeChecks -stdInOrInputFiles :: Term (Maybe [FilePath])-stdInOrInputFiles = combine <$> useStdIn <*> inputFiles+stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])+stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles   where-  combine False input = Just input-  combine True _ = Nothing+  combine False True input = Just (prelude : input)+  combine False False input = Just input+  combine True _ _ = Nothing -term :: Term (IO ())-term = compile <$> options <*> stdInOrInputFiles <*> outputFile <*> externsFile+term :: FilePath -> Term (IO ())+term prelude = compile <$> options <*> stdInOrInputFiles prelude <*> outputFile <*> externsFile  termInfo :: TermInfo termInfo = defTI   { termName = "psc"-  , version  = "1.0"+  , version  = showVersion $ Paths.version   , termDoc  = "Compiles PureScript to Javascript"   }  main :: IO ()-main = run (term, termInfo)+main = do+  prelude <- preludeFilename+  run (term prelude, termInfo)