b21773b · rowtype-yoga/purescript-native

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

on golang help sign in

Get rid of Escaped

b21773bPhil Freeman13 years ago

src/Language/PureScript/CodeGen/Common.hs−1

compare with golang

unifiedsplit

@@ -32,7 +32,6 @@ identToJs :: Ident -> String

32identToJs (Ident name) | nameIsJsReserved name = "$$" ++ name

33identToJs (Ident name) = concatMap identCharToString name

34identToJs (Op op) = concatMap identCharToString op

35−identToJs (Escaped name) = name

37-- |

36-- |

38-- Attempts to find a human-readable name for a symbol, if none has been specified returns the

37-- Attempts to find a human-readable name for a symbol, if none has been specified returns the

src/Language/PureScript/CodeGen/JS.hs+1−2

@@ -91,7 +91,7 @@ declToJs _ _ _ _ = Nothing

91-- module.

92--

93exportToJs :: DeclarationRef -> [JS]

94−exportToJs (TypeRef _ (Just dctors)) = flip map dctors (export . Escaped . runProperName)

94+exportToJs (TypeRef _ (Just dctors)) = flip map dctors (export . Ident . runProperName)

95exportToJs (ValueRef name) = [export name]

96exportToJs (TypeInstanceRef name) = [export name]

97exportToJs _ = []

@@ -118,7 +118,6 @@ var = JSVar . identToJs

118accessor :: Ident -> JS -> JS

119accessor (Ident prop) = accessorString prop

120accessor (Op op) = JSIndexer (JSStringLiteral op)

121−accessor (Escaped prop) = JSAccessor prop

122

121

123accessorString :: String -> JS -> JS

122accessorString :: String -> JS -> JS

124accessorString prop | isIdent prop = JSAccessor prop

123accessorString prop | isIdent prop = JSAccessor prop

src/Language/PureScript/Names.hs+1−18

@@ -19,7 +19,6 @@ module Language.PureScript.Names where

20import Data.List

21import Data.Data

22−import Data.Function (on)

24-- |

23-- |

25-- Names for value identifiers

24-- Names for value identifiers

@@ -32,27 +31,11 @@ data Ident

32 -- |

31 -- |

33 -- A symbolic name for an infix operator

32 -- A symbolic name for an infix operator

34 --

33 --

35− | Op String

36− -- |

37− -- An escaped name

38− --

39− | Escaped String deriving (Data, Typeable)

34+ | Op String deriving (Eq, Ord, Data, Typeable)

41instance Show Ident where

36instance Show Ident where

42 show (Ident s) = s

37 show (Ident s) = s

43 show (Op op) = '(':op ++ ")"

38 show (Op op) = '(':op ++ ")"

44− show (Escaped s) = s

45−

46−instance Eq Ident where

47− Ident s1 == Ident s2 = s1 == s2

48− Op s1 == Op s2 = s1 == s2

49− Escaped s1 == Escaped s2 = s1 == s2

50− Ident s1 == Escaped s2 = s1 == s2

51− Escaped s1 == Ident s2 = s1 == s2

52− _ == _ = False

53−

54−instance Ord Ident where

55− compare = compare `on` show

57-- |

40-- |

58-- Proper names, i.e. capitalized names for e.g. module names, type//data constructors.

41-- Proper names, i.e. capitalized names for e.g. module names, type//data constructors.

src/Language/PureScript/Sugar/TypeClasses.hs+15−11

@@ -29,12 +29,12 @@ import Language.PureScript.CodeGen.Common (identToJs)

30import Control.Applicative

31import Control.Monad.State

32−import Control.Arrow (second)

32+import Control.Arrow (Arrow(..), second)

33import Data.Maybe (catMaybes)

35import qualified Data.Map as M

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

37+type MemberMap = M.Map (ModuleName, ProperName) ([String], [(Ident, Type)])

39type Desugar = StateT MemberMap (Either ErrorStack)

@@ -98,19 +98,23 @@ desugarDecl mn (PositionedDeclaration pos d) = do

98 return (dr, map (PositionedDeclaration pos) ds)

99desugarDecl _ other = return (Nothing, [other])

100

101−memberToNameAndType :: Declaration -> (String, Type)

101+memberToNameAndType :: Declaration -> (Ident, Type)

102−memberToNameAndType (TypeDeclaration ident ty) = (identToJs ident, ty)

102+memberToNameAndType (TypeDeclaration ident ty) = (ident, ty)

103memberToNameAndType (PositionedDeclaration _ d) = memberToNameAndType d

104memberToNameAndType _ = error "Invalid declaration in type class definition"

105

106+identToProperty :: Ident -> String

107+identToProperty (Ident name) = name

108+identToProperty (Op op) = op

109+

106typeClassDictionaryDeclaration :: ProperName -> [String] -> [Declaration] -> Declaration

110typeClassDictionaryDeclaration :: ProperName -> [String] -> [Declaration] -> Declaration

107typeClassDictionaryDeclaration name args members =

111typeClassDictionaryDeclaration name args members =

108− TypeSynonymDeclaration name args (TypeApp tyObject $ rowFromList (map memberToNameAndType members, REmpty))

112+ TypeSynonymDeclaration name args (TypeApp tyObject $ rowFromList (map (first identToProperty . memberToNameAndType) members, REmpty))

109

113

110typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [String] -> Declaration -> Declaration

114typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [String] -> Declaration -> Declaration

111typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =

115typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =

112 ExternDeclaration TypeClassAccessorImport ident

116 ExternDeclaration TypeClassAccessorImport ident

113− (Just (JSFunction (Just $ identToJs ident) ["dict"] (JSBlock [JSReturn (JSAccessor (identToJs ident) (JSVar "dict"))])))

117+ (Just (JSFunction (Just $ identToJs ident) ["dict"] (JSBlock [JSReturn (JSIndexer (JSStringLiteral (identToProperty ident)) (JSVar "dict"))])))

114 (quantify (ConstrainedType [(Qualified (Just mn) name, map TypeVar args)] ty))

118 (quantify (ConstrainedType [(Qualified (Just mn) name, map TypeVar args)] ty))

115typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos d) =

119typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos d) =

116 PositionedDeclaration pos $ typeClassMemberToDictionaryAccessor mn name args d

120 PositionedDeclaration pos $ typeClassMemberToDictionaryAccessor mn name args d

@@ -127,13 +131,13 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls = do

127 -- Replace the type arguments with the appropriate types in the member types

131 -- Replace the type arguments with the appropriate types in the member types

128 let memberTypes = map (second (replaceAllTypeVars (zip args tys))) instanceTys

132 let memberTypes = map (second (replaceAllTypeVars (zip args tys))) instanceTys

129 -- Create values for the type instance members

133 -- Create values for the type instance members

130− memberNames <- mapM (memberToNameAndValue memberTypes) decls

134+ memberNames <- map (first identToProperty) <$> mapM (memberToNameAndValue memberTypes) decls

131 -- Create the type of the dictionary

135 -- Create the type of the dictionary

132 -- The type is an object type, but depending on type instance dependencies, may be constrained.

136 -- The type is an object type, but depending on type instance dependencies, may be constrained.

133 -- The dictionary itself is an object literal, but for reasons related to recursion, the dictionary

137 -- The dictionary itself is an object literal, but for reasons related to recursion, the dictionary

134 -- must be guarded by at least one function abstraction. For that reason, if the dictionary has no

138 -- must be guarded by at least one function abstraction. For that reason, if the dictionary has no

135 -- dependencies, we introduce an unnamed function parameter.

139 -- dependencies, we introduce an unnamed function parameter.

136− let dictTy = TypeApp tyObject (rowFromList (memberTypes, REmpty))

140+ let dictTy = TypeApp tyObject (rowFromList (map (first identToProperty) memberTypes, REmpty))

137 constrainedTy = quantify (if null deps then function unit dictTy else ConstrainedType deps dictTy)

141 constrainedTy = quantify (if null deps then function unit dictTy else ConstrainedType deps dictTy)

138 dict = if null deps then Abs (Left (Ident "_")) (ObjectLiteral memberNames) else ObjectLiteral memberNames

142 dict = if null deps then Abs (Left (Ident "_")) (ObjectLiteral memberNames) else ObjectLiteral memberNames

139 return $ ValueDeclaration name TypeInstanceDictionaryValue [] Nothing (TypedValue True dict constrainedTy)

143 return $ ValueDeclaration name TypeInstanceDictionaryValue [] Nothing (TypedValue True dict constrainedTy)

@@ -141,11 +145,11 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls = do

141 unit :: Type

145 unit :: Type

142 unit = TypeApp tyObject REmpty

146 unit = TypeApp tyObject REmpty

143

147

144− memberToNameAndValue :: [(String, Type)] -> Declaration -> Desugar (String, Value)

148+ memberToNameAndValue :: [(Ident, Type)] -> Declaration -> Desugar (Ident, Value)

145 memberToNameAndValue tys' d@(ValueDeclaration ident _ _ _ _) = do

149 memberToNameAndValue tys' d@(ValueDeclaration ident _ _ _ _) = do

146− _ <- lift . maybe (Left $ mkErrorStack "Type class member type not found" Nothing) Right $ lookup (identToJs ident) tys'

150+ _ <- lift . maybe (Left $ mkErrorStack "Type class member type not found" Nothing) Right $ lookup ident tys'

147 let memberValue = typeInstanceDictionaryEntryValue d

151 let memberValue = typeInstanceDictionaryEntryValue d

148− return (identToJs ident, memberValue)

152+ return (ident, memberValue)

149 memberToNameAndValue tys' (PositionedDeclaration pos d) = do

153 memberToNameAndValue tys' (PositionedDeclaration pos d) = do

150 (ident, val) <- memberToNameAndValue tys' d

154 (ident, val) <- memberToNameAndValue tys' d

151 return (ident, PositionedValue pos val)

155 return (ident, PositionedValue pos val)