git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fixity declarations
commita9905bfede2eefd8d4c51bff6815319747fe7e10 authorPhil Freeman <paf31@cantab.net> dateMon 28 Oct 2013, 22:50 (13 years ago) parent1997015
10 files changed+190−91
compare with golang
unifiedsplit
PureScript.cabal+10−8 examples/Operators.ps+2 src/Main.hs+1−1 src/PureScript/Declarations.hs+9−2 src/PureScript/Parser/Common.hs+16−11 src/PureScript/Parser/Declarations.hs+29−8 src/PureScript/Parser/State.hs+27 src/PureScript/Parser/Types.hs+16−15 src/PureScript/Parser/Values.hs+74−46 src/PureScript/TypeChecker.hs+6
PureScript.cabal+10−8
@@ -13,9 +13,11 @@ author: Phil Freeman <paf31@cantab.net>
1313data-dir: ""
1414
1515library
16− build-depends: base -any, syb -any, cmdtheline -any,
17− containers -any, mtl -any, parsec -any, utf8-string -any
18− exposed-modules: PureScript PureScript.Declarations PureScript.Names PureScript.TypeChecker.Synonyms
16+ build-depends: base -any, syb -any,
17+ cmdtheline -any, containers -any, mtl -any, transformers -any, parsec -any,
18+ utf8-string -any
19+ exposed-modules: PureScript PureScript.Declarations
20+ PureScript.Names PureScript.TypeChecker.Synonyms
1921 PureScript.CodeGen.Externs PureScript.CodeGen.JS
2022 PureScript.CodeGen.Common.Gen PureScript.CodeGen.Common Main
2123 PureScript.CodeGen PureScript.Kinds PureScript.Parser
@@ -23,16 +25,16 @@ library
2325 PureScript.Parser.Common PureScript.Parser.Declarations
2426 PureScript.Parser.Types PureScript.Parser.Values
2527 PureScript.TypeChecker.Kinds PureScript.TypeChecker.Monad
26− PureScript.TypeChecker.Types
28+ PureScript.TypeChecker.Types PureScript.Parser.State
2729 exposed: True
2830 buildable: True
2931 hs-source-dirs: src
30− other-modules:
3132
3233executable psc
33− build-depends: base -any, cmdtheline -any, containers -any,
34− mtl -any, parsec -any, utf8-string -any
34+ build-depends: base -any,
35+ cmdtheline -any, containers -any, mtl -any, transformers -any, parsec -any,
36+ utf8-string -any
3537 main-is: Main.hs
3638 buildable: True
3739 hs-source-dirs: src
38− other-modules:
40+
examples/Operators.ps+2
@@ -8,6 +8,8 @@ k = \x -> \y -> x
88
99test4 = 1 `k` 2
1010
11+infixl 5 %%
12+
1113(%%) = \x -> \y -> x * y + y
1214
1315test5 = 1 %% 2 %% 3
src/Main.hs+1−1
@@ -28,7 +28,7 @@ compile :: [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()
2828compile inputFiles outputFile externsFile = do
2929 asts <- fmap (fmap concat . sequence) $ flip mapM inputFiles $ \inputFile -> do
3030 text <- U.readFile inputFile
31− return $ runIndentParser 0 parseDeclarations text
31+ return $ runIndentParser parseDeclarations text
3232 case asts of
3333 Left err -> do
3434 U.print err
src/PureScript/Declarations.hs+9−2
@@ -20,11 +20,18 @@ import PureScript.Values
2020import PureScript.Types
2121import PureScript.Names
2222
23−import Data.Data
23+import qualified Data.Data as D
24+
25+type Precedence = Integer
26+
27+data Associativity = Infixl | Infixr deriving (Show, D.Data, D.Typeable)
28+
29+data Fixity = Fixity Associativity Precedence deriving (Show, D.Data, D.Typeable)
2430
2531data Declaration
2632 = DataDeclaration String [String] [(String, Maybe Type)]
2733 | TypeSynonymDeclaration String [String] Type
2834 | TypeDeclaration Ident PolyType
2935 | ValueDeclaration Ident Value
30− | ExternDeclaration Ident PolyType deriving (Show, Data, Typeable)
36+ | ExternDeclaration Ident PolyType
37+ | FixityDeclaration Fixity String deriving (Show, D.Data, D.Typeable)
src/PureScript/Parser/Common.hs+16−11
@@ -20,6 +20,8 @@ import Data.Char (isSpace)
2020import Control.Applicative
2121import Control.Monad
2222import Control.Monad.State
23+import PureScript.Parser.State
24+import qualified Data.Map as M
2325import qualified Text.Parsec as P
2426import qualified Text.Parsec.Pos as P
2527import qualified Text.Parsec.Token as PT
@@ -66,7 +68,9 @@ reservedNames = [ "case"
6668 , "with"
6769 , "Number"
6870 , "String"
69− , "Boolean" ]
71+ , "Boolean"
72+ , "infixl"
73+ , "infixr" ]
7074
7175reservedOpNames :: [String]
7276reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
@@ -122,6 +126,7 @@ semiSep = PT.semiSep tokenParser
122126semiSep1 = PT.semiSep1 tokenParser
123127commaSep = PT.commaSep tokenParser
124128commaSep1 = PT.commaSep1 tokenParser
129+natural = PT.natural tokenParser
125130
126131tick :: P.Parsec String u Char
127132tick = lexeme $ P.char '`'
@@ -151,26 +156,26 @@ parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)
151156parseIdentInfix :: P.Parsec String u Ident
152157parseIdentInfix = (Ident <$> P.between tick tick identifier) <|> (Op <$> operator)
153158
154−mark :: P.Parsec String P.Column a -> P.Parsec String P.Column a
159+mark :: P.Parsec String ParseState a -> P.Parsec String ParseState a
155160mark p = do
156− current <- P.getState
161+ current <- indentationLevel <$> P.getState
157162 pos <- P.sourceColumn <$> P.getPosition
158− P.putState pos
163+ P.modifyState $ \st -> st { indentationLevel = pos }
159164 a <- p
160− P.putState current
165+ P.modifyState $ \st -> st { indentationLevel = current }
161166 return a
162167
163−checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec String P.Column ()
168+checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec String ParseState ()
164169checkIndentation rel = (do
165170 col <- P.sourceColumn <$> P.getPosition
166− current <- P.getState
171+ current <- indentationLevel <$> P.getState
167172 guard $ col `rel` current) <|> P.parserFail "Indentation check"
168173
169−indented :: P.Parsec String P.Column ()
174+indented :: P.Parsec String ParseState ()
170175indented = checkIndentation (>)
171176
172−same :: P.Parsec String P.Column ()
177+same :: P.Parsec String ParseState ()
173178same = checkIndentation (==)
174179
175−runIndentParser :: P.Column -> P.Parsec String P.Column a -> String -> Either P.ParseError a
176−runIndentParser col p = P.runParser p 0 ""
180+runIndentParser :: P.Parsec String ParseState a -> String -> Either P.ParseError a
181+runIndentParser p = P.runParser p (ParseState 0 M.empty) ""
src/PureScript/Parser/Declarations.hs+29−8
@@ -24,17 +24,19 @@ import Data.Function
2424import Control.Applicative
2525import Control.Arrow (Arrow(..))
2626import Control.Monad.State
27+import qualified Data.Map as M
2728import qualified Text.Parsec as P
2829import qualified Text.Parsec.Pos as P
2930
3031import PureScript.Values
3132import PureScript.Types
33+import PureScript.Parser.State
3234import PureScript.Parser.Common
3335import PureScript.Declarations
3436import PureScript.Parser.Values
3537import PureScript.Parser.Types
3638
37−parseDataDeclaration :: P.Parsec String P.Column Declaration
39+parseDataDeclaration :: P.Parsec String ParseState Declaration
3840parseDataDeclaration = do
3941 reserved "data"
4042 name <- indented *> properName
@@ -43,34 +45,53 @@ parseDataDeclaration = do
4345 ctors <- P.sepBy1 ((,) <$> (indented *> properName) <*> P.optionMaybe parseType) (lexeme $ indented *> P.char '|')
4446 return $ DataDeclaration name tyArgs ctors
4547
46−parseTypeDeclaration :: P.Parsec String P.Column Declaration
48+parseTypeDeclaration :: P.Parsec String ParseState Declaration
4749parseTypeDeclaration =
4850 TypeDeclaration <$> parseIdent
4951 <*> (lexeme (indented *> P.string "::") *> parsePolyType)
5052
51−parseTypeSynonymDeclaration :: P.Parsec String P.Column Declaration
53+parseTypeSynonymDeclaration :: P.Parsec String ParseState Declaration
5254parseTypeSynonymDeclaration =
5355 TypeSynonymDeclaration <$> (reserved "type" *> indented *> properName)
5456 <*> many (indented *> identifier)
5557 <*> (lexeme (indented *> P.char '=') *> parseType)
5658
57−parseValueDeclaration :: P.Parsec String P.Column Declaration
59+parseValueDeclaration :: P.Parsec String ParseState Declaration
5860parseValueDeclaration =
5961 ValueDeclaration <$> parseIdent
6062 <*> (lexeme (indented *> P.char '=') *> parseValue)
6163
62−parseExternDeclaration :: P.Parsec String P.Column Declaration
64+parseExternDeclaration :: P.Parsec String ParseState Declaration
6365parseExternDeclaration =
6466 ExternDeclaration <$> (reserved "extern" *> indented *> parseIdent)
6567 <*> (lexeme (indented *> P.string "::") *> parsePolyType)
6668
67−parseDeclaration :: P.Parsec String P.Column Declaration
69+parseAssociativity :: P.Parsec String ParseState Associativity
70+parseAssociativity =
71+ (reserved "infixl" >> return Infixl) <|>
72+ (reserved "infixr" >> return Infixr)
73+
74+parseFixity :: P.Parsec String ParseState Fixity
75+parseFixity = Fixity <$> parseAssociativity <*> (indented *> natural)
76+
77+parseFixityDeclaration :: P.Parsec String ParseState Declaration
78+parseFixityDeclaration = do
79+ fixity <- parseFixity
80+ indented
81+ name <- operator
82+ current <- fixities <$> P.getState
83+ when (name `M.member` current) (P.unexpected $ "redefined fixity for " ++ show name)
84+ P.modifyState $ \st -> st { fixities = M.insert name fixity current }
85+ return $ FixityDeclaration fixity name
86+
87+parseDeclaration :: P.Parsec String ParseState Declaration
6888parseDeclaration = P.choice $ map P.try
6989 [ parseDataDeclaration
7090 , parseTypeDeclaration
7191 , parseTypeSynonymDeclaration
7292 , parseValueDeclaration
73− , parseExternDeclaration ]
93+ , parseExternDeclaration
94+ , parseFixityDeclaration ]
7495
75−parseDeclarations :: P.Parsec String P.Column [Declaration]
96+parseDeclarations :: P.Parsec String ParseState [Declaration]
7697parseDeclarations = whiteSpace *> mark (same *> P.many parseDeclaration) <* P.eof
src/PureScript/Parser/State.hsnew file+27
@@ -0,0 +1,27 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : PureScript.Parser.State
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+--
13+-----------------------------------------------------------------------------
14+
15+module PureScript.Parser.State where
16+
17+import PureScript.Names
18+import PureScript.Declarations
19+
20+import qualified Text.Parsec as P
21+import qualified Data.Map as M
22+
23+data ParseState = ParseState
24+ { indentationLevel :: P.Column
25+ , fixities :: M.Map String Fixity } deriving Show
26+
27+
src/PureScript/Parser/Types.hs+16−15
@@ -19,41 +19,42 @@ module PureScript.Parser.Types (
1919) where
2020
2121import PureScript.Types
22+import PureScript.Parser.State
2223import PureScript.Parser.Common
2324import Control.Applicative
2425import qualified Text.Parsec as P
2526import qualified Text.Parsec.Expr as P
2627import Control.Arrow (Arrow(..))
2728
28−parseNumber :: P.Parsec String P.Column Type
29+parseNumber :: P.Parsec String ParseState Type
2930parseNumber = const Number <$> reserved "Number"
3031
31−parseString :: P.Parsec String P.Column Type
32+parseString :: P.Parsec String ParseState Type
3233parseString = const String <$> reserved "String"
3334
34−parseBoolean :: P.Parsec String P.Column Type
35+parseBoolean :: P.Parsec String ParseState Type
3536parseBoolean = const Boolean <$> reserved "Boolean"
3637
37−parseArray :: P.Parsec String P.Column Type
38+parseArray :: P.Parsec String ParseState Type
3839parseArray = squares $ Array <$> parseType
3940
40−parseObject :: P.Parsec String P.Column Type
41+parseObject :: P.Parsec String ParseState Type
4142parseObject = braces $ Object <$> parseRow
4243
43−parseFunction :: P.Parsec String P.Column Type
44+parseFunction :: P.Parsec String ParseState Type
4445parseFunction = do
4546 args <- lexeme $ parens $ commaSep parseType
4647 lexeme $ P.string "->"
4748 resultType <- parseType
4849 return $ Function args resultType
4950
50−parseTypeVariable :: P.Parsec String P.Column Type
51+parseTypeVariable :: P.Parsec String ParseState Type
5152parseTypeVariable = TypeVar <$> identifier
5253
53−parseTypeConstructor :: P.Parsec String P.Column Type
54+parseTypeConstructor :: P.Parsec String ParseState Type
5455parseTypeConstructor = TypeConstructor <$> properName
5556
56−parseTypeAtom :: P.Parsec String P.Column Type
57+parseTypeAtom :: P.Parsec String ParseState Type
5758parseTypeAtom = indented *> P.choice (map P.try
5859 [ parseNumber
5960 , parseString
@@ -65,24 +66,24 @@ parseTypeAtom = indented *> P.choice (map P.try
6566 , parseTypeConstructor
6667 , parens parseType ])
6768
68−parsePolyType :: P.Parsec String P.Column PolyType
69+parsePolyType :: P.Parsec String ParseState PolyType
6970parsePolyType = PolyType <$> (P.option [] (indented *> reserved "forall" *> many (indented *> identifier) <* indented <* dot))
7071 <*> parseType
7172
72−parseType :: P.Parsec String P.Column Type
73+parseType :: P.Parsec String ParseState Type
7374parseType = P.buildExpressionParser operators . buildPostfixParser postfixTable $ parseTypeAtom
7475 where
75− postfixTable :: [P.Parsec String P.Column (Type -> Type)]
76+ postfixTable :: [P.Parsec String ParseState (Type -> Type)]
7677 postfixTable = [ flip TypeApp <$> (indented *> parseTypeAtom) ]
7778 operators = [ [ P.Infix (lexeme (P.try (P.string "->")) >> return (\t1 t2 -> Function [t1] t2)) P.AssocRight ] ]
7879
79−parseNameAndType :: P.Parsec String P.Column (String, Type)
80+parseNameAndType :: P.Parsec String ParseState (String, Type)
8081parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parseType
8182
82−parseRowEnding :: P.Parsec String P.Column Row
83+parseRowEnding :: P.Parsec String ParseState Row
8384parseRowEnding = P.option REmpty (RowVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))
8485
85−parseRow :: P.Parsec String P.Column Row
86+parseRow :: P.Parsec String ParseState Row
8687parseRow = fromList <$> (parseNameAndType `P.sepBy` (indented *> semi)) <*> parseRowEnding
8788 where
8889 fromList :: [(String, Type)] -> Row -> Row
src/PureScript/Parser/Values.hs+74−46
@@ -18,6 +18,13 @@ module PureScript.Parser.Values (
1818) where
1919
2020import PureScript.Values
21+import PureScript.Names
22+import PureScript.Declarations
23+import PureScript.Parser.State
24+import Data.Function (on)
25+import Data.List
26+import Data.Functor.Identity
27+import qualified Data.Map as M
2128import qualified PureScript.Parser.Common as C
2229import Control.Applicative
2330import qualified Text.Parsec as P
@@ -27,29 +34,29 @@ import Control.Arrow (Arrow(..))
2734import PureScript.Parser.Types
2835import PureScript.Types
2936
30−booleanLiteral :: P.Parsec String P.Column Bool
37+booleanLiteral :: P.Parsec String ParseState Bool
3138booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)
3239
33−parseNumericLiteral :: P.Parsec String P.Column Value
40+parseNumericLiteral :: P.Parsec String ParseState Value
3441parseNumericLiteral = NumericLiteral <$> C.integerOrFloat
3542
36−parseStringLiteral :: P.Parsec String P.Column Value
43+parseStringLiteral :: P.Parsec String ParseState Value
3744parseStringLiteral = StringLiteral <$> C.stringLiteral
3845
39−parseBooleanLiteral :: P.Parsec String P.Column Value
46+parseBooleanLiteral :: P.Parsec String ParseState Value
4047parseBooleanLiteral = BooleanLiteral <$> booleanLiteral
4148
42−parseArrayLiteral :: P.Parsec String P.Column Value
49+parseArrayLiteral :: P.Parsec String ParseState Value
4350parseArrayLiteral = ArrayLiteral <$> (C.squares $ parseValue `P.sepBy` (C.indented *> C.comma))
4451
45−parseObjectLiteral :: P.Parsec String P.Column Value
52+parseObjectLiteral :: P.Parsec String ParseState Value
4653parseObjectLiteral = ObjectLiteral <$> (C.braces $ parseIdentifierAndValue `P.sepBy` (C.indented *> C.comma))
4754
48−parseIdentifierAndValue :: P.Parsec String P.Column (String, Value)
55+parseIdentifierAndValue :: P.Parsec String ParseState (String, Value)
4956parseIdentifierAndValue = (,) <$> (C.indented *> C.identifier <* C.indented <* C.colon)
5057 <*> (C.indented *> parseValue)
5158
52−parseAbs :: P.Parsec String P.Column Value
59+parseAbs :: P.Parsec String ParseState Value
5360parseAbs = do
5461 C.lexeme $ P.char '\\'
5562 args <- (C.indented *> C.parseIdent) `P.sepBy` (C.indented *> C.comma)
@@ -57,35 +64,35 @@ parseAbs = do
5764 value <- parseValue
5865 return $ Abs args value
5966
60−parseApp :: P.Parsec String P.Column Value
67+parseApp :: P.Parsec String ParseState Value
6168parseApp = App <$> parseValue
6269 <*> (C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma)))
6370
64−parseVar :: P.Parsec String P.Column Value
71+parseVar :: P.Parsec String ParseState Value
6572parseVar = Var <$> C.parseIdent
6673
67−parseConstructor :: P.Parsec String P.Column Value
74+parseConstructor :: P.Parsec String ParseState Value
6875parseConstructor = Constructor <$> C.properName
6976
70−parseCase :: P.Parsec String P.Column Value
77+parseCase :: P.Parsec String ParseState Value
7178parseCase = Case <$> (P.between (C.reserved "case") (C.indented *> C.reserved "of") parseValue)
7279 <*> (C.indented *> C.mark (P.many (C.same *> C.mark parseCaseAlternative)))
7380
74−parseCaseAlternative :: P.Parsec String P.Column (Binder, Value)
81+parseCaseAlternative :: P.Parsec String ParseState (Binder, Value)
7582parseCaseAlternative = (,) <$> (parseGuardedBinder <* C.lexeme (P.string "->")) <*> parseValue
7683
77−parseIfThenElse :: P.Parsec String P.Column Value
84+parseIfThenElse :: P.Parsec String ParseState Value
7885parseIfThenElse = IfThenElse <$> (C.reserved "if" *> C.indented *> parseValue)
7986 <*> (C.indented *> C.reserved "then" *> C.indented *> parseValue)
8087 <*> (C.indented *> C.reserved "else" *> C.indented *> parseValue)
81−
82−parseBlock :: P.Parsec String P.Column Value
88+
89+parseBlock :: P.Parsec String ParseState Value
8390parseBlock = Block <$> (C.reserved "do" *> parseManyStatements)
8491
85−parseManyStatements :: P.Parsec String P.Column [Statement]
92+parseManyStatements :: P.Parsec String ParseState [Statement]
8693parseManyStatements = C.indented *> (C.mark $ P.many $ C.same *> C.mark parseStatement)
8794
88−parseValueAtom :: P.Parsec String P.Column Value
95+parseValueAtom :: P.Parsec String ParseState Value
8996parseValueAtom = C.indented *> P.choice (map P.try
9097 [ parseNumericLiteral
9198 , parseStringLiteral
@@ -100,8 +107,10 @@ parseValueAtom = C.indented *> P.choice (map P.try
100107 , parseIfThenElse
101108 , C.parens parseValue ])
102109
103−parseValue :: P.Parsec String P.Column Value
104−parseValue = buildExpressionParser operators . C.buildPostfixParser postfixTable2 $ indexersAndAccessors
110+parseValue :: P.Parsec String ParseState Value
111+parseValue = do
112+ customOps <- fixities <$> P.getState
113+ buildExpressionParser (operators customOps) . C.buildPostfixParser postfixTable2 $ indexersAndAccessors
105114 where
106115 indexersAndAccessors = C.buildPostfixParser postfixTable1 $ parseValueAtom
107116 postfixTable1 = [ Accessor <$> (C.indented *> C.dot *> C.indented *> C.identifier)
@@ -109,11 +118,13 @@ parseValue = buildExpressionParser operators . C.buildPostfixParser postfixTable
109118 postfixTable2 = [ C.indented *> indexersAndAccessors >>= \t2 -> return (\t1 -> App t1 [t2])
110119 , flip App <$> (C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma)))
111120 , flip TypedValue <$> (P.try $ C.lexeme (C.indented *> P.string "::") *> parsePolyType) ]
112− operators = [ [ Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "!") >> return (Unary Not)
121+ operators user =
122+ [ [ Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "!") >> return (Unary Not)
113123 , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "~") >> return (Unary BitwiseNot)
114124 , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "-") >> return (Unary Negate)
115125 , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "+") >> return id ]
116− , [ Infix (C.lexeme (P.try (C.indented *> C.parseIdentInfix) >>= \ident -> return $ \t1 t2 -> App (App (Var ident) [t1]) [t2])) AssocRight ]
126+ ] ++ customOperatorTable user ++
127+ [ [ Infix (C.lexeme (P.try (C.indented *> C.parseIdentInfix) >>= \ident -> return $ \t1 t2 -> App (App (Var ident) [t1]) [t2])) AssocRight ]
117128 , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "<=") >> return (Binary LessThanOrEqualTo)) AssocRight
118129 , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp ">=") >> return (Binary GreaterThanOrEqualTo)) AssocRight ]
119130 , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "<") >> return (Binary LessThan)) AssocRight
@@ -136,7 +147,24 @@ parseValue = buildExpressionParser operators . C.buildPostfixParser postfixTable
136147 , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "||") >> return (Binary Or)) AssocRight ]
137148 ]
138149
139−parseVariableIntroduction :: P.Parsec String P.Column Statement
150+customOperatorTable :: M.Map String Fixity -> OperatorTable String ParseState Identity Value
151+customOperatorTable fixities =
152+ let
153+ ops = map (\(name, Fixity a p) -> (name, (a, p))) . M.toList $ fixities
154+ sorted = sortBy (compare `on` (snd . snd)) ops
155+ levels = groupBy ((==) `on` (snd . snd)) sorted
156+ in
157+ flip map levels (map (\(name, (a, _)) -> flip Infix (toAssoc a) $ do
158+ C.lexeme $ P.try $ do
159+ C.indented
160+ C.reservedOp name
161+ return $ \t1 t2 -> App (App (Var (Op name)) [t1]) [t2]))
162+
163+toAssoc :: Associativity -> Assoc
164+toAssoc Infixl = AssocLeft
165+toAssoc Infixr = AssocRight
166+
167+parseVariableIntroduction :: P.Parsec String ParseState Statement
140168parseVariableIntroduction = do
141169 C.reserved "var"
142170 name <- C.indented *> C.parseIdent
@@ -144,45 +172,45 @@ parseVariableIntroduction = do
144172 value <- parseValue
145173 return $ VariableIntroduction name value
146174
147−parseAssignment :: P.Parsec String P.Column Statement
175+parseAssignment :: P.Parsec String ParseState Statement
148176parseAssignment = do
149177 tgt <- parseAssignmentTarget
150178 C.lexeme $ C.indented *> P.char '='
151179 value <- parseValue
152180 return $ Assignment tgt value
153181
154−parseWhile :: P.Parsec String P.Column Statement
182+parseWhile :: P.Parsec String ParseState Statement
155183parseWhile = While <$> (C.reserved "while" *> C.indented *> parseValue <* C.indented <* C.colon)
156184 <*> parseManyStatements
157185
158−parseFor :: P.Parsec String P.Column Statement
186+parseFor :: P.Parsec String ParseState Statement
159187parseFor = For <$> (C.reserved "for" *> C.indented *> C.parseIdent)
160188 <*> (C.indented *> C.lexeme (P.string "<-") *> parseValue)
161189 <*> (C.indented *> C.reserved "until" *> parseValue <* C.colon)
162190 <*> parseManyStatements
163191
164−parseForEach :: P.Parsec String P.Column Statement
192+parseForEach :: P.Parsec String ParseState Statement
165193parseForEach = ForEach <$> (C.reserved "foreach" *> C.indented *> C.parseIdent)
166194 <*> (C.indented *> C.reserved "in" *> parseValue <* C.colon)
167195 <*> parseManyStatements
168196
169−parseIf :: P.Parsec String P.Column Statement
197+parseIf :: P.Parsec String ParseState Statement
170198parseIf = If <$> parseIfStatement
171199
172−parseIfStatement :: P.Parsec String P.Column IfStatement
200+parseIfStatement :: P.Parsec String ParseState IfStatement
173201parseIfStatement =
174202 IfStatement <$> (C.reserved "if" *> C.indented *> parseValue <* C.indented <* C.colon)
175203 <*> parseManyStatements
176204 <*> P.optionMaybe (C.same *> parseElseStatement)
177205
178−parseElseStatement :: P.Parsec String P.Column ElseStatement
206+parseElseStatement :: P.Parsec String ParseState ElseStatement
179207parseElseStatement = C.reserved "else" >> (ElseIf <$> (C.indented *> parseIfStatement)
180208 <|> Else <$> (C.indented *> C.colon *> parseManyStatements))
181209
182−parseReturn :: P.Parsec String P.Column Statement
210+parseReturn :: P.Parsec String ParseState Statement
183211parseReturn = Return <$> (C.reserved "return" *> parseValue)
184212
185−parseStatement :: P.Parsec String P.Column Statement
213+parseStatement :: P.Parsec String ParseState Statement
186214parseStatement = P.choice (map P.try
187215 [ parseVariableIntroduction
188216 , parseAssignment
@@ -192,46 +220,46 @@ parseStatement = P.choice (map P.try
192220 , parseIf
193221 , parseReturn ])
194222
195−parseStringBinder :: P.Parsec String P.Column Binder
223+parseStringBinder :: P.Parsec String ParseState Binder
196224parseStringBinder = StringBinder <$> C.stringLiteral
197225
198−parseBooleanBinder :: P.Parsec String P.Column Binder
226+parseBooleanBinder :: P.Parsec String ParseState Binder
199227parseBooleanBinder = BooleanBinder <$> booleanLiteral
200228
201−parseNumberBinder :: P.Parsec String P.Column Binder
229+parseNumberBinder :: P.Parsec String ParseState Binder
202230parseNumberBinder = NumberBinder <$> C.integerOrFloat
203231
204−parseVarBinder :: P.Parsec String P.Column Binder
232+parseVarBinder :: P.Parsec String ParseState Binder
205233parseVarBinder = VarBinder <$> C.parseIdent
206234
207−parseNullaryBinder :: P.Parsec String P.Column Binder
235+parseNullaryBinder :: P.Parsec String ParseState Binder
208236parseNullaryBinder = NullaryBinder <$> C.lexeme C.properName
209237
210−parseUnaryBinder :: P.Parsec String P.Column Binder
238+parseUnaryBinder :: P.Parsec String ParseState Binder
211239parseUnaryBinder = UnaryBinder <$> C.lexeme C.properName <*> (C.indented *> parseBinder)
212240
213−parseObjectBinder :: P.Parsec String P.Column Binder
241+parseObjectBinder :: P.Parsec String ParseState Binder
214242parseObjectBinder = ObjectBinder <$> C.braces ((C.indented *> parseIdentifierAndBinder) `P.sepBy` (C.indented *> C.comma))
215243
216−parseArrayBinder :: P.Parsec String P.Column Binder
244+parseArrayBinder :: P.Parsec String ParseState Binder
217245parseArrayBinder = C.squares $ ArrayBinder <$> ((C.indented *> parseBinder) `P.sepBy` (C.indented *> C.comma))
218246 <*> P.optionMaybe (C.indented *> C.colon *> C.indented *> parseBinder)
219247
220−parseNamedBinder :: P.Parsec String P.Column Binder
248+parseNamedBinder :: P.Parsec String ParseState Binder
221249parseNamedBinder = NamedBinder <$> (C.parseIdent <* C.indented <* C.lexeme (P.char '@'))
222250 <*> (C.indented *> parseBinder)
223251
224−parseNullBinder :: P.Parsec String P.Column Binder
252+parseNullBinder :: P.Parsec String ParseState Binder
225253parseNullBinder = C.lexeme (P.char '_') *> P.notFollowedBy C.identLetter *> return NullBinder
226254
227−parseIdentifierAndBinder :: P.Parsec String P.Column (String, Binder)
255+parseIdentifierAndBinder :: P.Parsec String ParseState (String, Binder)
228256parseIdentifierAndBinder = do
229257 name <- C.lexeme C.identifier
230258 C.lexeme $ C.indented *> P.char '='
231259 binder <- C.indented *> parseBinder
232260 return (name, binder)
233261
234−parseBinder :: P.Parsec String P.Column Binder
262+parseBinder :: P.Parsec String ParseState Binder
235263parseBinder = P.choice (map P.try
236264 [ parseNullBinder
237265 , parseStringBinder
@@ -245,10 +273,10 @@ parseBinder = P.choice (map P.try
245273 , parseArrayBinder
246274 , C.parens parseBinder ])
247275
248−parseGuardedBinder :: P.Parsec String P.Column Binder
276+parseGuardedBinder :: P.Parsec String ParseState Binder
249277parseGuardedBinder = flip ($) <$> parseBinder <*> P.option id (GuardedBinder <$> (C.indented *> C.lexeme (P.char '|') *> C.indented *> parseValue))
250278
251−parseAssignmentTarget :: P.Parsec String P.Column AssignmentTarget
279+parseAssignmentTarget :: P.Parsec String ParseState AssignmentTarget
252280parseAssignmentTarget = buildExpressionParser operators (AssignVariable <$> C.parseIdent)
253281 where
254282 operators = [ [ Postfix $ AssignArrayIndex <$> (C.indented *> C.squares parseValue)
src/PureScript/TypeChecker.hs+6
@@ -29,9 +29,11 @@ import PureScript.TypeChecker.Synonyms
2929import Data.List
3030import Data.Maybe
3131import Data.Function
32+import qualified Data.Map as M
3233
3334import PureScript.Values
3435import PureScript.Types
36+import PureScript.Names
3537import PureScript.Kinds
3638import PureScript.Declarations
3739
@@ -86,3 +88,7 @@ typeCheckAll (ExternDeclaration name ty : rest) = do
8688 Just _ -> throwError $ show name ++ " is already defined"
8789 Nothing -> putEnv (env { names = M.insert name (ty, Extern) (names env) })
8890 typeCheckAll rest
91+typeCheckAll (FixityDeclaration _ name : rest) = do
92+ typeCheckAll rest
93+ env <- getEnv
94+ guardWith ("Fixity declaration with no binding: " ++ name) $ M.member (Op name) $ names env