Commits

camlspotter committed faf4f80

added more OCaml related operators

Comments (0)

Files changed (3)

+name="treeprint"
+version="@version@"
+description="Small tree structure printer with operator associations and precedences"
+requires="spotlib, ocaml_conv"
+archive(byte)="treeprint.cmo"
+archive(native)="treeprint.cmx"
+linkopts = ""
 
 module OCaml = struct
   let mbinop assoc lev sep = binop assoc lev ~op:(space ++ string sep ++ space)
+
+(*
+%nonassoc IN
+%nonassoc below_SEMI
+%nonassoc SEMI                          /* below EQUAL ({lbl=...; lbl=...}) */
+*)
+
+  let sequence = list 0.25 (string ";" ++ space)
+
+(*
+%nonassoc LET                           /* above SEMI ( ...; let ... in ...) */
+%nonassoc below_WITH
+%nonassoc FUNCTION WITH                 /* below BAR  (match ... with ...) */
+%nonassoc AND             /* above WITH (module rec A: SIG with ... and ...) */
+%nonassoc THEN                          /* below ELSE (if ... then ...) */
+%nonassoc ELSE                          /* (if ... then ... else ...) */
+*)
+
+  let if_then_else e1 e2 e3 = list 0.5 space [string "if"; reset e1; string "then"; e2; string "else"; e3]
+  let if_then e1 e2 = list 0.5 space [string "if"; reset e1; string "then"; e2]
+
+(*
+%nonassoc LESSMINUS                     /* below COLONEQUAL (lbl <- x := e) */
+%right    COLONEQUAL                    /* expr (e := e := e) */
+%nonassoc AS
+*)
+
+  let ty_as = mbinop Noassoc 0.6 "as"
+
+(*
+%left     BAR                           /* pattern (p|p|p) */
+%nonassoc below_COMMA
+%left     COMMA                         /* expr/expr_comma_list (e,e,e) */
+*)
+
+  let tuple = list 0.8 (string "," ++ space (* CR jfuruse: should be break *))
+
+(*
+%right    MINUSGREATER                  /* core_type2 (t -> t -> t) */
+*)
+
+  let ( ^-> ) = mbinop Right 0.9 "->"
+
+(*
+%right    OR BARBAR                     /* expr (e || e || e) */
+%right    AMPERSAND AMPERAMPER          /* expr (e && e && e) */
+%nonassoc below_EQUAL
+%left     INFIXOP0 EQUAL LESS GREATER   /* expr (e OP e OP e) */
+%right    INFIXOP1                      /* expr (e OP e OP e) */
+%right    COLONCOLON                    /* expr (e :: e :: e) */
+%left     INFIXOP2 PLUS PLUSDOT MINUS MINUSDOT  /* expr (e OP e OP e) */
+%left     INFIXOP3 STAR                 /* expr (e OP e OP e) */
+%right    INFIXOP4                      /* expr (e OP e OP e) */
+*)
+
   let (+) = mbinop Left 1.0 "+"
   let (-) = mbinop Left 1.0 "-"
   let ( * ) = mbinop Left 2.0 "*"
+
+  let ty_tuple = list 2.0 (space ++ string "* ")
+(*
+%nonassoc prec_unary_minus prec_unary_plus /* unary - */
+*)
+
+  let mprefix lev op = prefix lev ~op:(string op)
+  let uminus = mprefix 5.0 "-"
   
-  let ( ^-> ) = mbinop Right 1.0 "->"
+(*
+%nonassoc prec_constant_constructor     /* cf. simple_expr (C versus C x) */
+%nonassoc prec_constr_appl              /* above AS BAR COLONCOLON COMMA */
+%nonassoc below_SHARP
+%nonassoc SHARP                         /* simple_expr/toplevel_directive */
+%nonassoc below_DOT
+%nonassoc DOT
+/* Finally, the first tokens of simple_expr are above everything else. */
+%nonassoc BACKQUOTE BANG BEGIN CHAR FALSE FLOAT INT INT32 INT64
+          LBRACE LBRACELESS LBRACKET LBRACKETBAR LIDENT LPAREN
+          NEW NATIVEINT PREFIXOP STRING TRUE UIDENT
+*)
+
+  let app = binop Left 100.0 ~op:space (* CR jfuruse: contiguous spaces must be contracted *)
   
-  let mprefix lev op = prefix lev ~op:(string op)
-  let uminus = mprefix 3.0 "-"
-  
-  let tuple = list 1.0 (string "," ++ space (* CR jfuruse: should be break *))
-  
-  let app = binop Left 100.0 ~op:space (* CR jfuruse: contiguous spaces must be contracted *)
-  let sequence = list 0.25 (string ";" ++ space)
-  
-  let if_then_else e1 e2 e3 = list 0.5 space [string "if"; reset e1; string "then"; e2; string "else"; e3]
-  let if_then e1 e2 = list 0.5 space [string "if"; reset e1; string "then"; e2]
 end
 
 (** Drivers *)
   let num z = string (string_of_int z)
   let id x = string x
   let int = id "int"
+  let alpha = id "'a"
 
   let test t answer = 
     let str = Token.show (t Noassoc 0.0) in
     test (uminus (uminus (num 1))) "- -1";
     test (int ^-> int ^-> int) "int -> int -> int";
     test ((int ^-> int) ^-> int) "(int -> int) -> int";
+    test (ty_as (int ^-> int ^-> int) alpha) "int -> int -> int as 'a";
+    test ((ty_as (int ^-> int) alpha) ^-> int) "(int -> int as 'a) -> int";
     test (tuple [num 1; num 2; num 3]) "1, 2, 3";
     test (tuple [num 1; tuple [num 2; num 3]; num 4]) "1, (2, 3), 4";
     test (app (app (id "x") (id "y")) (id "z")) "x y z";
 
 (** OCaml like printers *)
 module OCaml : sig
+  val sequence     : ppr list -> ppr
+  val if_then_else : ppr -> ppr -> ppr -> ppr
+  val if_then      : ppr -> ppr -> ppr
+  val ty_as         : ppr -> ppr -> ppr (** for [t as 'a] *)
+  val tuple        : ppr list -> ppr
+  val ( ^-> )      : ppr -> ppr -> ppr
   val ( + )        : ppr -> ppr -> ppr
   val ( - )        : ppr -> ppr -> ppr
   val ( * )        : ppr -> ppr -> ppr
+  val ty_tuple     : ppr list -> ppr
   val uminus       : ppr -> ppr
-  val tuple        : ppr list -> ppr
-  val ( ^-> )      : ppr -> ppr -> ppr
   val app          : ppr -> ppr -> ppr
-  val sequence     : ppr list -> ppr
-  val if_then_else : ppr -> ppr -> ppr -> ppr
-  val if_then      : ppr -> ppr -> ppr
 end
 
 (** Drivers *)