e74c777 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Add indexer notation for operators at the top level #142

e74c777Phil Freeman13 years ago

src/Language/PureScript/CodeGen/JS.hs+24−19

compare with golang

unifiedsplit

@@ -52,8 +52,8 @@ moduleToJs opts (Module pname@(ProperName name) decls) env =

52 [ JSVariableIntroduction name Nothing

53 , JSApp (JSFunction Nothing [name]

54 (JSBlock (concat $ mapMaybe (\decl -> fmap (map $ optimize opts) $ declToJs opts (ModuleName pname) decl env) (sortBy typeClassesLast decls))))

55− [JSAssignment (JSAssignVariable name)

55+ [JSAssignment (JSVar name)

56− (JSBinary Or (JSVar name) (JSObjectLiteral []))]

56+ (JSBinary Or (JSVar name) (JSObjectLiteral []))]

57 ]

58 where

59 typeClassesLast (ExternDeclaration TypeClassDictionaryImport _ _ _) (ExternDeclaration TypeClassDictionaryImport _ _ _) = EQ

@@ -66,12 +66,12 @@ moduleToJs opts (Module pname@(ProperName name) decls) env =

66--

67declToJs :: Options -> ModuleName -> Declaration -> Environment -> Maybe [JS]

68declToJs opts mp (ValueDeclaration ident _ _ val) e =

69− Just [ JSVariableIntroduction (identToJs ident) (Just (valueToJs opts mp e val)),

69+ Just $ JSVariableIntroduction (identToJs ident) (Just (valueToJs opts mp e val))

70− setProperty (identToJs ident) (var ident) mp ]

70+ : setProperty ident (var ident) mp

71declToJs opts mp (BindingGroupDeclaration vals) e =

72 Just $ concatMap (\(ident, val) ->

73− [ JSVariableIntroduction (identToJs ident) (Just (valueToJs opts mp e val)),

73+ JSVariableIntroduction (identToJs ident) (Just (valueToJs opts mp e val))

74− setProperty (identToJs ident) (var ident) mp ]

74+ : setProperty ident (var ident) mp

75 ) vals

76declToJs _ mp (DataDeclaration _ _ ctors) _ =

77 Just $ flip concatMap ctors $ \(pn@(ProperName ctor), maybeTy) ->

@@ -83,19 +83,22 @@ declToJs _ mp (DataDeclaration _ _ ctors) _ =

83 (JSBlock [JSReturn

84 (JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified (Just mp) pn)))

85 , ("value", JSVar "value") ])])

86− in [ ctorJs, setProperty ctor (JSVar ctor) mp ]

86+ in ctorJs : setProperty (Escaped ctor) (JSVar ctor) mp

87declToJs opts mp (DataBindingGroupDeclaration ds) e =

88 Just $ concat $ mapMaybe (flip (declToJs opts mp) e) ds

89declToJs _ mp (ExternDeclaration importTy ident (Just js) _) _ =

90− Just [ js

91− , setProperty (identToJs ident) (var ident) mp ]

90+ Just $ js : setProperty ident (var ident) mp

92declToJs _ _ _ _ = Nothing

91declToJs _ _ _ _ = Nothing

94−setProperty :: String -> JS -> ModuleName -> JS

93+setProperty :: Ident -> JS -> ModuleName -> [JS]

95−setProperty prop val (ModuleName (ProperName moduleName)) = JSAssignment (JSAssignProperty prop (JSAssignVariable moduleName)) val

94+setProperty ident@(Op op) val (ModuleName (ProperName moduleName)) =

95+ [ JSAssignment (JSAccessor (identToJs ident) (JSVar moduleName)) val

96+ , JSAssignment (JSIndexer (JSStringLiteral op) (JSVar moduleName)) (JSAccessor (identToJs ident) (JSVar moduleName)) ]

97+setProperty ident val (ModuleName (ProperName moduleName)) =

98+ [ JSAssignment (JSAccessor (identToJs ident) (JSVar moduleName)) val ]

97var :: Ident -> JS

100var :: Ident -> JS

98−var name = JSVar $ identToJs name

101+var = JSVar . identToJs

102

100valueToJs :: Options -> ModuleName -> Environment -> Value -> JS

103valueToJs :: Options -> ModuleName -> Environment -> Value -> JS

101valueToJs _ _ _ (NumericLiteral n) = JSNumericLiteral n

104valueToJs _ _ _ (NumericLiteral n) = JSNumericLiteral n

@@ -154,13 +157,15 @@ runtimeTypeChecks arg ty =

154 arrayCheck js = JSIfElse (JSUnary Not (JSApp (JSAccessor "isArray" (JSVar "Array")) [js])) (JSBlock [JSThrow (JSStringLiteral "Array expected")]) Nothing

157 arrayCheck js = JSIfElse (JSUnary Not (JSApp (JSAccessor "isArray" (JSVar "Array")) [js])) (JSBlock [JSThrow (JSStringLiteral "Array expected")]) Nothing

155

158

156varToJs :: ModuleName -> Environment -> Qualified Ident -> JS

159varToJs :: ModuleName -> Environment -> Qualified Ident -> JS

157−varToJs m e qual@(Qualified _ ident) = case M.lookup (qualify m qual) (names e) of

160+varToJs m e qual@(Qualified _ ident) = go qual

158− Just (_, ty) | isExtern ty -> var ident

159− Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS identToJs (Qualified (Just aliasModule) aliasIdent)

160− _ -> case qual of

161− Qualified Nothing _ -> var ident

162− _ -> qualifiedToJS identToJs qual

163 where

161 where

162+ go qual = case M.lookup (qualify m qual) (names e) of

163+ Just (_, ty) | isExtern ty -> var ident

164+ Just (_, Alias aliasModule aliasIdent) -> go (Qualified (Just aliasModule) aliasIdent)

165+ _ -> case qual of

166+ Qualified Nothing _ -> var ident

167+ Qualified (Just (ModuleName (ProperName mn))) (Op op) -> JSIndexer (JSStringLiteral op) (JSVar mn)

168+ _ -> qualifiedToJS identToJs qual

164 isExtern (Extern ForeignImport) = True

169 isExtern (Extern ForeignImport) = True

165 isExtern (Alias m' ident') = case M.lookup (m', ident') (names e) of

170 isExtern (Alias m' ident') = case M.lookup (m', ident') (names e) of

166 Just (_, ty') -> isExtern ty'

171 Just (_, ty') -> isExtern ty'

@@ -263,7 +268,7 @@ isOnlyConstructor m e ctor =

263

268

264statementToJs :: Options -> ModuleName -> Environment -> Statement -> JS

269statementToJs :: Options -> ModuleName -> Environment -> Statement -> JS

265statementToJs opts m e (VariableIntroduction ident value) = JSVariableIntroduction (identToJs ident) (Just (valueToJs opts m e value))

270statementToJs opts m e (VariableIntroduction ident value) = JSVariableIntroduction (identToJs ident) (Just (valueToJs opts m e value))

266−statementToJs opts m e (Assignment target value) = JSAssignment (JSAssignVariable (identToJs target)) (valueToJs opts m e value)

271+statementToJs opts m e (Assignment target value) = JSAssignment (JSVar (identToJs target)) (valueToJs opts m e value)

267statementToJs opts m e (While cond sts) = JSWhile (valueToJs opts m e cond) (JSBlock (map (statementToJs opts m e) sts))

272statementToJs opts m e (While cond sts) = JSWhile (valueToJs opts m e cond) (JSBlock (map (statementToJs opts m e) sts))

268statementToJs opts m e (For ident start end sts) = JSFor (identToJs ident) (valueToJs opts m e start) (valueToJs opts m e end) (JSBlock (map (statementToJs opts m e) sts))

273statementToJs opts m e (For ident start end sts) = JSFor (identToJs ident) (valueToJs opts m e start) (valueToJs opts m e end) (JSBlock (map (statementToJs opts m e) sts))

269statementToJs opts m e (If ifst) = ifToJs ifst

274statementToJs opts m e (If ifst) = ifToJs ifst

src/Language/PureScript/CodeGen/JS/AST.hs+1−14

@@ -88,7 +88,7 @@ data JS

88 -- |

89 -- A variable assignment

90 --

91− | JSAssignment JSAssignment JS

91+ | JSAssignment JS JS

92 -- |

93 -- While loop

94 --

@@ -129,16 +129,3 @@ data JS

129 -- Raw Javascript (generated when parsing fails for an inline foreign import declaration)

130 --

131 | JSRaw String deriving (Show, Eq, Data, Typeable)

132−

133−-- |

134−-- Data type for expressions which can appear on the left hand side of an assignment

135−--

136−data JSAssignment

137− -- |

138− -- Assign a variable

139− --

140− = JSAssignVariable String

141− -- |

142− -- Assign an object property

143− --

144− | JSAssignProperty String JSAssignment deriving (Show, Eq, Data, Typeable)

src/Language/PureScript/CodeGen/Optimize.hs+11−7

@@ -105,9 +105,11 @@ isUsed var1 = everything (||) (mkQ False check)

105 check (JSAssignment target _) | var1 == targetVariable target = True

106 check _ = False

107

108−targetVariable :: JSAssignment -> String

108+targetVariable :: JS -> String

109−targetVariable (JSAssignVariable var) = var

109+targetVariable (JSVar var) = var

110+targetVariable (JSAccessor _ tgt) = targetVariable tgt

110−targetVariable (JSAssignProperty _ tgt) = targetVariable tgt

111+targetVariable (JSIndexer _ tgt) = targetVariable tgt

112+targetVariable _ = error "Invalid argument to targetVariable"

111

113

112isUpdated :: (Data d) => String -> d -> Bool

114isUpdated :: (Data d) => String -> d -> Bool

113isUpdated var1 = everything (||) (mkQ False check)

115isUpdated var1 = everything (||) (mkQ False check)

@@ -231,7 +233,7 @@ tco' = everywhere (mkT convert)

231 JSBlock $ zipWith (\val arg ->

233 JSBlock $ zipWith (\val arg ->

232 JSVariableIntroduction (tcoVar arg) (Just val)) allArgumentValues allArgs

234 JSVariableIntroduction (tcoVar arg) (Just val)) allArgumentValues allArgs

233 ++ map (\arg ->

235 ++ map (\arg ->

234− JSAssignment (JSAssignVariable arg) (JSVar (tcoVar arg))) allArgs

236+ JSAssignment (JSVar arg) (JSVar (tcoVar arg))) allArgs

235 ++ [ JSContinue tcoLabel ]

237 ++ [ JSContinue tcoLabel ]

236 loopify other = other

238 loopify other = other

237 collectSelfCallArgs :: [[JS]] -> JS -> [[JS]]

239 collectSelfCallArgs :: [[JS]] -> JS -> [[JS]]

@@ -257,12 +259,13 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

257 convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock [JSReturn ret])]) | isBind bind =

259 convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock [JSReturn ret])]) | isBind bind =

258 JSFunction (Just fnName) [] $ JSBlock [ JSVariableIntroduction arg (Just (JSApp m [])), JSReturn (JSApp ret []) ]

260 JSFunction (Just fnName) [] $ JSBlock [ JSVariableIntroduction arg (Just (JSApp m [])), JSReturn (JSApp ret []) ]

259 convert other = other

261 convert other = other

260− isBind (JSApp bindPoly [JSApp effDict []]) | isBindPoly bindPoly && isEffDict effDict = True

262+ isBind (JSApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict effDict = True

261 isBind _ = False

263 isBind _ = False

262− isReturn (JSApp retPoly [JSApp effDict []]) | isRetPoly retPoly && isEffDict effDict = True

264+ isReturn (JSApp retPoly [effDict]) | isRetPoly retPoly && isEffDict effDict = True

263 isReturn _ = False

265 isReturn _ = False

264 isBindPoly (JSVar op) | op == identToJs (Op ">>=") = True

266 isBindPoly (JSVar op) | op == identToJs (Op ">>=") = True

265 isBindPoly (JSAccessor prop (JSVar "Prelude")) | prop == identToJs (Op ">>=") = True

267 isBindPoly (JSAccessor prop (JSVar "Prelude")) | prop == identToJs (Op ">>=") = True

268+ isBindPoly (JSIndexer (JSStringLiteral ">>=") (JSVar "Prelude")) = True

266 isBindPoly _ = False

269 isBindPoly _ = False

267 isRetPoly (JSVar "ret") = True

270 isRetPoly (JSVar "ret") = True

268 isRetPoly (JSAccessor "ret" (JSVar "Prelude")) = True

271 isRetPoly (JSAccessor "ret" (JSVar "Prelude")) = True

@@ -296,5 +299,6 @@ inlineDollar = everywhere (mkT convert)

296 convert :: JS -> JS

299 convert :: JS -> JS

297 convert (JSApp (JSApp dollar [f]) [x]) | isDollar dollar = JSApp f [x]

300 convert (JSApp (JSApp dollar [f]) [x]) | isDollar dollar = JSApp f [x]

298 convert other = other

301 convert other = other

299− isDollar (JSAccessor name (JSVar "Prelude")) | name == identToJs (Op "$") = True

302+ isDollar (JSAccessor "$dollar" (JSVar "Prelude")) = True

303+ isDollar (JSIndexer (JSStringLiteral "$") (JSVar "Prelude")) = True

300 isDollar _ = False

304 isDollar _ = False

src/Language/PureScript/Parser/JS.hs+3−8

@@ -74,7 +74,6 @@ parseJSAtom = P.choice

74 , parseBlock

75 , P.try parseVar

76 , parseVariableIntroduction

77− , P.try parseAssignment

78 , parseWhile

77 , parseWhile

79 , parseIf

78 , parseIf

80 , parseReturn

79 , parseReturn

@@ -110,7 +109,7 @@ parseJS =

110 $ indexersAndAccessors) P.<?> "javascript"

109 $ indexersAndAccessors) P.<?> "javascript"

111 where

110 where

112 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseJSAtom

111 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseJSAtom

113− postfixTable1 = [ parseAccessor, parseIndexer, parseConditional ]

112+ postfixTable1 = [ parseAccessor, parseIndexer, parseConditional, parseAssignment ]

114 postfixTable2 = [ \v -> P.try $ JSApp v <$> (P.parens C.tokenParser (P.commaSep C.tokenParser parseJS)) ]

113 postfixTable2 = [ \v -> P.try $ JSApp v <$> (P.parens C.tokenParser (P.commaSep C.tokenParser parseJS)) ]

115 operators = [ [ binary LessThan "<" P.AssocLeft]

114 operators = [ [ binary LessThan "<" P.AssocLeft]

116 , [ binary LessThanOrEqualTo "<=" P.AssocLeft]

115 , [ binary LessThanOrEqualTo "<=" P.AssocLeft]

@@ -149,17 +148,13 @@ parseVariableIntroduction = do

149 return value

148 return value

150 return $ JSVariableIntroduction name value

149 return $ JSVariableIntroduction name value

151

150

152−parseAssignment :: P.Parsec String u JS

151+parseAssignment :: JS -> P.Parsec String u JS

153−parseAssignment = do

152+parseAssignment tgt = do

154− tgt <- parseAssignmentTarget

155 _ <- C.lexeme $ P.char '='

153 _ <- C.lexeme $ P.char '='

156 value <- parseJS

154 value <- parseJS

157 _ <- C.semi

155 _ <- C.semi

158 return $ JSAssignment tgt value

156 return $ JSAssignment tgt value

159

157

160−parseAssignmentTarget :: P.Parsec String u JSAssignment

161−parseAssignmentTarget = C.buildPostfixParser [] (JSAssignVariable <$> P.identifier C.tokenParser)

162−

163parseWhile :: P.Parsec String u JS

158parseWhile :: P.Parsec String u JS

164parseWhile = JSWhile <$> (C.reserved "while" *> P.parens C.tokenParser parseJS)

159parseWhile = JSWhile <$> (C.reserved "while" *> P.parens C.tokenParser parseJS)

165 <*> parseJS

160 <*> parseJS

src/Language/PureScript/Pretty/JS.hs+1−5

@@ -96,7 +96,7 @@ literals = mkPattern' match

96 , maybe (return "") (fmap (" = " ++) . prettyPrintJS') value

97 ]

98 match (JSAssignment target value) = fmap concat $ sequence

99− [ return $ targetToJs target

99+ [ prettyPrintJS' target

100 , return " = "

101 , prettyPrintJS' value

102 ]

@@ -138,10 +138,6 @@ literals = mkPattern' match

138 match (JSRaw js) = return js

139 match _ = mzero

140

141−targetToJs :: JSAssignment -> String

142−targetToJs (JSAssignVariable ident) = ident

143−targetToJs (JSAssignProperty prop target) = targetToJs target ++ "." ++ prop

144−

145conditional :: Pattern PrinterState JS ((JS, JS), JS)

141conditional :: Pattern PrinterState JS ((JS, JS), JS)

146conditional = mkPattern match

142conditional = mkPattern match

147 where

143 where