diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index dab8ed2..609d015 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -55,11 +55,11 @@ jobs: - name: Compile Hello.agda to Rust run: cabal run -- agda2rust ./test/hello.agda - - name: Install Rust latest nightly + - name: Install Rust uses: actions-rs/toolchain@v1 with: profile: minimal toolchain: stable - - name: Compile Hello - run: rustc --crate-type=lib test/Hello.rs + - name: Compile using Rust compiler output files + run: rustc --crate-type=lib test/hello.rs diff --git a/README.md b/README.md index 46bc3ca..f6c5f4e 100644 --- a/README.md +++ b/README.md @@ -5,15 +5,15 @@ ```sh cabal run -- agda2rust --help -cabal run -- agda2rust test/Hello.agda -cabal run -- agda2rust test/Test.agda +cabal run -- agda2rust test/hello.agda +cabal run -- agda2rust test/test.agda ``` * Testing compiled Rust code ```sh -rustc --crate-type=lib test/Hello.rs -rustc --crate-type=lib test/Test.rs +rustc --crate-type=lib test/hello.rs +rustc --crate-type=lib test/test.rs ``` # Working with source code diff --git a/src/Agda/Compiler/Rust/PrettyPrintingUtils.hs b/src/Agda/Compiler/Rust/PrettyPrintingUtils.hs index 4354107..f9d7a3b 100644 --- a/src/Agda/Compiler/Rust/PrettyPrintingUtils.hs +++ b/src/Agda/Compiler/Rust/PrettyPrintingUtils.hs @@ -1,13 +1,20 @@ module Agda.Compiler.Rust.PrettyPrintingUtils ( + argList, bracket, - indent, + combineLines, + defsSeparator, exprSeparator, - defsSeparator + funReturnTypeSeparator, + indent, + typeSeparator ) where bracket :: String -> String bracket str = "{\n" <> str <> "\n}" +argList :: String -> String +argList str = "(" <> str <> ")" + indent :: String indent = " " @@ -16,3 +23,12 @@ exprSeparator = " " defsSeparator :: String defsSeparator = "\n" + +typeSeparator :: String +typeSeparator = ":" + +funReturnTypeSeparator :: String +funReturnTypeSeparator = "->" + +combineLines :: [String] -> String +combineLines xs = unlines (filter (not . null) xs) diff --git a/src/Agda/Compiler/Rust/ToRustCompiler.hs b/src/Agda/Compiler/Rust/ToRustCompiler.hs index 16b9f58..d56bc78 100644 --- a/src/Agda/Compiler/Rust/ToRustCompiler.hs +++ b/src/Agda/Compiler/Rust/ToRustCompiler.hs @@ -9,19 +9,25 @@ import qualified Data.List.NonEmpty as Nel import Agda.Compiler.Backend ( IsMain ) import Agda.Syntax.Abstract.Name ( QName ) import Agda.Syntax.Common.Pretty ( prettyShow ) -import Agda.Syntax.Internal ( Clause ) -import Agda.Syntax.Internal ( qnameName, qnameModule ) -import Agda.Syntax.TopLevelModuleName ( TopLevelModuleName, moduleNameParts ) +import Agda.Syntax.Common ( Arg(..), ArgName, Named(..), moduleNameParts ) +import Agda.Syntax.Internal ( + Clause(..), DeBruijnPattern, DBPatVar(..), Dom(..), unDom, PatternInfo(..), Pattern'(..), + qnameName, qnameModule, Telescope, Tele(..), Term(..), Type, Type''(..) ) +import Agda.Syntax.TopLevelModuleName ( TopLevelModuleName ) import Agda.TypeChecking.Monad.Base ( Definition(..) ) import Agda.TypeChecking.Monad -import Agda.TypeChecking.CompiledClause ( CompiledClauses ) +import Agda.TypeChecking.CompiledClause ( CompiledClauses(..), CompiledClauses'(..) ) import Agda.Compiler.Rust.CommonTypes ( Options, CompiledDef, ModuleEnv ) import Agda.Compiler.Rust.PrettyPrintingUtils ( + argList, bracket, - indent, + combineLines, + defsSeparator, exprSeparator, - defsSeparator ) + funReturnTypeSeparator, + indent, + typeSeparator ) compile :: Options -> ModuleEnv -> IsMain -> Definition -> TCM CompiledDef compile _ _ _ Defn{..} @@ -41,7 +47,7 @@ compileDefn defName theDef = Function{funCompiled = funDef, funClauses = fc} -> compileFunction defName funDef fc _ -> - "UNSUPPORTED " <> showName defName <> " = " <> prettyShow theDef + "Unsupported compileDefn" <> showName defName <> " = " <> prettyShow theDef compileDataType :: QName -> [QName] -> CompiledDef compileDataType defName fields = "enum" <> exprSeparator @@ -58,23 +64,85 @@ compileFunction :: QName compileFunction defName funDef fc = "pub fn" <> exprSeparator <> showName defName - <> "(" - -- TODO handle multiple function clauses - <> compileFunctionArgument fc - <> ")" <> exprSeparator <> - bracket ( + <> argList ( + -- TODO handle multiple function clauses and arguments + compileFunctionArgument fc + <> typeSeparator <> exprSeparator + <> compileFunctionArgType fc ) + <> exprSeparator <> funReturnTypeSeparator <> exprSeparator <> compileFunctionResultType fc + <> exprSeparator <> bracket ( -- TODO proper indentation for every line of function body + -- including nested expressions + -- build intermediate AST and pretty printer for it indent <> compileFunctionBody funDef) <> defsSeparator +-- TODO this is hacky way to reach find first argument name, assuming function has 1 argument +-- TODO proper way is to handle deBruijn indices +-- TODO read docs for `data Clause` section in https://hackage.haskell.org/package/Agda-2.6.4.1/docs/Agda-Syntax-Internal.html +-- TODO start from uncommenting line below and figure out the path to match indices with name and type +-- compileFunctionArgument fc = show fc compileFunctionArgument :: [Clause] -> CompiledDef compileFunctionArgument [] = "" -compileFunctionArgument [fc] = prettyShow fc +compileFunctionArgument [fc] = fromDeBruijnPattern (namedThing (unArg (head (namedClausePats fc)))) compileFunctionArgument xs = error "unsupported compileFunctionArgument" ++ (show xs) +compileFunctionArgType :: [Clause] -> CompiledDef +compileFunctionArgType [ Clause{clauseTel = ct} ] = fromTelescope ct +compileFunctionArgType xs = error "unsupported compileFunctionArgType" ++ (show xs) + +fromTelescope :: Telescope -> CompiledDef +fromTelescope = \case + ExtendTel a _ -> fromDom a + other -> error ("unhandled fromType" ++ show other) + +fromDom :: Dom Type -> CompiledDef +fromDom x = fromType (unDom x) + +compileFunctionResultType :: [Clause] -> CompiledDef +compileFunctionResultType [Clause{clauseType = ct}] = fromMaybeType ct +compileFunctionResultType other = error ("unhandled compileFunctionResultType" ++ show other) + +fromMaybeType :: Maybe (Arg Type) -> CompiledDef +fromMaybeType (Just argType) = fromArgType argType +fromMaybeType other = error ("unhandled fromMaybeType" ++ show other) + +fromArgType :: Arg Type -> CompiledDef +fromArgType arg = fromType (unArg arg) + +fromType :: Type -> CompiledDef +fromType = \case + a@(El _ ue) -> fromTerm ue + other -> error ("unhandled fromType" ++ show other) + +fromTerm :: Term -> CompiledDef +fromTerm = \case + Def qname el -> fromQName qname + other -> error ("unhandled fromTerm" ++ show other) + +fromQName :: QName -> CompiledDef +fromQName x = prettyShow (qnameName x) + +fromDeBruijnPattern :: DeBruijnPattern -> CompiledDef +fromDeBruijnPattern = \case + VarP a b -> (dbPatVarName b) + a@(ConP x y z) -> show a + other -> error ("unhandled fromDeBruijnPattern" ++ show other) + +-- TODO this is wrong for function other than identity +-- see asFriday in Hello.agda vs Hello.rs compileFunctionBody :: Maybe CompiledClauses -> CompiledDef -compileFunctionBody funDef = prettyShow funDef +compileFunctionBody (Just funDef) = "return" <> exprSeparator <> fromCompiledClauses funDef +compileFunctionBody funDef = error ("unhandled compileFunctionBody " ++ show funDef) + +fromCompiledClauses :: CompiledClauses -> CompiledDef +fromCompiledClauses = \case + (Done (x:xs) term) -> fromArgName x + other -> error ("unhandled fromCompiledClauses " ++ show other) + +fromArgName :: Arg ArgName -> CompiledDef +fromArgName = unArg showName :: QName -> CompiledDef showName = prettyShow . qnameName @@ -82,11 +150,11 @@ showName = prettyShow . qnameName compileModule :: TopLevelModuleName -> [CompiledDef] -> String compileModule mName cdefs = moduleHeader (moduleName mName) - <> bracket (unlines (map prettyShow cdefs)) + <> bracket (combineLines (map prettyShow cdefs)) <> defsSeparator moduleName :: TopLevelModuleName -> String -moduleName n = prettyShow (Nel.head (moduleNameParts n)) +moduleName n = prettyShow (Nel.last (moduleNameParts n)) moduleHeader :: String -> String moduleHeader mName = "mod" <> exprSeparator <> mName <> exprSeparator diff --git a/test/Hello.rs b/test/Hello.rs deleted file mode 100644 index 4a1af99..0000000 --- a/test/Hello.rs +++ /dev/null @@ -1,9 +0,0 @@ -mod test { -enum Rgb { - Red, Green, Blue -} - - - - -} diff --git a/test/Test.rs b/test/Test.rs deleted file mode 100644 index 51a7f12..0000000 --- a/test/Test.rs +++ /dev/null @@ -1,2 +0,0 @@ -mod test { -} diff --git a/test/hello.agda b/test/hello.agda index 4df485a..42b057d 100644 --- a/test/hello.agda +++ b/test/hello.agda @@ -1,11 +1,52 @@ module test.hello where -- simple record type -data Rgb : Set where - Red Green Blue : Rgb -{-# COMPILE AGDA2RUST Rgb #-} +data TheRgb : Set where + Red Green Blue : TheRgb +{-# COMPILE AGDA2RUST TheRgb #-} -- simple function --- idRgb : Rgb → Rgb --- idRgb x = x --- {-# COMPILE AGDA2RUST idRgb #-} +idRgb : TheRgb → TheRgb +idRgb rgbArg = rgbArg +{-# COMPILE AGDA2RUST idRgb #-} + +data TheWeekDay : Set where + Monday Tuesday Wednesday Thursday Friday Saturday Sunday : TheWeekDay +{-# COMPILE AGDA2RUST TheWeekDay #-} + +-- asFriday : TheRgb → TheWeekDay +-- asFriday rgbArg = Friday -- TODO compile body +-- {-# COMPILE AGDA2RUST asFriday #-} + +-- TODO multiple clauses +-- day-color : TheWeekDay → TheRgb +-- day-color Saturday = green +-- day-color Sunday = blue +-- day-color _ = red +-- {-# COMPILE AGDA2RUST day-color #-} + +-- TODO multiple arguments +-- ≡Days? : TheWeekDay → TheWeekDay → TheRgb +-- ≡Days? Saturday Saturday = green +-- ≡Days? Sunday Sunday = blue +-- ≡Days? _ _ = red +-- {-# COMPILE AGDA2RUST ≡Days? #-} + +-- TODO polymorphic types + +-- TODO Data.Bool +-- TODO if expressions, and, or + +-- TODO Data.Nat +-- TODO arithmetic expressions + +-- TODO Lists + +-- TODO Data.String +-- TODO borrow types + +-- TODO Data.Product + +-- TODO Data.Sum + +-- recursive functions diff --git a/test/hello.rs b/test/hello.rs new file mode 100644 index 0000000..9d5183f --- /dev/null +++ b/test/hello.rs @@ -0,0 +1,13 @@ +mod hello { +enum TheRgb { + Red, Green, Blue +} +pub fn idRgb(rgbArg: TheRgb) -> TheRgb { + return rgbArg +} + +enum TheWeekDay { + Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday +} + +} diff --git a/test/Test.agda b/test/test.agda similarity index 100% rename from test/Test.agda rename to test/test.agda diff --git a/test/test.rs b/test/test.rs new file mode 100644 index 0000000..e69de29