@@ -6,7 +6,7 @@ import qualified Data.Map as Map
6import qualified Data.List as List
6import qualified Data.List as List
7import Data.Binary (encodeFile, decodeFile)
7import Data.Binary (encodeFile, decodeFile)
8import Data.Version (showVersion)
8import Data.Version (showVersion)
9−import System.Console.CmdArgs
9+import System.Console.CmdArgs hiding (program)
10import System.Directory
10import System.Directory
11import System.Exit
11import System.Exit
12import System.FilePath
12import System.FilePath
@@ -17,11 +17,12 @@ import qualified Text.Jasmine as JS
17import qualified Data.ByteString.Lazy.Char8 as BS
17import qualified Data.ByteString.Lazy.Char8 as BS
19import SourceSyntax.Module
19import SourceSyntax.Module
20−import Initialize (buildFromSource, getSortedModuleNames, TypeLibrary)
20+import Initialize (buildFromSource, getSortedModuleNames, Interfaces)
21import Generate.JavaScript (jsModule)
21import Generate.JavaScript (jsModule)
22import Generate.Html (createHtml, JSStyle(..), JSSource(..))
22import Generate.Html (createHtml, JSStyle(..), JSSource(..))
23import Paths_Elm
23import Paths_Elm
25+import SourceSyntax.PrettyPrint (pretty)
25import Text.PrettyPrint as P
26import Text.PrettyPrint as P
26import qualified Type.Type as Type
27import qualified Type.Type as Type
27import qualified Parse.Type as Parse
28import qualified Parse.Type as Parse
@@ -33,6 +34,7 @@ data Flags =
33 , runtime :: Maybe FilePath
34 , runtime :: Maybe FilePath
34 , only_js :: Bool
35 , only_js :: Bool
35 , print_types :: Bool
36 , print_types :: Bool
37+ , print_program :: Bool
36 , scripts :: [FilePath]
38 , scripts :: [FilePath]
37 , no_prelude :: Bool
39 , no_prelude :: Bool
38 , minify :: Bool
40 , minify :: Bool
@@ -50,6 +52,8 @@ flags = Flags
50 &= help "Compile only to JavaScript."
52 &= help "Compile only to JavaScript."
51 , print_types = False
53 , print_types = False
52 &= help "Print out infered types of top-level definitions."
54 &= help "Print out infered types of top-level definitions."
55+ , print_program = False
56+ &= help "Print out an internal representation of a program."
53 , scripts = [] &= typFile
57 , scripts = [] &= typFile
54 &= help "Load JavaScript files in generated HTML. Files will be included in the given order."
58 &= help "Load JavaScript files in generated HTML. Files will be included in the given order."
55 , no_prelude = False
59 , no_prelude = False
@@ -79,7 +83,7 @@ elmo flags filePath = file flags filePath "elmo"
79elmi flags filePath = file flags filePath "elmi"
83elmi flags filePath = file flags filePath "elmi"
82−buildFile :: Flags -> Int -> Int -> TypeLibrary -> FilePath -> IO ModuleInterface
86+buildFile :: Flags -> Int -> Int -> Interfaces -> FilePath -> IO ModuleInterface
83buildFile flags moduleNum numModules interfaces filePath =
87buildFile flags moduleNum numModules interfaces filePath =
84 do compiled <- alreadyCompiled
88 do compiled <- alreadyCompiled
85 if compiled then decodeFile (elmi flags filePath) else compile
89 if compiled then decodeFile (elmi flags filePath) else compile
@@ -107,13 +111,15 @@ buildFile flags moduleNum numModules interfaces filePath =
107 metaModule <-
111 metaModule <-
108 case buildFromSource interfaces source of
112 case buildFromSource interfaces source of
109 Left err -> mapM print err >> exitFailure
113 Left err -> mapM print err >> exitFailure
115+ if print_program flags then print . pretty $ program modul else return ()
110− Right modul -> return (modul :: MetadataModule () ())
116+ return (modul :: MetadataModule () ())
111 if print_types flags then printTypes metaModule else return ()
118 if print_types flags then printTypes metaModule else return ()
112 tipes <- toSrcTypes (types metaModule)
119 tipes <- toSrcTypes (types metaModule)
113− let fmt (name, tvars, ctors) = (name, (length tvars, map fst ctors))
114− interface = ModuleInterface {
120+ let interface = ModuleInterface {
115 iTypes = tipes,
121 iTypes = tipes,
116− iAdts = Map.fromList . map fmt $ datatypes metaModule
122+ iAdts = datatypes metaModule
118 encodeFile (elmi flags filePath) interface
124 encodeFile (elmi flags filePath) interface
119 let js = jsModule metaModule
125 let js = jsModule metaModule
@@ -167,7 +173,7 @@ build flags rootFile = do
167 [ Source (if minify flags then Minified else Readable) js ]
173 [ Source (if minify flags then Minified else Readable) js ]
170−buildFiles :: Flags -> Int -> TypeLibrary -> [FilePath] -> IO TypeLibrary
176+buildFiles :: Flags -> Int -> Interfaces -> [FilePath] -> IO Interfaces
171buildFiles _ _ interfaces [] = return interfaces
177buildFiles _ _ interfaces [] = return interfaces
172buildFiles flags numModules interfaces (filePath:rest) = do
178buildFiles flags numModules interfaces (filePath:rest) = do
173 interface <- buildFile flags (numModules - length rest) numModules interfaces filePath
179 interface <- buildFile flags (numModules - length rest) numModules interfaces filePath