@@ -1,6 +1,6 @@
11module Transform.Canonicalize (interface, metadataModule) where
22
3−import Control.Arrow (first, second, (***))
3+import Control.Arrow ((***))
44import Control.Monad.Identity
55import qualified Data.Map as Map
66import qualified Data.Set as Set
@@ -13,7 +13,8 @@ import SourceSyntax.Pattern
1313import SourceSyntax.Helpers (isOp)
1414import qualified SourceSyntax.Type as Type
1515import qualified Transform.SortDefinitions as SD
16−import Text.PrettyPrint
16+import Text.PrettyPrint as P
17+
1718
1819interface :: String -> ModuleInterface -> ModuleInterface
1920interface moduleName iface =
@@ -50,8 +51,15 @@ renameType rename tipe =
5051metadataModule :: Interfaces -> MetadataModule t v -> Either [Doc] (MetadataModule t v)
5152metadataModule ifaces modul =
5253 do program' <- rename initialEnv (program modul)
53− return $ modul { program = program' }
54+ aliases' <- mapM (third renameType') (aliases modul)
55+ datatypes' <- mapM (third (mapM (second (mapM renameType')))) (datatypes modul)
56+ return $ modul { program = program', aliases = aliases', datatypes = datatypes' }
5457 where
58+ second f (a,b) = (,) a `fmap` f b
59+ third f (a,b,c) = (,,) a b `fmap` f c
60+ renameType' =
61+ Either.either (\err -> Left [P.text err]) return . renameType (replace initialEnv)
62+
5563 get1 (a,_,_) = a
5664 canon (name, importMethod) =
5765 let pair pre var = (pre ++ drop (length name + 1) var, var)
@@ -67,8 +75,7 @@ metadataModule ifaces modul =
6775 where vs = Set.fromList $ map (\v -> name ++ "." ++ v) vars
6876
6977 pair n = (n,n)
70− localEnv = concat [ map (pair . get1) (aliases modul)
71− , map (pair . get1) (datatypes modul) ]
78+ localEnv = map pair (map get1 (aliases modul) ++ map get1 (datatypes modul))
7279 globalEnv = map pair $ ["_List",saveEnvName,"::","[]","Int","Float","Char","Bool"] ++
7380 map (\n -> "_Tuple" ++ show n) [0..9]
7481 realImports = filter (not . List.isPrefixOf "Native." . fst) (imports modul)
@@ -96,7 +103,7 @@ replace env v =
96103rename :: Env -> LExpr t v -> Either [Doc] (LExpr t v)
97104rename env lexpr@(L t s expr) =
98105 let rnm = rename env
99− throw err = Left [ text $ "Error " ++ show s ++ "\n" ++ err ]
106+ throw err = Left [ P.text $ "Error " ++ show s ++ "\n" ++ err ]
100107 format = Either.either throw return
101108 in
102109 L t s `liftM`