Example of type indexed values using mutual recursion with multiple type variables

generic-mutrec.sml

infix & +` *`

datatype ('a, 'b) stmt =
  Assign of 'a * ('a, 'b) expr
| If of ('a, 'b) expr * ('b, 'a) stmt list * ('a, 'b) stmt list
and ('a, 'b) expr =
  Stmt of ('a, 'a) stmt
| Int of 'b
| Bop of ('b, 'a) expr * ('a, 'b) expr

val stmt_expr = fn (a_, b_) =>
  let
    open Generic
    fun stmt (t1_, expr_1_2, stmt_2_1, stmt_1_2) =
      data'
        (C1' "Assign" (tuple2 (t1_, expr_1_2))
         +` C1' "If" (tuple3 (expr_1_2, list stmt_2_1, list stmt_1_2)))
        ( fn If ? => INR ? | Assign ? => INL ?
        , fn INR ? => If ? | INL ? => Assign ?
        )
    fun expr (t2_, stmt_1_1, expr_2_1, expr_1_2) =
      data'
        (C1' "Stmt" stmt_1_1 +` C1' "Int" t2_
         +` C1' "Bop" (tuple2 (expr_2_1, expr_1_2)))
        ( fn Bop ? => INR ? | Int ? => INL (INR ?) | Stmt ? => INL (INL ?)
        , fn INR ? => Bop ? | INL (INR ?) => Int ? | INL (INL ?) => Stmt ?
        )
    val op*` = Tie.*`
    val stmt & _ & _ & _ & expr & _ & _ & _ =
      Tie.fix (Y *` Y *` Y *` Y *` Y *` Y *` Y *` Y)
        (fn stmt_a_b & stmt_b_a & stmt_a_a & stmt_b_b & expr_a_b & expr_b_a &
             expr_a_a & expr_b_b =>
           stmt (a_, expr_a_b, stmt_b_a, stmt_a_b)
           & stmt (b_, expr_b_a, stmt_a_b, stmt_b_a)
           & stmt (a_, expr_a_a, stmt_a_a, stmt_a_a)
           & stmt (b_, expr_b_b, stmt_b_b, stmt_b_b)
           & expr (b_, stmt_a_a, expr_b_a, expr_a_b)
           & expr (a_, stmt_b_b, expr_a_b, expr_b_a)
           & expr (a_, stmt_a_a, expr_a_a, expr_a_a)
           & expr (b_, stmt_b_b, expr_b_b, expr_b_b))
  in
    (stmt, expr)
  end

val stmt = fn t => #1 (stmt_expr t)
val expr = fn t => #2 (stmt_expr t)

val sampleExpr = Stmt (If
  (Bop (Int 0, Int 1), [Assign (0, Int 2)], [Assign (1, (Bop (Int 3, Int 4)))]))
val sampleStmt = Assign ("hello", Bop (Int "hello", Int 1))

val _ =
  let
    open Generic
  in
    print (show (expr (int, int)) sampleExpr ^ "\n");
    print (show (stmt (string, int)) sampleStmt ^ "\n");
    print
      ((show (list (expr (int, int))) (children (expr (int, int)) (Bop
          (Bop (Int 1, Int 2), Bop (Int 3, Int 4))))) ^ "\n")
  end