Permalink
Browse files

Added --dumpc flag

  • Loading branch information...
1 parent bb76c6c commit 4ff3b25441c231c2da55903eaff53054ca6b85f9 @edwinb edwinb committed Oct 7, 2012
Showing with 32 additions and 8 deletions.
  1. +3 −0 CHANGELOG
  2. +7 −4 src/IRTS/CodegenC.hs
  3. +2 −1 src/IRTS/Compiler.hs
  4. +1 −1 src/IRTS/LParser.hs
  5. +12 −0 src/Idris/AbsSyntax.hs
  6. +4 −2 src/Idris/AbsSyntaxTree.hs
  7. +2 −0 src/Idris/REPL.hs
  8. +1 −0 src/Main.hs
View
@@ -4,10 +4,13 @@ New in 0.9.4:
User visible changes:
* Simple packaging system
+* Added --dumpc flag for displaying generated code
Internal changes:
* Improve overloading resolution (especially where this is a type error)
+* Various important bug fixes with evaluation and compilation
+* More aggressive compile-time evaluation
New in 0.9.3:
-------------
View
@@ -16,15 +16,16 @@ import Control.Monad
data DbgLevel = NONE | DEBUG | TRACE
-codegenC :: [(Name, SDecl)] ->
+codegenC :: Maybe FilePath -> -- dump output
+ [(Name, SDecl)] ->
String -> -- output file name
Bool -> -- generate executable if True, only .o if False
[FilePath] -> -- include files
String -> -- extra object files
String -> -- extra compiler flags
DbgLevel ->
IO ()
-codegenC defs out exec incs objs libs dbg
+codegenC dump defs out exec incs objs libs dbg
= do -- print defs
let bc = map toBC defs
let h = concatMap toDecl (map fst bc)
@@ -45,12 +46,14 @@ codegenC defs out exec incs objs libs dbg
" " ++ tmpn ++
" `idris --link` `idris --include` " ++ libs ++
" -o " ++ out
- -- putStrLn cout
+ case dump of
+ Just co -> do writeFile co cout
+ Nothing -> return ()
exit <- system gcc
when (exit /= ExitSuccess) $
putStrLn ("FAILURE: " ++ gcc)
-headers [] = "#include <idris_rts.h>\n#include <idris_stdfgn.h>\n#include<assert.h>\n"
+headers [] = "#include <idris_rts.h>\n#include <idris_stdfgn.h>\n#include <assert.h>\n"
headers (x : xs) = "#include <" ++ x ++ ">\n" ++ headers xs
debug TRACE = "#define IDRIS_TRACE\n\n"
View
@@ -46,9 +46,10 @@ compile target f tm
-- iputStrLn $ showSep "\n" (map show (toAlist defuns))
let checked = checkDefs defuns (toAlist defuns)
+ dumpC <- getDumpC
case checked of
OK c -> case target of
- ViaC -> liftIO $ codegenC c f True hdrs
+ ViaC -> liftIO $ codegenC dumpC c f True hdrs
(concatMap mkObj objs)
(concatMap mkLib libs) NONE
ViaJava -> liftIO $ codegenJava c f
View
@@ -54,7 +54,7 @@ fovm f = do defs <- parseFOVM f
let checked = checkDefs defuns (toAlist defuns)
-- print checked
case checked of
- OK c -> codegenC c "a.out" True ["math.h"] "" "" TRACE
+ OK c -> codegenC Nothing c "a.out" True ["math.h"] "" "" TRACE
Error e -> fail $ show e
parseFOVM :: FilePath -> IO [(Name, LDecl)]
View
@@ -194,6 +194,18 @@ setLogLevel l = do i <- get
let opt' = opts { opt_logLevel = l }
put (i { idris_options = opt' } )
+setCmdLine :: [Opt] -> Idris ()
+setCmdLine opts = do i <- get
+ let iopts = idris_options i
+ put (i { idris_options = iopts { opt_cmdline = opts } })
+
+getDumpC :: Idris (Maybe FilePath)
+getDumpC = do i <- get
+ return $ findC (opt_cmdline (idris_options i))
+ where findC [] = Nothing
+ findC (DumpC x : _) = Just x
+ findC (_ : xs) = findC xs
+
logLevel :: Idris Int
logLevel = do i <- get
return (opt_logLevel (idris_options i))
@@ -31,11 +31,12 @@ data IOption = IOption { opt_logLevel :: Int,
opt_repl :: Bool,
opt_verbose :: Bool,
opt_ibcsubdir :: FilePath,
- opt_importdirs :: [FilePath]
+ opt_importdirs :: [FilePath],
+ opt_cmdline :: [Opt] -- remember whole command line
}
deriving (Show, Eq)
-defaultOpts = IOption 0 False False True False False True True "" []
+defaultOpts = IOption 0 False False True False False True True "" [] []
-- TODO: Add 'module data' to IState, which can be saved out and reloaded quickly (i.e
-- without typechecking).
@@ -171,6 +172,7 @@ data Opt = Filename String
| WarnOnly
| Pkg String
| BCAsm String
+ | DumpC String
| FOVM String
deriving (Show, Eq)
View
@@ -392,6 +392,7 @@ parseArgs ("--install":n:ns) = PkgInstall n : (parseArgs ns)
parseArgs ("--clean":n:ns) = PkgClean n : (parseArgs ns)
parseArgs ("--bytecode":n:ns) = NoREPL : BCAsm n : (parseArgs ns)
parseArgs ("--fovm":n:ns) = NoREPL : FOVM n : (parseArgs ns)
+parseArgs ("--dumpc":n:ns) = DumpC n : (parseArgs ns)
parseArgs (n:ns) = Filename n : (parseArgs ns)
help =
@@ -434,6 +435,7 @@ idrisMain opts =
let pkgdirs = opt getPkgDir opts
setREPL runrepl
setVerbose runrepl
+ setCmdLine opts
when (Verbose `elem` opts) $ setVerbose True
mapM_ makeOption opts
-- if we have the --fovm flag, drop into the first order VM testing
View
@@ -80,6 +80,7 @@ usagemsg = "Idris version " ++ ver ++ "\n" ++
"\t--noprelude Don't import the prelude\n" ++
"\t--typeintype Disable universe checking\n" ++
"\t--log [level] Set debugging log level\n" ++
+ "\t--dumpc [file] Dump generated C code\n" ++
"\t--libdir Show library install directory and exit\n" ++
"\t--link Show C library directories and exit (for C linking)\n" ++
"\t--include Show C include directories and exit (for C linking)\n"

0 comments on commit 4ff3b25

Please sign in to comment.