prettyprinter.fs

let baseTyConString b =
    match b with
    | TyConNumber -> "Number"
    | TyConBool -> "Bool"
    | TyConUnit -> "()"
    | TyConUserDefined name -> name
    | _ -> sprintf "%A" b

let parens s = sprintf "(%s)" s

let rec flattenKindChain k =
    match k with
    | KFun (l, r) -> l::(flattenKindChain r)
    | Star -> [k]

let rec kindString k =
    match flattenKindChain k with
    | [Star] -> "*"
    | chain -> List.map (kindString >> parens) chain |> String.concat " -> "

let tyVarString (TyVar (name, _)) = sprintf "'%s" name
let tyConString (TyCon (baseTyCon, _)) = baseTyConString baseTyCon

let flattenTypeAppChain e =
    let rec flattenTypeAppChain' e accum =
        match e with
        | TApExpr (l, r) -> flattenTypeAppChain' l (r::accum)
        | _ -> e::accum
    flattenTypeAppChain' e []

let rec tyExprString e =
    match flattenTypeAppChain e with
    | [TConExpr (TyCon (TyConList, _)); elementTy] ->
        sprintf "[%s]" (tyExprString elementTy)
    | (TConExpr (TyCon (TyConFun, _)))::args ->
        List.map (tyExprString >> parens) args |> String.concat " -> "
    | (TConExpr (TyCon (TyConTuple, _)))::args ->
        List.map tyExprString args |> String.concat ", " |> (sprintf "(%s)")
    | (TVarExpr v)::args ->
        (tyVarString v)::(List.map (tyExprString >> parens) args) |> String.concat " "
    | (TConExpr (TyCon (TyConUserDefined name, _)))::args ->
        name::(List.map (tyExprString >> parens) args) |> String.concat " "
    | [TConExpr (TyCon (baseTyCon, _))] ->
        baseTyConString baseTyCon
    | _ ->
        // Use the F# pretty printer for all other cases
        sprintf "%A" e

let schemeString (Forall (tyvars, tau)) =
    sprintf "∀ %s . %s" (List.map tyVarString tyvars |> String.concat " ") (tyExprString tau)