Skip to content

Commit

Permalink
compile record name
Browse files Browse the repository at this point in the history
  • Loading branch information
lemastero committed Dec 19, 2023
1 parent 6c45d5b commit f42ebab
Show file tree
Hide file tree
Showing 5 changed files with 31 additions and 17 deletions.
16 changes: 11 additions & 5 deletions src/Agda/Compiler/Rust/AgdaToRustExpr.hs
Original file line number Diff line number Diff line change
Expand Up @@ -30,22 +30,28 @@ compile _ _ _ Defn{..}

compileDefn :: QName -> Defn -> CompiledDef
compileDefn defName theDef =
-- https://hackage.haskell.org/package/Agda/docs/Agda-Compiler-Backend.html#t:Defn
case theDef of
Datatype{dataCons = fields} ->
compileDataType defName fields
Function{funCompiled = funDef, funClauses = fc} ->
compileFunction defName funDef fc
_ ->
Unhandled "compileDefn" (show defName ++ " = " ++ show theDef)
RecordDefn(RecordData{_recFields = recFields, _recTel = recTel}) ->
compileRecord defName recFields recTel
other ->
Unhandled "compileDefn" (show defName ++ "\n = \n" ++ show theDef)

compileDataType :: QName -> [QName] -> CompiledDef
compileDataType defName fields = TeEnum (showName defName) (map showName fields)
compileDataType defName fields = ReEnum (showName defName) (map showName fields)

compileRecord :: QName -> [Dom QName] -> Telescope -> CompiledDef
compileRecord defName recFields recTel = ReRec (showName defName) (prettyShow recTel)

compileFunction :: QName
-> Maybe CompiledClauses
-> [Clause]
-> CompiledDef
compileFunction defName funDef fc = TeFun
compileFunction defName funDef fc = ReFun
(showName defName)
(RustElem (compileFunctionArgument fc) (compileFunctionArgType fc))
(compileFunctionResultType fc)
Expand Down Expand Up @@ -120,7 +126,7 @@ showName = prettyShow . qnameName

compileModule :: TopLevelModuleName -> [CompiledDef] -> CompiledDef
compileModule mName cdefs =
TeMod (moduleName mName) cdefs
ReMod (moduleName mName) cdefs

moduleName :: TopLevelModuleName -> String
moduleName n = prettyShow (Nel.last (moduleNameParts n))
9 changes: 6 additions & 3 deletions src/Agda/Compiler/Rust/PrettyPrintingUtils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,15 +6,15 @@ import Agda.Compiler.Rust.RustExpr ( RustExpr(..), RustElem(..), FunBody )

prettyPrintRustExpr :: CompiledDef -> String
prettyPrintRustExpr def = case def of
(TeEnum name fields) ->
(ReEnum name fields) ->
"enum" <> exprSeparator
<> name
<> exprSeparator
<> bracket (
indent -- TODO this is too simplistic indentation
<> concat (intersperse ", " fields))
<> defsSeparator
(TeFun fName (RustElem aName aType) resType fBody) ->
(ReFun fName (RustElem aName aType) resType fBody) ->
"pub fn" <> exprSeparator
<> fName
<> argList (
Expand All @@ -25,12 +25,15 @@ prettyPrintRustExpr def = case def of
<> exprSeparator <> bracket (
indent <> (prettyPrintFunctionBody fBody))
<> defsSeparator
(TeMod mName defs) ->
(ReMod mName defs) ->
moduleHeader mName
<> bracket (
defsSeparator -- empty line before first definition in module
<> combineLines (map prettyPrintRustExpr defs))
<> defsSeparator
(ReRec name payload) -> "pub struct" <> exprSeparator <> name
<> exprSeparator <> (bracket payload)
<> defsSeparator
(Unhandled name payload) -> ""
-- XXX at the end there should be no Unhandled expression
-- other -> "unsupported prettyPrintRustExpr " ++ (show other)
Expand Down
9 changes: 5 additions & 4 deletions src/Agda/Compiler/Rust/RustExpr.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,12 +15,13 @@ data RustElem = RustElem RustName RustType
deriving ( Show )

data RustExpr
= TeMod RustName [RustExpr]
| TeEnum RustName [RustName]
| TeFun RustName RustElem RustType FunBody
= ReMod RustName [RustExpr]
| ReEnum RustName [RustName]
| ReFun RustName RustElem RustType FunBody -- TODO [RustElem]
| ReRec RustName RustName -- TODO [RustElem]
| Unhandled RustName String
deriving ( Show )

unHandled :: RustExpr -> Bool
unHandled (Unhandled _ _) = True
unHandled (Unhandled "" "") = True
unHandled _ = False
10 changes: 5 additions & 5 deletions test/hello.agda
Original file line number Diff line number Diff line change
Expand Up @@ -18,11 +18,11 @@ id_rgb x = x

-- product types

-- record ThePair : Set where
-- field
-- pairFst : Rgb
-- pairSnd : WeekDay
-- {-# COMPILE AGDA2RUST ThePair #-}
record ThePair : Set where
field
pairFst : Rgb
pairSnd : WeekDay
{-# COMPILE AGDA2RUST ThePair #-}

-- record Foo (A : Set) : Set where
-- field
Expand Down
4 changes: 4 additions & 0 deletions test/hello.rs
Original file line number Diff line number Diff line change
Expand Up @@ -12,5 +12,9 @@ pub fn id_rgb(x: Rgb) -> Rgb {
return x;
}

pub struct ThePair {
(pairFst : test.hello.Rgb) (pairSnd : test.hello.WeekDay)
}


}

0 comments on commit f42ebab

Please sign in to comment.