git.iko.soy/elk
on master help sign in
Properly convert Type.Type to SourceSyntax.Type
commitf8fe8e449530664ecaa0e2b9f0d9be7b3e294b3f authorEvan Czaplicki <info@elm-lang.org> dateMon 29 Jul 2013, 20:23 (13 years ago) parentac450ae
2 files changed+30−6
compare with master
unifiedsplit
compiler/Compiler.hs+1−6 compiler/Type/Type.hs+29
compiler/Compiler.hs+1−6
@@ -27,7 +27,6 @@ import Paths_Elm
2727import SourceSyntax.PrettyPrint (pretty, variable)
2828import Text.PrettyPrint as P
2929import qualified Type.Type as Type
30−import qualified Parse.Type as Parse
3130import qualified Data.Traversable as Traverse
3231
3332data Flags =
@@ -125,7 +124,7 @@ buildFile flags moduleNum numModules interfaces filePath =
125124 return modul
126125
127126 if print_types flags then printTypes metaModule else return ()
128− tipes <- toSrcTypes (types metaModule)
127+ tipes <- Traverse.traverse Type.toSrcType (types metaModule)
129128 let interface = Canonical.interface name $ ModuleInterface {
130129 iTypes = tipes,
131130 iAdts = datatypes metaModule,
@@ -136,10 +135,6 @@ buildFile flags moduleNum numModules interfaces filePath =
136135 writeFile (elmo flags filePath) (jsModule metaModule)
137136 return interface
138137
139−toSrcTypes tipes = Traverse.traverse convert tipes
140− where
141− convert t = fmap (Parse.readType . P.render) (Type.extraPretty t)
142−
143138printTypes metaModule = do
144139 putStrLn ""
145140 forM_ (Map.toList $ types metaModule) $ \(n,t) -> do
compiler/Type/Type.hs+29
@@ -1,5 +1,6 @@
11module Type.Type where
22
3+import qualified Data.Char as Char
34import qualified Data.List as List
45import qualified Data.Map as Map
56import qualified Data.UnionFind.IO as UF
@@ -336,3 +337,31 @@ instance Crawl Descriptor where
336337 structure' <- traverse (crawl nextState) (structure desc)
337338 put state'
338339 return $ desc { name = name', structure = structure' }
340+
341+
342+toSrcType :: Variable -> IO Src.Type
343+toSrcType variable = do
344+ desc <- UF.descriptor =<< addNames variable
345+ case structure desc of
346+ Just term ->
347+ case term of
348+ App1 a b -> do
349+ Src.Data name ts <- toSrcType a
350+ b' <- toSrcType b
351+ return (Src.Data name (ts ++ [b']))
352+ Fun1 a b -> Src.Lambda <$> toSrcType a <*> toSrcType b
353+ Var1 a -> toSrcType a
354+ EmptyRecord1 -> return Src.EmptyRecord
355+ Record1 fs ext -> do
356+ fs' <- traverse (mapM toSrcType) fs
357+ let fs'' = concat [ map ((,) name) ts | (name,ts) <- Map.toList fs' ]
358+ Src.Record fs'' <$> toSrcType ext
359+ Nothing ->
360+ case name desc of
361+ Just x@(c:cs) | Char.isLower c -> return (Src.Var x)
362+ | otherwise -> return (Src.Data x [])
363+ Nothing ->
364+ error $ concat
365+ [ "Problem converting the following type "
366+ , "from a type-checker type to a source-syntax type:"
367+ , P.render (pretty Never variable) ]