@@ -34,6 +34,7 @@ import qualified Data.Traversable as T (traverse)
3434
3535import Control.Arrow ((&&&))
3636import Control.Monad (replicateM, forM)
37+import Control.Monad.Error.Class (MonadError(..))
3738import Control.Monad.Reader (MonadReader, asks)
3839import Control.Monad.Supply.Class
3940
@@ -43,6 +44,7 @@ import Language.PureScript.CodeGen.JS.AST as AST
4344import Language.PureScript.CodeGen.JS.Common as Common
4445import Language.PureScript.CoreFn
4546import Language.PureScript.Names
47+import Language.PureScript.Errors
4648import Language.PureScript.CodeGen.JS.Optimizer
4749import Language.PureScript.Options
4850import Language.PureScript.Traversals (sndM)
@@ -54,22 +56,23 @@ import System.FilePath.Posix ((</>))
5456-- Generate code in the simplified Javascript intermediate representation for all declarations in a
5557-- module.
5658--
57−moduleToJs :: forall m. (Applicative m, Monad m, MonadReader Options m, MonadSupply m)
59+moduleToJs :: forall m. (Applicative m, Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)
5860 => Module Ann -> Maybe JS -> m [JS]
59−moduleToJs (Module coms mn imps exps foreigns decls) foreign_ = do
60− jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps
61− jsDecls <- mapM bindToJs decls
62− optimized <- T.traverse (T.traverse optimize) jsDecls
63− comments <- not <$> asks optionsNoComments
64− let strict = JSStringLiteral "use strict"
65− let header = if comments && not (null coms) then JSComment coms strict else strict
66− let foreign' = [JSVariableIntroduction "$foreign" foreign_ | not $ null foreigns || isNothing foreign_]
67− let moduleBody = header : foreign' ++ jsImports ++ concat optimized
68− let foreignExps = exps `intersect` (fst `map` foreigns)
69− let standardExps = exps \\ foreignExps
70− let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) standardExps
71− ++ map (runIdent &&& foreignIdent) foreignExps
72− return $ moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']
61+moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
62+ rethrow (addHint (ErrorInModule mn)) $ do
63+ jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps
64+ jsDecls <- mapM bindToJs decls
65+ optimized <- T.traverse (T.traverse optimize) jsDecls
66+ comments <- not <$> asks optionsNoComments
67+ let strict = JSStringLiteral "use strict"
68+ let header = if comments && not (null coms) then JSComment coms strict else strict
69+ let foreign' = [JSVariableIntroduction "$foreign" foreign_ | not $ null foreigns || isNothing foreign_]
70+ let moduleBody = header : foreign' ++ jsImports ++ concat optimized
71+ let foreignExps = exps `intersect` (fst `map` foreigns)
72+ let standardExps = exps \\ foreignExps
73+ let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) standardExps
74+ ++ map (runIdent &&& foreignIdent) foreignExps
75+ return $ moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']
7376
7477 where
7578
@@ -129,8 +132,8 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ = do
129132 -- Generate code in the simplified Javascript intermediate representation for a value or expression.
130133 --
131134 valueToJs :: Expr Ann -> m JS
132− valueToJs (Literal _ l) =
133− literalToValueJS l
135+ valueToJs (Literal (pos, _, _, _) l) =
136+ maybe id rethrowWithPosition pos $ literalToValueJS l
134137 valueToJs (Var (_, _, _, Just (IsConstructor _ [])) name) =
135138 return $ JSAccessor "value" $ qualifiedToJS id name
136139 valueToJs (Var (_, _, _, Just (IsConstructor _ _)) name) =
@@ -207,7 +210,13 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ = do
207210 iife v exprs = JSApp (JSFunction Nothing [] (JSBlock $ exprs ++ [JSReturn $ JSVar v])) []
208211
209212 literalToValueJS :: Literal (Expr Ann) -> m JS
210− literalToValueJS (NumericLiteral n) = return $ JSNumericLiteral n
213+ literalToValueJS (NumericLiteral (Left i)) =
214+ let minInt = -2147483648
215+ maxInt = 2147483647
216+ in if i < minInt || i > maxInt
217+ then throwError . errorMessage $ IntOutOfRange i "JavaScript" minInt maxInt
218+ else return $ JSNumericLiteral (Left i)
219+ literalToValueJS (NumericLiteral (Right n)) = return $ JSNumericLiteral (Right n)
211220 literalToValueJS (StringLiteral s) = return $ JSStringLiteral s
212221 literalToValueJS (CharLiteral c) = return $ JSStringLiteral [c]
213222 literalToValueJS (BooleanLiteral b) = return $ JSBooleanLiteral b
@@ -275,10 +284,10 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ = do
275284 go _ _ _ = internalError "Invalid arguments to bindersToJs"
276285
277286 failedPatternError :: [String] -> JS
278− failedPatternError names = JSUnary JSNew $ JSApp (JSVar "Error") [JSBinary Add (JSStringLiteral errorMessage) (JSArrayLiteral $ zipWith valueError names vals)]
287+ failedPatternError names = JSUnary JSNew $ JSApp (JSVar "Error") [JSBinary Add (JSStringLiteral failedPatternMessage) (JSArrayLiteral $ zipWith valueError names vals)]
279288
280− errorMessage :: String
281− errorMessage = "Failed pattern match" ++ maybe "" (((" at " ++ runModuleName mn ++ " ") ++) . displayStartEndPos) maybeSpan ++ ": "
289+ failedPatternMessage :: String
290+ failedPatternMessage = "Failed pattern match" ++ maybe "" (((" at " ++ runModuleName mn ++ " ") ++) . displayStartEndPos) maybeSpan ++ ": "
282291
283292 valueError :: String -> JS -> JS
284293 valueError _ l@(JSNumericLiteral _) = l