patrick/WoofWare.Myriad
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.Myriad synced 2025-10-30 08:08:59 +00:00
Code Issues Packages Projects Releases Wiki Activity

Add match clause

Browse Source
This commit is contained in:
Smaug123
2024-02-16 14:26:41 +00:00
parent b7f7db8c11
commit d651aae6fb
2 changed files with 111 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

43
ConsumePlugin/GeneratedCatamorphism.fs
View File

@@ -14,28 +14,28 @@ open WoofWare.Myriad.Plugins
/// Description of how to combine cases during a fold
type ExprCata<'Expr, 'ExprBuilder> =
/// How to operate on the Const case
abstract Const : Const -> 'Expr
abstract Const: Const -> 'Expr
/// How to operate on the Pair case
abstract Pair : 'Expr -> 'Expr -> PairOpKind -> 'Expr
abstract Pair: 'Expr -> 'Expr -> PairOpKind -> 'Expr
/// How to operate on the Sequential case
abstract Sequential : 'Expr list -> 'Expr
abstract Sequential: 'Expr list -> 'Expr
/// How to operate on the Builder case
abstract Builder : 'Expr -> 'ExprBuilder -> 'Expr
abstract Builder: 'Expr -> 'ExprBuilder -> 'Expr
/// Description of how to combine cases during a fold
type ExprBuilderCata<'Expr, 'ExprBuilder> =
/// How to operate on the Child case
abstract Child : 'ExprBuilder -> 'ExprBuilder
abstract Child: 'ExprBuilder -> 'ExprBuilder
/// How to operate on the Parent case
abstract Parent : 'Expr -> 'ExprBuilder
abstract Parent: 'Expr -> 'ExprBuilder
/// Specifies how to perform a fold (catamorphism) over the type Expr.
type Cata<'Expr, 'ExprBuilder> =
{
/// TODO: doc
Expr : ExprCata<'Expr, 'ExprBuilder>
Expr: ExprCata<'Expr, 'ExprBuilder>
/// TODO: doc
ExprBuilder : ExprBuilderCata<'Expr, 'ExprBuilder>
ExprBuilder: ExprBuilderCata<'Expr, 'ExprBuilder>
}
/// Methods to perform a catamorphism over the type Expr
@@ -51,21 +51,30 @@ module ExprCata =
| ExprBuilderChild
| ExprBuilderParent
let private loop (cata : Cata<_, _>) (instructions : ResizeArray<Instruction>) =
let ExprBuilderStack = ResizeArray ()
let ExprStack = ResizeArray ()
let private loop (cata: Cata<_, _>) (instructions: ResizeArray<Instruction>) =
let ExprBuilderStack = ResizeArray()
let ExprStack = ResizeArray()
while instructions.Count > 0 do
let currentInstruction = instructions.[instructions.Count - 1]
instructions.RemoveAt(instructions.Count - 1)
match currentInstruction with
ExprStack, ExprBuilderStack
/// Execute the catamorphism.
let runExpr (cata : Cata<'ExprRet, 'ExprBuilderRet>) (x : Expr) : 'ExprRet =
let instructions = ResizeArray ()
instructions.Add (Instruction.ProcessExpr x)
let runExpr (cata: Cata<'ExprRet, 'ExprBuilderRet>) (x: Expr) : 'ExprRet =
let instructions = ResizeArray()
instructions.Add(Instruction.ProcessExpr x)
let ExprRetStack, ExprBuilderRetStack = loop cata instructions
Seq.exactlyOne ExprRetStack
/// Execute the catamorphism.
let runExprBuilder (cata : Cata<'ExprRet, 'ExprBuilderRet>) (x : ExprBuilder) : 'ExprBuilderRet =
let instructions = ResizeArray ()
instructions.Add (Instruction.ProcessExprBuilder x)
let runExprBuilder (cata: Cata<'ExprRet, 'ExprBuilderRet>) (x: ExprBuilder) : 'ExprBuilderRet =
let instructions = ResizeArray()
instructions.Add(Instruction.ProcessExprBuilder x)
let ExprRetStack, ExprBuilderRetStack = loop cata instructions
Seq.exactlyOne ExprBuilderRetStack

85
WoofWare.Myriad.Plugins/CataGenerator.fs
View File

@@ -546,6 +546,21 @@ module internal CataGenerator =
}
)
let minusN (ident : SynLongIdent) (n : int) : SynExpr =
SynExpr.CreateApp (
SynExpr.CreateAppInfix (
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
[ Ident.Create "op_Subtraction" ],
[],
[ Some (IdentTrivia.OriginalNotation "-") ]
)
),
SynExpr.CreateLongIdent ident
),
SynExpr.CreateConst (SynConst.Int32 n)
)
let createLoopFunction (allUnionTypes : SynTypeDefn list) : SynBinding =
let valData =
SynValData.SynValData (
@@ -608,9 +623,79 @@ module internal CataGenerator =
List.last(getName ty).idText + "Stack" |> Ident.Create
)
let matchStatement =
SynExpr.CreateMatch (SynExpr.CreateIdentString "currentInstruction", [])
let body =
SynExpr.CreateSequential
[
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "instructions" ; "RemoveAt" ]),
SynExpr.CreateParen (minusN (SynLongIdent.Create [ "instructions" ; "Count" ]) 1)
)
matchStatement
]
let body =
SynExpr.LetOrUse (
false,
false,
[
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Empty,
SynValData.SynValData (None, SynValInfo.SynValInfo ([], SynArgInfo.Empty), None),
SynPat.CreateNamed (Ident.Create "currentInstruction"),
None,
SynExpr.DotIndexedGet (
SynExpr.CreateIdentString "instructions",
minusN (SynLongIdent.Create [ "instructions" ; "Count" ]) 1,
range0,
range0
),
range0,
DebugPointAtBinding.Yes range0,
{
LeadingKeyword = SynLeadingKeyword.Let range0
InlineKeyword = None
EqualsRange = Some range0
}
)
],
body,
range0,
{
InKeyword = None
}
)
let body =
SynExpr.CreateSequential
[
SynExpr.While (
DebugPointAtWhile.Yes range0,
SynExpr.CreateApp (
SynExpr.CreateAppInfix (
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
[ Ident.Create "op_GreaterThan" ],
[],
[ Some (IdentTrivia.OriginalNotation ">") ]
)
),
SynExpr.CreateLongIdent (SynLongIdent.Create [ "instructions" ; "Count" ])
),
SynExpr.CreateConst (SynConst.Int32 0)
),
body,
range0
)
SynExpr.CreateTuple (
stackNames
|> List.map (List.singleton >> SynLongIdent.CreateFromLongIdent >> SynExpr.CreateLongIdent)