1 {- A simple driver that loads, typechecks, prepares, re-typechecks, and interprets the
2 GHC standard Prelude modules and an application module called Main.
4 Note that, if compiled under GHC, this requires a very large heap to run!
8 import System.Environment
21 -- You may need to change this.
22 baseDir = "../../libraries/"
25 -- Code for checking that the external and GHC printers print the same results
28 validateResults :: FilePath -> FilePath -> IO ()
29 validateResults origFile genFile = do
30 resultCode <- system $ "diff -u " ++ origFile ++ " " ++ genFile
31 putStrLn $ case resultCode of
32 ExitSuccess -> "Parse validated for " ++ origFile
33 ExitFailure 1 -> "Parse failed to validate for " ++ origFile
34 _ -> "Error diffing files: " ++ origFile ++ " " ++ genFile
35 ------------------------------------------------------------------------------
37 process :: Bool -> (Check.Menv,[Module]) -> String -> IO (Check.Menv,[Module])
38 process doTest (senv,modules) f =
39 do putStrLn ("Processing " ++ f)
40 resultOrErr <- parseCore f
43 putStrLn "Parse succeeded"
44 let outF = f ++ ".parsed"
45 writeFile outF (show m)
46 when doTest $ (validateResults f outF)
47 case checkModule senv m of
49 do putStrLn "Check succeeded"
50 let m' = prepModule senv' m
51 {- writeFile (f ++ ".prepped") (show m') -}
52 case checkModule senv m' of
54 do putStrLn "Recheck succeeded"
55 return (senv'',modules ++ [m'])
57 do putStrLn ("Recheck failed: " ++ s)
60 do putStrLn ("Check failed: " ++ s)
62 Left err -> do putStrLn ("Parse failed: " ++ show err)
65 main = do args <- getArgs
68 (f:fn:_) | f == testFlag -> (True,fn)
71 "usage: ./Driver [filename]"
72 mapM_ (process doTest (initialEnv,[])) (libs ++ [fname])
73 (_,modules) <- foldM (process doTest) (initialEnv,[]) (libs ++ [fname])
74 let result = evalProgram modules
75 putStrLn ("Result = " ++ show result)
77 where libs = map (baseDir ++) ["./ghc-prim/GHC/Generics.hcr",
78 "./ghc-prim/GHC/PrimopWrappers.hcr",
79 "./ghc-prim/GHC/Bool.hcr",
80 "./ghc-prim/GHC/IntWord64.hcr",
81 "./base/GHC/Base.hcr",
82 "./base/GHC/List.hcr",
83 "./base/GHC/Enum.hcr",
84 "./base/GHC/Show.hcr",
87 "./base/GHC/Real.hcr",
88 "./base/GHC/STRef.hcr",
90 "./base/GHC/Float.hcr",
91 "./base/GHC/Read.hcr",
93 "./base/GHC/Word.hcr",
95 "./base/GHC/Unicode.hcr",
96 "./base/GHC/IOBase.hcr",
98 "./base/GHC/Exception.hcr",
99 "./base/GHC/Stable.hcr",
100 "./base/GHC/Storable.hcr",
101 "./base/GHC/Pack.hcr",
102 "./base/GHC/Weak.hcr",
103 "./base/GHC/Handle.hcr",
105 "./base/GHC/Dotnet.hcr",
106 "./base/GHC/Environment.hcr",
107 "./base/GHC/Exts.hcr",
108 "./base/GHC/PArr.hcr",
109 "./base/GHC/TopHandler.hcr",
110 "./base/GHC/Desugar.hcr",
111 "./base/Data/Ord.hcr",
112 "./base/Data/Maybe.hcr",
113 "./base/Data/Bits.hcr",
114 "./base/Data/STRef/Lazy.hcr",
115 "./base/Data/Generics/Basics.hcr",
116 "./base/Data/Generics/Aliases.hcr",
117 "./base/Data/Generics/Twins.hcr",
118 "./base/Data/Generics/Instances.hcr",
119 "./base/Data/Generics/Text.hcr",
120 "./base/Data/Generics/Schemes.hcr",
121 "./base/Data/Tuple.hcr",
122 "./base/Data/String.hcr",
123 "./base/Data/Either.hcr",
124 "./base/Data/Char.hcr",
125 "./base/Data/List.hcr",
126 "./base/Data/HashTable.hcr",
127 "./base/Data/Typeable.hcr",
128 "./base/Data/Dynamic.hcr",
129 "./base/Data/Function.hcr",
130 "./base/Data/IORef.hcr",
131 "./base/Data/Fixed.hcr",
132 "./base/Data/Monoid.hcr",
133 "./base/Data/Ratio.hcr",
134 "./base/Data/STRef.hcr",
135 "./base/Data/Version.hcr",
136 "./base/Data/Complex.hcr",
137 "./base/Data/Unique.hcr",
138 "./base/Data/Foldable.hcr",
139 "./base/Data/Traversable.hcr"]