@@ -25,9 +25,10 @@ module Language.PureScript.Sugar.Operators (
25 desugarOperatorSections
25 desugarOperatorSections
28−import Language.PureScript.Names
29import Language.PureScript.AST
28import Language.PureScript.AST
30import Language.PureScript.Errors
29import Language.PureScript.Errors
30+import Language.PureScript.Names
31+import Language.PureScript.Supply
32import Control.Applicative
33import Control.Applicative
33import Control.Monad.State
34import Control.Monad.State
@@ -149,14 +150,16 @@ matchOp op = do
149 ident <- parseOp
150 ident <- parseOp
150 guard $ ident == op
151 guard $ ident == op
152−desugarOperatorSections :: Module -> Module
153+desugarOperatorSections :: Module -> SupplyT (Either ErrorStack) Module
153−desugarOperatorSections (Module mn ds exts) = Module mn (map goDecl ds) exts
154+desugarOperatorSections (Module mn ds exts) = Module mn <$> mapM goDecl ds <*> pure exts
156− goDecl :: Declaration -> Declaration
157+ goDecl :: Declaration -> SupplyT (Either ErrorStack) Declaration
157− (goDecl, _, _) = everywhereOnValues id goExpr id
158+ (goDecl, _, _) = everywhereOnValuesM return goExpr return
159− goExpr :: Expr -> Expr
160+ goExpr :: Expr -> SupplyT (Either ErrorStack) Expr
160− goExpr (OperatorSection op (Left val)) = App (Var op) val
161+ goExpr (OperatorSection op (Left val)) = return $ App (Var op) val
162+ goExpr (OperatorSection op (Right val)) = do
163+ arg <- Ident <$> freshName
161− goExpr (OperatorSection op (Right val)) = Abs (Left $ Ident "_lhs") $ App (App (Var op) (Var (Qualified Nothing (Ident "_lhs")))) val
164+ return $ Abs (Left arg) $ App (App (Var op) (Var (Qualified Nothing arg))) val
162− goExpr other = other
165+ goExpr other = return other