purescript 0.3.13 → 0.3.13.1
raw patch · 9 files changed
+57/−42 lines, 9 files
Files
- prelude/prelude.purs +9/−0
- psc/Main.hs +5/−1
- psci/Main.hs +1/−1
- purescript.cabal +1/−1
- src/Language/PureScript.hs +3/−3
- src/Language/PureScript/CodeGen/JS.hs +30/−32
- src/Language/PureScript/Options.hs +6/−1
- src/Language/PureScript/Parser/Common.hs +2/−2
- src/Language/PureScript/TypeChecker.hs +0/−1
prelude/prelude.purs view
@@ -898,6 +898,15 @@ foreign import tan "function tan(n){\ \ return Math.tan(n);\ \}" :: Number -> Number+ + foreign import e "var e = Math.E;" :: Number+ foreign import ln2 "var ln2 = Math.LN2;" :: Number+ foreign import ln10 "var ln10 = Math.LN10;" :: Number+ foreign import log2e "var log2e = Math.LOG2E;" :: Number+ foreign import log10e "var log10e = Math.LOG10E;" :: Number+ foreign import pi "var pi = Math.PI;" :: Number+ foreign import sqrt1_2 "var sqrt1_2 = Math.SQRT1_2;" :: Number+ foreign import sqrt2 "var sqrt2 = Math.SQRT2;" :: Number module Eff where
psc/Main.hs view
@@ -94,8 +94,12 @@ noOpts = value $ flag $ (optInfo [ "no-opts" ]) { optDoc = "Skip the optimization phase." } +browserNamespace :: Term String+browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])+ { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }+ options :: Term P.Options-options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain <*> noOpts+options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain <*> noOpts <*> browserNamespace stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath]) stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles
psci/Main.hs view
@@ -35,7 +35,7 @@ getPreludeFilename = Paths.getDataFileName "prelude/prelude.purs" options :: P.Options-options = P.Options True False True True True+options = P.Options True False True True True "PS" completion :: [P.Module] -> CompletionFunc IO completion ms = completeWord Nothing " \t\n\r" findCompletions
purescript.cabal view
@@ -1,5 +1,5 @@ name: purescript-version: 0.3.13+version: 0.3.13.1 cabal-version: >=1.8 build-type: Simple license: MIT
src/Language/PureScript.hs view
@@ -59,12 +59,12 @@ modify (\s -> s { checkCurrentModule = Just (ModuleName moduleName) }) Module moduleName <$> typeCheckAll (ModuleName moduleName) decls regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated- let js = concatMap (flip (moduleToJs opts) env) $ regrouped+ let js = map (flip (moduleToJs opts) env) $ regrouped let exts = intercalate "\n" . map (flip moduleToPs env) $ regrouped js' <- case () of _ | optionsRunMain opts -> do when ((ModuleName (ProperName "Main"), Ident "main") `M.notMember` (names env)) $ Left "Main.main is undefined"- return $ js ++ [JSApp (JSAccessor "main" (JSVar "Main")) []]+ return $ js ++ [JSApp (JSAccessor "main" (JSAccessor "Main" (JSVar "_ps"))) []] | otherwise -> return js- return (prettyPrintJS [(wrapExportsContainer js')], exts, env)+ return (prettyPrintJS [(wrapExportsContainer opts js')], exts, env)
src/Language/PureScript/CodeGen/JS.hs view
@@ -51,31 +51,30 @@ -- Generate code in the simplified Javascript intermediate representation for all declarations in a -- module. ---moduleToJs :: Options -> Module -> Environment -> [JS]+moduleToJs :: Options -> Module -> Environment -> JS moduleToJs opts (Module pname@(ProperName name) decls) env =- [ JSVariableIntroduction name Nothing- , JSApp (JSFunction Nothing [name]- (JSBlock (concat $ mapMaybe (\decl -> fmap (map $ optimize opts) $ declToJs opts (ModuleName pname) decl env) (decls))))- [JSAssignment (JSVar name)- (JSBinary Or (JSVar name) (JSObjectLiteral []))]- , JSAssignment (JSAccessor name (JSVar "exports")) (JSVar name)- ]+ JSAssignment (JSAccessor name (JSVar "_ps")) $ JSApp (JSFunction Nothing ["module"]+ (JSBlock $ jsDecls ++ [JSReturn $ JSVar "module"]))+ [(JSBinary Or (JSAccessor name (JSVar "_ps")) (JSObjectLiteral []))]+ where+ jsDecls = (concat $ mapMaybe (\decl -> fmap (map $ optimize opts) $ declToJs opts (ModuleName pname) decl env) (decls)) -- | -- Generate code in the simplified Javascript intermediate representation for a declaration -- declToJs :: Options -> ModuleName -> Declaration -> Environment -> Maybe [JS] declToJs opts mp (ValueDeclaration ident _ _ val) e =- Just $ JSVariableIntroduction (identToJs ident) (Just (valueToJs opts mp e val))- : setProperty ident (var ident) mp+ Just $ [ JSVariableIntroduction (identToJs ident) (Just (valueToJs opts mp e val))+ , setExportProperty ident (var ident) ] declToJs opts mp (BindingGroupDeclaration vals) e = Just $ concatMap (\(ident, val) ->- JSVariableIntroduction (identToJs ident) (Just (valueToJs opts mp e val))- : setProperty ident (var ident) mp+ [ JSVariableIntroduction (identToJs ident) (Just (valueToJs opts mp e val))+ , setExportProperty ident (var ident) ] ) vals declToJs _ mp (DataDeclaration _ _ ctors) _ = Just $ flip concatMap ctors $ \(pn@(ProperName ctor), tys) ->- JSVariableIntroduction ctor (Just (go pn 0 tys [])) : setProperty (Escaped ctor) (JSVar ctor) mp+ [ JSVariableIntroduction ctor (Just (go pn 0 tys []))+ , setExportProperty (Escaped ctor) (JSVar ctor) ] where go pn _ [] values = JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified (Just mp) pn))), ("values", JSArrayLiteral $ reverse values) ]@@ -85,19 +84,15 @@ declToJs opts mp (DataBindingGroupDeclaration ds) e = Just $ concat $ mapMaybe (flip (declToJs opts mp) e) ds declToJs _ mp (ExternDeclaration importTy ident (Just js) _) _ =- Just $ js : setProperty ident (var ident) mp+ Just $ [js, setExportProperty ident (var ident)] declToJs _ _ _ _ = Nothing -- |--- Generate code in the simplified Javascript intermediate representation for setting the property--- of an object.+-- Generate code in the simplified Javascript intermediate representation for exporting a+-- declaration from a module. ---setProperty :: Ident -> JS -> ModuleName -> [JS]-setProperty ident@(Op op) val (ModuleName (ProperName moduleName)) =- [ JSAssignment (accessor ident (JSVar moduleName)) val- , JSAssignment (JSIndexer (JSStringLiteral op) (JSVar moduleName)) (accessor ident (JSVar moduleName)) ]-setProperty ident val (ModuleName (ProperName moduleName)) =- [ JSAssignment (accessor ident (JSVar moduleName)) val ]+setExportProperty :: Ident -> JS -> JS+setExportProperty ident val = JSAssignment (accessor ident (JSVar "module")) val -- | -- Generate code in the simplified Javascript intermediate representation for a variable based on a@@ -113,6 +108,7 @@ -- accessor :: Ident -> JS -> JS accessor (Ident name) | nameIsJsReserved name = JSIndexer (JSStringLiteral name)+accessor (Op op) = JSIndexer (JSStringLiteral op) accessor ident = JSAccessor (identToJs ident) -- |@@ -127,9 +123,9 @@ valueToJs opts m e (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar "Object")) [ valueToJs opts m e o, JSObjectLiteral (map (second (valueToJs opts m e)) ps)] valueToJs _ m e (Constructor (Qualified Nothing name)) = case M.lookup (m, name) (dataConstructors e) of- Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS id (Qualified (Just aliasModule) aliasIdent)+ Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS m id (Qualified (Just aliasModule) aliasIdent) _ -> JSVar . runProperName $ name-valueToJs _ _ _ (Constructor name) = qualifiedToJS (Ident . runProperName) name+valueToJs _ m _ (Constructor name) = qualifiedToJS m (Ident . 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) = 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)@@ -202,7 +198,7 @@ Just (_, Alias aliasModule aliasIdent) -> go (Qualified (Just aliasModule) aliasIdent) _ -> case qual of Qualified Nothing _ -> var ident- _ -> qualifiedToJS id qual+ _ -> qualifiedToJS m id qual isExtern (Extern ForeignImport) = True isExtern (Alias m' ident') = case M.lookup (m', ident') (names e) of Just (_, ty') -> isExtern ty'@@ -213,9 +209,9 @@ -- Generate code in the simplified Javascript intermediate representation for a reference to a -- variable that may have a qualified name. ---qualifiedToJS :: (a -> Ident) -> Qualified a -> JS-qualifiedToJS f (Qualified (Just (ModuleName (ProperName m))) a) = accessor (f a) (JSVar m)-qualifiedToJS f (Qualified Nothing a) = JSVar $ identToJs (f a)+qualifiedToJS :: ModuleName -> (a -> Ident) -> Qualified a -> JS+qualifiedToJS m f (Qualified (Just m'@(ModuleName (ProperName mn))) a) | m /= m' = accessor (f a) (JSAccessor mn $ JSVar "_ps")+qualifiedToJS m f (Qualified _ a) = JSVar $ identToJs (f a) -- | -- Generate code in the simplified Javascript intermediate representation for pattern match binders@@ -346,10 +342,12 @@ elseToJs (ElseIf elif) = ifToJs elif statementToJs opts m e (Return value) = JSReturn (valueToJs opts m e value) -wrapExportsContainer :: [JS] -> JS-wrapExportsContainer modules = JSApp (JSFunction Nothing ["exports"] $ JSBlock $ (JSStringLiteral "use strict") : modules) [exportSelector]- where exportSelector = JSConditional (JSBinary And (JSBinary NotEqualTo (JSTypeOf $ JSVar "module") (JSStringLiteral "undefined")) (JSAccessor "exports" (JSVar "module")))+wrapExportsContainer :: Options -> [JS] -> JS+wrapExportsContainer opts modules = JSApp (JSFunction Nothing ["_ps"] $ JSBlock $ (JSStringLiteral "use strict") : modules) [exportSelector]+ where+ exportSelector = JSConditional (JSBinary And (JSBinary NotEqualTo (JSTypeOf $ JSVar "module") (JSStringLiteral "undefined")) (JSAccessor "exports" (JSVar "module"))) (JSAccessor "exports" (JSVar "module")) (JSConditional (JSBinary NotEqualTo (JSTypeOf $ JSVar "window") (JSStringLiteral "undefined"))- (JSAssignment (JSAccessor "PS" (JSVar "window")) (JSObjectLiteral []))+ (JSAssignment (JSAccessor browserNamespace (JSVar "window")) (JSBinary Or (JSAccessor browserNamespace (JSVar "window")) (JSObjectLiteral []))) (JSApp (JSFunction Nothing [] $ JSBlock [JSThrow $ JSStringLiteral "PureScript doesn't know how to export modules in the current environment"]) []))+ browserNamespace = optionsBrowserNamespace opts
src/Language/PureScript/Options.hs view
@@ -39,10 +39,15 @@ -- Skip all optimizations -- , optionsNoOptimizations :: Bool+ -- |+ -- Specify the namespace that PureScript modules will be exported to when running in the+ -- browser.+ --+ , optionsBrowserNamespace :: String } deriving Show -- | -- Default compiler options -- defaultOptions :: Options-defaultOptions = Options False False False False False+defaultOptions = Options False False False False False "PS"
src/Language/PureScript/Parser/Common.hs view
@@ -217,8 +217,8 @@ -- Parse an integer or floating point value -- integerOrFloat :: P.Parsec String u (Either Integer Double)-integerOrFloat = (Left <$> P.try (PT.natural tokenParser) <|>- Right <$> P.try (PT.float tokenParser)) P.<?> "number"+integerOrFloat = (Right <$> P.try (PT.float tokenParser) <|>+ Left <$> P.try (PT.natural tokenParser)) P.<?> "number" -- | -- Parse an identifier or parenthesized operator
src/Language/PureScript/TypeChecker.hs view
@@ -50,7 +50,6 @@ addDataConstructor moduleName name args dctor tys = do env <- getEnv dataConstructorIsNotDefined moduleName dctor- when (runModuleName moduleName == dctor) $ throwError "A data constructor may not have the same name as its enclosing module." let retTy = foldl TypeApp (TypeConstructor (Qualified (Just moduleName) name)) (map TypeVar args) let dctorTy = foldr function retTy tys let polyType = mkForAll args dctorTy