Commits

Paweł Wieczorek committed aa44ba9

more interesting demo, arithmetic expressions

  • Participants
  • Parent commits 34ed641

Comments (0)

Files changed (2)

File demo/Demo.ml

 open StringPainter
 
-let one_line = sp_nested
-    [ sp_word "one"
-    ; sp_value_keyword "line"
-    ; sp_value "1"
-    ]
 
-let multi_line = sp_nested
-    [ sp_word "first_line"
-    ; sp_break
-    ; sp_word "second_line"
-    ]
+module ArithmeticExpressions = struct
 
-let sp_if cond expr0 expr1 =
-    if any_multiline [cond; expr0; expr1]
-    then sp_nested
-        [ sp_keyword "if"
-        ; sp_indent_when_multiline [cond]
-        ; sp_break
-        ; sp_keyword "then"
-        ; sp_indent_when_multiline [expr0]
-        ; sp_break
-        ; sp_keyword "else"
-        ; sp_indent_when_multiline [expr1]
-        ]
-    else sp_nested
-        [ sp_keyword "if"
-        ; cond
-        ; sp_keyword "then"
-        ; expr0
-        ; sp_keyword "else"
-        ; expr1
-        ]
+    type binop = Add | Sub | Mul | Div | Mod
+    type unop  = Neg
+
+    type expr
+        = Int of int
+        | Binop of binop * expr * expr
+        | Unop of unop * expr
+
+    let sp_binop = function
+        | Add ->
+            sp_operator "+"
+
+        | Sub ->
+            sp_operator "-"
+
+        | Mul ->
+            sp_operator "*"
+
+        | Div ->
+            sp_operator "/"
+
+        | Mod ->
+            sp_operator "mod"
+
+    let sp_unop = function
+        | Neg ->
+            sp_operator "-"
+
+    let rec sp_expr = function
+        | Int i ->
+            sp_value_int i
+
+        | Binop(op, e1, e2) -> sp_nested
+            [ sp_expr e1
+            ; sp_binop op
+            ; sp_expr e2
+            ]
+                
+
+        | Unop (op, e1) -> sp_nested
+            [ sp_unop op
+            ; sp_expr e1
+            ]
+
+
+    let expr1 = Int 5
+    let expr2 = Int 10
+    let expr3 = Int 15
+
+    (* (5 + 10) + 15 *)
+    let expr_12   = Binop(Add, expr1,   expr2)
+    let expr_12_3 = Binop(Add, expr_12, expr3)
+
+    (* 5 + (10 + 15) *)
+    let expr_23   = Binop(Add, expr2, expr3)
+    let expr_1_23 = Binop(Add, expr1, expr_23)
+
+end
+
+open ArithmeticExpressions
 
 ;;
 
-print_painter_nl (sp_if one_line one_line one_line)
-
-;;
-
-print_painter_nl (sp_if one_line one_line multi_line)
-
-;;
-
-print_painter_nl (sp_if one_line multi_line multi_line)
-
-
-;;
-
-print_painter_nl (sp_ml_list [])
-
-;;
-
-print_painter_nl (sp_ml_list [sp_value "1"])
-
-;;
-
-print_painter_nl (sp_ml_list [sp_value "1"; sp_value "2"])
-
+print_painter_nl (sp_expr expr_12_3 );;
+print_painter_nl (sp_expr expr_1_23 )

File src/StringPainter.ml

         { cs_keyword        : attribute list
         ; cs_value          : attribute list
         ; cs_value_keyword  : attribute list
+        ; cs_operator       : attribute list
         ; cs_syntax         : attribute list
         }
 
         { cs_keyword        = []
         ; cs_value          = []
         ; cs_value_keyword  = []
+        ; cs_operator       = []
         ; cs_syntax         = []
         }
 
         { cs_keyword        = [Bright; Underline]
         ; cs_value          = [Foreground Cyan]
         ; cs_value_keyword  = [Bright; Foreground Cyan]
+        ; cs_operator       = [Foreground Yellow]
         ; cs_syntax         = [Bright; Foreground Black]
         }
 
         { fcs_keyword       : string -> string
         ; fcs_value         : string -> string
         ; fcs_value_keyword : string -> string
+        ; fcs_operator      : string -> string
         ; fcs_syntax        : string -> string
         }
 
         { fcs_keyword       = escape cs.cs_keyword
         ; fcs_value         = escape cs.cs_value
         ; fcs_value_keyword = escape cs.cs_value_keyword
+        ; fcs_operator      = escape cs.cs_operator
         ; fcs_syntax        = escape cs.cs_syntax
         }
 end
                 | A_Keyword         -> internal.color_scheme.fcs_keyword
                 | A_Value           -> internal.color_scheme.fcs_value
                 | A_ValueKeyword    -> internal.color_scheme.fcs_value_keyword
-                | A_Oper            -> fun x -> x
+                | A_Oper            -> internal.color_scheme.fcs_operator
                 | A_Syntax          -> internal.color_scheme.fcs_syntax
 
 
                     ]
 
             | Word txt :: rest
-            | Label txt :: rest
+            | Label txt :: rest ->
+                process_text multiline rest 
+                    [ S_Text txt
+                    ; S_Text " "
+                    ]
+
             | Operator txt :: rest ->
                 process_text multiline rest 
-                    [ S_Text txt
+                    [ S_TextA (txt, A_Oper)
                     ; S_Text " "
                     ]
 
         [ Value txt
         ]
 
+    let sp_operator txt = preprocess
+        [ Operator txt
+        ]
+
     let sp_syntax txt = preprocess
         [ Syntax txt
         ]
         then sp_indent sp
         else sp_nested sp
 
+    let sp_value_int x = sp_value (string_of_int x)
+
 
     let sp_list opening closing separator = function
         | [] -> sp_nested