mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-25 13:58:40 +00:00
94 lines
3.5 KiB
Forth
94 lines
3.5 KiB
Forth
//------------------------------------------------------------------------------
|
|
// This code was generated by myriad.
|
|
// Changes to this file will be lost when the code is regenerated.
|
|
//------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
|
|
|
|
namespace ConsumePlugin
|
|
|
|
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
|
|
/// How to operate on the Pair case
|
|
abstract Pair : 'Expr -> 'Expr -> PairOpKind -> 'Expr
|
|
/// How to operate on the Sequential case
|
|
abstract Sequential : 'Expr list -> 'Expr
|
|
/// How to operate on the Builder case
|
|
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
|
|
/// How to operate on the Parent case
|
|
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>
|
|
/// TODO: doc
|
|
ExprBuilder : ExprBuilderCata<'Expr, 'ExprBuilder>
|
|
}
|
|
|
|
/// Methods to perform a catamorphism over the type Expr
|
|
[<RequireQualifiedAccess>]
|
|
module ExprCata =
|
|
[<RequireQualifiedAccess>]
|
|
type private Instruction =
|
|
| Process__Expr of Expr
|
|
| Process__ExprBuilder of ExprBuilder
|
|
| Expr_Pair of PairOpKind
|
|
| Expr_Sequential of int
|
|
| Expr_Builder
|
|
| ExprBuilder_Child
|
|
| ExprBuilder_Parent
|
|
|
|
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
|
|
| Instruction.Process__Expr x ->
|
|
match x with
|
|
| Expr.Const (arg0) -> cata.Expr.Const arg0 |> exprStack.Add
|
|
| Expr.Pair (arg0, arg1, arg2) -> ()
|
|
| Expr.Sequential (arg0) -> ()
|
|
| Expr.Builder (arg0, arg1) -> ()
|
|
| Instruction.Process__ExprBuilder x ->
|
|
match x with
|
|
| ExprBuilder.Child (arg0) -> ()
|
|
| ExprBuilder.Parent (arg0) -> ()
|
|
| Instruction.Expr_Pair (arg2) -> ()
|
|
| Instruction.Expr_Sequential (n) -> ()
|
|
| Instruction.Expr_Builder -> ()
|
|
| Instruction.ExprBuilder_Child -> ()
|
|
| Instruction.ExprBuilder_Parent -> ()
|
|
|
|
exprStack, exprBuilderStack
|
|
|
|
/// Execute the catamorphism.
|
|
let runExpr (cata : Cata<'ExprRet, 'ExprBuilderRet>) (x : Expr) : 'ExprRet =
|
|
let instructions = ResizeArray ()
|
|
instructions.Add (Instruction.Process__Expr 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.Process__ExprBuilder x)
|
|
let exprRetStack, exprBuilderRetStack = loop cata instructions
|
|
Seq.exactlyOne exprBuilderRetStack
|