Source

Opifex / src / Language / CWCPS / CWCPS_PrettyPrinter.ml

The branch 'port-stringpainter' does not exist.
(*
 * Opifex
 *
 * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
 *)

open CWCPS_AST
open Formatter
open Batteries

(*************************************************************************************************
 ************************************************************************************************)


(*************************************************************************************************
 * Pretty printers
 ************************************************************************************************)

(*------------------------------------------------------------------------------------------------
 * Pretty printer for expression
 *)

let show_type_variable var =
    [ Formatter.psp_label (string_of_type_variable var)
    ]


let show_with_brackets fmt =
    [ Formatter.psp_syntax "("
    ; Formatter.psp_nested 0 fmt
    ; Formatter.psp_syntax ")"
    ]

let precedense_priority = function
    | TP_Ref _ -> 1
    | TP_Fun _ -> 2
    | _        -> 0


let rec show_type_expression _type = match _type with
    | TP_Int -> [ Formatter.psp_keyword "int" ]
    | TP_Bool -> [ Formatter.psp_keyword "bool" ]
    | TP_Unit ->  [ Formatter.psp_keyword "unit" ]
    | TP_Fun (tp_dom, tp_codom) ->
        show_with_brackets
        [ Formatter.psp_nested 0 (show_type_expression tp_dom)
        ; Formatter.psp_operator "->"
        ; Formatter.psp_nested 0 (show_type_expression tp_codom)
        ]

    | TP_Ref tp_ref ->
        [ Formatter.psp_nested 0 (show_type_expression tp_ref)
        ; Formatter.psp_keyword "ref"
        ]

    | TP_Variable tv ->
        [ Formatter.psp_nested 0 (show_type_variable tv)
        ]

(*------------------------------------------------------------------------------------------------
 * Pretty printer for expression
 *)

let show_arithmetic_binary_primitive_operation = function
    | PRIMOP_Add -> [ psp_operator "+" ]
    | PRIMOP_Sub -> [ psp_operator "-" ]
    | PRIMOP_Mul -> [ psp_operator "*" ]
    | PRIMOP_Div -> [ psp_operator "/" ]
    | PRIMOP_Mod -> [ psp_operator "mod" ]
    | PRIMOP_And -> [ psp_operator "and" ]
    | PRIMOP_Or  -> [ psp_operator "or" ]
    | PRIMOP_Xor -> [ psp_operator "xor "]

let show_arithmetic_unary_primitive_operation = function
    | PRIMOP_Not -> [ psp_operator "not" ]
    | PRIMOP_Neg -> [ psp_operator "neg" ]

let show_condition_primitive_operation = function
    | PRIMOP_LT -> [ psp_operator "<" ]
    | PRIMOP_LEQ -> [ psp_operator "<=" ]
    | PRIMOP_EQ ->  [ psp_operator "=" ]
    | PRIMOP_GT -> [ psp_operator ">" ]
    | PRIMOP_GEQ -> [ psp_operator ">=" ]
    | PRIMOP_NEQ -> [ psp_operator "<>" ]

let rec show_expression = function
    | lambda_expression ->
        show_lambda_expression lambda_expression

(*------------------------------------------------------------------------------------------------
 * Pretty printer for lambda_expression
 *)

and show_value_expression = function
    | VEXPR_Integer i -> 
        [ psp_value_int i 
        ]

    | VEXPR_Unit ->
        [ psp_value "()"
        ]

    | VEXPR_Variable var ->
        [ psp_variable var
        ]

and show_lambda_expression = function

    | EXPR_App (_, value_expression, argument_values) ->
        [ psp_nested 0 (show_value_expression value_expression)
        ; psp_nested 0 (List.map (fun x -> psp_nested 0 (show_value_expression x)) argument_values)
        ]

    | EXPR_Fix (_, definitions, expression) ->
        let handle_def (_, variable, argument_variables, binded_expression) aux =
            [ psp_variable variable
            ; psp_nested 0 (List.map (fun x -> psp_variable x) argument_variables)
            ; psp_operator "="
            ; psp_indent 0 (show_expression binded_expression)
            ; psp_break
            ; psp_newline
            ] :: aux in

        let aux = List.fold_right handle_def definitions [] in

        let result = Util.concat_intersperse' [psp_keyword "and"] aux in

        [ psp_keyword "let"
        ; psp_indent 0
            [ psp_keyword "fix"
            ; psp_nested 0 result
            ]
        ; psp_keyword "in"
        ; psp_break
        ; psp_nested 0 (show_expression expression)
        ] 

    | EXPR_ArithmeticBinaryPrimOp (label, operator, val1, val2, res, branch) ->
        [ psp_keyword "let"
        ; psp_keyword "primop"
        ; psp_variable res 
        ; psp_operator "="
        ; psp_nested 0 (show_value_expression val1)
        ; psp_nested 0 (show_arithmetic_binary_primitive_operation operator)
        ; psp_nested 0 (show_value_expression val2)
        ; psp_keyword "in"
        ; psp_break
        ; psp_nested 0 (show_expression branch)
        ]

    | EXPR_ArithmeticUnaryPrimOp (label, operator, val1, res, branch) ->
        [ psp_keyword "let"
        ; psp_keyword "primop"
        ; psp_variable res 
        ; psp_operator "="
        ; psp_nested 0 (show_arithmetic_unary_primitive_operation operator)
        ; psp_nested 0 (show_value_expression val1)
        ; psp_keyword "in"
        ; psp_break
        ; psp_nested 0 (show_expression branch)
        ]

    | EXPR_ConditionPrimOp (label, operator, val1, val2, branch1, branch2) ->
        [ psp_keyword "if"
        ; psp_keyword "primop"
        ; psp_nested 0 (show_value_expression val1)
        ; psp_nested 0 (show_condition_primitive_operation operator)
        ; psp_nested 0 (show_value_expression val2)
        ; psp_indent 0 
            [ psp_keyword "then"
            ; psp_indent 0 (show_expression branch1)
            ]
        ; psp_indent 0 
            [ psp_keyword "else"
            ; psp_indent 0 (show_expression branch2)
            ]
        ]

    | EXPR_Switch (label, selval, default_branch, branches) ->
        let f i expr = psp_nested 0
            [ psp_operator "|"
            ; psp_value_int i
            ; psp_operator "->"
            ; psp_break
            ; psp_indent 0 (show_expression expr)
            ]
            in
        [ psp_keyword "switch"
        ; psp_nested 0 (show_value_expression selval)
        ; psp_indent 0
            (BatList.mapi f branches)
        ; psp_indent 0 
            [ psp_operator "|"
            ; psp_syntax "_"
            ; psp_operator "->"
            ; psp_indent 0 (show_expression default_branch)
            ]
        ]

    | EXPR_Select (label, offset, value, result, in_expr) ->
        [ psp_keyword "let"
        ; psp_keyword "select"
        ; psp_value_int offset
        ; psp_keyword "from"
        ; psp_nested 0 (show_value_expression value)
        ; psp_keyword "in"
        ; psp_break
        ; psp_nested 0 (show_expression in_expr)
        ]

    | EXPR_Offset (label, offset, value, result, in_expr) ->
        [ psp_keyword "let"
        ; psp_keyword "offset"
        ; psp_value_int offset
        ; psp_keyword "from"
        ; psp_nested 0 (show_value_expression value)
        ; psp_keyword "in"
        ; psp_break
        ; psp_nested 0 (show_expression in_expr)
        ]

    | EXPR_Record (label, [], result, in_expr) ->
        [ psp_keyword "let"
        ; psp_keyword "record"
        ; psp_syntax "("
        ; psp_syntax ")"
        ; psp_keyword "in"
        ; psp_break
        ; psp_nested 0 (show_expression in_expr)
        ]

    | EXPR_Record (label, [vf1], result, in_expr) ->
        [ psp_keyword "let"
        ; psp_keyword "record"
        ; psp_syntax "("
        ; psp_nested 0 (show_value_expression (fst vf1))
        ; psp_syntax ")"
        ; psp_keyword "in"
        ; psp_break
        ; psp_nested 0 (show_expression in_expr)
        ]

(*------------------------------------------------------------------------------------------------
 * Pretty printer for declaration
 *)

let show_declaration = function
    | DECL_Fix (_, declarations)  ->
        let handle_def (_, name, argument_variables, expression) aux = 
            [ psp_variable name
            ; psp_nested 0 (List.map (fun x -> psp_variable x) argument_variables)
            ; psp_operator "="
            ; psp_indent 0 (show_expression expression)
            ; psp_break
            ; psp_newline
            ] :: aux in 
        let result = Util.concat_intersperse' [psp_keyword "and"]  (List.fold_right handle_def declarations []) in
        [ psp_keyword "let"
        ; psp_keyword "fix"
        ; psp_nested 0 (result)
        ; psp_break
        ] 

(*------------------------------------------------------------------------------------------------
 * Pretty printer for program
 *)

let show_program = function
    | PROGRAM declarations ->
       Util.concat_map show_declaration declarations

(*************************************************************************************************
 * Type representation
 ************************************************************************************************)

let print_program = Formatter.render_painter -| psp_nested 0 -| show_program

let print_expression = Formatter.render_painter -| psp_nested 0 -| show_expression