feat: pretty printer for AST

NeML.opam

@@ -17,6 +17,7 @@ depends: [
   "ocaml"
   "dune" {>= "3.15"}
   "base"
+  "pprint"
   "stdio"
   "angstrom"
   "ppx_deriving"

dune-project

@@ -21,4 +21,4 @@
  (name NeML)
  (synopsis "NeML compiler")
  (description "A compiler for some non-existent programming language")
- (depends ocaml dune base stdio angstrom ppx_deriving ppx_expect))
+ (depends ocaml dune base pprint stdio angstrom ppx_deriving ppx_expect))

lib/ast/LAst.ml

@@ -15,7 +15,6 @@ module Const = struct
     | Char of char  (** Character such as ['c'] *)
     | String of string
         (** Constant string such as ["constant"] or [{|other constant|}] *)
-  [@@deriving show {with_path= false}]
 end
 
 module Ty = struct
@@ -29,7 +28,6 @@ module Ty = struct
           - [T tconstr]             when [l=[T]]
           - [(T1, ..., Tn) tconstr] when [l=[T1, ..., Tn]]
         *)
-  [@@deriving show {with_path= false}]
 end
 
 module Pat = struct
@@ -45,17 +43,15 @@ module Pat = struct
           - [C P] when [arg] is [Some P]
         *)
     | Constraint of t * Ty.t  (** [(P : T)] *)
-  [@@deriving show {with_path= false}]
 end
 
 module Expr = struct
-  type rec_flag = Rec | Nonrec [@@deriving show {with_path= false}]
+  type rec_flag = Rec | Nonrec
 
   type value_binding = {pat: Pat.t; expr: t}
-  [@@deriving show {with_path= false}]
 
   (** Pattern matching case *)
-  and case = {left: Pat.t; right: t} [@@deriving show {with_path= false}]
+  and case = {left: Pat.t; right: t}
 
   and t =
     | Id of Id.t  (** Identifiers such as [x], [fact] *)
@@ -80,17 +76,14 @@ module Expr = struct
     | If of t * t * t option  (** [if E1 then E2 else E3] *)
     | Seq of t List2.t  (** [E1; E2] *)
     | Constraint of t * Ty.t  (** [(E : T)] *)
-  [@@deriving show {with_path= false}]
 end
 
 module StrItem = struct
   (** Constructor declaration. E.g. [A of string] *)
   type construct_decl = {id: Id.t; arg: Ty.t option}
-  [@@deriving show {with_path= false}]
 
   (** Variant type declaration *)
   type type_decl = {id: Id.t; params: Id.t list; variants: construct_decl list}
-  [@@deriving show {with_path= false}]
 
   type t =
     | Eval of Expr.t  (** [E] *)
@@ -100,7 +93,6 @@ module StrItem = struct
           - [let P1 = E1 and ... and Pn = EN]      when [flag] is [Nonrec]
           - [let rec P1 = E1 and ... and Pn = EN ] when [flag] is [Rec]
         *)
-  [@@deriving show {with_path= false}]
 end
 
-type structure = StrItem.t list [@@deriving show {with_path= false}]
+type structure = StrItem.t list

lib/ast/dune

@@ -2,7 +2,5 @@
  (name LAst)
  (public_name NeML.Ast)
  (libraries base LMisc)
- (preprocess
-  (pps ppx_deriving.show))
  (instrumentation
   (backend bisect_ppx)))

lib/misc/LMisc.ml

@@ -10,27 +10,47 @@ open! Base
 
 (** Identifiers *)
 module Id = struct
-  type t = I of string [@@deriving show {with_path= false}]
+  type t = I of string
 end
 
 (** List containing at least 1 element *)
 module List1 = struct
-  type 'a t = 'a * 'a list [@@deriving show {with_path= false}]
+  type 'a t = 'a * 'a list
 
   let of_list_exn : 'a list -> 'a t = function
     | hd :: tl ->
         (hd, tl)
     | [] ->
         raise (Invalid_argument "empty list")
+
+  let to_list : 'a t -> 'a list = fun (hd, tl) -> hd :: tl
 end
 
 (** List containing at least 2 elements *)
 module List2 = struct
-  type 'a t = 'a * 'a * 'a list [@@deriving show {with_path= false}]
+  type 'a t = 'a * 'a * 'a list
 
   let of_list_exn : 'a list -> 'a t = function
     | fst :: snd :: tl ->
         (fst, snd, tl)
     | _ :: [] | [] ->
         raise (Invalid_argument "not enough elements")
+
+  let to_list : 'a t -> 'a list = fun (fst, snd, tl) -> fst :: snd :: tl
 end
+
+(* https://ocaml.org/manual/5.0/lex.html#sss:lex-ops-symbols *)
+let is_op_first_char = function
+  | '$' | '&' | '*' | '+' | '-' | '/' | '=' | '<' | '>' | '@' | '^' | '|' | '%'
+    ->
+      true
+  | _ ->
+      false
+
+let is_op_char = function
+  | ch when is_op_first_char ch ->
+      true
+  | '~' | '!' | '?' | ':' | '.' ->
+      true
+  | _ ->
+      false

lib/misc/dune

@@ -2,7 +2,5 @@
  (name LMisc)
  (public_name NeML.Misc)
  (libraries base)
- (preprocess
-  (pps ppx_deriving.show))
  (instrumentation
   (backend bisect_ppx)))

lib/parse/common.ml

@@ -82,23 +82,6 @@ let pconstruct_id =
   in
   pident `Capitalized <|> keywords
 
-(* https://ocaml.org/manual/5.0/lex.html#sss:lex-ops-symbols *)
-
-let is_op_first_char = function
-  | '$' | '&' | '*' | '+' | '-' | '/' | '=' | '<' | '>' | '@' | '^' | '|' | '%'
-    ->
-      true
-  | _ ->
-      false
-
-let is_op_char = function
-  | ch when is_op_first_char ch ->
-      true
-  | '~' | '!' | '?' | ':' | '.' ->
-      true
-  | _ ->
-      false
-
 let is_keyword_op = function "|" | "->" -> true | _ -> false
 
 let pinfix_id ?starts () =