e354866 · rowtype-yoga/purescript-native

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

Some parser tidying, bump version, fix overlapping imports issue

commite35486691dc8d7a170ff3783ec3a57ceb2947679 authorPhil Freeman <paf31@cantab.net> dateSun 17 Nov 2013, 11:00 (13 years ago) parent29d223d

9 files changed+51−49

compare with golang

unifiedsplit

examples/passing/TypeSynonyms.ps+4−4 purescript.cabal+1−1 src/Language/PureScript/CodeGen/JS.hs+2−3 src/Language/PureScript/Parser/Common.hs+14−9 src/Language/PureScript/Parser/Declarations.hs+6−10 src/Language/PureScript/Parser/Types.hs+1−1 src/Language/PureScript/Parser/Values.hs+8−8 src/Language/PureScript/TypeChecker.hs+12−13 src/Language/PureScript/TypeChecker/Monad.hs+3

examples/passing/TypeSynonyms.ps+4−4

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

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

1616

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

18−fst = {

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

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

21−}

18+fst =

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

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

21+ }

2222

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

2424test1 = composeLenses fst fst

purescript.cabal+1−1

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

11name: purescript

2−version: 0.1.9

2+version: 0.1.10

33cabal-version: >=1.8

44build-type: Simple

55license: MIT

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

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

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

6666declToJs mod omp (ImportDeclaration mp idents) env =

6767 Just $ case idents of

68− Nothing ->

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

70− idents = map snd identPairs

68+ Nothing ->

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

7170 in map mkLocal idents

7271 Just idents -> map mkLocal idents

7372 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

120120operator = PT.operator tokenParser

121121stringLiteral = PT.stringLiteral tokenParser

122122whiteSpace = PT.whiteSpace tokenParser

123−parens = PT.parens tokenParser

124−braces = PT.braces tokenParser

125−angles = PT.angles tokenParser

126123squares = PT.squares tokenParser

127124semi = PT.semi tokenParser

128125comma = PT.comma tokenParser

129126colon = PT.colon tokenParser

130127dot = PT.dot tokenParser

131−semiSep = PT.semiSep tokenParser

132−semiSep1 = PT.semiSep1 tokenParser

133−commaSep = PT.commaSep tokenParser

134−commaSep1 = PT.commaSep1 tokenParser

135128natural = PT.natural tokenParser

136129

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+

138142tick = lexeme $ P.char '`'

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

139144

140145properName :: P.Parsec String u ProperName

141146properName = 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 ($))

167172operatorOrBuiltIn :: P.Parsec String u String

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

169174

170−parseIdent :: P.Parsec String u Ident

175+parseIdent :: P.Parsec String ParseState Ident

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

172177

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

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

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

4444 name <- indented *> properName

4545 tyArgs <- many (indented *> identifier)

4646 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

4848 return $ DataDeclaration name tyArgs ctors

4949

5050parseTypeDeclaration :: P.Parsec String ParseState Declaration

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

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

9898 return $ ModuleDeclaration name decls

9999

100+parseModulePath :: P.Parsec String ParseState ModulePath

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

102+

100103parseImportDeclaration :: P.Parsec String ParseState Declaration

101104parseImportDeclaration = do

102105 reserved "import"

103106 indented

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

105− idents <- P.optionMaybe $ do

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)

107+ modulePath <- parseModulePath

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

111109 return $ ImportDeclaration modulePath idents

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

113− mkModulePath path _ = path

114110

115111parseDeclaration :: P.Parsec String ParseState Declaration

116112parseDeclaration = P.choice

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

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

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

8585

8686parseRow :: P.Parsec String ParseState Row

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

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

8888 where

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

9090 fromList [] r = r

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

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

4747parseBooleanLiteral = BooleanLiteral <$> booleanLiteral

4848

4949parseArrayLiteral :: 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)

5151

5252parseObjectLiteral :: 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)

5454

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

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

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

6666 where

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

6868 manyArgs = do

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

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

7070 return $ Abs args

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

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

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

7676

7777parseApp :: P.Parsec String ParseState Value

7878parseApp = App <$> parseValue

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

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

8080

8181parseVar :: P.Parsec String ParseState Value

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

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

134134 where

135135 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom

136136 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))) ]

138138 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))

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

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

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

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

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

222222

223223parseObjectBinder :: 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))

225225

226226parseArrayBinder :: 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))

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

229229

230230parseNamedBinder :: P.Parsec String ParseState Binder

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

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

119119 typeCheckAll rest

120120typeCheckAll (ImportDeclaration modulePath idents : rest) = do

121121 env <- getEnv

122− omp <- checkModulePath `fmap` get

122+ currentModule <- checkModulePath `fmap` get

123123 rethrow errorMessage $ do

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

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

125125 case idents of

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

127− Just idents -> bindIdents idents omp env

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

127+ Just idents -> bindIdents idents currentModule env

128128 typeCheckAll rest

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

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

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

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

131131 moduleExists env = not $ null $ filterModule env

132− bindIdents idents omp env =

133− forM_ idents $ \ident ->

134− case M.lookup (modulePath, ident) (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)

138− (names env') })

132+ bindIdents idents currentModule env =

133+ forM_ idents $ \ident -> do

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

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

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

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

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

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

5757putEnv :: Environment -> Check ()

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

5959

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

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

62+

6063fresh :: Check Int

6164fresh = do

6265 st <- get