Commit 6a32b989 authored by POTTIER Francois's avatar POTTIER Francois

Printer improvements.

parent b6c8894b
...@@ -9,8 +9,15 @@ let indentation = 2 ...@@ -9,8 +9,15 @@ let indentation = 2
let block opening contents closing = let block opening contents closing =
group (opening ^^ nest indentation (contents) ^^ closing) group (opening ^^ nest indentation (contents) ^^ closing)
let oblock opening contents = (* -------------------------------------------------------------------------- *)
block opening contents empty
(* Bindings, or annotations: [x : t]. *)
let spacecolon =
string " :"
let binding x t =
block (x ^^ spacecolon) (space ^^ t) empty
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
......
...@@ -9,8 +9,15 @@ let indentation = 2 ...@@ -9,8 +9,15 @@ let indentation = 2
let block opening contents closing = let block opening contents closing =
group (opening ^^ nest indentation (contents) ^^ closing) group (opening ^^ nest indentation (contents) ^^ closing)
let oblock opening contents = (* -------------------------------------------------------------------------- *)
block opening contents empty
(* Bindings, or annotations: [x : t]. *)
let spacecolon =
string " :"
let binding x t =
block (x ^^ spacecolon) (space ^^ t) empty
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
......
...@@ -5,6 +5,9 @@ open F ...@@ -5,6 +5,9 @@ open F
let arrow = let arrow =
string "->" string "->"
let doublebackslash =
string "\\\\"
let forall = let forall =
string "forall" string "forall"
...@@ -28,18 +31,13 @@ and typ2 ty = ...@@ -28,18 +31,13 @@ and typ2 ty =
match ty with match ty with
| TyArrow (ty1, ty2) -> | TyArrow (ty1, ty2) ->
group (typ1 ty1 ^/^ arrow ^/^ typ2 ty2) group (typ1 ty1 ^/^ arrow ^/^ typ2 ty2)
| _ ->
typ1 ty
and typ3 ty =
match ty with
| TyForall (x, ty) -> | TyForall (x, ty) ->
group (forall ^/^ string x ^^ dot ^/^ typ3 ty) group (forall ^/^ string x ^^ dot ^/^ typ2 ty)
| _ -> | _ ->
typ2 ty typ1 ty
and typ ty = and typ ty =
typ3 ty typ2 ty
let rec term0 t = let rec term0 t =
match t with match t with
...@@ -68,27 +66,32 @@ and term1 t = ...@@ -68,27 +66,32 @@ and term1 t =
and term2 t = and term2 t =
match t with match t with
| TePair (t1, t2) -> | TePair (t1, t2) ->
term1 t1 ^^ comma ^/^ term2 t2 group (term1 t1 ^^ comma ^/^ term2 t2)
| _ -> | _ ->
term1 t term1 t
and term3 t = and term3 t =
match t with match t with
| TeAbs (x, ty, t) -> | TeAbs (x, ty, t) ->
oblock block
(backslash ^^ string x ^^ colon ^^ typ ty ^^ dot) (backslash ^^ string x ^^ spacecolon)
(term3 t) (break 1 ^^ typ ty)
(break 1 ^^ dot)
^/^
term3 t
| TeLet (x, t1, t2) -> | TeLet (x, t1, t2) ->
block block
(string "let" ^/^ string x ^/^ equals) (string "let" ^/^ string x ^/^ equals ^^ space)
(term t1) (term t1)
(string "in") (string " in")
^/^ ^/^
term t2 term t2
| TeTyAbs (a, t) -> | TeTyAbs (a, t) ->
oblock group (
(backslash ^^ backslash ^^ string a ^^ dot) doublebackslash ^^ string a ^^ space ^^ dot
(term3 t) ^/^
term3 t
)
| _ -> | _ ->
term2 t term2 t
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment