git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix some issues with the order of desugaring passes
commit200aafc198628d9c85b135e9862efd84d3276e15 authorPhil Freeman <paf31@cantab.net> dateTue 4 Mar 2014, 14:46 (13 years ago) parent059bd9b
4 files changed+13−7
compare with golang
unifiedsplit
examples/passing/RedefinedFixity.purs+1−1 src/Language/PureScript/Sugar.hs+2−2 src/Language/PureScript/Sugar/CaseDeclarations.hs+9−3 src/Language/PureScript/Sugar/Names.hs+1−1
examples/passing/RedefinedFixity.purs+1−1
@@ -12,7 +12,7 @@ module M3 where
1212
1313import M1
1414import M2
15−
15+
1616module Main where
1717
1818main = Debug.Trace.trace "Done"
src/Language/PureScript/Sugar.hs+2−2
@@ -51,9 +51,9 @@ import Language.PureScript.Sugar.Names as S
5151desugar :: [Module] -> Either String [Module]
5252desugar = rebracket
5353 >=> desugarDo
54+ >=> desugarCasesModule
5455 >=> desugarLetBindings
55− >>> desugarCasesModule
56+ >>> desugarImports
5657 >=> desugarTypeDeclarationsModule
57− >=> desugarImports
5858 >=> desugarTypeClasses
5959 >=> createBindingGroupsModule
src/Language/PureScript/Sugar/CaseDeclarations.hs+9−3
@@ -22,8 +22,8 @@ module Language.PureScript.Sugar.CaseDeclarations (
2222import Data.List (groupBy)
2323import Data.Generics (mkT, everywhere)
2424
25−import Control.Applicative ((<$>))
26−import Control.Monad (forM, join, unless)
25+import Control.Applicative
26+import Control.Monad ((<=<), forM, join, unless)
2727import Control.Monad.Error.Class
2828
2929import Language.PureScript.Names
@@ -51,7 +51,13 @@ desugarAbs = everywhere (mkT replace)
5151-- Replace all top-level binders with case expressions.
5252--
5353desugarCases :: [Declaration] -> Either String [Declaration]
54−desugarCases = fmap join . mapM toDecls . groupBy inSameGroup
54+desugarCases = desugarRest <=< fmap join . mapM toDecls . groupBy inSameGroup
55+ where
56+ desugarRest :: [Declaration] -> Either String [Declaration]
57+ desugarRest ((TypeInstanceDeclaration constraints className tys ds) : rest) =
58+ (:) <$> (TypeInstanceDeclaration constraints className tys <$> desugarCases ds) <*> desugarRest rest
59+ desugarRest (d : ds) = (:) d <$> desugarRest ds
60+ desugarRest [] = pure []
5561
5662inSameGroup :: Declaration -> Declaration -> Bool
5763inSameGroup (ValueDeclaration ident1 _ _ _) (ValueDeclaration ident2 _ _ _) = ident1 == ident2
src/Language/PureScript/Sugar/Names.hs+1−1
@@ -226,7 +226,7 @@ resolveImports env (Module currentModule decls) =
226226 scope :: M.Map ModuleName (Maybe ExplicitImports)
227227 scope = M.insert currentModule Nothing (findImports decls)
228228 resolveImport' imp (mn, i) = do
229− m <- maybe (throwError $ "Cannot import from unknown module '" ++ show mn ++ "'") return $ mn `M.lookup` env
229+ let m = fromMaybe (Exports S.empty S.empty S.empty) $ mn `M.lookup` env
230230 resolveImport currentModule mn m imp i
231231
232232-- |