e354866 · rowtype-yoga/purescript-native

examples/passing/TypeSynonyms.ps+4−4

compare with golang

unifiedsplit

@@ -15,10 +15,10 @@ composeLenses = \l1 -> \l2 ->

15type Pair a b = { fst :: a, snd :: b }

16

17fst :: forall a b. Lens (Pair a b) a

18−fst = {

18+fst =

19− get: \p -> p.fst,

19+ { get: \p -> p.fst

20− set: \p -> \a -> { fst: a, snd: p.snd }

20+ , set: \p -> \a -> { fst: a, snd: p.snd }

21−}

21+ }

22

23test1 :: forall a b c. Lens (Pair (Pair a b) c) a

24test1 = composeLenses fst fst

purescript.cabal+1−1

@@ -1,5 +1,5 @@

1name: purescript

2−version: 0.1.9

2+version: 0.1.10

3cabal-version: >=1.8

4build-type: Simple

5license: MIT

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

@@ -65,9 +65,8 @@ declToJs mod mp (ModuleDeclaration pn@(ProperName name) decls) env =

65 maybe [] (return . setProperty name (JSVar (Ident name))) mod

66declToJs mod omp (ImportDeclaration mp idents) env =

67 Just $ case idents of

68− Nothing ->

68+ Nothing ->

69− let identPairs = filter (\(m, _) -> m == mp) (M.keys (names env))

69+ let idents = map snd . filter ((== mp) . fst) . M.keys $ names env

70− idents = map snd identPairs

71 in map mkLocal idents

70 in map mkLocal idents

72 Just idents -> map mkLocal idents

71 Just idents -> map mkLocal idents

73 where mkLocal ident = JSVariableIntroduction ident (Just (qualifiedToJS identToJs (Qualified mp ident)))

72 where mkLocal ident = JSVariableIntroduction ident (Just (qualifiedToJS identToJs (Qualified mp ident)))

src/Language/PureScript/Parser/Common.hs+14−9

@@ -120,22 +120,27 @@ reservedOp = PT.reservedOp tokenParser

120operator = PT.operator tokenParser

121stringLiteral = PT.stringLiteral tokenParser

122whiteSpace = PT.whiteSpace tokenParser

123−parens = PT.parens tokenParser

124−braces = PT.braces tokenParser

125−angles = PT.angles tokenParser

126squares = PT.squares tokenParser

123squares = PT.squares tokenParser

127semi = PT.semi tokenParser

124semi = PT.semi tokenParser

128comma = PT.comma tokenParser

125comma = PT.comma tokenParser

129colon = PT.colon tokenParser

126colon = PT.colon tokenParser

130dot = PT.dot tokenParser

127dot = PT.dot tokenParser

131−semiSep = PT.semiSep tokenParser

132−semiSep1 = PT.semiSep1 tokenParser

133−commaSep = PT.commaSep tokenParser

134−commaSep1 = PT.commaSep1 tokenParser

135natural = PT.natural tokenParser

128natural = PT.natural tokenParser

136

129

137−tick :: P.Parsec String u Char

130+parens = P.between (lexeme $ P.char '(') (lexeme $ indented *> P.char ')') . (indented *>)

131+braces = P.between (lexeme $ P.char '{') (lexeme $ indented *> P.char '}') . (indented *>)

132+angles = P.between (lexeme $ P.char '<') (lexeme $ indented *> P.char '>') . (indented *>)

133+

134+sepBy p s = P.sepBy (indented *> p) (indented *> s)

135+sepBy1 p s = P.sepBy1 (indented *> p) (indented *> s)

136+

137+semiSep = flip sepBy semi

138+semiSep1 = flip sepBy1 semi

139+commaSep = flip sepBy comma

140+commaSep1 = flip sepBy1 comma

141+

138tick = lexeme $ P.char '`'

142tick = lexeme $ P.char '`'

143+pipe = lexeme $ P.char '|'

139

144

140properName :: P.Parsec String u ProperName

145properName :: P.Parsec String u ProperName

141properName = lexeme $ ProperName <$> P.try ((:) <$> P.upper <*> many (PT.identLetter langDef) P.<?> "name")

146properName = lexeme $ ProperName <$> P.try ((:) <$> P.upper <*> many (PT.identLetter langDef) P.<?> "name")

@@ -167,7 +172,7 @@ buildPostfixParser f x = fold x (P.choice f) (flip ($))

167operatorOrBuiltIn :: P.Parsec String u String

172operatorOrBuiltIn :: P.Parsec String u String

168operatorOrBuiltIn = P.try operator <|> P.choice (map (\s -> P.try (reservedOp s) >> return s) builtInOperators)

173operatorOrBuiltIn = P.try operator <|> P.choice (map (\s -> P.try (reservedOp s) >> return s) builtInOperators)

169

174

170−parseIdent :: P.Parsec String u Ident

175+parseIdent :: P.Parsec String ParseState Ident

171parseIdent = (Ident <$> identifier) <|> (Op <$> parens operatorOrBuiltIn)

176parseIdent = (Ident <$> identifier) <|> (Op <$> parens operatorOrBuiltIn)

172

177

173parseIdentInfix :: P.Parsec String ParseState (Qualified Ident)

178parseIdentInfix :: P.Parsec String ParseState (Qualified Ident)

src/Language/PureScript/Parser/Declarations.hs+6−10

@@ -44,7 +44,7 @@ parseDataDeclaration = do

44 name <- indented *> properName

45 tyArgs <- many (indented *> identifier)

46 lexeme $ indented *> P.char '='

47− ctors <- P.sepBy1 ((,) <$> (indented *> properName) <*> P.optionMaybe parseType) (lexeme $ indented *> P.char '|')

47+ ctors <- sepBy1 ((,) <$> properName <*> P.optionMaybe (indented *> parseType)) pipe

48 return $ DataDeclaration name tyArgs ctors

49

50parseTypeDeclaration :: P.Parsec String ParseState Declaration

@@ -97,20 +97,16 @@ parseModuleDeclaration = do

97 decls <- mark (P.many (same *> parseDeclaration))

98 return $ ModuleDeclaration name decls

99

100+parseModulePath :: P.Parsec String ParseState ModulePath

101+parseModulePath = ModulePath <$> properName `sepBy1` dot

102+

100parseImportDeclaration :: P.Parsec String ParseState Declaration

103parseImportDeclaration :: P.Parsec String ParseState Declaration

101parseImportDeclaration = do

104parseImportDeclaration = do

102 reserved "import"

105 reserved "import"

103 indented

106 indented

104− segments <- P.sepBy1 properName (lexeme $ P.char '.')

107+ modulePath <- parseModulePath

105− idents <- P.optionMaybe $ do

108+ idents <- P.optionMaybe $ parens $ commaSep1 parseIdent

106− lexeme $ indented *> P.char '('

107− idents <- P.sepBy1 parseIdent (lexeme $ indented *> P.char ',')

108− lexeme $ indented *> P.char ')'

109− return idents

110− let modulePath = mkModulePath (ModulePath [head segments]) (tail segments)

111 return $ ImportDeclaration modulePath idents

109 return $ ImportDeclaration modulePath idents

112− where mkModulePath path (s:ss) = mkModulePath (subModule path s) ss

113− mkModulePath path _ = path

114

110

115parseDeclaration :: P.Parsec String ParseState Declaration

111parseDeclaration :: P.Parsec String ParseState Declaration

116parseDeclaration = P.choice

112parseDeclaration = P.choice

src/Language/PureScript/Parser/Types.hs+1−1

@@ -84,7 +84,7 @@ parseRowEnding :: P.Parsec String ParseState Row

84parseRowEnding = P.option REmpty (RowVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))

85

86parseRow :: P.Parsec String ParseState Row

87−parseRow = (fromList <$> (parseNameAndType `P.sepBy` (indented *> comma)) <*> parseRowEnding) P.<?> "row"

87+parseRow = (fromList <$> (commaSep parseNameAndType) <*> parseRowEnding) P.<?> "row"

88 where

89 fromList :: [(String, Type)] -> Row -> Row

90 fromList [] r = r

src/Language/PureScript/Parser/Values.hs+8−8

@@ -47,10 +47,10 @@ parseBooleanLiteral :: P.Parsec String ParseState Value

47parseBooleanLiteral = BooleanLiteral <$> booleanLiteral

48

49parseArrayLiteral :: P.Parsec String ParseState Value

50−parseArrayLiteral = ArrayLiteral <$> C.squares (parseValue `P.sepBy` (C.indented *> C.comma))

50+parseArrayLiteral = ArrayLiteral <$> C.squares (C.commaSep parseValue)

51

52parseObjectLiteral :: P.Parsec String ParseState Value

53−parseObjectLiteral = ObjectLiteral <$> C.braces (parseIdentifierAndValue `P.sepBy` (C.indented *> C.comma))

53+parseObjectLiteral = ObjectLiteral <$> C.braces (C.commaSep parseIdentifierAndValue)

54

55parseIdentifierAndValue :: P.Parsec String ParseState (String, Value)

56parseIdentifierAndValue = (,) <$> (C.indented *> C.identifier <* C.indented <* C.colon)

@@ -66,7 +66,7 @@ parseAbs = do

66 where

67 manyArgs :: P.Parsec String ParseState (Value -> Value)

68 manyArgs = do

69− args <- C.parens ((C.indented *> C.parseIdent) `P.sepBy` (C.indented *> C.comma))

69+ args <- C.parens (C.commaSep C.parseIdent)

70 return $ Abs args

71 singleArg :: P.Parsec String ParseState (Value -> Value)

72 singleArg = Abs . return <$> C.parseIdent

@@ -76,7 +76,7 @@ parseAbs = do

76

77parseApp :: P.Parsec String ParseState Value

78parseApp = App <$> parseValue

79− <*> (C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma)))

79+ <*> (C.indented *> C.parens (C.commaSep parseValue))

80

81parseVar :: P.Parsec String ParseState Value

82parseVar = Var <$> C.parseQualified C.parseIdent

@@ -134,9 +134,9 @@ parseValue =

134 where

135 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom

136 postfixTable1 = [ Accessor <$> (C.indented *> C.dot *> C.indented *> C.identifier)

137− , P.try $ flip ObjectUpdate <$> (C.indented *> C.braces ((C.indented *> parsePropertyUpdate) `P.sepBy1` (C.indented *> C.comma))) ]

137+ , P.try $ flip ObjectUpdate <$> (C.indented *> C.braces (C.commaSep1 (C.indented *> parsePropertyUpdate))) ]

138 postfixTable2 = [ P.try (C.indented *> indexersAndAccessors >>= \t2 -> return (\t1 -> App t1 [t2]))

139− , P.try $ flip App <$> (C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma)))

139+ , P.try $ flip App <$> (C.indented *> C.parens (C.commaSep parseValue))

140 , flip TypedValue <$> (P.try (C.lexeme (C.indented *> P.string "::")) *> parsePolyType) ]

141 operators = [ [ Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "!") >> return (Unary Not)

142 , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "~") >> return (Unary BitwiseNot)

@@ -221,10 +221,10 @@ parseUnaryBinder :: P.Parsec String ParseState Binder

221parseUnaryBinder = UnaryBinder <$> C.lexeme (C.parseQualified C.properName) <*> (C.indented *> parseBinder)

222

223parseObjectBinder :: P.Parsec String ParseState Binder

224−parseObjectBinder = ObjectBinder <$> C.braces ((C.indented *> parseIdentifierAndBinder) `P.sepBy` (C.indented *> C.comma))

224+parseObjectBinder = ObjectBinder <$> C.braces (C.commaSep (C.indented *> parseIdentifierAndBinder))

225

226parseArrayBinder :: P.Parsec String ParseState Binder

227−parseArrayBinder = C.squares $ ArrayBinder <$> ((C.indented *> parseBinder) `P.sepBy` (C.indented *> C.comma))

227+parseArrayBinder = C.squares $ ArrayBinder <$> (C.commaSep (C.indented *> parseBinder))

228 <*> P.optionMaybe (C.indented *> C.colon *> C.indented *> parseBinder)

229

230parseNamedBinder :: P.Parsec String ParseState Binder

src/Language/PureScript/TypeChecker.hs+12−13

@@ -119,20 +119,19 @@ typeCheckAll (ModuleDeclaration name decls : rest) = do

119 typeCheckAll rest

120typeCheckAll (ImportDeclaration modulePath idents : rest) = do

121 env <- getEnv

122− omp <- checkModulePath `fmap` get

122+ currentModule <- checkModulePath `fmap` get

123 rethrow errorMessage $ do

124− guardWith "module does not exist" $ moduleExists env

124+ guardWith ("Module " ++ show modulePath ++ " does not exist") $ moduleExists env

125 case idents of

126− Nothing -> bindIdents (map snd $ filterModule env) omp env

126+ Nothing -> bindIdents (map snd $ filterModule env) currentModule env

127− Just idents -> bindIdents idents omp env

127+ Just idents -> bindIdents idents currentModule env

128 typeCheckAll rest

129− where errorMessage = (("Error importing " ++ show modulePath ++ ": ") ++)

129+ where errorMessage = (("Error in import declaration " ++ show modulePath ++ ": ") ++)

130− filterModule env = filter (\(m, _) -> m == modulePath) (M.keys (names env))

130+ filterModule = filter ((== modulePath) . fst) . M.keys . names

131 moduleExists env = not $ null $ filterModule env

132− bindIdents idents omp env =

132+ bindIdents idents currentModule env =

133− forM_ idents $ \ident ->

133+ forM_ idents $ \ident -> do

134+ guardWith (show currentModule ++ "." ++ show ident ++ " is already defined") $ (currentModule, ident) `M.notMember` names env

134− case M.lookup (modulePath, ident) (names env) of

135+ case (modulePath, ident) `M.lookup` names env of

135− Nothing -> throwError $ show modulePath ++ "." ++ show ident ++ " is undefined"

136− Just (pt, _) -> getEnv >>= \env' ->

137− putEnv (env' { names = M.insert (omp, ident) (pt, Alias modulePath ident)

136+ Just (pt, _) -> modifyEnv (\e -> e { names = M.insert (currentModule, ident) (pt, Alias modulePath ident) (names e) })

138− (names env') })

137+ Nothing -> throwError (show modulePath ++ "." ++ show ident ++ " is undefined")

src/Language/PureScript/TypeChecker/Monad.hs+3

@@ -57,6 +57,9 @@ getEnv = fmap checkEnv get

57putEnv :: Environment -> Check ()

58putEnv env = modify (\s -> s { checkEnv = env })

59

60+modifyEnv :: (Environment -> Environment) -> Check ()

61+modifyEnv f = modify (\s -> s { checkEnv = f (checkEnv s) })

62+

60fresh :: Check Int

63fresh :: Check Int

61fresh = do

64fresh = do

62 st <- get

65 st <- get