CLI options to output IR and Lua AST

Unisay · Apr 1, 2024 · 282a388 · 282a388
1 parent ccc2df8
commit 282a388
Show file tree

Hide file tree

Showing 4 changed files with 107 additions and 48 deletions.
diff --git a/exe/Cli.hs b/exe/Cli.hs
@@ -13,6 +13,7 @@ import Options.Applicative
  ( Parser
  , eitherReader
  , execParser
+ , flag
  , fullDesc
  , header
  , helpDoc
@@ -25,7 +26,15 @@ import Options.Applicative
  , short
  , value
  )
-import Path (reldir, relfile, Dir, File, SomeBase (..), parseSomeDir, parseSomeFile)
+import Path
+ ( Dir
+ , File
+ , SomeBase (..)
+ , parseSomeDir
+ , parseSomeFile
+ , reldir
+ , relfile
+ )
 import Prettyprinter (Doc, annotate, flatAlt, indent, line, vsep, (<+>))
 import Prettyprinter qualified as PP
 import Prettyprinter.Render.Terminal (AnsiStyle, Color (..))
@@ -35,51 +44,69 @@ data Args = Args
  { foreignPath ∷ Tagged "foreign" (SomeBase Dir)
  , psOutputPath ∷ Tagged "output" (SomeBase Dir)
  , luaOutputFile ∷ Tagged "output-lua" (SomeBase File)
+ , outputIR ∷ Maybe ExtraOutput
+ , outputLuaAst ∷ Maybe ExtraOutput
  , appOrModule ∷ AppOrModule
  }
  deriving stock (Show)
 
+data ExtraOutput = OutputIR | OutputLuaAst
+ deriving stock (Eq, Show)
+
 options ∷ Parser Args
 options = do
  foreignPath ←
- option
- (eitherReader (bimap displayException Tagged . parseSomeDir))
- ( fold
- [ metavar "FOREIGN-PATH"
- , long "foreign-path"
- , value $ Tagged $ Rel [reldir|foreign|]
- , helpDoc . Just $
- "Path to a directory containing foreign files."
- <> linebreak
- <> bold "Default: foreign"
- ]
- )
+ option (eitherReader (bimap displayException Tagged . parseSomeDir)) $
+ fold
+ [ metavar "FOREIGN-PATH"
+ , long "foreign-path"
+ , value $ Tagged $ Rel [reldir|foreign|]
+ , helpDoc . Just $
+ "Path to a directory containing foreign files."
+ <> linebreak
+ <> bold "Default: foreign"
+ ]
+
  psOutputPath ←
- option
- (eitherReader (bimap displayException Tagged . parseSomeDir))
- ( fold
- [ metavar "PS-PATH"
- , long "ps-output"
- , value $ Tagged $ Rel [reldir|output|]
- , helpDoc . Just $
- "Path to purs output directory."
- <> linebreak
- <> bold "Default: output"
- ]
- )
+ option (eitherReader (bimap displayException Tagged . parseSomeDir)) $
+ fold
+ [ metavar "PS-PATH"
+ , long "ps-output"
+ , value $ Tagged $ Rel [reldir|output|]
+ , helpDoc . Just $
+ "Path to purs output directory."
+ <> linebreak
+ <> bold "Default: output"
+ ]
+
  luaOutputFile ←
- option
- (eitherReader (bimap displayException Tagged . parseSomeFile))
- ( fold
- [ metavar "LUA-OUT-FILE"
- , long "lua-output-file"
- , value $ Tagged $ Rel [relfile|main.lua|]
- , helpDoc . Just $
- "Path to write compiled Lua file to."
- <> linebreak
- <> bold "Default: main.lua"
- ]
- )
+ option (eitherReader (bimap displayException Tagged . parseSomeFile)) $
+ fold
+ [ metavar "LUA-OUT-FILE"
+ , long "lua-output-file"
+ , value $ Tagged $ Rel [relfile|main.lua|]
+ , helpDoc . Just $
+ "Path to write compiled Lua file to."
+ <> linebreak
+ <> bold "Default: main.lua"
+ ]
+
+ outputLuaAst ←
+ flag Nothing (Just OutputLuaAst) . fold $
+ [ long "output-lua-ast"
+ , helpDoc . Just $
+ "Output Lua AST."
+ <> linebreak
+ <> bold "Default: false"
+ ]
+ outputIR ←
+ flag Nothing (Just OutputIR) . fold $
+ [ long "output-ir"
+ , helpDoc . Just $
+ "Output IR."
+ <> linebreak
+ <> bold "Default: false"
+ ]
  appOrModule ←
  option (eitherReader parseAppOrModule) . fold $
  [ metavar "ENTRY"

diff --git a/exe/Main.hs b/exe/Main.hs
@@ -1,26 +1,30 @@
 module Main where
 
-import Cli (Args (luaOutputFile))
+import Cli (Args (luaOutputFile), ExtraOutput (..))
 import Cli qualified
 import Control.Monad.Oops qualified as Oops
 import Data.Tagged (Tagged (..))
+import Language.PureScript.Backend (CompilationResult (..))
 import Language.PureScript.Backend qualified as Backend
 import Language.PureScript.Backend.IR qualified as IR
 import Language.PureScript.Backend.Lua qualified as Lua
 import Language.PureScript.Backend.Lua.Printer qualified as Printer
 import Language.PureScript.CoreFn.Reader qualified as CoreFn
 import Language.PureScript.Names (runIdent, runModuleName)
 import Main.Utf8 qualified as Utf8
-import Path (Abs, Dir, Path, SomeBase (..), toFilePath)
+import Path (Abs, Dir, Path, SomeBase (..), replaceExtension, toFilePath)
 import Path.IO qualified as Path
 import Prettyprinter (defaultLayoutOptions, layoutPretty)
 import Prettyprinter.Render.Text (renderIO)
+import Text.Pretty.Simple (pHPrint)
 
 main ∷ IO ()
 main = Utf8.withUtf8 do
  Cli.Args
  { foreignPath
  , luaOutputFile
+ , outputIR
+ , outputLuaAst
  , psOutputPath
  , appOrModule
  } ←
@@ -37,9 +41,10 @@ main = Utf8.withUtf8 do
  Path.Abs a → pure a
  Path.Rel r → Path.makeAbsolute r
 
- putTextLn "Compiling modules:"
+ let extraOutputs = catMaybes [outputLuaAst, outputIR]
 
- luaChunk ←
+ CompilationResult {lua, ir} ← do
+ putTextLn "PS Lua: compiling ..."
  Backend.compileModules psOutputPath foreignDir appOrModule
  & handleModuleNotFoundError
  & handleModuleDecodingError
@@ -50,7 +55,17 @@ main = Utf8.withUtf8 do
  let outputFile = toFilePath luaOutput
  withFile outputFile WriteMode \h →
  renderIO h . layoutPretty defaultLayoutOptions $
- Printer.printLuaChunk luaChunk
+ Printer.printLuaChunk lua
+
+ when (OutputIR `elem` extraOutputs) do
+ irOutputFile ← toFilePath <$> replaceExtension ".ir" luaOutput
+ withFile irOutputFile WriteMode (`pHPrint` ir)
+ putTextLn $ "Wrote IR to " <> toText irOutputFile
+
+ when (OutputLuaAst `elem` extraOutputs) do
+ luaAstOutputFile ← toFilePath <$> replaceExtension ".lua-ast" luaOutput
+ withFile luaAstOutputFile WriteMode (`pHPrint` lua)
+ putTextLn $ "Wrote Lua AST to " <> toText luaAstOutputFile
 
  putTextLn $ "Wrote linked modules to " <> toText outputFile
 

diff --git a/lib/Language/PureScript/Backend.hs b/lib/Language/PureScript/Backend.hs
@@ -15,6 +15,11 @@ import Language.PureScript.CoreFn.Reader qualified as CoreFn
 import Path (Abs, Dir, Path, SomeBase)
 import Prelude hiding (show)
 
+data CompilationResult = CompilationResult
+ { ir ∷ Linker.UberModule
+ , lua ∷ Lua.Chunk
+ }
+
 compileModules
  ∷ e
  `CouldBeAnyOf` '[ CoreFn.ModuleNotFound
@@ -25,7 +30,7 @@ compileModules
  ⇒ Tagged "output" (SomeBase Dir)
  → Tagged "foreign" (Path Abs Dir)
  → AppOrModule
- → ExceptT (Variant e) IO Lua.Chunk
+ → ExceptT (Variant e) IO CompilationResult
 compileModules outputDir foreignDir appOrModule = do
  cfnModules ←
  CoreFn.readModuleRecursively outputDir (entryPointModule appOrModule)
@@ -38,8 +43,10 @@ compileModules outputDir foreignDir appOrModule = do
  & optimizedUberModule
  let needsRuntimeLazy = Tagged (any untag needsRuntimeLazys)
 
- Lua.fromUberModule foreignDir needsRuntimeLazy appOrModule uberModule
- <&> optimizeChunk
+ unoptimizedChunk ←
+ Lua.fromUberModule foreignDir needsRuntimeLazy appOrModule uberModule
+ pure
+ CompilationResult {lua = optimizeChunk unoptimizedChunk, ir = uberModule}
 
 linkerMode ∷ AppOrModule → Linker.LinkMode
 linkerMode = \case

diff --git a/test/Language/PureScript/Backend/Lua/PrinterSpec.hs b/test/Language/PureScript/Backend/Lua/PrinterSpec.hs
@@ -31,9 +31,9 @@ spec = do
  f = [Lua.name|foo|]
  renderedExpression (Lua.varField e f) `shouldBe` "({ foo = 1 }).foo"
 
- it "Assignment" do
- let s = Lua.assign (Lua.VarName [Lua.name|foo|]) (Lua.Boolean True)
- renderedStatement s `shouldBe` "foo = true"
+  it "Assignment" do
+  let s = Lua.assign (Lua.VarName [Lua.name|foo|]) (Lua.Boolean True)
+  renderedStatement s `shouldBe` "foo = true"
 
  describe "Local declaration" do
  it "without a value" do
@@ -114,6 +114,16 @@ spec = do
  , " return aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
  , "end"
  ]
+ it "function application" do
+ let expr =
+ Lua.functionCall
+ ( Lua.functionDef
+ [ParamNamed [Lua.name|a|], ParamNamed [Lua.name|b|]]
+ [Lua.return (Lua.varName [Lua.name|a|])]
+ )
+ [Lua.Integer 1, Lua.Integer 2]
+ renderedExpression expr
+ `shouldBe` "(function(a, b) return a end)(1, 2)"
 
  describe "expression" do
  describe "unary" do