git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Use Supply to generate arg name for swap lambda
9f5eeebGary Burgess
src/Language/PureScript/Sugar.hs+2−2
@@ -58,8 +58,8 @@ import Language.PureScript.Sugar.TypeDeclarations as S
58desugar :: [Module] -> SupplyT (Either ErrorStack) [Module]
58desugar :: [Module] -> SupplyT (Either ErrorStack) [Module]
59desugar = map removeSignedLiterals
59desugar = map removeSignedLiterals
60 >>> map desugarObjectConstructors
60 >>> map desugarObjectConstructors
61− >>> map desugarOperatorSections
61+ >>> mapM desugarOperatorSections
62− >>> mapM desugarDoModule
62+ >=> mapM desugarDoModule
63 >=> desugarCasesModule
63 >=> desugarCasesModule
64 >=> lift . (desugarTypeDeclarationsModule
64 >=> lift . (desugarTypeDeclarationsModule
65 >=> desugarImports
65 >=> desugarImports
src/Language/PureScript/Sugar/Operators.hs+12−9
@@ -25,9 +25,10 @@ module Language.PureScript.Sugar.Operators (
25 desugarOperatorSections
25 desugarOperatorSections
26) where
26) where
27
27
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
31
32
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
151
152
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
154 where
155 where
155
156
156− goDecl :: Declaration -> Declaration
157+ goDecl :: Declaration -> SupplyT (Either ErrorStack) Declaration
157− (goDecl, _, _) = everywhereOnValues id goExpr id
158+ (goDecl, _, _) = everywhereOnValuesM return goExpr return
158
159
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