9fd5b26 · rowtype-yoga/purescript-native

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

on golang help sign in

Merge pull request #168 from garyb/stringnames

9fd5b26Phil Freeman13 years ago

purescript.cabal+1

compare with golang

unifiedsplit

@@ -36,6 +36,7 @@ library

36 Language.PureScript.Sugar.Operators

37 Language.PureScript.Sugar.TypeClasses

38 Language.PureScript.CodeGen

39+ Language.PureScript.CodeGen.Common

39 Language.PureScript.CodeGen.Externs

40 Language.PureScript.CodeGen.Externs

40 Language.PureScript.CodeGen.JS

41 Language.PureScript.CodeGen.JS

41 Language.PureScript.CodeGen.JS.AST

42 Language.PureScript.CodeGen.JS.AST

src/Language/PureScript.hs+1−1

@@ -65,6 +65,6 @@ compile opts ms = do

65 _ | optionsRunMain opts -> do

66 when ((ModuleName (ProperName "Main"), Ident "main") `M.notMember` (names env)) $

67 Left "Main.main is undefined"

68− return $ js ++ [JSApp (JSAccessor "main" (JSVar (Ident "Main"))) []]

68+ return $ js ++ [JSApp (JSAccessor "main" (JSVar "Main")) []]

69 | otherwise -> return js

70 return (prettyPrintJS js', exts, env)

src/Language/PureScript/CodeGen/Common.hsnew file+56

@@ -0,0 +1,56 @@

1+-----------------------------------------------------------------------------

2+--

3+-- Module : Language.PureScript.CodeGen.Common

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+-- Common code generation utility functions

13+--

14+-----------------------------------------------------------------------------

15+

16+module Language.PureScript.CodeGen.Common where

17+

18+import Data.Char

19+import Language.PureScript.Names

20+

21+-- |

22+-- Convert an Ident into a valid Javascript identifier:

23+--

24+-- * Alphanumeric characters are kept unmodified

25+--

26+-- * Symbols are encoded as a dollar symbol ($) followed by their ordinal value

27+--

28+identToJs :: Ident -> String

29+identToJs (Ident name) = concatMap identCharToString name

30+identToJs (Op op) = concatMap identCharToString op

31+identToJs (Escaped name) = name

32+

33+identCharToString :: Char -> String

34+identCharToString c | isAlphaNum c = [c]

35+identCharToString '_' = "_"

36+identCharToString '.' = "$dot"

37+identCharToString '$' = "$dollar"

38+identCharToString '~' = "$tilde"

39+identCharToString '=' = "$eq"

40+identCharToString '<' = "$less"

41+identCharToString '>' = "$greater"

42+identCharToString '!' = "$bang"

43+identCharToString '#' = "$hash"

44+identCharToString '%' = "$percent"

45+identCharToString '^' = "$up"

46+identCharToString '&' = "$amp"

47+identCharToString '|' = "$bar"

48+identCharToString '*' = "$times"

49+identCharToString '/' = "$div"

50+identCharToString '+' = "$plus"

51+identCharToString '-' = "$minus"

52+identCharToString ':' = "$colon"

53+identCharToString '\\' = "$bslash"

54+identCharToString '?' = "$qmark"

55+identCharToString '@' = "$at"

56+identCharToString c = '$' : show (ord c)

src/Language/PureScript/CodeGen/JS.hs+36−32

@@ -41,6 +41,7 @@ import Language.PureScript.Options

41import Language.PureScript.CodeGen.JS.AST as AST

42import Language.PureScript.Types

43import Language.PureScript.CodeGen.Optimize

44+import Language.PureScript.CodeGen.Common (identToJs)

44import Language.PureScript.TypeChecker.Monad (canonicalizeDataConstructor)

45import Language.PureScript.TypeChecker.Monad (canonicalizeDataConstructor)

46-- |

47-- |

@@ -48,11 +49,11 @@ import Language.PureScript.TypeChecker.Monad (canonicalizeDataConstructor)

48--

49--

49moduleToJs :: Options -> Module -> Environment -> [JS]

50moduleToJs :: Options -> Module -> Environment -> [JS]

50moduleToJs opts (Module pname@(ProperName name) decls) env =

51moduleToJs opts (Module pname@(ProperName name) decls) env =

51− [ JSVariableIntroduction (Ident name) Nothing

52+ [ JSVariableIntroduction name Nothing

52− , JSApp (JSFunction Nothing [Ident name]

53+ , JSApp (JSFunction Nothing [name]

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

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

54− [JSAssignment (JSAssignVariable (Ident name))

55+ [JSAssignment (JSAssignVariable name)

55− (JSBinary Or (JSVar (Ident name)) (JSObjectLiteral []))]

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

56 ]

57 ]

57 where

58 where

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

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

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

65--

66--

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

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

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

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

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

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

69− setProperty (identToJs ident) (JSVar ident) mp ]

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

70declToJs opts mp (BindingGroupDeclaration vals) e =

71declToJs opts mp (BindingGroupDeclaration vals) e =

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

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

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

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

73− setProperty (identToJs ident) (JSVar ident) mp ]

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

74 ) vals

75 ) vals

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

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

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

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

77 let

78 let

78 ctorJs =

79 ctorJs =

79 case maybeTy of

80 case maybeTy of

80− Nothing -> JSVariableIntroduction (Ident ctor) (Just (JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified (Just mp) pn))) ]))

81+ Nothing -> JSVariableIntroduction ctor (Just (JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified (Just mp) pn))) ]))

81− Just _ -> JSFunction (Just (Ident ctor)) [Ident "value"]

82+ Just _ -> JSFunction (Just ctor) ["value"]

82 (JSBlock [JSReturn

83 (JSBlock [JSReturn

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

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

84− , ("value", JSVar (Ident "value")) ])])

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

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

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

86declToJs opts mp (DataBindingGroupDeclaration ds) e =

87declToJs opts mp (DataBindingGroupDeclaration ds) e =

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

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

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

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

89 Just [ js

90 Just [ js

90− , setProperty (identToJs ident) (JSVar ident) mp ]

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

91declToJs _ _ _ _ = Nothing

92declToJs _ _ _ _ = Nothing

93setProperty :: String -> JS -> ModuleName -> JS

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

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

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

96+

97+var :: Ident -> JS

98+var name = JSVar $ identToJs name

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

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

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

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

@@ -99,11 +103,11 @@ valueToJs _ _ _ (StringLiteral s) = JSStringLiteral s

99valueToJs _ _ _ (BooleanLiteral b) = JSBooleanLiteral b

103valueToJs _ _ _ (BooleanLiteral b) = JSBooleanLiteral b

100valueToJs opts m e (ArrayLiteral xs) = JSArrayLiteral (map (valueToJs opts m e) xs)

104valueToJs opts m e (ArrayLiteral xs) = JSArrayLiteral (map (valueToJs opts m e) xs)

101valueToJs opts m e (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs opts m e)) ps)

105valueToJs opts m e (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs opts m e)) ps)

102−valueToJs opts m e (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar (Ident "Object"))) [ valueToJs opts m e o, JSObjectLiteral (map (second (valueToJs opts m e)) ps)]

106+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)]

103valueToJs _ m e (Constructor (Qualified Nothing name)) =

107valueToJs _ m e (Constructor (Qualified Nothing name)) =

104 case M.lookup (m, name) (dataConstructors e) of

108 case M.lookup (m, name) (dataConstructors e) of

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

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

106− _ -> JSVar . Ident . runProperName $ name

110+ _ -> JSVar . runProperName $ name

107valueToJs _ _ _ (Constructor name) = qualifiedToJS runProperName name

111valueToJs _ _ _ (Constructor name) = qualifiedToJS runProperName name

108valueToJs opts m e (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs opts m e) sts))) []

112valueToJs opts m e (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs opts m e) sts))) []

109valueToJs opts m e (Case values binders) = bindersToJs opts m e binders (map (valueToJs opts m e) values)

113valueToJs opts m e (Case values binders) = bindersToJs opts m e binders (map (valueToJs opts m e) values)

@@ -111,8 +115,8 @@ valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e c

111valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)

115valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)

112valueToJs opts m e (Indexer index val) = JSIndexer (valueToJs opts m e index) (valueToJs opts m e val)

116valueToJs opts m e (Indexer index val) = JSIndexer (valueToJs opts m e index) (valueToJs opts m e val)

113valueToJs opts m e (App val arg) = JSApp (valueToJs opts m e val) [valueToJs opts m e arg]

117valueToJs opts m e (App val arg) = JSApp (valueToJs opts m e val) [valueToJs opts m e arg]

114−valueToJs opts m e (Abs arg val) = JSFunction Nothing [arg] (JSBlock [JSReturn (valueToJs opts m e val)])

118+valueToJs opts m e (Abs arg val) = JSFunction Nothing [identToJs arg] (JSBlock [JSReturn (valueToJs opts m e val)])

115−valueToJs opts m e (TypedValue _ (Abs arg val) ty) | optionsPerformRuntimeTypeChecks opts = JSFunction Nothing [arg] (JSBlock $ runtimeTypeChecks arg ty ++ [JSReturn (valueToJs opts m e val)])

119+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)])

116valueToJs opts m e (Unary op val) = JSUnary op (valueToJs opts m e val)

120valueToJs opts m e (Unary op val) = JSUnary op (valueToJs opts m e val)

117valueToJs opts m e (Binary op v1 v2) = JSBinary op (valueToJs opts m e v1) (valueToJs opts m e v2)

121valueToJs opts m e (Binary op v1 v2) = JSBinary op (valueToJs opts m e v1) (valueToJs opts m e v2)

118valueToJs _ m e (Var ident) = varToJs m e ident

122valueToJs _ m e (Var ident) = varToJs m e ident

@@ -120,7 +124,7 @@ valueToJs opts m e (TypedValue _ val _) = valueToJs opts m e val

120valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not replaced"

124valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not replaced"

121valueToJs _ _ _ _ = error "Invalid argument to valueToJs"

125valueToJs _ _ _ _ = error "Invalid argument to valueToJs"

122

126

123−runtimeTypeChecks :: Ident -> Type -> [JS]

127+runtimeTypeChecks :: String -> Type -> [JS]

124runtimeTypeChecks arg ty =

128runtimeTypeChecks arg ty =

125 let

129 let

126 argTy = getFunctionArgumentType ty

130 argTy = getFunctionArgumentType ty

@@ -147,14 +151,14 @@ runtimeTypeChecks arg ty =

147 typeCheck :: JS -> String -> JS

151 typeCheck :: JS -> String -> JS

148 typeCheck js ty' = JSIfElse (JSBinary NotEqualTo (JSTypeOf js) (JSStringLiteral ty')) (JSBlock [JSThrow (JSStringLiteral $ ty' ++ " expected")]) Nothing

152 typeCheck js ty' = JSIfElse (JSBinary NotEqualTo (JSTypeOf js) (JSStringLiteral ty')) (JSBlock [JSThrow (JSStringLiteral $ ty' ++ " expected")]) Nothing

149 arrayCheck :: JS -> JS

153 arrayCheck :: JS -> JS

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

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

151

155

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

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

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

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

154− Just (_, ty) | isExtern ty -> JSVar ident

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

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

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

156 _ -> case qual of

160 _ -> case qual of

157− Qualified Nothing _ -> JSVar ident

161+ Qualified Nothing _ -> var ident

158 _ -> qualifiedToJS identToJs qual

162 _ -> qualifiedToJS identToJs qual

159 where

163 where

160 isExtern (Extern ForeignImport) = True

164 isExtern (Extern ForeignImport) = True

@@ -164,17 +168,17 @@ varToJs m e qual@(Qualified _ ident) = case M.lookup (qualify m qual) (names e)

164 isExtern _ = False

168 isExtern _ = False

165

169

166qualifiedToJS :: (a -> String) -> Qualified a -> JS

170qualifiedToJS :: (a -> String) -> Qualified a -> JS

167−qualifiedToJS f (Qualified (Just (ModuleName (ProperName m))) a) = JSAccessor (f a) (JSVar (Ident m))

171+qualifiedToJS f (Qualified (Just (ModuleName (ProperName m))) a) = JSAccessor (f a) (JSVar m)

168−qualifiedToJS f (Qualified Nothing a) = JSVar (Ident (f a))

172+qualifiedToJS f (Qualified Nothing a) = JSVar (f a)

169

173

170bindersToJs :: Options -> ModuleName -> Environment -> [([Binder], Maybe Guard, Value)] -> [JS] -> JS

174bindersToJs :: Options -> ModuleName -> Environment -> [([Binder], Maybe Guard, Value)] -> [JS] -> JS

171−bindersToJs opts m e binders vals = runGen (unusedNames (binders, vals)) $ do

175+bindersToJs opts m e binders vals = runGen (map identToJs (unusedNames (binders, vals))) $ do

172 valNames <- replicateM (length vals) fresh

176 valNames <- replicateM (length vals) fresh

173 jss <- forM binders $ \(bs, grd, result) -> go valNames [JSReturn (valueToJs opts m e result)] bs grd

177 jss <- forM binders $ \(bs, grd, result) -> go valNames [JSReturn (valueToJs opts m e result)] bs grd

174 return $ JSApp (JSFunction Nothing valNames (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))

178 return $ JSApp (JSFunction Nothing valNames (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))

175 vals

179 vals

176 where

180 where

177− go :: [Ident] -> [JS] -> [Binder] -> Maybe Guard -> Gen [JS]

181+ go :: [String] -> [JS] -> [Binder] -> Maybe Guard -> Gen [JS]

178 go _ done [] Nothing = return done

182 go _ done [] Nothing = return done

179 go _ done [] (Just cond) = return [JSIfElse (valueToJs opts m e cond) (JSBlock done) Nothing]

183 go _ done [] (Just cond) = return [JSIfElse (valueToJs opts m e cond) (JSBlock done) Nothing]

180 go (v:vs) done' (b:bs) grd = do

184 go (v:vs) done' (b:bs) grd = do

@@ -182,7 +186,7 @@ bindersToJs opts m e binders vals = runGen (unusedNames (binders, vals)) $ do

182 binderToJs m e v done'' b

186 binderToJs m e v done'' b

183 go _ _ _ _ = error "Invalid arguments to bindersToJs"

187 go _ _ _ _ = error "Invalid arguments to bindersToJs"

184

188

185−binderToJs :: ModuleName -> Environment -> Ident -> [JS] -> Binder -> Gen [JS]

189+binderToJs :: ModuleName -> Environment -> String -> [JS] -> Binder -> Gen [JS]

186binderToJs _ _ _ done NullBinder = return done

190binderToJs _ _ _ done NullBinder = return done

187binderToJs _ _ varName done (StringBinder str) =

191binderToJs _ _ varName done (StringBinder str) =

188 return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral str)) (JSBlock done) Nothing]

192 return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral str)) (JSBlock done) Nothing]

@@ -193,7 +197,7 @@ binderToJs _ _ varName done (BooleanBinder True) =

193binderToJs _ _ varName done (BooleanBinder False) =

197binderToJs _ _ varName done (BooleanBinder False) =

194 return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]

198 return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]

195binderToJs _ _ varName done (VarBinder ident) =

199binderToJs _ _ varName done (VarBinder ident) =

196− return (JSVariableIntroduction ident (Just (JSVar varName)) : done)

200+ return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : done)

197binderToJs m e varName done (NullaryBinder ctor) =

201binderToJs m e varName done (NullaryBinder ctor) =

198 if isOnlyConstructor m e ctor

202 if isOnlyConstructor m e ctor

199 then

203 then

@@ -243,7 +247,7 @@ binderToJs m e varName done (ConsBinder headBinder tailBinder) = do

243 )) Nothing]

247 )) Nothing]

244binderToJs m e varName done (NamedBinder ident binder) = do

248binderToJs m e varName done (NamedBinder ident binder) = do

245 js <- binderToJs m e varName done binder

249 js <- binderToJs m e varName done binder

246− return (JSVariableIntroduction ident (Just (JSVar varName)) : js)

250+ return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)

247

251

248isOnlyConstructor :: ModuleName -> Environment -> Qualified ProperName -> Bool

252isOnlyConstructor :: ModuleName -> Environment -> Qualified ProperName -> Bool

249isOnlyConstructor m e ctor =

253isOnlyConstructor m e ctor =

@@ -258,10 +262,10 @@ isOnlyConstructor m e ctor =

258 typeConstructor fn = error $ "Invalid arguments to typeConstructor: " ++ show fn

262 typeConstructor fn = error $ "Invalid arguments to typeConstructor: " ++ show fn

259

263

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

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

261−statementToJs opts m e (VariableIntroduction ident value) = JSVariableIntroduction ident (Just (valueToJs opts m e value))

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

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

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

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

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

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

268+statementToJs 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))

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

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

266 where

270 where

267 ifToJs :: IfStatement -> JS

271 ifToJs :: IfStatement -> JS

src/Language/PureScript/CodeGen/JS/AST.hs+5−6

@@ -17,7 +17,6 @@

18module Language.PureScript.CodeGen.JS.AST where

20−import Language.PureScript.Names

21import Language.PureScript.Values

20import Language.PureScript.Values

23import Data.Data

22import Data.Data

@@ -65,7 +64,7 @@ data JS

65 -- |

64 -- |

66 -- A function introduction (optional name, arguments, body)

65 -- A function introduction (optional name, arguments, body)

67 --

66 --

68− | JSFunction (Maybe Ident) [Ident] JS

67+ | JSFunction (Maybe String) [String] JS

69 -- |

68 -- |

70 -- Function application

69 -- Function application

71 --

70 --

@@ -73,7 +72,7 @@ data JS

73 -- |

72 -- |

74 -- Variable

73 -- Variable

75 --

74 --

76− | JSVar Ident

75+ | JSVar String

77 -- |

76 -- |

78 -- Conditional expression

77 -- Conditional expression

79 --

78 --

@@ -85,7 +84,7 @@ data JS

85 -- |

84 -- |

86 -- A variable introduction and optional initialization

85 -- A variable introduction and optional initialization

87 --

86 --

88− | JSVariableIntroduction Ident (Maybe JS)

87+ | JSVariableIntroduction String (Maybe JS)

89 -- |

88 -- |

90 -- A variable assignment

89 -- A variable assignment

91 --

90 --

@@ -97,7 +96,7 @@ data JS

97 -- |

96 -- |

98 -- For loop

97 -- For loop

99 --

98 --

100− | JSFor Ident JS JS JS

99+ | JSFor String JS JS JS

101 -- |

100 -- |

102 -- If-then-else statement

101 -- If-then-else statement

103 --

102 --

@@ -138,7 +137,7 @@ data JSAssignment

138 -- |

137 -- |

139 -- Assign a variable

138 -- Assign a variable

140 --

139 --

141− = JSAssignVariable Ident

140+ = JSAssignVariable String

142 -- |

141 -- |

143 -- Assign an object property

142 -- Assign an object property

144 --

143 --

src/Language/PureScript/CodeGen/Monad.hs+3−3

@@ -26,18 +26,18 @@ import Language.PureScript.Names

26-- |

27-- Code generation monad data type

28--

29−newtype Gen a = Gen { unGen :: State [Ident] a } deriving (Functor, Applicative, Monad, MonadState [Ident])

29+newtype Gen a = Gen { unGen :: State [String] a } deriving (Functor, Applicative, Monad, MonadState [String])

31-- |

32-- Run a computation in the code generation monad

33--

34−runGen :: [Ident] -> Gen a -> a

34+runGen :: [String] -> Gen a -> a

35runGen names = flip evalState names . unGen

37-- |

38-- Generate a fresh name

39--

40−fresh :: Gen Ident

40+fresh :: Gen String

41fresh = do

42 (s:ss) <- get

43 put ss

src/Language/PureScript/CodeGen/Optimize.hs+24−26

@@ -42,7 +42,7 @@ import Data.Generics

42import Language.PureScript.Names

43import Language.PureScript.CodeGen.JS.AST

44import Language.PureScript.Options

45−import Language.PureScript.Pretty.Common (identToJs)

45+import Language.PureScript.CodeGen.Common (identToJs)

46import Language.PureScript.Sugar.TypeClasses

47 (mkDictionaryValueName)

48import Language.PureScript.Types (Type(..))

@@ -70,19 +70,19 @@ untilFixedPoint f a = go a

70 go a' = let a'' = f a' in

71 if a'' == a' then a'' else go a''

73−replaceIdent :: (Data d) => Ident -> JS -> d -> d

73+replaceIdent :: (Data d) => String -> JS -> d -> d

74replaceIdent var1 js = everywhere (mkT replace)

75 where

76 replace (JSVar var2) | var1 == var2 = js

77 replace other = other

79−replaceIdents :: (Data d) => [(Ident, JS)] -> d -> d

79+replaceIdents :: (Data d) => [(String, JS)] -> d -> d

80replaceIdents vars = everywhere (mkT replace)

81 where

82 replace v@(JSVar var) = fromMaybe v $ lookup var vars

83 replace other = other

85−isReassigned :: (Data d) => Ident -> d -> Bool

85+isReassigned :: (Data d) => String -> d -> Bool

86isReassigned var1 = everything (||) (mkQ False check)

87 where

88 check :: JS -> Bool

@@ -97,7 +97,7 @@ isRebound js d = any (\var -> isReassigned var d) (variablesOf js)

97 variablesOf (JSIndexer index val) = variablesOf index ++ variablesOf val

98 variablesOf _ = []

100−isUsed :: (Data d) => Ident -> d -> Bool

100+isUsed :: (Data d) => String -> d -> Bool

101isUsed var1 = everything (||) (mkQ False check)

102 where

103 check :: JS -> Bool

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

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

106 check _ = False

107

108−targetVariable :: JSAssignment -> Ident

108+targetVariable :: JSAssignment -> String

109targetVariable (JSAssignVariable var) = var

110targetVariable (JSAssignProperty _ tgt) = targetVariable tgt

111

112−isUpdated :: (Data d) => Ident -> d -> Bool

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

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

114 where

115 check :: JS -> Bool

@@ -173,12 +173,10 @@ tco' = everywhere (mkT convert)

173 where

174 tcoLabel :: String

175 tcoLabel = "tco"

176− tcoVar :: Ident -> Ident

176+ tcoVar :: String -> String

177− tcoVar (Ident arg) = Ident $ "__tco_" ++ arg

177+ tcoVar arg = "__tco_" ++ arg

178− tcoVar _ = error "Invalid name in tcoVar"

178+ copyVar :: String -> String

179− copyVar :: Ident -> Ident

180− copyVar (Ident arg) = Ident $ "__copy_" ++ arg

179+ copyVar arg = "__copy_" ++ arg

181− copyVar _ = error "Invalid name in copyVar"

182 convert :: JS -> JS

180 convert :: JS -> JS

183 convert js@(JSVariableIntroduction name (Just fn@(JSFunction _ _ _))) =

181 convert js@(JSVariableIntroduction name (Just fn@(JSFunction _ _ _))) =

184 let

182 let

@@ -191,7 +189,7 @@ tco' = everywhere (mkT convert)

191 JSVariableIntroduction name (Just (replace (toLoop name allArgs body')))

189 JSVariableIntroduction name (Just (replace (toLoop name allArgs body')))

192 | otherwise -> js

190 | otherwise -> js

193 convert js = js

191 convert js = js

194− collectAllFunctionArgs :: [[Ident]] -> (JS -> JS) -> JS -> ([[Ident]], JS, JS -> JS)

192+ collectAllFunctionArgs :: [[String]] -> (JS -> JS) -> JS -> ([[String]], JS, JS -> JS)

195 collectAllFunctionArgs allArgs f (JSFunction ident args (JSBlock (body@(JSReturn _):_))) =

193 collectAllFunctionArgs allArgs f (JSFunction ident args (JSBlock (body@(JSReturn _):_))) =

196 collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction ident (map copyVar args) (JSBlock [b]))) body

194 collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction ident (map copyVar args) (JSBlock [b]))) body

197 collectAllFunctionArgs allArgs f (JSFunction ident args body@(JSBlock _)) =

195 collectAllFunctionArgs allArgs f (JSFunction ident args body@(JSBlock _)) =

@@ -201,7 +199,7 @@ tco' = everywhere (mkT convert)

201 collectAllFunctionArgs allArgs f (JSReturn (JSFunction ident args body@(JSBlock _))) =

199 collectAllFunctionArgs allArgs f (JSReturn (JSFunction ident args body@(JSBlock _))) =

202 (args : allArgs, body, \b -> f (JSReturn (JSFunction ident (map copyVar args) b)))

200 (args : allArgs, body, \b -> f (JSReturn (JSFunction ident (map copyVar args) b)))

203 collectAllFunctionArgs allArgs f body = (allArgs, body, f)

201 collectAllFunctionArgs allArgs f body = (allArgs, body, f)

204− isTailCall :: Ident -> JS -> Bool

202+ isTailCall :: String -> JS -> Bool

205 isTailCall ident js =

203 isTailCall ident js =

206 let

204 let

207 numSelfCalls = everything (+) (mkQ 0 countSelfCalls) js

205 numSelfCalls = everything (+) (mkQ 0 countSelfCalls) js

@@ -220,7 +218,7 @@ tco' = everywhere (mkT convert)

220 countSelfCallsInTailPosition _ = 0

218 countSelfCallsInTailPosition _ = 0

221 countSelfCallsUnderFunctions (JSFunction _ _ js') = everything (+) (mkQ 0 countSelfCalls) js'

219 countSelfCallsUnderFunctions (JSFunction _ _ js') = everything (+) (mkQ 0 countSelfCalls) js'

222 countSelfCallsUnderFunctions _ = 0

220 countSelfCallsUnderFunctions _ = 0

223− toLoop :: Ident -> [Ident] -> JS -> JS

221+ toLoop :: String -> [String] -> JS -> JS

224 toLoop ident allArgs js = JSBlock $

222 toLoop ident allArgs js = JSBlock $

225 map (\arg -> JSVariableIntroduction arg (Just (JSVar (copyVar arg)))) allArgs ++

223 map (\arg -> JSVariableIntroduction arg (Just (JSVar (copyVar arg)))) allArgs ++

226 [ JSLabel tcoLabel $ JSWhile (JSBooleanLiteral True) (JSBlock [ everywhere (mkT loopify) js ]) ]

224 [ JSLabel tcoLabel $ JSWhile (JSBooleanLiteral True) (JSBlock [ everywhere (mkT loopify) js ]) ]

@@ -239,7 +237,7 @@ tco' = everywhere (mkT convert)

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

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

240 collectSelfCallArgs allArgumentValues (JSApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn

238 collectSelfCallArgs allArgumentValues (JSApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn

241 collectSelfCallArgs allArgumentValues _ = allArgumentValues

239 collectSelfCallArgs allArgumentValues _ = allArgumentValues

242− isSelfCall :: Ident -> JS -> Bool

240+ isSelfCall :: String -> JS -> Bool

243 isSelfCall ident (JSApp (JSVar ident') _) | ident == ident' = True

241 isSelfCall ident (JSApp (JSVar ident') _) | ident == ident' = True

244 isSelfCall ident (JSApp fn _) = isSelfCall ident fn

242 isSelfCall ident (JSApp fn _) = isSelfCall ident fn

245 isSelfCall _ _ = False

243 isSelfCall _ _ = False

@@ -251,10 +249,10 @@ magicDo opts | optionsMagicDo opts = magicDo'

251magicDo' :: JS -> JS

249magicDo' :: JS -> JS

252magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

250magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

253 where

251 where

254− fnName = Ident "__do"

252+ fnName = "__do"

255 convert :: JS -> JS

253 convert :: JS -> JS

256 convert (JSApp (JSApp ret [val]) []) | isReturn ret = val

254 convert (JSApp (JSApp ret [val]) []) | isReturn ret = val

257− convert (JSApp (JSApp bind [m]) [JSFunction Nothing [Ident "_"] (JSBlock [JSReturn ret])]) | isBind bind =

255+ convert (JSApp (JSApp bind [m]) [JSFunction Nothing ["_"] (JSBlock [JSReturn ret])]) | isBind bind =

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

256 JSFunction (Just fnName) [] $ JSBlock [ JSApp m [], JSReturn (JSApp ret []) ]

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

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

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

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

@@ -263,11 +261,11 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

263 isBind _ = False

261 isBind _ = False

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

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

265 isReturn _ = False

263 isReturn _ = False

266− isBindPoly (JSVar (Op ">>=")) = True

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

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

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

268 isBindPoly _ = False

266 isBindPoly _ = False

269− isRetPoly (JSVar (Ident "ret")) = True

267+ isRetPoly (JSVar "ret") = True

270− isRetPoly (JSAccessor "ret" (JSVar (Ident "Prelude"))) = True

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

271 isRetPoly _ = False

269 isRetPoly _ = False

272 prelude = ModuleName (ProperName "Prelude")

270 prelude = ModuleName (ProperName "Prelude")

273 effModule = ModuleName (ProperName "Eff")

271 effModule = ModuleName (ProperName "Eff")

@@ -275,8 +273,8 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

275 effModule

273 effModule

276 (Qualified (Just prelude) (ProperName "Monad"))

274 (Qualified (Just prelude) (ProperName "Monad"))

277 (TypeConstructor (Qualified (Just effModule) (ProperName "Eff")))

275 (TypeConstructor (Qualified (Just effModule) (ProperName "Eff")))

278− isEffDict (JSVar (Ident ident)) | ident == effDictName = True

276+ isEffDict (JSVar ident) | ident == effDictName = True

279− isEffDict (JSAccessor prop (JSVar (Ident "Eff"))) | prop == effDictName = True

277+ isEffDict (JSAccessor prop (JSVar "Eff")) | prop == effDictName = True

280 isEffDict _ = False

278 isEffDict _ = False

281 undo :: JS -> JS

279 undo :: JS -> JS

282 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body

280 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body

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

298 convert :: JS -> JS

296 convert :: JS -> JS

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

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

300 convert other = other

298 convert other = other

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

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

302 isDollar _ = False

300 isDollar _ = False

src/Language/PureScript/Parser/JS.hs+5−5

@@ -52,8 +52,8 @@ parseIdentifierAndValue = (,) <$> (C.identifier <* C.colon)

52parseFunction :: P.Parsec String u JS

53parseFunction = do

54 C.reserved "function"

55− name <- P.optionMaybe (Ident <$> C.identifier)

55+ name <- P.optionMaybe C.identifier

56− args <- P.parens C.tokenParser $ P.commaSep C.tokenParser (Ident <$> C.identifier)

56+ args <- P.parens C.tokenParser $ P.commaSep C.tokenParser C.identifier

57 body <- parseJS

58 return $ JSFunction name args body

@@ -61,7 +61,7 @@ parseBlock :: P.Parsec String u JS

61parseBlock = JSBlock <$> P.braces C.tokenParser (P.many parseJS)

63parseVar :: P.Parsec String u JS

64−parseVar = JSVar <$> Ident <$> C.identifier

64+parseVar = JSVar <$> C.identifier

66parseJSAtom :: P.Parsec String u JS

67parseJSAtom = P.choice

@@ -141,7 +141,7 @@ parseJS =

141parseVariableIntroduction :: P.Parsec String u JS

142parseVariableIntroduction = do

143 C.reserved "var"

144− name <- Ident <$> P.identifier C.tokenParser

144+ name <- P.identifier C.tokenParser

145 value <- P.optionMaybe $ do

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

147 value <- parseJS

@@ -158,7 +158,7 @@ parseAssignment = do

158 return $ JSAssignment tgt value

159

160parseAssignmentTarget :: P.Parsec String u JSAssignment

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

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

162

163parseWhile :: P.Parsec String u JS

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

src/Language/PureScript/Pretty/Common.hs−48

@@ -13,56 +13,8 @@

13--

14-----------------------------------------------------------------------------

16−{-# LANGUAGE GeneralizedNewtypeDeriving, GADTs #-}

17−

18module Language.PureScript.Pretty.Common where

16module Language.PureScript.Pretty.Common where

20−import Data.Char

21−import Control.Monad.State

22−import qualified Control.Category as C

23−import Control.Category ((>>>))

24−import qualified Control.Arrow as A

25−import Control.Arrow ((***), (<+>))

26−

27−import Language.PureScript.Names

28−

29−-- |

30−-- Convert an Ident into a valid Javascript identifier:

31−--

32−-- * Alphanumeric characters are kept unmodified

33−--

34−-- * Symbols are encoded as a dollar symbol ($) followed by their ordinal value

35−--

36−identToJs :: Ident -> String

37−identToJs (Ident name) = concatMap identCharToString name

38−identToJs (Op op) = concatMap identCharToString op

39−identToJs (Escaped name) = name

40−

41−identCharToString :: Char -> String

42−identCharToString c | isAlphaNum c = [c]

43−identCharToString '_' = "_"

44−identCharToString '.' = "$dot"

45−identCharToString '$' = "$dollar"

46−identCharToString '~' = "$tilde"

47−identCharToString '=' = "$eq"

48−identCharToString '<' = "$less"

49−identCharToString '>' = "$greater"

50−identCharToString '!' = "$bang"

51−identCharToString '#' = "$hash"

52−identCharToString '%' = "$percent"

53−identCharToString '^' = "$up"

54−identCharToString '&' = "$amp"

55−identCharToString '|' = "$bar"

56−identCharToString '*' = "$times"

57−identCharToString '/' = "$div"

58−identCharToString '+' = "$plus"

59−identCharToString '-' = "$minus"

60−identCharToString ':' = "$colon"

61−identCharToString '\\' = "$bslash"

62−identCharToString '?' = "$qmark"

63−identCharToString '@' = "$at"

64−identCharToString c = '$' : show (ord c)

65−

66-- |

18-- |

67-- Wrap a string in parentheses

19-- Wrap a string in parentheses

68--

20--

src/Language/PureScript/Pretty/JS.hs+9−9

@@ -89,10 +89,10 @@ literals = mkPattern' match

89 , currentIndent

90 , return "}"

91 ]

92− match (JSVar ident) = return (identToJs ident)

92+ match (JSVar ident) = return ident

93 match (JSVariableIntroduction ident value) = fmap concat $ sequence

94 [ return "var "

95− , return $ identToJs ident

95+ , return ident

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

97 ]

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

@@ -107,11 +107,11 @@ literals = mkPattern' match

107 , prettyPrintJS' sts

108 ]

109 match (JSFor ident start end sts) = fmap concat $ sequence

110− [ return $ "for (" ++ identToJs ident ++ " = "

110+ [ return $ "for (" ++ ident ++ " = "

111 , prettyPrintJS' start

112− , return $ "; " ++ identToJs ident ++ " < "

112+ , return $ "; " ++ ident ++ " < "

113 , prettyPrintJS' end

114− , return $ "; " ++ identToJs ident ++ "++) "

114+ , return $ "; " ++ ident ++ "++) "

115 , prettyPrintJS' sts

116 ]

117 match (JSIfElse cond thens elses) = fmap concat $ sequence

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

139 match _ = mzero

140

141targetToJs :: JSAssignment -> String

142−targetToJs (JSAssignVariable ident) = identToJs ident

142+targetToJs (JSAssignVariable ident) = ident

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

144

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

@@ -160,7 +160,7 @@ indexer = mkPattern' match

160 match (JSIndexer index val) = (,) <$> prettyPrintJS' index <*> pure val

161 match _ = mzero

162

163−lam :: Pattern PrinterState JS ((Maybe Ident, [Ident]), JS)

163+lam :: Pattern PrinterState JS ((Maybe String, [String]), JS)

164lam = mkPattern match

165 where

166 match (JSFunction name args ret) = Just ((name, args), ret)

@@ -227,8 +227,8 @@ prettyPrintJS' = A.runKleisli $ runPattern matchValue

227 , [ Wrap indexer $ \index val -> val ++ "[" ++ index ++ "]" ]

228 , [ Wrap app $ \args val -> val ++ "(" ++ args ++ ")" ]

229 , [ Wrap lam $ \(name, args) ret -> "function "

230− ++ maybe "" identToJs name

230+ ++ maybe "" id name

231− ++ "(" ++ intercalate ", " (map identToJs args) ++ ") "

231+ ++ "(" ++ (intercalate ", " args) ++ ") "

232 ++ ret ]

233 , [ Wrap conditional $ \(th, el) cond -> cond ++ " ? " ++ prettyPrintJS1 th ++ " : " ++ prettyPrintJS1 el ]

234 , [ binary LessThan "<" ]

src/Language/PureScript/Scope.hs+5−5

@@ -44,11 +44,11 @@ usedNames val = nub $ everything (++) (mkQ [] namesV `extQ` namesS `extQ` namesB

44 namesB (VarBinder name) = [name]

45 namesB _ = []

46 namesJS :: JS -> [Ident]

47− namesJS (JSVar name) = [name]

47+ namesJS (JSVar name) = [Ident name]

48− namesJS (JSFunction (Just name) args _) = name : args

48+ namesJS (JSFunction (Just name) args _) = (Ident name) : (Ident `map` args)

49− namesJS (JSFunction Nothing args _) = args

49+ namesJS (JSFunction Nothing args _) = (Ident `map` args)

50− namesJS (JSVariableIntroduction name _) = [name]

50+ namesJS (JSVariableIntroduction name _) = [Ident name]

51− namesJS (JSFor name _ _ _) = [name]

51+ namesJS (JSFor name _ _ _) = [Ident name]

52 namesJS _ = []

54-- |

src/Language/PureScript/Sugar/TypeClasses.hs+2−2

@@ -34,7 +34,7 @@ import Control.Monad.State

34import Data.Maybe (fromMaybe)

35import Data.List (nub)

36import Data.Generics (mkQ, everything)

37−import Language.PureScript.Pretty.Common (identToJs)

37+import Language.PureScript.CodeGen.Common (identToJs)

39type MemberMap = M.Map (ModuleName, ProperName) (String, [(String, Type)])

@@ -73,7 +73,7 @@ typeClassDictionaryDeclaration name arg members =

73typeClassMemberToDictionaryAccessor :: ProperName -> String -> Declaration -> Declaration

74typeClassMemberToDictionaryAccessor name arg (TypeDeclaration ident ty) =

75 ExternDeclaration TypeClassAccessorImport ident

76− (Just (JSFunction (Just ident) [Ident "dict"] (JSBlock [JSReturn (JSAccessor (identToJs ident) (JSVar (Ident "dict")))])))

76+ (Just (JSFunction (Just $ identToJs ident) ["dict"] (JSBlock [JSReturn (JSAccessor (identToJs ident) (JSVar "dict"))])))

77 (ForAll arg (ConstrainedType [(Qualified Nothing name, TypeVar arg)] ty))

78typeClassMemberToDictionaryAccessor _ _ _ = error "Invalid declaration in type class definition"