summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilFreeman <>2014-01-10 22:17:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-01-10 22:17:00 (GMT)
commit2b5b2a434d935e9fa97fb1582e9c759cedda9bbd (patch)
tree4f0f52e87841e2d0724590d505154d764992f70a
parent0e6a7ff9ce3358d2b6170d37b0930e7097ba399d (diff)
version 0.2.10.10.2.10.1
-rw-r--r--purescript.cabal3
-rw-r--r--src/Language/PureScript/CodeGen/JS.hs5
-rw-r--r--src/Language/PureScript/Declarations.hs3
-rw-r--r--src/Language/PureScript/Parser/Declarations.hs7
-rw-r--r--src/Language/PureScript/Parser/JS.hs169
-rw-r--r--src/Language/PureScript/Pretty/JS.hs1
-rw-r--r--src/Language/PureScript/Pretty/Values.hs1
-rw-r--r--src/Language/PureScript/Values.hs3
8 files changed, 184 insertions, 8 deletions
diff --git a/purescript.cabal b/purescript.cabal
index fc8ee4c..3d5cb4b 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
name: purescript
-version: 0.2.10
+version: 0.2.10.1
cabal-version: >=1.8
build-type: Simple
license: MIT
@@ -46,6 +46,7 @@ library
Language.PureScript.Parser.State
Language.PureScript.Parser.Types
Language.PureScript.Parser.Values
+ Language.PureScript.Parser.JS
Language.PureScript.Pretty
Language.PureScript.Pretty.Common
Language.PureScript.Pretty.JS
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index a057899..ea4a3c2 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -36,10 +36,7 @@ import Language.PureScript.Types
moduleToJs :: Options -> Module -> Environment -> [JS]
moduleToJs opts (Module pname@(ProperName name) decls) env =
- let
- rawDecls = mapMaybe filterRawDecls decls
- in
- map JSRaw rawDecls ++
+ mapMaybe filterRawDecls decls ++
[ JSVariableIntroduction (Ident name) Nothing
, JSApp (JSFunction Nothing [Ident name]
(JSBlock (concat $ mapMaybe (\decl -> declToJs opts (ModuleName pname) decl env) decls)))
diff --git a/src/Language/PureScript/Declarations.hs b/src/Language/PureScript/Declarations.hs
index 8b4c98e..066f3b9 100644
--- a/src/Language/PureScript/Declarations.hs
+++ b/src/Language/PureScript/Declarations.hs
@@ -20,6 +20,7 @@ import Language.PureScript.Values
import Language.PureScript.Types
import Language.PureScript.Names
import Language.PureScript.Kinds
+import Language.PureScript.CodeGen.JS.AST
import qualified Data.Data as D
@@ -38,7 +39,7 @@ data Declaration
| TypeDeclaration Ident Type
| ValueDeclaration Ident [[Binder]] (Maybe Guard) Value
| BindingGroupDeclaration [(Ident, Value)]
- | ExternDeclaration Ident (Maybe String) Type
+ | ExternDeclaration Ident (Maybe JS) Type
| ExternDataDeclaration ProperName Kind
| FixityDeclaration Fixity String
| ImportDeclaration ModuleName (Maybe [Either Ident ProperName])
diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs
index 3e16282..eb07837 100644
--- a/src/Language/PureScript/Parser/Declarations.hs
+++ b/src/Language/PureScript/Parser/Declarations.hs
@@ -28,6 +28,8 @@ import Language.PureScript.Declarations
import Language.PureScript.Parser.Values
import Language.PureScript.Parser.Types
import Language.PureScript.Parser.Kinds
+import Language.PureScript.Parser.JS
+import Language.PureScript.CodeGen.JS.AST
import Language.PureScript.Values
parseDataDeclaration :: P.Parsec String ParseState Declaration
@@ -65,9 +67,12 @@ parseExternDeclaration = P.try (reserved "foreign") *> indented *> (reserved "im
(ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName)
<*> (lexeme (indented *> P.string "::") *> parseKind)
<|> ExternDeclaration <$> parseIdent
- <*> P.optionMaybe stringLiteral
+ <*> P.optionMaybe (parseJSLiteral <$> stringLiteral)
<*> (lexeme (indented *> P.string "::") *> parsePolyType))
+parseJSLiteral :: String -> JS
+parseJSLiteral s = either (const $ JSRaw s) id $ P.runParser parseJS () "Javascript" s
+
parseAssociativity :: P.Parsec String ParseState Associativity
parseAssociativity =
(P.try (reserved "infixl") >> return Infixl) <|>
diff --git a/src/Language/PureScript/Parser/JS.hs b/src/Language/PureScript/Parser/JS.hs
new file mode 100644
index 0000000..b90bb94
--- /dev/null
+++ b/src/Language/PureScript/Parser/JS.hs
@@ -0,0 +1,169 @@
+-----------------------------------------------------------------------------
+--
+-- Module : Language.PureScript.Parser.JS
+-- Copyright : (c) Phil Freeman 2013
+-- License : MIT
+--
+-- Maintainer : Phil Freeman <paf31@cantab.net>
+-- Stability : experimental
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+
+module Language.PureScript.Parser.JS (
+ parseJS
+) where
+
+import Language.PureScript.Values
+import Language.PureScript.Names
+import Language.PureScript.CodeGen.JS.AST
+import qualified Language.PureScript.Parser.Common as C
+import Control.Applicative
+import Data.Functor.Identity
+import qualified Text.Parsec as P
+import qualified Text.Parsec.Token as P
+import qualified Text.Parsec.Expr as P
+
+booleanLiteral :: P.Parsec String u Bool
+booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)
+
+parseNumericLiteral :: P.Parsec String u JS
+parseNumericLiteral = JSNumericLiteral <$> C.integerOrFloat
+
+parseStringLiteral :: P.Parsec String u JS
+parseStringLiteral = JSStringLiteral <$> C.stringLiteral
+
+parseBooleanLiteral :: P.Parsec String u JS
+parseBooleanLiteral = JSBooleanLiteral <$> booleanLiteral
+
+parseArrayLiteral :: P.Parsec String u JS
+parseArrayLiteral = JSArrayLiteral <$> P.squares C.tokenParser (P.commaSep C.tokenParser parseJS)
+
+parseObjectLiteral :: P.Parsec String u JS
+parseObjectLiteral = JSObjectLiteral <$> P.braces C.tokenParser (P.commaSep C.tokenParser parseIdentifierAndValue)
+
+parseIdentifierAndValue :: P.Parsec String u (String, JS)
+parseIdentifierAndValue = (,) <$> (C.identifier <* C.colon)
+ <*> parseJS
+
+parseFunction :: P.Parsec String u JS
+parseFunction = do
+ C.reserved "function"
+ name <- P.optionMaybe (Ident <$> C.identifier)
+ args <- P.parens C.tokenParser $ P.commaSep C.tokenParser (Ident <$> C.identifier)
+ body <- parseJS
+ return $ JSFunction name args body
+
+parseBlock :: P.Parsec String u JS
+parseBlock = JSBlock <$> P.braces C.tokenParser (P.many parseJS)
+
+parseVar :: P.Parsec String u JS
+parseVar = JSVar <$> Ident <$> C.identifier
+
+parseJSAtom :: P.Parsec String u JS
+parseJSAtom = P.choice
+ [ P.try parseNumericLiteral
+ , P.try parseStringLiteral
+ , P.try parseBooleanLiteral
+ , parseArrayLiteral
+ , P.try parseObjectLiteral
+ , parseFunction
+ , parseBlock
+ , P.try parseVar
+ , parseVariableIntroduction
+ , P.try parseAssignment
+ , parseWhile
+ , parseIf
+ , parseReturn
+ , P.parens C.tokenParser parseJS ]
+
+parseAccessor :: JS -> P.Parsec String u JS
+parseAccessor js = P.try $ flip JSAccessor js <$> (C.dot *> P.notFollowedBy C.opLetter *> C.identifier)
+
+parseIndexer :: JS -> P.Parsec String u JS
+parseIndexer js = P.try $ flip JSIndexer js <$> (P.squares C.tokenParser parseJS)
+
+parseConditional :: JS -> P.Parsec String u JS
+parseConditional js = P.try $ do
+ C.lexeme $ P.char '?'
+ tr <- parseJS
+ C.lexeme $ P.char ':'
+ fa <- parseJS
+ return $ JSConditional js tr fa
+
+binary :: BinaryOperator -> String -> P.Assoc -> P.Operator String u Identity JS
+binary op s f = P.Infix (P.try $ C.reservedOp s >> return (JSBinary op)) f
+
+unary :: UnaryOperator -> String -> P.Operator String u Identity JS
+unary op s = P.Prefix (P.try $ C.reservedOp s >> return (JSUnary op))
+
+parseJS :: P.Parsec String u JS
+parseJS =
+ (P.buildExpressionParser operators
+ . C.buildPostfixParser postfixTable2
+ $ indexersAndAccessors) P.<?> "javascript"
+ where
+ indexersAndAccessors = C.buildPostfixParser postfixTable1 parseJSAtom
+ postfixTable1 = [ parseAccessor, parseIndexer, parseConditional ]
+ postfixTable2 = [ \v -> P.try $ JSApp v <$> (P.parens C.tokenParser (P.commaSep C.tokenParser parseJS)) ]
+ operators = [ [ binary LessThan "<" P.AssocLeft]
+ , [ binary LessThanOrEqualTo "<=" P.AssocLeft]
+ , [ binary GreaterThan ">" P.AssocLeft]
+ , [ binary GreaterThanOrEqualTo ">=" P.AssocLeft]
+ , [ unary Not "!" ]
+ , [ unary BitwiseNot "~" ]
+ , [ unary Negate "-" ]
+ , [ unary Positive "+" ]
+ , [ binary Multiply "*" P.AssocLeft]
+ , [ binary Divide "/" P.AssocLeft]
+ , [ binary Modulus "%" P.AssocLeft]
+ , [ binary Concat "+" P.AssocLeft]
+ , [ binary Add "+" P.AssocLeft]
+ , [ binary Subtract "-" P.AssocLeft]
+ , [ binary ShiftLeft "<<" P.AssocLeft]
+ , [ binary ShiftRight ">>" P.AssocLeft]
+ , [ binary ZeroFillShiftRight ">>>" P.AssocLeft]
+ , [ binary EqualTo "===" P.AssocLeft]
+ , [ binary NotEqualTo "!==" P.AssocLeft]
+ , [ binary BitwiseAnd "&" P.AssocLeft]
+ , [ binary BitwiseXor "^" P.AssocLeft]
+ , [ binary BitwiseOr "|" P.AssocLeft]
+ , [ binary And "&&" P.AssocRight]
+ , [ binary Or "||" P.AssocRight]
+ ]
+
+parseVariableIntroduction :: P.Parsec String u JS
+parseVariableIntroduction = do
+ C.reserved "var"
+ name <- Ident <$> P.identifier C.tokenParser
+ value <- P.optionMaybe $ do
+ C.lexeme $ P.char '='
+ value <- parseJS
+ C.semi
+ return value
+ return $ JSVariableIntroduction name value
+
+parseAssignment :: P.Parsec String u JS
+parseAssignment = do
+ tgt <- parseAssignmentTarget
+ C.lexeme $ P.char '='
+ value <- parseJS
+ C.semi
+ return $ JSAssignment tgt value
+
+parseAssignmentTarget :: P.Parsec String u JSAssignment
+parseAssignmentTarget = C.buildPostfixParser [] (JSAssignVariable <$> Ident <$> P.identifier C.tokenParser)
+
+parseWhile :: P.Parsec String u JS
+parseWhile = JSWhile <$> (C.reserved "while" *> P.parens C.tokenParser parseJS)
+ <*> parseJS
+
+parseIf :: P.Parsec String u JS
+parseIf = JSIfElse <$> (C.reserved "if" *> P.parens C.tokenParser parseJS)
+ <*> parseJS
+ <*> P.optionMaybe (C.reserved "else" >> parseJS)
+
+parseReturn :: P.Parsec String u JS
+parseReturn = JSReturn <$> (C.reserved "return" *> parseJS <* C.semi)
diff --git a/src/Language/PureScript/Pretty/JS.hs b/src/Language/PureScript/Pretty/JS.hs
index 6ff4ede..2fa9680 100644
--- a/src/Language/PureScript/Pretty/JS.hs
+++ b/src/Language/PureScript/Pretty/JS.hs
@@ -219,6 +219,7 @@ prettyPrintJS' = A.runKleisli $ runPattern matchValue
, [ unary Not "!" ]
, [ unary BitwiseNot "~" ]
, [ unary Negate "-" ]
+ , [ unary Positive "+" ]
, [ binary Multiply "*" ]
, [ binary Divide "/" ]
, [ binary Modulus "%" ]
diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs
index b904901..9890147 100644
--- a/src/Language/PureScript/Pretty/Values.hs
+++ b/src/Language/PureScript/Pretty/Values.hs
@@ -140,6 +140,7 @@ prettyPrintValue = fromMaybe (error "Incomplete pattern") . pattern matchValue (
, [ unary Not "!" ]
, [ unary BitwiseNot "~" ]
, [ unary Negate "-" ]
+ , [ unary Positive "+" ]
, [ binary Multiply "*" ]
, [ binary Divide "/" ]
, [ binary Modulus "%" ]
diff --git a/src/Language/PureScript/Values.hs b/src/Language/PureScript/Values.hs
index 26902aa..f2c57d0 100644
--- a/src/Language/PureScript/Values.hs
+++ b/src/Language/PureScript/Values.hs
@@ -26,7 +26,8 @@ type Guard = Value
data UnaryOperator
= Negate
| Not
- | BitwiseNot deriving (Show, Eq, Data, Typeable)
+ | BitwiseNot
+ | Positive deriving (Show, Eq, Data, Typeable)
data BinaryOperator
= Add