summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilFreeman <>2014-02-11 23:02:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-02-11 23:02:00 (GMT)
commit52ee81fd0a89698afa62a30cfbf67d58ec0450e8 (patch)
treea1a08c9fb1019b4ae9289535c26c51eab633ca60
parente0b7d7b734222037539d352a4317f4cc1770db2a (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.purs
index 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.hs
index 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) <*> inputFiles
diff --git a/psci/Main.hs b/psci/Main.hs
index 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" findCompletions
diff --git a/purescript.cabal b/purescript.cabal
index 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: MIT
diff --git a/src/Language/PureScript.hs b/src/Language/PureScript.hs
index 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.hs
index 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 opts
diff --git a/src/Language/PureScript/Options.hs b/src/Language/PureScript/Options.hs
index 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.hs
index 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 operator
diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs
index 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