From 282a3880b978e1dc90a55259b071d6c73f53072d Mon Sep 17 00:00:00 2001 From: Yura Lazarev Date: Mon, 1 Apr 2024 18:13:27 +0200 Subject: [PATCH] CLI options to output IR and Lua AST --- exe/Cli.hs | 101 +++++++++++------- exe/Main.hs | 25 ++++- lib/Language/PureScript/Backend.hs | 13 ++- .../PureScript/Backend/Lua/PrinterSpec.hs | 16 ++- 4 files changed, 107 insertions(+), 48 deletions(-) diff --git a/exe/Cli.hs b/exe/Cli.hs index 93bd804..839f586 100644 --- 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 index 527705b..1c66926 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -1,9 +1,10 @@ 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 @@ -11,16 +12,19 @@ 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 index d913a0e..090bca7 100644 --- 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 index 9c65c97..d0478fc 100644 --- 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