structure Syntax =
struct
  (* SML syntax *)
  datatype etype =
    Tyvar of string
  | Tycon of etype list * string
  | TyTuple of etype list
  | Tyfun of etype * etype

  datatype pat =
    PWild
  | PVar of string
  | PInt of int
  | PTuple of pat list
  | PCon of string * pat

  datatype expr =
    EIdent of string list
  | EBuiltin of string
  | EInt of int
  | EStr of string
  | ETuple of expr list
  | EList of expr list
  | EApp of expr * expr
  | ETyped of expr * etype
  | EAndAlso of expr * expr
  | EOrElse of expr * expr
  | ELet of dec list * expr
  | ELambda of pat * expr
  | ECase of expr * (pat * expr) list

  and dec =
    DVal of pat * expr
  | DValRec of pat * expr
  | DDatatype of string * (string * etype option) list

  (* Lambda language *)
  type var = int

  datatype primop =
    PExit
  | PAdd
  | PSub
  | PMul
  | PDiv
  | PLess
  | PEq
  | PIf

  datatype lexp =
    LVar of var
  | LFn of var * lexp
  | LFix of (var * var * lexp) list * lexp
  | LApp of lexp * lexp
  | LInt of int
  | LString of string
  | LRecord of lexp list
  | LSelect of int * lexp
  | LPrim of primop
  | LSwitch of lexp * (int * lexp) list * lexp option

  (* CPS *)
  datatype value =
    VVar of var
  | VLabel of var
  | VInt of int
  | VString of string

  datatype cexp =
    CRecord of ((value * int list) list * var) list * cexp
  | CSelect of int * value * var * cexp
  | CApp of value * value list
  | CFix of (var * var list * cexp) list * cexp
  | CPrimop of primop * value list * var list * cexp list

  datatype opcode =
    OAlloc of var * value
  | OCall
  | OPoke of int * var * value
  | OPeek of var * int * value
  | OShuf of var * value
  | OExit of value
  | OAdd of var * value * value
  | OSub of var * value * value
  | OMul of var * value * value
  | ODiv of var * value * value
  | OLess of var * value * value
  | OEq of var * value * value
  | OIf of value * var
  | OLabel of var

  fun listToString (show : 'a -> string) (l : 'a list) =
    "[" ^ String.concatWith ", " (map show l) ^ "]"

  fun multilineListToString (show : string -> 'a -> string) (indent : string) (l : 'a list) =
    case l of
      [] => "[]"
    | [x] => "[ " ^ show (indent ^ "  ") x ^ " ]"
    | (x :: xs) =>
        let val indent' = indent ^ "  "
        in "[ " ^ show indent' x ^ concat (map (fn x => "\n" ^ indent ^ ", " ^ show indent' x) xs) ^ "\n" ^ indent ^ "]"
        end

  fun quote (s : string) : string = "\"" ^ String.toString s ^ "\""

  fun optionToString (show : 'a -> string) (x : 'a option) =
    case x of
      NONE => "NONE"
    | SOME x => "SOME " ^ show x

  fun etypeToString (x : etype) : string =
    case x of
      Tyvar s => "Tyvar " ^ quote s
    | Tycon (args, con) => "Tycon (" ^ listToString etypeToString args ^ ", " ^ quote con ^ ")"
    | TyTuple args => "TyTuple " ^ listToString etypeToString args
    | Tyfun (a, b) => "Tyfun (" ^ etypeToString a ^ ", " ^ etypeToString b ^ ")"

  fun patToString (p : pat) : string =
    case p of
      PWild => "PWild"
    | PVar v => "PVar " ^ quote v
    | PInt i => "PInt " ^ Int.toString i
    | PTuple pats => "PTuple " ^ listToString patToString pats
    | PCon (con, v) => "PCon " ^ "(" ^ quote con ^ ", " ^ patToString v ^ ")"

  fun exprToStringI (indent : string) (x : expr) : string =
    let val self = exprToStringI indent
    in case x of
         EIdent i => "EIdent " ^ listToString quote i
       | EBuiltin b => "EBuiltin " ^ quote b
       | EInt i => "EInt " ^ Int.toString i
       | EStr s => "EStr " ^ quote s
       | ETuple xs => "ETuple " ^ listToString self xs
       | EList l => "EList " ^ listToString self l
       | EApp (f, x) => "EApp (" ^ self f ^ ", " ^ self x ^ ")"
       | ETyped (e, t) => "ETyped (" ^ self e ^ ", " ^ etypeToString t ^ ")"
       | EAndAlso (a, b) => "EAndAlso (" ^ self a ^ ", " ^ self b ^ ")"
       | EOrElse (a, b) => "EOrElse (" ^ self a ^ ", " ^ self b ^ ")"
       | ELet (decs, e) => "ELet (" ^ multilineListToString decToStringI indent decs ^ ", " ^ self e ^ ")"
       | ELambda (pat, e) => "ELambda (" ^ patToString pat ^ ", " ^ exprToStringI indent e ^ ")"
       | ECase (e, branches) => "ECase (" ^ self e ^ ", " ^ multilineListToString (fn indent => fn (pat, body) => "(" ^ patToString pat ^ ", " ^ exprToStringI indent body ^ ")") indent branches ^ ")"
    end

  and decToStringI (indent : string) (x : dec) : string =
    case x of
      DVal (p, e) => "DVal (" ^ patToString p ^ ", " ^ exprToStringI indent e ^ ")"
    | DValRec (p, e) => "DValRec (" ^ patToString p ^ ", " ^ exprToStringI indent e ^ ")"
    | DDatatype (name, arms) => "DDatatype (" ^ quote name ^ ", " ^ listToString (fn (con, v) => "(" ^ quote con ^ ", " ^ optionToString etypeToString v ^ ")") arms ^ ")"

  val exprToString : expr -> string = exprToStringI ""

  val decToString : dec -> string = decToStringI ""

  fun primopToString (x : primop) : string =
    case x of
      PExit => "PExit"
    | PAdd => "PAdd"
    | PSub => "PSub"
    | PMul => "PMul"
    | PDiv => "PDiv"
    | PLess => "PLess"
    | PEq => "PEq"
    | PIf => "PIf"

  fun lexpToString (x : lexp) : string =
    case x of
      LVar v => "LVar " ^ Int.toString v
    | LFn (arg, expr) => "LFun (" ^ Int.toString arg ^ ", " ^ lexpToString expr ^ ")"
    | LFix (decls, body) => "LFix (" ^ listToString (fn (arg, var, expr) => "(" ^ Int.toString arg ^ ", " ^ Int.toString var ^ ", " ^ lexpToString expr ^ ")") decls ^ ", " ^ lexpToString body ^ ")"
    | LApp (a, b) => "LApp (" ^ lexpToString a ^ ", " ^ lexpToString b ^ ")"
    | LInt i => "LInt " ^ Int.toString i
    | LString s => "LString " ^ quote s
    | LRecord l => "LRecord " ^ listToString lexpToString l
    | LSelect (i, r) => "LSelect (" ^ Int.toString i ^ ", " ^ lexpToString r ^ ")"
    | LPrim p => "LPrim " ^ primopToString p
    | LSwitch (e, arms, otherwise) => "LSwitch (" ^ lexpToString e ^ ", " ^ listToString (fn (x, e) => "(" ^ Int.toString x ^ ", " ^ lexpToString e ^ ")") arms ^ ", " ^ optionToString lexpToString otherwise ^ ")"

  fun valueToString (x : value) : string =
    case x of
      VVar v => "VVar " ^ Int.toString v
    | VLabel l => "VLabel " ^ Int.toString l
    | VInt i => "VInt " ^ Int.toString i
    | VString s => "VString " ^ quote s

  fun cexpToStringI (indent : string) (x : cexp) : string =
    let
      val self = cexpToStringI indent
      val newIndent = indent ^ "\t"
    in case x of
         CRecord (records, c) => "CRecord (" ^ listToString (fn (a, b) => listToString (fn (x, y) => "(" ^ valueToString x ^ ", " ^ listToString Int.toString y ^ ")") a ^ ", " ^ Int.toString b ^ ")") records ^ ",\n" ^ indent ^ self c ^ ")"
       | CSelect (a, b, c, d) => "CSelect (" ^ Int.toString a ^ ", " ^ valueToString b ^ ", " ^ Int.toString c ^ ",\n" ^ indent ^ self d ^ ")"
       | CApp (a, b) => "CApp (" ^ valueToString a ^ ", " ^ listToString valueToString b ^ ")"
       | CFix (a, b) => "CFix (" ^ multilineListToString (fn indent' => fn (x, y, z) => "(" ^ Int.toString x ^ ", " ^ listToString Int.toString y ^ ",\n" ^ indent' ^ "\t" ^ cexpToStringI (indent' ^ "\t") z) newIndent a ^ ",\n" ^ newIndent ^ cexpToStringI newIndent b ^ ")"
       | CPrimop (a, b, c, d) => "CPrimop (" ^ primopToString a ^ ", " ^ listToString valueToString b ^ ", " ^ listToString Int.toString c ^ ",\n" ^ indent ^ multilineListToString cexpToStringI indent d ^ ")"
    end

  val cexpToString : cexp -> string = cexpToStringI ""

  fun opcodeToString (oper : opcode) : string =
    case oper of
      OAlloc (r, s) => "Var " ^ Int.toString r ^ " = OAlloc (" ^ valueToString s ^ ")"
    | OCall => "OCall"
    | OPoke (i, p, v) => "Var " ^ Int.toString p ^ "[" ^ Int.toString i ^ "] = " ^ valueToString v
    | OPeek (r, i, p) => "Var " ^ Int.toString r ^ " = " ^ valueToString p ^ "[" ^ Int.toString i ^ "]"
    | OShuf (d, s) => "Var " ^ Int.toString d ^ " = " ^ valueToString s
    | OExit v => "OExit (" ^ valueToString v ^ ")"
    | OAdd (r, v1, v2) => "Var " ^ Int.toString r ^ " = OAdd (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")"
    | OSub (r, v1, v2) => "Var " ^ Int.toString r ^ " = OSub (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")"
    | OMul (r, v1, v2) => "Var " ^ Int.toString r ^ " = OMul (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")"
    | ODiv (r, v1, v2) => "Var " ^ Int.toString r ^ " = ODiv (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")"
    | OLess (r, v1, v2) => "Var " ^ Int.toString r ^ " = OLess (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")"
    | OEq (r, v1, v2) => "Var " ^ Int.toString r ^ " = OEq (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")"
    | OIf (condition, target) => "OIf (" ^ valueToString condition ^ ") goto " ^ Int.toString target
    | OLabel l => "OLabel " ^ Int.toString l
end