summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilFreeman <>2014-02-08 18:24:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-02-08 18:24:00 (GMT)
commit955e0713f57ecdd576e4c7f378202ad1b741526f (patch)
tree92beab7c6c5fdf48bb48db75dd6f557dd3aef043
parentde52288120e0cde661aca4c1cbdf794fffded8cb (diff)
version 0.3.110.3.11
-rw-r--r--prelude/prelude.purs (renamed from libraries/prelude/prelude.purs)0
-rw-r--r--psc/Main.hs2
-rw-r--r--psci/Main.hs2
-rw-r--r--purescript.cabal4
-rw-r--r--src/Language/PureScript/CodeGen/Common.hs77
-rw-r--r--src/Language/PureScript/CodeGen/JS.hs80
-rw-r--r--src/Language/PureScript/Parser/Common.hs70
-rw-r--r--tests/Main.hs2
8 files changed, 148 insertions, 89 deletions
diff --git a/libraries/prelude/prelude.purs b/prelude/prelude.purs
index 7959f73..7959f73 100644
--- a/libraries/prelude/prelude.purs
+++ b/prelude/prelude.purs
diff --git a/psc/Main.hs b/psc/Main.hs
index e219565..3de42e2 100644
--- a/psc/Main.hs
+++ b/psc/Main.hs
@@ -25,7 +25,7 @@ import qualified Paths_purescript as Paths
import Data.Version (showVersion)
preludeFilename :: IO FilePath
-preludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"
+preludeFilename = Paths.getDataFileName "prelude/prelude.purs"
readInput :: Maybe [FilePath] -> IO (Either ParseError [P.Module])
readInput Nothing = getContents >>= return . P.runIndentParser "" P.parseModules
diff --git a/psci/Main.hs b/psci/Main.hs
index 6a7927e..197ffaa 100644
--- a/psci/Main.hs
+++ b/psci/Main.hs
@@ -32,7 +32,7 @@ import qualified System.IO.UTF8 as U (readFile)
import qualified Text.Parsec as Parsec (eof)
getPreludeFilename :: IO FilePath
-getPreludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"
+getPreludeFilename = Paths.getDataFileName "prelude/prelude.purs"
options :: P.Options
options = P.Options True False True True True
diff --git a/purescript.cabal b/purescript.cabal
index 7043137..268dfbf 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
name: purescript
-version: 0.3.10.1
+version: 0.3.11
cabal-version: >=1.8
build-type: Simple
license: MIT
@@ -11,7 +11,7 @@ synopsis: PureScript Programming Language Compiler
description: A small compile-to-JS language with extensible records and type-safe blocks
category: Language
author: Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
-data-files: libraries/prelude/prelude.purs
+data-files: prelude/prelude.purs
data-dir: ""
library
diff --git a/src/Language/PureScript/CodeGen/Common.hs b/src/Language/PureScript/CodeGen/Common.hs
index e581057..ec8bbcf 100644
--- a/src/Language/PureScript/CodeGen/Common.hs
+++ b/src/Language/PureScript/CodeGen/Common.hs
@@ -21,15 +21,22 @@ import Language.PureScript.Names
-- |
-- Convert an Ident into a valid Javascript identifier:
--
--- * Alphanumeric characters are kept unmodified
+-- * Alphanumeric characters are kept unmodified.
--
--- * Symbols are encoded as a dollar symbol ($) followed by their ordinal value
+-- * Reserved javascript identifiers are prefixed with '$$'.
+--
+-- * Symbols are prefixed with '$' followed by a symbol name or their ordinal value.
--
identToJs :: Ident -> String
+identToJs (Ident name) | nameIsJsReserved name = "$$" ++ name
identToJs (Ident name) = concatMap identCharToString name
identToJs (Op op) = concatMap identCharToString op
identToJs (Escaped name) = name
+-- |
+-- Attempts to find a human-readable name for a symbol, if none has been specified returns the
+-- ordinal value.
+--
identCharToString :: Char -> String
identCharToString c | isAlphaNum c = [c]
identCharToString '_' = "_"
@@ -53,4 +60,70 @@ identCharToString ':' = "$colon"
identCharToString '\\' = "$bslash"
identCharToString '?' = "$qmark"
identCharToString '@' = "$at"
+identCharToString '\'' = "$prime"
identCharToString c = '$' : show (ord c)
+
+-- |
+-- Checks whether an identifier name is reserved in Javascript.
+--
+nameIsJsReserved :: String -> Bool
+nameIsJsReserved name =
+ elem name [ "abstract"
+ , "boolean"
+ , "break"
+ , "byte"
+ , "case"
+ , "catch"
+ , "char"
+ , "class"
+ , "const"
+ , "continue"
+ , "debugger"
+ , "default"
+ , "delete"
+ , "do"
+ , "double"
+ , "else"
+ , "enum"
+ , "export"
+ , "extends"
+ , "final"
+ , "finally"
+ , "float"
+ , "for"
+ , "function"
+ , "goto"
+ , "if"
+ , "implements"
+ , "import"
+ , "in"
+ , "instanceof"
+ , "int"
+ , "interface"
+ , "let"
+ , "long"
+ , "native"
+ , "new"
+ , "package"
+ , "private"
+ , "protected"
+ , "public"
+ , "return"
+ , "short"
+ , "static"
+ , "super"
+ , "switch"
+ , "synchronized"
+ , "this"
+ , "throw"
+ , "throws"
+ , "transient"
+ , "try"
+ , "typeof"
+ , "var"
+ , "void"
+ , "volatile"
+ , "while"
+ , "with"
+ , "yield" ]
+
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index 6784817..616e8fb 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -41,11 +41,12 @@ import Language.PureScript.Options
import Language.PureScript.CodeGen.JS.AST as AST
import Language.PureScript.Types
import Language.PureScript.CodeGen.Optimize
-import Language.PureScript.CodeGen.Common (identToJs)
+import Language.PureScript.CodeGen.Common
import Language.PureScript.TypeChecker.Monad (canonicalizeDataConstructor)
-- |
--- Generate code in the simplified Javascript intermediate representation for all declarations in a module
+-- Generate code in the simplified Javascript intermediate representation for all declarations in a
+-- module.
--
moduleToJs :: Options -> Module -> Environment -> [JS]
moduleToJs opts (Module pname@(ProperName name) decls) env =
@@ -85,16 +86,36 @@ declToJs _ mp (ExternDeclaration importTy ident (Just js) _) _ =
Just $ js : setProperty ident (var ident) mp
declToJs _ _ _ _ = Nothing
+-- |
+-- Generate code in the simplified Javascript intermediate representation for setting the property
+-- of an object.
+--
setProperty :: Ident -> JS -> ModuleName -> [JS]
setProperty ident@(Op op) val (ModuleName (ProperName moduleName)) =
- [ JSAssignment (JSAccessor (identToJs ident) (JSVar moduleName)) val
- , JSAssignment (JSIndexer (JSStringLiteral op) (JSVar moduleName)) (JSAccessor (identToJs ident) (JSVar moduleName)) ]
+ [ JSAssignment (accessor ident (JSVar moduleName)) val
+ , JSAssignment (JSIndexer (JSStringLiteral op) (JSVar moduleName)) (accessor ident (JSVar moduleName)) ]
setProperty ident val (ModuleName (ProperName moduleName)) =
- [ JSAssignment (JSAccessor (identToJs ident) (JSVar moduleName)) val ]
+ [ JSAssignment (accessor ident (JSVar moduleName)) val ]
+-- |
+-- Generate code in the simplified Javascript intermediate representation for a variable based on a
+-- PureScript identifier.
+--
var :: Ident -> JS
var = JSVar . identToJs
+-- |
+-- Generate code in the simplified Javascript intermediate representation for an accessor based on
+-- a PureScript identifier. If the name is not valid in Javascript (symbol based, reserved name) an
+-- indexer is returned.
+--
+accessor :: Ident -> JS -> JS
+accessor (Ident name) | nameIsJsReserved name = JSIndexer (JSStringLiteral name)
+accessor ident = JSAccessor (identToJs ident)
+
+-- |
+-- Generate code in the simplified Javascript intermediate representation for a value or expression.
+--
valueToJs :: Options -> ModuleName -> Environment -> Value -> JS
valueToJs _ _ _ (NumericLiteral n) = JSNumericLiteral n
valueToJs _ _ _ (StringLiteral s) = JSStringLiteral s
@@ -104,21 +125,31 @@ 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 identToJs (Qualified (Just aliasModule) aliasIdent)
+ Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS id (Qualified (Just aliasModule) aliasIdent)
_ -> JSVar . runProperName $ name
-valueToJs _ _ _ (Constructor name) = qualifiedToJS runProperName name
+valueToJs _ _ _ (Constructor name) = qualifiedToJS (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)
valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)
valueToJs opts m e (App val arg) = JSApp (valueToJs opts m e val) [valueToJs opts m e arg]
-valueToJs opts m e (Abs arg val) = JSFunction Nothing [identToJs arg] (JSBlock [JSReturn (valueToJs opts m e val)])
+valueToJs opts m e (Abs arg val) = JSFunction Nothing [identToJs arg] (JSBlock [JSReturn (valueToJs opts m (bindName m arg e) val)])
valueToJs opts m e (TypedValue _ (Abs arg val) ty) | optionsPerformRuntimeTypeChecks opts = let arg' = identToJs arg in JSFunction Nothing [arg'] (JSBlock $ runtimeTypeChecks arg' ty ++ [JSReturn (valueToJs opts m e val)])
valueToJs _ m e (Var ident) = varToJs m e ident
valueToJs opts m e (TypedValue _ val _) = valueToJs opts m e val
valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not replaced"
valueToJs _ _ _ _ = error "Invalid argument to valueToJs"
+-- |
+-- Temporarily extends the environment to include a local variable name introduced by a lambda
+-- abstraction.
+--
+bindName :: ModuleName -> Ident -> Environment -> Environment
+bindName m ident env = env { names = M.insert (m, ident) (error "Temporary lambda variable type was read", LocalVariable) $ names env }
+
+-- |
+-- Generate code in the simplified Javascript intermediate representation for runtime type checks.
+--
runtimeTypeChecks :: String -> Type -> [JS]
runtimeTypeChecks arg ty =
let
@@ -148,6 +179,10 @@ runtimeTypeChecks arg ty =
arrayCheck :: JS -> JS
arrayCheck js = JSIfElse (JSUnary Not (JSApp (JSAccessor "isArray" (JSVar "Array")) [js])) (JSBlock [JSThrow (JSStringLiteral "Array expected")]) Nothing
+-- |
+-- Generate code in the simplified Javascript intermediate representation for a reference to a
+-- variable.
+--
varToJs :: ModuleName -> Environment -> Qualified Ident -> JS
varToJs m e qual@(Qualified _ ident) = go qual
where
@@ -156,18 +191,25 @@ varToJs m e qual@(Qualified _ ident) = go qual
Just (_, Alias aliasModule aliasIdent) -> go (Qualified (Just aliasModule) aliasIdent)
_ -> case qual of
Qualified Nothing _ -> var ident
- Qualified (Just (ModuleName (ProperName mn))) (Op op) -> JSIndexer (JSStringLiteral op) (JSVar mn)
- _ -> qualifiedToJS identToJs qual
+ _ -> qualifiedToJS id qual
isExtern (Extern ForeignImport) = True
isExtern (Alias m' ident') = case M.lookup (m', ident') (names e) of
Just (_, ty') -> isExtern ty'
Nothing -> error "Undefined alias in varToJs"
isExtern _ = False
-qualifiedToJS :: (a -> String) -> Qualified a -> JS
-qualifiedToJS f (Qualified (Just (ModuleName (ProperName m))) a) = JSAccessor (f a) (JSVar m)
-qualifiedToJS f (Qualified Nothing a) = JSVar (f a)
+-- |
+-- 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)
+-- |
+-- Generate code in the simplified Javascript intermediate representation for pattern match binders
+-- and guards.
+--
bindersToJs :: Options -> ModuleName -> Environment -> [([Binder], Maybe Guard, Value)] -> [JS] -> JS
bindersToJs opts m e binders vals = runGen (map identToJs (unusedNames (binders, vals))) $ do
valNames <- replicateM (length vals) fresh
@@ -183,6 +225,10 @@ bindersToJs opts m e binders vals = runGen (map identToJs (unusedNames (binders,
binderToJs m e v done'' b
go _ _ _ _ = error "Invalid arguments to bindersToJs"
+-- |
+-- Generate code in the simplified Javascript intermediate representation for a pattern match
+-- binder.
+--
binderToJs :: ModuleName -> Environment -> String -> [JS] -> Binder -> Gen [JS]
binderToJs _ _ _ done NullBinder = return done
binderToJs _ _ varName done (StringBinder str) =
@@ -246,6 +292,10 @@ binderToJs m e varName done (NamedBinder ident binder) = do
js <- binderToJs m e varName done binder
return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)
+-- |
+-- Checks whether a data constructor is the only constructor for that type, used to simplify the
+-- check when generating code for binders.
+--
isOnlyConstructor :: ModuleName -> Environment -> Qualified ProperName -> Bool
isOnlyConstructor m e ctor =
let (ty, _) = fromMaybe (error "Data constructor not found") $ qualify m ctor `M.lookup` dataConstructors e
@@ -258,6 +308,10 @@ isOnlyConstructor m e ctor =
typeConstructor (TypeApp ty _) = typeConstructor ty
typeConstructor fn = error $ "Invalid arguments to typeConstructor: " ++ show fn
+-- |
+-- Generate code in the simplified Javascript intermediate representation for a statement in a
+-- PureScript block.
+--
statementToJs :: Options -> ModuleName -> Environment -> Statement -> JS
statementToJs opts m e (VariableIntroduction ident value) = JSVariableIntroduction (identToJs ident) (Just (valueToJs opts m e value))
statementToJs opts m e (Assignment target value) = JSAssignment (JSVar (identToJs target)) (valueToJs opts m e value)
diff --git a/src/Language/PureScript/Parser/Common.hs b/src/Language/PureScript/Parser/Common.hs
index 365edbd..2d24968 100644
--- a/src/Language/PureScript/Parser/Common.hs
+++ b/src/Language/PureScript/Parser/Common.hs
@@ -53,69 +53,6 @@ reservedPsNames = [ "data"
]
-- |
--- A list of javascript reserved identifiers
---
-reservedJsNames :: [String]
-reservedJsNames = [ "abstract"
- , "boolean"
- , "break"
- , "byte"
- , "case"
- , "catch"
- , "char"
- , "class"
- , "const"
- , "continue"
- , "debugger"
- , "default"
- , "delete"
- , "do"
- , "double"
- , "else"
- , "enum"
- , "export"
- , "extends"
- , "final"
- , "finally"
- , "float"
- , "for"
- , "function"
- , "goto"
- , "if"
- , "implements"
- , "import"
- , "in"
- , "instanceof"
- , "int"
- , "interface"
- , "let"
- , "long"
- , "native"
- , "new"
- , "package"
- , "private"
- , "protected"
- , "public"
- , "return"
- , "short"
- , "static"
- , "super"
- , "switch"
- , "synchronized"
- , "this"
- , "throw"
- , "throws"
- , "transient"
- , "try"
- , "typeof"
- , "var"
- , "void"
- , "volatile"
- , "while"
- , "with"
- , "yield" ]
-
--- |
-- A list of reserved identifiers for types
--
reservedTypeNames :: [String]
@@ -287,12 +224,7 @@ integerOrFloat = (Left <$> P.try (PT.natural tokenParser) <|>
-- Parse an identifier or parenthesized operator
--
parseIdent :: P.Parsec String ParseState Ident
-parseIdent = parseIdent' <|> (Op <$> parens operator)
- where
- parseIdent' :: P.Parsec String ParseState Ident
- parseIdent' = do
- ident <- identifier
- return $ if (ident `elem` reservedJsNames) then (Escaped $ "$" ++ ident) else (Ident ident)
+parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)
-- |
-- Parse a token inside square brackets
diff --git a/tests/Main.hs b/tests/Main.hs
index cb3e567..d9ec999 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -34,7 +34,7 @@ import qualified System.IO.UTF8 as U
import qualified Data.Map as M
preludeFilename :: IO FilePath
-preludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"
+preludeFilename = Paths.getDataFileName "prelude/prelude.purs"
readInput :: [FilePath] -> IO (Either ParseError [P.Module])
readInput inputFiles = fmap (fmap concat . sequence) $ forM inputFiles $ \inputFile -> do