Commits

Paweł Wieczorek committed 8d974c7

CWCPS on string painters

  • Participants
  • Parent commits 8675ea7
  • Branches port-stringpainter

Comments (0)

Files changed (3)

src/Language/CWCPS/CWCPS_PrettyPrinter.ml

  *)
 
 let show_type_variable var =
-    [ Formatter.Id (Identifier (string_of_type_variable var))
+    [ Formatter.psp_label (string_of_type_variable var)
     ]
 
 
 let show_with_brackets fmt =
-    [ Formatter.SyntaxPrefix "("
-    ; Formatter.Nested fmt
-    ; Formatter.SyntaxSuffix ")"
+    [ Formatter.psp_syntax "("
+    ; Formatter.psp_nested 0 fmt
+    ; Formatter.psp_syntax ")"
     ]
 
 let precedense_priority = function
 
 
 let rec show_type_expression _type = match _type with
-    | TP_Int -> [ Formatter.Keyword "int" ]
-    | TP_Bool -> [ Formatter.Keyword "bool" ]
-    | TP_Unit ->  [ Formatter.Keyword "unit" ]
+    | 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.Nested (show_type_expression tp_dom)
-        ; Formatter.Oper "->"
-        ; Formatter.Nested (show_type_expression tp_codom)
+        [ 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.Nested (show_type_expression tp_ref)
-        ; Formatter.Keyword "ref"
+        [ Formatter.psp_nested 0 (show_type_expression tp_ref)
+        ; Formatter.psp_keyword "ref"
         ]
 
     | TP_Variable tv ->
-        [ Formatter.Nested (show_type_variable tv)
+        [ Formatter.psp_nested 0 (show_type_variable tv)
         ]
 
 (*------------------------------------------------------------------------------------------------
  *)
 
 let show_arithmetic_binary_primitive_operation = function
-    | PRIMOP_Add -> [ Oper "+" ]
-    | PRIMOP_Sub -> [ Oper "-" ]
-    | PRIMOP_Mul -> [ Oper "*" ]
-    | PRIMOP_Div -> [ Oper "/" ]
-    | PRIMOP_Mod -> [ Oper "mod" ]
-    | PRIMOP_And -> [ Oper "and" ]
-    | PRIMOP_Or  -> [ Oper "or" ]
-    | PRIMOP_Xor -> [ Oper "xor "]
+    | 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 -> [ Oper "not" ]
-    | PRIMOP_Neg -> [ Oper "neg" ]
+    | PRIMOP_Not -> [ psp_operator "not" ]
+    | PRIMOP_Neg -> [ psp_operator "neg" ]
 
 let show_condition_primitive_operation = function
-    | PRIMOP_LT -> [ Oper "<" ]
-    | PRIMOP_LEQ -> [ Oper "<=" ]
-    | PRIMOP_EQ ->  [ Oper "=" ]
-    | PRIMOP_GT -> [ Oper ">" ]
-    | PRIMOP_GEQ -> [ Oper ">=" ]
-    | PRIMOP_NEQ -> [ Oper "<>" ]
+    | 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 ->
 
 and show_value_expression = function
     | VEXPR_Integer i -> 
-        [ Int i 
+        [ psp_value_int i 
         ]
 
     | VEXPR_Unit ->
-        [ Value "()"
+        [ psp_value "()"
         ]
 
     | VEXPR_Variable var ->
-        [ Var var
+        [ psp_variable var
         ]
 
 and show_lambda_expression = function
 
     | EXPR_App (_, value_expression, argument_values) ->
-        [ Nested (show_value_expression value_expression)
-        ; Nested (List.map (fun x -> Nested (show_value_expression x)) 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 =
-            [ Var variable
-            ; Nested (List.map (fun x -> Var x) argument_variables)
-            ; Oper "="
-            ; IndentBreak (show_expression binded_expression)
-            ; Break
-            ; Newline
+            [ 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' [Keyword "and"] aux in
+        let result = Util.concat_intersperse' [psp_keyword "and"] aux in
 
-        [ Keyword "let"
-        ; IndentBreak
-            [ Keyword "fix"
-            ; Nested result
+        [ psp_keyword "let"
+        ; psp_indent 0
+            [ psp_keyword "fix"
+            ; psp_nested 0 result
             ]
-        ; Keyword "in"
-        ; Break
-        ; Nested (show_expression expression)
+        ; psp_keyword "in"
+        ; psp_break
+        ; psp_nested 0 (show_expression expression)
         ] 
 
     | EXPR_ArithmeticBinaryPrimOp (label, operator, val1, val2, res, branch) ->
-        [ Keyword "let"
-        ; Keyword "primop"
-        ; Var res 
-        ; Oper "="
-        ; Nested (show_value_expression val1)
-        ; Nested (show_arithmetic_binary_primitive_operation operator)
-        ; Nested (show_value_expression val2)
-        ; Keyword "in"
-        ; Break
-        ; Nested (show_expression 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) ->
-        [ Keyword "let"
-        ; Keyword "primop"
-        ; Var res 
-        ; Oper "="
-        ; Nested (show_arithmetic_unary_primitive_operation operator)
-        ; Nested (show_value_expression val1)
-        ; Keyword "in"
-        ; Break
-        ; Nested (show_expression 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) ->
-        [ Keyword "if"
-        ; Keyword "primop"
-        ; Nested (show_value_expression val1)
-        ; Nested (show_condition_primitive_operation operator)
-        ; Nested (show_value_expression val2)
-        ; IndentBreak 
-            [ Keyword "then"
-            ; IndentBreak (show_expression branch1)
+        [ 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)
             ]
-        ; IndentBreak 
-            [ Keyword "else"
-            ; IndentBreak (show_expression branch2)
+        ; psp_indent 0 
+            [ psp_keyword "else"
+            ; psp_indent 0 (show_expression branch2)
             ]
         ]
 
     | EXPR_Switch (label, selval, default_branch, branches) ->
-        let f i expr = Nested
-            [ Oper "|"
-            ; Int i
-            ; Oper "->"
-            ; Break
-            ; IndentBreak (show_expression expr)
+        let f i expr = psp_nested 0
+            [ psp_operator "|"
+            ; psp_value_int i
+            ; psp_operator "->"
+            ; psp_break
+            ; psp_indent 0 (show_expression expr)
             ]
             in
-        [ Keyword "switch"
-        ; Nested (show_value_expression selval)
-        ; IndentBreak
+        [ psp_keyword "switch"
+        ; psp_nested 0 (show_value_expression selval)
+        ; psp_indent 0
             (BatList.mapi f branches)
-        ; IndentBreak 
-            [ Oper "|"
-            ; Syntax "_"
-            ; Oper "->"
-            ; IndentBreak (show_expression default_branch)
+        ; psp_indent 0 
+            [ psp_operator "|"
+            ; psp_syntax "_"
+            ; psp_operator "->"
+            ; psp_indent 0 (show_expression default_branch)
             ]
         ]
 
     | EXPR_Select (label, offset, value, result, in_expr) ->
-        [ Keyword "let"
-        ; Keyword "select"
-        ; Int offset
-        ; Keyword "from"
-        ; Nested (show_value_expression value)
-        ; Keyword "in"
-        ; Break
-        ; Nested (show_expression 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) ->
-        [ Keyword "let"
-        ; Keyword "offset"
-        ; Int offset
-        ; Keyword "from"
-        ; Nested (show_value_expression value)
-        ; Keyword "in"
-        ; Break
-        ; Nested (show_expression 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) ->
-        [ Keyword "let"
-        ; Keyword "record"
-        ; Syntax "("
-        ; Syntax ")"
-        ; Keyword "in"
-        ; Break
-        ; Nested (show_expression 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) ->
-        [ Keyword "let"
-        ; Keyword "record"
-        ; Syntax "("
-        ; Nested (show_value_expression (fst vf1))
-        ; Syntax ")"
-        ; Keyword "in"
-        ; Break
-        ; Nested (show_expression 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)
         ]
 
 (*------------------------------------------------------------------------------------------------
 let show_declaration = function
     | DECL_Fix (_, declarations)  ->
         let handle_def (_, name, argument_variables, expression) aux = 
-            [ Var name
-            ; Nested (List.map (fun x -> Var x) argument_variables)
-            ; Oper "="
-            ; NestedIndent (show_expression expression)
-            ; Break
-            ; Newline
+            [ 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' [Keyword "and"]  (List.fold_right handle_def declarations []) in
-        [ Keyword "let"
-        ; Keyword "fix"
-        ; Nested (result)
-        ; Break
+        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
         ] 
 
 (*------------------------------------------------------------------------------------------------
  * Type representation
  ************************************************************************************************)
 
-let print_program = Formatter.build_string -| show_program
+let print_program = Formatter.render_painter -| psp_nested 0 -| show_program
 
-let print_expression = Formatter.build_string -| show_expression
+let print_expression = Formatter.render_painter -| psp_nested 0 -| show_expression

src/Language/CWCPS/CWCPS_Util.ml

 
 
 let rec _show_closure mem args body env =
-        [ Formatter.SpecialValue "closure"
-        ; Formatter.Nested (List.map (fun x -> Formatter.Var x) args)
-        ; Formatter.Oper "->"
-        ; Formatter.Break
-        ; Formatter.IndentBreak (CWCPS_PrettyPrinter.show_expression body)
-        ; Formatter.IndentBreak 
-            [ Formatter.Nested (_show_environment mem env)
+        [ Formatter.psp_value_keyword "closure"
+        ; Formatter.psp_nested 0 (List.map (fun x -> Formatter.psp_variable x) args)
+        ; Formatter.psp_operator "->"
+        ; Formatter.psp_break
+        ; Formatter.psp_indent 0 (CWCPS_PrettyPrinter.show_expression body)
+        ; Formatter.psp_indent 0 
+            [ Formatter.psp_nested 0 (_show_environment mem env)
             ]
         ]
 
 and _show_real_value mem = function
-    | VAL_Integer i     -> [ Formatter.Int i ]
-    | VAL_Unit          -> [ Formatter.Value "()" ]
+    | VAL_Integer i     -> [ Formatter.psp_value_int i ]
+    | VAL_Unit          -> [ Formatter.psp_value "()" ]
     | VAL_Closure (args,body,env) ->  _show_closure mem args body env
 
 
         if not (is_closure v) then raise Not_found
         else ();
         let path = Hashtbl.find ht v in
-        [ Formatter.Id (Identifier (Util.concat_intersperse "." (List.rev path)))
+        [ Formatter.psp_identifier (Identifier (Util.concat_intersperse "." (List.rev path)))
         ]
     with
         Not_found ->
             _show_real_value (ht, mpath) v
 
 and _show_environment mem environment =
+    (*
     Environment.PrettyPrinter.show_environment _show_value update_mem mem environment
+    *)
+    raise Exit
 
 
 let show_value v = _show_value (Hashtbl.create 127, ["@"]) v
 
 let standard_io_driver = 
     let _read () = VAL_Integer (print_string "> "; read_int ()) in
-    let _write = print_endline -| Formatter.build_string -| ValuePrinter.show_value in
+    let _write = print_endline -| Formatter.render_painter -| Formatter.psp_nested 0 -| ValuePrinter.show_value in
     (_read, _write)
 
 end

src/Language/Language_drivers.ml

     let eval store ast = 
         CWCPS_Eval.eval_program store (IODriver.standard_io_driver) ast
 
-    let print_result = print_endline -| Formatter.build_string -| ValuePrinter.show_environment
+    let print_result i = (*print_endline -| Formatter.build_string -| ValuePrinter.show_environment*) raise Exit
 
     let print_typecheck_result _ = raise Exit
 
 let language_drivers =
     [ (module WHILE_driver  : Language_driver)
     ; (module MiniML_driver : Language_driver)
-    ; (module CWCPS_driver  : Language_driver)
+    (*; (module CWCPS_driver  : Language_driver)*)
     ]