summaryrefslogtreecommitdiff log msg author committer range
diff options
 context: 12345678910152025303540 space: includeignore mode: unifiedssdiff
author committer PhilFreeman <> 2014-02-11 23:02:00 (GMT) hdiff 2014-02-11 23:02:00 (GMT) 52ee81fd0a89698afa62a30cfbf67d58ec0450e8 (patch) a1a08c9fb1019b4ae9289535c26c51eab633ca60 e0b7d7b734222037539d352a4317f4cc1770db2a (diff)
version 0.3.13.10.3.13.1
-rw-r--r--prelude/prelude.purs9
-rw-r--r--psc/Main.hs6
-rw-r--r--psci/Main.hs2
-rw-r--r--purescript.cabal2
-rw-r--r--src/Language/PureScript.hs6
-rw-r--r--src/Language/PureScript/CodeGen/JS.hs62
-rw-r--r--src/Language/PureScript/Options.hs7
-rw-r--r--src/Language/PureScript/Parser/Common.hs4
-rw-r--r--src/Language/PureScript/TypeChecker.hs1
9 files changed, 57 insertions, 42 deletions
 diff --git a/prelude/prelude.purs b/prelude/prelude.pursindex c17988d..cbf0b0f 100644--- a/prelude/prelude.purs+++ b/prelude/prelude.purs@@ -898,6 +898,15 @@ module Math where 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 diff --git a/psc/Main.hs b/psc/Main.hsindex 3de42e2..f331f75 100644--- a/psc/Main.hs+++ b/psc/Main.hs@@ -94,8 +94,12 @@ noOpts :: Term Bool 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) <*> inputFilesdiff --git a/psci/Main.hs b/psci/Main.hsindex 197ffaa..65fe327 100644--- a/psci/Main.hs+++ b/psci/Main.hs@@ -35,7 +35,7 @@ getPreludeFilename :: IO FilePath 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" findCompletionsdiff --git a/purescript.cabal b/purescript.cabalindex 7d45c47..6a68dd6 100644--- a/purescript.cabal+++ b/purescript.cabal@@ -1,5 +1,5 @@ name: purescript-version: 0.3.13+version: 0.3.13.1 cabal-version: >=1.8 build-type: Simple license: MITdiff --git a/src/Language/PureScript.hs b/src/Language/PureScript.hsindex 34dbb02..d16132e 100644--- a/src/Language/PureScript.hs+++ b/src/Language/PureScript.hs@@ -59,12 +59,12 @@ compile opts ms = do 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)diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hsindex ab01907..0923da2 100644--- a/src/Language/PureScript/CodeGen/JS.hs+++ b/src/Language/PureScript/CodeGen/JS.hs@@ -51,31 +51,30 @@ import Language.PureScript.TypeChecker.Monad (canonicalizeDataConstructor) -- 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 _ mp (DataDeclaration _ _ ctors) _ = 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 @@ var = JSVar . identToJs -- 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 (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs 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 @@ varToJs m e qual@(Qualified _ ident) = go qual 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 @@ varToJs m e qual@(Qualified _ ident) = go qual -- 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 @@ statementToJs opts m e (If ifst) = ifToJs ifst 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 optsdiff --git a/src/Language/PureScript/Options.hs b/src/Language/PureScript/Options.hsindex a4e038e..09b86fb 100644--- a/src/Language/PureScript/Options.hs+++ b/src/Language/PureScript/Options.hs@@ -39,10 +39,15 @@ data Options = Options { -- 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"diff --git a/src/Language/PureScript/Parser/Common.hs b/src/Language/PureScript/Parser/Common.hsindex 2d24968..fa0d722 100644--- a/src/Language/PureScript/Parser/Common.hs+++ b/src/Language/PureScript/Parser/Common.hs@@ -217,8 +217,8 @@ parseQualified parser = qual -- 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 operatordiff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hsindex 0d993eb..d6f8b47 100644--- a/src/Language/PureScript/TypeChecker.hs+++ b/src/Language/PureScript/TypeChecker.hs@@ -50,7 +50,6 @@ addDataConstructor :: ModuleName -> ProperName -> [String] -> ProperName -> [Typ 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