git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Try to parse the Javascript in foreign import declarations.
92e66f1Phil Freeman
examples/passing/ExternRaw.purs+6
compare with golang
unifiedsplit
@@ -1,5 +1,11 @@
1module ExternRaw where
1module ExternRaw where
2
2
3+foreign import first "function first(xs) { return xs[0]; }" :: forall a. [a] -> a
4+
5+foreign import cond "function cond(b, t, f) { return b ? t : f; }" :: forall a. (Boolean, a, a) -> a
6+
7+foreign import loop "function loop() { while (true) {} }" :: forall a. a
8+
3foreign import concat "function concat(xs) { \
9foreign import concat "function concat(xs) { \
4 \ return function(ys) { \
10 \ return function(ys) { \
5 \ return xs.concat(ys); \
11 \ return xs.concat(ys); \
purescript.cabal+2−1
@@ -1,5 +1,5 @@
1name: purescript
1name: purescript
2−version: 0.2.10
2+version: 0.2.10.1
3cabal-version: >=1.8
3cabal-version: >=1.8
4build-type: Simple
4build-type: Simple
5license: MIT
5license: MIT
@@ -46,6 +46,7 @@ library
46 Language.PureScript.Parser.State
46 Language.PureScript.Parser.State
47 Language.PureScript.Parser.Types
47 Language.PureScript.Parser.Types
48 Language.PureScript.Parser.Values
48 Language.PureScript.Parser.Values
49+ Language.PureScript.Parser.JS
49 Language.PureScript.Pretty
50 Language.PureScript.Pretty
50 Language.PureScript.Pretty.Common
51 Language.PureScript.Pretty.Common
51 Language.PureScript.Pretty.JS
52 Language.PureScript.Pretty.JS
src/Language/PureScript/CodeGen/JS.hs+1−4
@@ -36,10 +36,7 @@ import Language.PureScript.Types
36
36
37moduleToJs :: Options -> Module -> Environment -> [JS]
37moduleToJs :: Options -> Module -> Environment -> [JS]
38moduleToJs opts (Module pname@(ProperName name) decls) env =
38moduleToJs opts (Module pname@(ProperName name) decls) env =
39− let
40− rawDecls = mapMaybe filterRawDecls decls
39+ mapMaybe filterRawDecls decls ++
41− in
42− map JSRaw rawDecls ++
43 [ JSVariableIntroduction (Ident name) Nothing
40 [ JSVariableIntroduction (Ident name) Nothing
44 , JSApp (JSFunction Nothing [Ident name]
41 , JSApp (JSFunction Nothing [Ident name]
45 (JSBlock (concat $ mapMaybe (\decl -> declToJs opts (ModuleName pname) decl env) decls)))
42 (JSBlock (concat $ mapMaybe (\decl -> declToJs opts (ModuleName pname) decl env) decls)))
src/Language/PureScript/Declarations.hs+2−1
@@ -20,6 +20,7 @@ import Language.PureScript.Values
20import Language.PureScript.Types
20import Language.PureScript.Types
21import Language.PureScript.Names
21import Language.PureScript.Names
22import Language.PureScript.Kinds
22import Language.PureScript.Kinds
23+import Language.PureScript.CodeGen.JS.AST
23
24
24import qualified Data.Data as D
25import qualified Data.Data as D
25
26
@@ -38,7 +39,7 @@ data Declaration
38 | TypeDeclaration Ident Type
39 | TypeDeclaration Ident Type
39 | ValueDeclaration Ident [[Binder]] (Maybe Guard) Value
40 | ValueDeclaration Ident [[Binder]] (Maybe Guard) Value
40 | BindingGroupDeclaration [(Ident, Value)]
41 | BindingGroupDeclaration [(Ident, Value)]
41− | ExternDeclaration Ident (Maybe String) Type
42+ | ExternDeclaration Ident (Maybe JS) Type
42 | ExternDataDeclaration ProperName Kind
43 | ExternDataDeclaration ProperName Kind
43 | FixityDeclaration Fixity String
44 | FixityDeclaration Fixity String
44 | ImportDeclaration ModuleName (Maybe [Either Ident ProperName])
45 | ImportDeclaration ModuleName (Maybe [Either Ident ProperName])
src/Language/PureScript/Parser/Declarations.hs+6−1
@@ -28,6 +28,8 @@ import Language.PureScript.Declarations
28import Language.PureScript.Parser.Values
28import Language.PureScript.Parser.Values
29import Language.PureScript.Parser.Types
29import Language.PureScript.Parser.Types
30import Language.PureScript.Parser.Kinds
30import Language.PureScript.Parser.Kinds
31+import Language.PureScript.Parser.JS
32+import Language.PureScript.CodeGen.JS.AST
31import Language.PureScript.Values
33import Language.PureScript.Values
32
34
33parseDataDeclaration :: P.Parsec String ParseState Declaration
35parseDataDeclaration :: P.Parsec String ParseState Declaration
@@ -65,9 +67,12 @@ parseExternDeclaration = P.try (reserved "foreign") *> indented *> (reserved "im
65 (ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName)
67 (ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName)
66 <*> (lexeme (indented *> P.string "::") *> parseKind)
68 <*> (lexeme (indented *> P.string "::") *> parseKind)
67 <|> ExternDeclaration <$> parseIdent
69 <|> ExternDeclaration <$> parseIdent
68− <*> P.optionMaybe stringLiteral
70+ <*> P.optionMaybe (parseJSLiteral <$> stringLiteral)
69 <*> (lexeme (indented *> P.string "::") *> parsePolyType))
71 <*> (lexeme (indented *> P.string "::") *> parsePolyType))
70
72
73+parseJSLiteral :: String -> JS
74+parseJSLiteral s = either (const $ JSRaw s) id $ P.runParser parseJS () "Javascript" s
75+
71parseAssociativity :: P.Parsec String ParseState Associativity
76parseAssociativity :: P.Parsec String ParseState Associativity
72parseAssociativity =
77parseAssociativity =
73 (P.try (reserved "infixl") >> return Infixl) <|>
78 (P.try (reserved "infixl") >> return Infixl) <|>
src/Language/PureScript/Parser/JS.hsnew file+169
@@ -0,0 +1,169 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.Parser.JS
4+-- Copyright : (c) Phil Freeman 2013
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.PureScript.Parser.JS (
16+ parseJS
17+) where
18+
19+import Language.PureScript.Values
20+import Language.PureScript.Names
21+import Language.PureScript.CodeGen.JS.AST
22+import qualified Language.PureScript.Parser.Common as C
23+import Control.Applicative
24+import Data.Functor.Identity
25+import qualified Text.Parsec as P
26+import qualified Text.Parsec.Token as P
27+import qualified Text.Parsec.Expr as P
28+
29+booleanLiteral :: P.Parsec String u Bool
30+booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)
31+
32+parseNumericLiteral :: P.Parsec String u JS
33+parseNumericLiteral = JSNumericLiteral <$> C.integerOrFloat
34+
35+parseStringLiteral :: P.Parsec String u JS
36+parseStringLiteral = JSStringLiteral <$> C.stringLiteral
37+
38+parseBooleanLiteral :: P.Parsec String u JS
39+parseBooleanLiteral = JSBooleanLiteral <$> booleanLiteral
40+
41+parseArrayLiteral :: P.Parsec String u JS
42+parseArrayLiteral = JSArrayLiteral <$> P.squares C.tokenParser (P.commaSep C.tokenParser parseJS)
43+
44+parseObjectLiteral :: P.Parsec String u JS
45+parseObjectLiteral = JSObjectLiteral <$> P.braces C.tokenParser (P.commaSep C.tokenParser parseIdentifierAndValue)
46+
47+parseIdentifierAndValue :: P.Parsec String u (String, JS)
48+parseIdentifierAndValue = (,) <$> (C.identifier <* C.colon)
49+ <*> parseJS
50+
51+parseFunction :: P.Parsec String u JS
52+parseFunction = do
53+ C.reserved "function"
54+ name <- P.optionMaybe (Ident <$> C.identifier)
55+ args <- P.parens C.tokenParser $ P.commaSep C.tokenParser (Ident <$> C.identifier)
56+ body <- parseJS
57+ return $ JSFunction name args body
58+
59+parseBlock :: P.Parsec String u JS
60+parseBlock = JSBlock <$> P.braces C.tokenParser (P.many parseJS)
61+
62+parseVar :: P.Parsec String u JS
63+parseVar = JSVar <$> Ident <$> C.identifier
64+
65+parseJSAtom :: P.Parsec String u JS
66+parseJSAtom = P.choice
67+ [ P.try parseNumericLiteral
68+ , P.try parseStringLiteral
69+ , P.try parseBooleanLiteral
70+ , parseArrayLiteral
71+ , P.try parseObjectLiteral
72+ , parseFunction
73+ , parseBlock
74+ , P.try parseVar
75+ , parseVariableIntroduction
76+ , P.try parseAssignment
77+ , parseWhile
78+ , parseIf
79+ , parseReturn
80+ , P.parens C.tokenParser parseJS ]
81+
82+parseAccessor :: JS -> P.Parsec String u JS
83+parseAccessor js = P.try $ flip JSAccessor js <$> (C.dot *> P.notFollowedBy C.opLetter *> C.identifier)
84+
85+parseIndexer :: JS -> P.Parsec String u JS
86+parseIndexer js = P.try $ flip JSIndexer js <$> (P.squares C.tokenParser parseJS)
87+
88+parseConditional :: JS -> P.Parsec String u JS
89+parseConditional js = P.try $ do
90+ C.lexeme $ P.char '?'
91+ tr <- parseJS
92+ C.lexeme $ P.char ':'
93+ fa <- parseJS
94+ return $ JSConditional js tr fa
95+
96+binary :: BinaryOperator -> String -> P.Assoc -> P.Operator String u Identity JS
97+binary op s f = P.Infix (P.try $ C.reservedOp s >> return (JSBinary op)) f
98+
99+unary :: UnaryOperator -> String -> P.Operator String u Identity JS
100+unary op s = P.Prefix (P.try $ C.reservedOp s >> return (JSUnary op))
101+
102+parseJS :: P.Parsec String u JS
103+parseJS =
104+ (P.buildExpressionParser operators
105+ . C.buildPostfixParser postfixTable2
106+ $ indexersAndAccessors) P.<?> "javascript"
107+ where
108+ indexersAndAccessors = C.buildPostfixParser postfixTable1 parseJSAtom
109+ postfixTable1 = [ parseAccessor, parseIndexer, parseConditional ]
110+ postfixTable2 = [ \v -> P.try $ JSApp v <$> (P.parens C.tokenParser (P.commaSep C.tokenParser parseJS)) ]
111+ operators = [ [ binary LessThan "<" P.AssocLeft]
112+ , [ binary LessThanOrEqualTo "<=" P.AssocLeft]
113+ , [ binary GreaterThan ">" P.AssocLeft]
114+ , [ binary GreaterThanOrEqualTo ">=" P.AssocLeft]
115+ , [ unary Not "!" ]
116+ , [ unary BitwiseNot "~" ]
117+ , [ unary Negate "-" ]
118+ , [ unary Positive "+" ]
119+ , [ binary Multiply "*" P.AssocLeft]
120+ , [ binary Divide "/" P.AssocLeft]
121+ , [ binary Modulus "%" P.AssocLeft]
122+ , [ binary Concat "+" P.AssocLeft]
123+ , [ binary Add "+" P.AssocLeft]
124+ , [ binary Subtract "-" P.AssocLeft]
125+ , [ binary ShiftLeft "<<" P.AssocLeft]
126+ , [ binary ShiftRight ">>" P.AssocLeft]
127+ , [ binary ZeroFillShiftRight ">>>" P.AssocLeft]
128+ , [ binary EqualTo "===" P.AssocLeft]
129+ , [ binary NotEqualTo "!==" P.AssocLeft]
130+ , [ binary BitwiseAnd "&" P.AssocLeft]
131+ , [ binary BitwiseXor "^" P.AssocLeft]
132+ , [ binary BitwiseOr "|" P.AssocLeft]
133+ , [ binary And "&&" P.AssocRight]
134+ , [ binary Or "||" P.AssocRight]
135+ ]
136+
137+parseVariableIntroduction :: P.Parsec String u JS
138+parseVariableIntroduction = do
139+ C.reserved "var"
140+ name <- Ident <$> P.identifier C.tokenParser
141+ value <- P.optionMaybe $ do
142+ C.lexeme $ P.char '='
143+ value <- parseJS
144+ C.semi
145+ return value
146+ return $ JSVariableIntroduction name value
147+
148+parseAssignment :: P.Parsec String u JS
149+parseAssignment = do
150+ tgt <- parseAssignmentTarget
151+ C.lexeme $ P.char '='
152+ value <- parseJS
153+ C.semi
154+ return $ JSAssignment tgt value
155+
156+parseAssignmentTarget :: P.Parsec String u JSAssignment
157+parseAssignmentTarget = C.buildPostfixParser [] (JSAssignVariable <$> Ident <$> P.identifier C.tokenParser)
158+
159+parseWhile :: P.Parsec String u JS
160+parseWhile = JSWhile <$> (C.reserved "while" *> P.parens C.tokenParser parseJS)
161+ <*> parseJS
162+
163+parseIf :: P.Parsec String u JS
164+parseIf = JSIfElse <$> (C.reserved "if" *> P.parens C.tokenParser parseJS)
165+ <*> parseJS
166+ <*> P.optionMaybe (C.reserved "else" >> parseJS)
167+
168+parseReturn :: P.Parsec String u JS
169+parseReturn = JSReturn <$> (C.reserved "return" *> parseJS <* C.semi)
src/Language/PureScript/Pretty/JS.hs+1
@@ -219,6 +219,7 @@ prettyPrintJS' = A.runKleisli $ runPattern matchValue
219 , [ unary Not "!" ]
219 , [ unary Not "!" ]
220 , [ unary BitwiseNot "~" ]
220 , [ unary BitwiseNot "~" ]
221 , [ unary Negate "-" ]
221 , [ unary Negate "-" ]
222+ , [ unary Positive "+" ]
222 , [ binary Multiply "*" ]
223 , [ binary Multiply "*" ]
223 , [ binary Divide "/" ]
224 , [ binary Divide "/" ]
224 , [ binary Modulus "%" ]
225 , [ binary Modulus "%" ]
src/Language/PureScript/Pretty/Values.hs+1
@@ -140,6 +140,7 @@ prettyPrintValue = fromMaybe (error "Incomplete pattern") . pattern matchValue (
140 , [ unary Not "!" ]
140 , [ unary Not "!" ]
141 , [ unary BitwiseNot "~" ]
141 , [ unary BitwiseNot "~" ]
142 , [ unary Negate "-" ]
142 , [ unary Negate "-" ]
143+ , [ unary Positive "+" ]
143 , [ binary Multiply "*" ]
144 , [ binary Multiply "*" ]
144 , [ binary Divide "/" ]
145 , [ binary Divide "/" ]
145 , [ binary Modulus "%" ]
146 , [ binary Modulus "%" ]
src/Language/PureScript/Values.hs+2−1
@@ -26,7 +26,8 @@ type Guard = Value
26data UnaryOperator
26data UnaryOperator
27 = Negate
27 = Negate
28 | Not
28 | Not
29+ | BitwiseNot
29− | BitwiseNot deriving (Show, Eq, Data, Typeable)
30+ | Positive deriving (Show, Eq, Data, Typeable)
30
31
31data BinaryOperator
32data BinaryOperator
32 = Add
33 = Add