Skip to content

Commit

Permalink
fix lazy io stuff
Browse files Browse the repository at this point in the history
  • Loading branch information
flupe committed Jan 29, 2025
1 parent 8705a83 commit 9eb8875
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 22 deletions.
2 changes: 2 additions & 0 deletions src/LambdaBox/Env.hs
Original file line number Diff line number Diff line change
Expand Up @@ -164,6 +164,8 @@ instance Pretty (GlobalDecl t) where
hang "mutual inductive(s):" 2 $
vsep $ map pretty indBodies

TypeAliasDecl _ -> "type alias:"

instance Pretty (GlobalEnv t) where
pretty (GlobalEnv env) =
vsep $ flip map (reverse env) \(kn, d) ->
Expand Down
41 changes: 19 additions & 22 deletions src/Main.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
{-# LANGUAGE DeriveGeneric, DeriveAnyClass, NamedFieldPuns, OverloadedStrings #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GADTs, BangPatterns #-}
-- | The agda2lambox Agda backend
module Main (main) where

Expand Down Expand Up @@ -41,7 +41,7 @@ main :: IO ()
main = runAgda [agda2lambox]

data Output = RocqOutput | AstOutput
deriving (Generic, NFData)
deriving (Eq, Show, Generic, NFData)

-- | Backend options.
data Options = forall t. Options
Expand Down Expand Up @@ -91,7 +91,7 @@ agda2lambox = Backend backend
"Write output files to DIR. (default: project root)"
, Option ['t'] ["typed"] (NoArg typedOpt)
"Compile to typed λ□ environments."
, Option ['c'] ["rocq"] (NoArg typedOpt)
, Option ['c'] ["rocq"] (NoArg rocqOpt)
"Output a Rocq file."
]
, isEnabled = \ _ -> True
Expand Down Expand Up @@ -120,31 +120,28 @@ writeModule
-> TCM ModuleRes
writeModule opts menv NotMain _ _ = pure ()
writeModule Options{..} menv IsMain m defs = do
programs <- filterM hasPragma defs
outDir <- flip fromMaybe optOutDir <$> compileDir

defs' <- filterOutWhere defs

env <- compile optTarget $ reverse defs'
defs' <- filterOutWhere defs
env <- compile optTarget $ reverse defs'
programs <- filterM hasPragma defs'

liftIO $ createDirectoryIfMissing True outDir

let fileName = (outDir </>) . moduleNameToFileName m
coqMod = CoqModule env (map qnameToKName programs)


liftIO do
putStrLn $ "Writing " <> fileName ".txt"

pp coqMod <> "\n"
& writeFile (fileName ".txt")

case optOutput of
RocqOutput -> do
putStrLn $ "Writing " <> fileName ".v"
prettyCoq optTarget coqMod <> "\n"
& writeFile (fileName ".v")

AstOutput -> do
putStrLn $ "Writing " <> fileName ".ast"
prettySexp optTarget coqMod <> "\n"
& LText.writeFile (fileName ".ast")
pp coqMod <> "\n" & writeFile (fileName ".txt")

liftIO $ case optOutput of
RocqOutput -> do
putStrLn $ "Writing " <> fileName ".v"
prettyCoq optTarget coqMod <> "\n"
& writeFile (fileName ".v")

AstOutput -> do
putStrLn $ "Writing " <> fileName ".ast"
prettySexp optTarget coqMod <> "\n"
& LText.writeFile (fileName ".ast")

0 comments on commit 9eb8875

Please sign in to comment.