Commits

Paweł Wieczorek committed 24b11d4

added Lambda to Demo application

Comments (0)

Files changed (3)

 
        ]
 
+    
+    let test () = List.iter
+        (fun (s,x) -> print_string ">> "; print_endline s; print_painter_nl (psp_expr x); print_newline ())
+        exprs
 end
 
-open ArithmeticExpressions
-;;
 
-List.iter (fun (s,x) -> print_string ">> "; print_endline s; print_painter_nl (psp_expr x); print_newline ()) exprs
+module Lambda = struct
+    
+    type binop = ArithmeticExpressions.binop
 
+    type expr
+        = Var of string
+        | App of expr * expr
+        | Binop of binop
+        | Let of string * expr * expr
+        | Abs of string * expr
+
+    let app_priority = psp_max_priority - 50
+
+    let prio_expr = function
+        | Binop _
+        | Var _ -> psp_max_priority
+        | App _ -> app_priority
+        | Abs _ -> app_priority - 1
+        | Let _ -> app_priority - 1
+
+
+    let rec _psp_expr = function
+        | Binop op ->
+            ArithmeticExpressions.psp_binop op
+
+        | Var txt ->
+            psp_word txt
+
+        | App (e1, e2) -> psp_infix
+            LeftAssociative
+            app_priority
+            (psp_nested 0 [])
+            (psp_expr e1) (psp_expr e2)
+
+        | Abs (x,e) -> psp_nested 0
+            [ psp_keyword "fun"
+            ; psp_word x
+            ; psp_operator "->"
+            ; psp_expr e
+            ]
+
+        | Let (x, e1, e2) -> psp_nested 0
+            [ psp_keyword "let"
+            ; psp_word x
+            ; psp_operator "="
+            ; psp_expr e1
+            ; psp_keyword "in"
+            ; psp_expr e2
+            ]
+
+    and psp_expr tm = psp_reprioritize (prio_expr tm) (_psp_expr tm)
+
+
+    let expr_f = Var "f"
+    let expr_g = Var "g"
+    let expr_h = Var "h"
+
+    let expr_fg = App (expr_f, expr_g)
+    let expr_gh = App (expr_g, expr_h)
+
+    let expr_let_x_f_g = Let ("x", expr_f, expr_g)
+    let expr_let_y_g_h = Let ("y", expr_g, expr_h)
+
+    let expr_abs_x_x = Abs ("x", Var "x")
+    let expr_abs_x_f = Abs ("x", expr_f)
+    let expr_abs_x_g = Abs ("x", expr_g)
+
+    let exprs =
+        let mk_pair a b = (a,b) in
+        [ mk_pair
+            "(f g) h"
+            (App (expr_fg, expr_h))
+
+        ; mk_pair
+            "f (g h)"
+            (App (expr_f, expr_gh))
+
+        ; mk_pair
+            "let x = f in g"
+            expr_let_x_f_g
+
+        ; mk_pair
+            "let x = f in let y = g in h"
+            (Let ("x", expr_f, expr_let_y_g_h))
+
+        ; mk_pair
+            "fun x -> x"
+            expr_abs_x_x
+
+        ; mk_pair
+            "fun x -> let y = g in h"
+            (Abs ("x", expr_let_y_g_h))
+
+        ; mk_pair
+            "(fun x -> x) f"
+            (App(expr_abs_x_x, expr_f))
+
+        ; mk_pair
+            "(let id = (fun x -> x) in id) f"
+            (App(Let("id", expr_abs_x_x, Var "id"), expr_f))
+
+        ; mk_pair
+            "(fun x -> x) (fun x -> x)"
+            (App(expr_abs_x_x, expr_abs_x_x))
+
+        ; mk_pair
+            "fun x -> (f g)"
+            (Abs("x", App(expr_f, expr_g)))
+        ]
+
+    
+    let test () = List.iter
+        (fun (s,x) -> print_string ">> "; print_endline s; print_painter_nl (psp_expr x); print_newline ())
+        exprs
+
+end
+
+let _ = Lambda.test ()
     }
 
 let default_color_scheme =
-    { cs_keyword        = [Bright; Underline]
+    { cs_keyword        = [Bright; Underline; Foreground Blue]
     ; cs_value          = [Foreground Cyan]
     ; cs_value_keyword  = [Bright; Foreground Cyan]
     ; cs_operator       = [Foreground Yellow]
 
 let psp_reprioritize n (_, sp) = (n, sp)
 
-let psp_max_priority = pred max_int
+let psp_max_priority = pred max_int / 2
 
 (*--------------------------------------------------------------------------------------------------------------------
  * Basic combinators
  *)
 
+let psp_break           = with_priority psp_max_priority Engine.sp_break
+
 let psp_word            = embed_sp1 psp_max_priority Engine.sp_word
 let psp_keyword         = embed_sp1 psp_max_priority Engine.sp_keyword
 let psp_value           = embed_sp1 psp_max_priority Engine.sp_value