diff --git a/NeML.opam b/NeML.opam index 32e3fa6..2e60d3d 100644 --- a/NeML.opam +++ b/NeML.opam @@ -17,6 +17,7 @@ depends: [ "ocaml" "dune" {>= "3.15"} "base" + "pprint" "stdio" "angstrom" "ppx_deriving" diff --git a/dune-project b/dune-project index a7e9ed5..8c6fb16 100644 --- a/dune-project +++ b/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)) diff --git a/lib/ast/LAst.ml b/lib/ast/LAst.ml index ca6cce1..43e3e9a 100644 --- a/lib/ast/LAst.ml +++ b/lib/ast/LAst.ml @@ -15,7 +15,11 @@ 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}] + + let pp = + let open PPrint in + function + | Int x -> OCaml.int x | Char x -> OCaml.char x | String x -> OCaml.string x end module Ty = struct @@ -29,7 +33,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 +48,50 @@ module Pat = struct - [C P] when [arg] is [Some P] *) | Constraint of t * Ty.t (** [(P : T)] *) - [@@deriving show {with_path= false}] + + module Prec = struct + type t = Or | Tuple | List | Construct | Other [@@deriving enum] + end + + let pp = + let open PrecedencePrinter (Prec) in + let rec p = + let open PPrint in + function + | Any -> + return Prec.Other (char '_') + | Var x -> + return Prec.Other (Id.pp x) + | Const x -> + return Prec.Other (Const.pp x) + | Construct (I "::", Some (Tuple (hd, tl, []))) -> + let op l r = group @@ l ^^ group (break 1 ^^ string ":: ") ^^ r in + pinfixr Prec.List op (p hd) (p tl) + | Construct (id, Some arg) -> + let op id arg = group @@ id ^^ group (break 1) ^^ arg in + pinfixr Prec.Construct op (return Prec.Other (Id.pp id)) (p arg) + | Construct (id, None) -> + return Prec.Construct (Id.pp id) + | Tuple (fst, snd, tl) -> + let op docs = group @@ flow (comma ^^ break 1) docs in + pinfixn Prec.Tuple op (List.map ~f:p (fst :: snd :: tl)) + | Or (x, y) -> + let op l r = group @@ l ^^ group (break 1 ^^ string "| " ^^ r) in + pinfixl Prec.Or op (p x) (p y) + | _ -> + return Prec.Other (string "wip") + in + + fun x -> run (p x) 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 +116,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 +133,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 diff --git a/lib/ast/dune b/lib/ast/dune index 1292c50..debabbb 100644 --- a/lib/ast/dune +++ b/lib/ast/dune @@ -1,8 +1,8 @@ (library (name LAst) (public_name NeML.Ast) - (libraries base LMisc) + (libraries base pprint LMisc) (preprocess - (pps ppx_deriving.show)) + (pps ppx_deriving.show ppx_deriving.enum)) (instrumentation (backend bisect_ppx))) diff --git a/lib/misc/LMisc.ml b/lib/misc/LMisc.ml index 8579c9c..5a3b560 100644 --- a/lib/misc/LMisc.ml +++ b/lib/misc/LMisc.ml @@ -10,27 +10,118 @@ open! Base (** Identifiers *) module Id = struct - type t = I of string [@@deriving show {with_path= false}] + type t = I of string + + let pp (I x) = + let open PPrint in + string x 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 + +module PrecedencePrinter (Prec : sig + type t + val min : int + val to_enum : t -> int +end) : sig + open PPrint + + type 'a t + + val run : document t -> document + + val return : Prec.t -> document -> document t + + val pprefix : Prec.t -> (document -> document) -> document t -> document t + + val pinfixl : + Prec.t + -> (document -> document -> document) + -> document t + -> document t + -> document t + + val pinfixr : + Prec.t + -> (document -> document -> document) + -> document t + -> document t + -> document t + + val pinfixn : + Prec.t -> (document list -> document) -> document t list -> document t +end = struct + type 'a t = Prec of (int -> 'a) + + let run' (Prec f) = f + let run (Prec f) = f Prec.min + + let ( let* ) p f = Prec (fun lvl -> run' (f (run' p lvl)) lvl) + + let cur_lvl = Prec Fn.id + + let pure x = Prec (fun _ -> x) + + let parens p = + let open PPrint in + group @@ align @@ char '(' ^^ align (break 0 ^^ p) ^^ break 0 ^^ char ')' + + let return' lvl doc = + let* cur = cur_lvl in + pure @@ if cur > lvl then parens doc else doc + + let return lvl = return' (Prec.to_enum lvl) + + let with_lvl lvl p = pure @@ run' p lvl + + let pprefix lvl op p = + let lvl = Prec.to_enum lvl in + let* doc = with_lvl (lvl + 1) p in + return' lvl (op doc) + + let pinfixl lvl op l r = + let lvl = Prec.to_enum lvl in + let* l = with_lvl lvl l in + let* r = with_lvl (lvl + 1) r in + return' lvl (op l r) + + let pinfixr lvl op l r = + let lvl = Prec.to_enum lvl in + let* l = with_lvl (lvl + 1) l in + let* r = with_lvl lvl r in + return' lvl (op l r) + + let pinfixn lvl op ps = + let lvl = Prec.to_enum lvl in + let* docs = + List.fold_right ps ~init:(pure []) ~f:(fun p acc -> + let* acc = acc in + let* doc = with_lvl (lvl + 1) p in + pure (doc :: acc) ) + in + return' lvl (op docs) end diff --git a/lib/misc/dune b/lib/misc/dune index d3da2da..3ee5c89 100644 --- a/lib/misc/dune +++ b/lib/misc/dune @@ -1,7 +1,7 @@ (library (name LMisc) (public_name NeML.Misc) - (libraries base) + (libraries base pprint) (preprocess (pps ppx_deriving.show)) (instrumentation diff --git a/lib/parse/LParse.ml b/lib/parse/LParse.ml index fa4ac9f..022a240 100644 --- a/lib/parse/LParse.ml +++ b/lib/parse/LParse.ml @@ -9,4 +9,4 @@ open! Base open Angstrom -let parse s = parse_string ~consume:All PStr.p s |> Result.ok +let parse s = parse_string ~consume:All PPat.p s |> Result.ok diff --git a/lib/parse/LParse.mli b/lib/parse/LParse.mli index 10de7a0..f69c362 100644 --- a/lib/parse/LParse.mli +++ b/lib/parse/LParse.mli @@ -9,4 +9,4 @@ open! Base open LAst -val parse : string -> structure option +val parse : string -> Pat.t option diff --git a/lib/parse/test/test.ml b/lib/parse/test/test.ml index dc7e779..532da65 100644 --- a/lib/parse/test/test.ml +++ b/lib/parse/test/test.ml @@ -7,861 +7,71 @@ [@@@ocaml.text "/*"] open! Base -open Stdio open LAst let run s = match LParse.parse s with | None -> - print_endline "syntax error" - | Some str -> - print_endline (show_structure str) - -let%expect_test _ = - run {| let rec fact n = if n <= 1 then 1 else n * fact (n - 1) |} ; - [%expect - {| - [(Let (Rec, - ({ pat = (Var (I "fact")); - expr = - (Fun (((Var (I "n")), []), - (If ( - (Apply ((Apply ((Id (I "<=")), (Id (I "n")))), (Const (Int 1)))), - (Const (Int 1)), - (Some (Apply ((Apply ((Id (I "*")), (Id (I "n")))), - (Apply ((Id (I "fact")), - (Apply ((Apply ((Id (I "-")), (Id (I "n")))), - (Const (Int 1)))) - )) - ))) - )) - )) - }, - []) - )) - ] - |}] - -(* ======= Patterns ======= *) - -let%expect_test _ = - run {| let Cons (hd, tl) = () |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = - (Construct ((I "Cons"), - (Some (Tuple ((Var (I "hd")), (Var (I "tl")), []))))); - expr = (Construct ((I "()"), None)) }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let C _ | a, b = () |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = - (Or ((Construct ((I "C"), (Some Any))), - (Tuple ((Var (I "a")), (Var (I "b")), [])))); - expr = (Construct ((I "()"), None)) }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let a | (b | c) | d = () |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = - (Or ((Or ((Var (I "a")), (Or ((Var (I "b")), (Var (I "c")))))), - (Var (I "d")))); - expr = (Construct ((I "()"), None)) }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let a, (b, c), d = () |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = - (Tuple - ((Var (I "a")), (Tuple ((Var (I "b")), (Var (I "c")), [])), - [(Var (I "d"))])); - expr = (Construct ((I "()"), None)) }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let a, b | c, d = () |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = - (Or ((Tuple ((Var (I "a")), (Var (I "b")), [])), - (Tuple ((Var (I "c")), (Var (I "d")), [])))); - expr = (Construct ((I "()"), None)) }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let a::(b::c)::d = () |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = - (Construct ((I "::"), - (Some (Tuple - ((Var (I "a")), - (Construct ((I "::"), - (Some (Tuple - ((Construct ((I "::"), - (Some (Tuple - ((Var (I "b")), (Var (I "c")), - []))) - )), - (Var (I "d")), []))) - )), - []))) - )); - expr = (Construct ((I "()"), None)) }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let a::b::c,d|e = () |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = - (Or ( - (Tuple - ((Construct ((I "::"), - (Some (Tuple - ((Var (I "a")), - (Construct ((I "::"), - (Some (Tuple ((Var (I "b")), (Var (I "c")), []))) - )), - []))) - )), - (Var (I "d")), [])), - (Var (I "e")))); - expr = (Construct ((I "()"), None)) }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let [a;b;c] = () |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = - (Construct ((I "::"), - (Some (Tuple - ((Var (I "a")), - (Construct ((I "::"), - (Some (Tuple - ((Var (I "b")), - (Construct ((I "::"), - (Some (Tuple - ((Var (I "c")), - (Construct ((I "[]"), None)), - []))) - )), - []))) - )), - []))) - )); - expr = (Construct ((I "()"), None)) }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let [a] = () |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = - (Construct ((I "::"), - (Some (Tuple ((Var (I "a")), (Construct ((I "[]"), None)), []))))); - expr = (Construct ((I "()"), None)) }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let [] = () |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = (Construct ((I "[]"), None)); - expr = (Construct ((I "()"), None)) }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let hd1::hd2::tl = () |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = - (Construct ((I "::"), - (Some (Tuple - ((Var (I "hd1")), - (Construct ((I "::"), - (Some (Tuple ((Var (I "hd2")), (Var (I "tl")), []))))), - []))) - )); - expr = (Construct ((I "()"), None)) }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let ( x : int ) = 1 |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = (Constraint ((Var (I "x")), (Con ((I "int"), [])))); - expr = (Const (Int 1)) }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let Some Some (x : int) = Some (Some 1) |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = - (Construct ((I "Some"), - (Some (Construct ((I "Some"), - (Some (Constraint ((Var (I "x")), (Con ((I "int"), []))))) - ))) - )); - expr = - (Construct ((I "Some"), - (Some (Construct ((I "Some"), (Some (Const (Int 1)))))))) - }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let Some Some x : int option option = Some (Some 1) |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = - (Constraint ( - (Construct ((I "Some"), - (Some (Construct ((I "Some"), (Some (Var (I "x")))))))), - (Con ((I "option"), [(Con ((I "option"), [(Con ((I "int"), []))]))] - )) - )); - expr = - (Construct ((I "Some"), - (Some (Construct ((I "Some"), (Some (Const (Int 1)))))))) - }, - []) - )) - ] - |}] - -(* ======= Expressions ======= *) - -let%expect_test _ = - run {| function | a -> true | b -> false |} ; - [%expect - {| - [(Eval - (Function - ({ left = (Var (I "a")); right = (Construct ((I "true"), None)) }, - [{ left = (Var (I "b")); right = (Construct ((I "false"), None)) }]))) - ] - |}] - -let%expect_test _ = - run {| fun x y -> x + y |} ; - [%expect - {| - [(Eval - (Fun (((Var (I "x")), [(Var (I "y"))]), - (Apply ((Apply ((Id (I "+")), (Id (I "x")))), (Id (I "y"))))))) - ] - |}] - -let%expect_test _ = - run {| a0b'c_d |} ; [%expect {| [(Eval (Id (I "a0b'c_d")))] |}] - -let%expect_test _ = - run "a >>= b ++ c ** d !+ e" ; - [%expect - {| - [(Eval - (Apply ((Apply ((Id (I ">>=")), (Id (I "a")))), - (Apply ((Apply ((Id (I "++")), (Id (I "b")))), - (Apply ((Apply ((Id (I "**")), (Id (I "c")))), - (Apply ((Id (I "d")), (Apply ((Id (I "!+")), (Id (I "e")))))))) - )) - ))) - ] - |}] - -let%expect_test _ = - run {| let rec a = 1 and b = 2 in let e = 3 in a |} ; - [%expect - {| - [(Eval - (Let (Rec, - ({ pat = (Var (I "a")); expr = (Const (Int 1)) }, - [{ pat = (Var (I "b")); expr = (Const (Int 2)) }]), - (Let (Nonrec, ({ pat = (Var (I "e")); expr = (Const (Int 3)) }, []), - (Id (I "a")))) - ))) - ] - |}] - -let%expect_test _ = - run {| if a then (if b then c) else d |} ; - [%expect - {| - [(Eval - (If ((Id (I "a")), (If ((Id (I "b")), (Id (I "c")), None)), - (Some (Id (I "d")))))) - ] - |}] - -let%expect_test _ = - run {| if a; b then c; d |} ; - [%expect - {| - [(Eval - (If ((Tuple ((Id (I "a")), (Id (I "b")), [])), - (Tuple ((Id (I "c")), (Id (I "d")), [])), None))) - ] - |}] - -let%expect_test _ = - run {| if a; b then (c; d) |} ; - [%expect - {| - [(Eval - (If ((Tuple ((Id (I "a")), (Id (I "b")), [])), - (Tuple ((Id (I "c")), (Id (I "d")), [])), None))) - ] - |}] - -let%expect_test _ = - run {| match a with b -> c | d -> e |} ; - [%expect - {| - [(Eval - (Match ((Id (I "a")), - ({ left = (Var (I "b")); right = (Id (I "c")) }, - [{ left = (Var (I "d")); right = (Id (I "e")) }]) - ))) - ] - |}] - -let%expect_test _ = - run {| match a with | b | c | d -> e | f -> g |} ; - [%expect - {| - [(Eval - (Match ((Id (I "a")), - ({ left = (Or ((Or ((Var (I "b")), (Var (I "c")))), (Var (I "d")))); - right = (Id (I "e")) }, - [{ left = (Var (I "f")); right = (Id (I "g")) }]) - ))) - ] - |}] - -let%expect_test _ = - run {| Nil |} ; [%expect {| [(Eval (Construct ((I "Nil"), None)))] |}] - -let%expect_test _ = - run {| Some x |} ; - [%expect {| [(Eval (Construct ((I "Some"), (Some (Id (I "x"))))))] |}] - -let%expect_test _ = - run {| Cons (1, Nil) |} ; - [%expect - {| - [(Eval - (Construct ((I "Cons"), - (Some (Tuple ((Const (Int 1)), (Construct ((I "Nil"), None)), [])))))) - ] - |}] - -let%expect_test _ = - run {| [a;b;c] |} ; - [%expect - {| - [(Eval - (Construct ((I "::"), - (Some (Tuple - ((Tuple ((Id (I "a")), (Id (I "b")), [(Id (I "c"))])), - (Construct ((I "[]"), None)), []))) - ))) - ] - |}] - -let%expect_test _ = - run {| [a;(b;c)] |} ; - [%expect - {| - [(Eval - (Construct ((I "::"), - (Some (Tuple - ((Tuple - ((Id (I "a")), (Tuple ((Id (I "b")), (Id (I "c")), [])), - [])), - (Construct ((I "[]"), None)), []))) - ))) - ] - |}] - -let%expect_test _ = - run {| [a] |} ; - [%expect - {| - [(Eval - (Construct ((I "::"), - (Some (Tuple ((Id (I "a")), (Construct ((I "[]"), None)), [])))))) - ] - |}] - -let%expect_test _ = - run {| [] |} ; [%expect {| [(Eval (Construct ((I "[]"), None)))] |}] - -let%expect_test _ = - run {| (a :: b) :: c :: d :: [] |} ; - [%expect - {| - [(Eval - (Construct ((I "::"), - (Some (Tuple - ((Construct ((I "::"), - (Some (Tuple ((Id (I "a")), (Id (I "b")), []))))), - (Construct ((I "::"), - (Some (Tuple - ((Id (I "c")), - (Construct ((I "::"), - (Some (Tuple - ((Id (I "d")), - (Construct ((I "[]"), None)), - []))) - )), - []))) - )), - []))) - ))) - ] - |}] - -let%expect_test _ = - run {| (a ; b) ; c ; d ; e |} ; - [%expect - {| - [(Eval - (Tuple - ((Tuple ((Id (I "a")), (Id (I "b")), [])), (Id (I "c")), - [(Id (I "d")); (Id (I "e"))]))) - ] - |}] - -let%expect_test _ = - run {| a, (b, c), d, e |} ; - [%expect - {| - [(Eval - (Tuple - ((Id (I "a")), (Tuple ((Id (I "b")), (Id (I "c")), [])), - [(Id (I "d")); (Id (I "e"))]))) - ] - |}] - -let%expect_test _ = - run {| a, (b, c) |} ; - [%expect - {| [(Eval (Tuple ((Id (I "a")), (Tuple ((Id (I "b")), (Id (I "c")), [])), [])))] |}] - -let%expect_test _ = - run {| (a, b), c |} ; - [%expect - {| [(Eval (Tuple ((Tuple ((Id (I "a")), (Id (I "b")), [])), (Id (I "c")), [])))] |}] - -let%expect_test _ = - run {| 1 + - + + 3 |} ; - [%expect - {| - [(Eval - (Apply ((Apply ((Id (I "+")), (Const (Int 1)))), - (Apply ((Id (I "~-")), - (Apply ((Id (I "~+")), (Apply ((Id (I "~+")), (Const (Int 3)))))))) - ))) - ] - |}] - -let%expect_test _ = - run {| !%< 123; !0 |} ; - [%expect - {| - [(Eval - (Tuple - ((Apply ((Id (I "!%<")), (Const (Int 123)))), - (Apply ((Id (I "!")), (Const (Int 0)))), []))) - ] - |}] - -let%expect_test _ = - run {| --+1 |} ; - [%expect - {| - [(Eval - (Apply ((Id (I "~-")), - (Apply ((Id (I "~-")), (Apply ((Id (I "~+")), (Const (Int 1))))))))) - ] - |}] - -let%expect_test _ = - run {| f(1+2+3) |} ; - [%expect - {| - [(Eval - (Apply ((Id (I "f")), - (Apply ( - (Apply ((Id (I "+")), - (Apply ((Apply ((Id (I "+")), (Const (Int 1)))), (Const (Int 2)) - )) - )), - (Const (Int 3)))) - ))) - ] - |}] - -let%expect_test _ = - run {| if(a && b) then(1+2) else(3) |} ; - [%expect - {| - [(Eval - (If ((Apply ((Apply ((Id (I "&&")), (Id (I "a")))), (Id (I "b")))), - (Apply ((Apply ((Id (I "+")), (Const (Int 1)))), (Const (Int 2)))), - (Some (Const (Int 3)))))) - ] - |}] - -let%expect_test _ = - run {| id let a = 1 in a |} ; - [%expect - {| - [(Eval - (Apply ((Id (I "id")), - (Let (Nonrec, ({ pat = (Var (I "a")); expr = (Const (Int 1)) }, []), - (Id (I "a")))) - ))) - ] - |}] - -let%expect_test _ = - run {| ! let a = 1 in a |} ; - [%expect - {| - [(Eval - (Apply ((Id (I "!")), - (Let (Nonrec, ({ pat = (Var (I "a")); expr = (Const (Int 1)) }, []), - (Id (I "a")))) - ))) - ] - |}] - -let%expect_test _ = - run {| 1 + let a = 1 in a |} ; - [%expect - {| - [(Eval - (Apply ((Apply ((Id (I "+")), (Const (Int 1)))), - (Let (Nonrec, ({ pat = (Var (I "a")); expr = (Const (Int 1)) }, []), - (Id (I "a")))) - ))) - ] - |}] - -let%expect_test _ = - run {| ( a : int ) |} ; - [%expect {| [(Eval (Constraint ((Id (I "a")), (Con ((I "int"), [])))))] |}] - -let%expect_test _ = - run {| (fun x -> x : int -> int) |} ; - [%expect - {| - [(Eval - (Constraint ((Fun (((Var (I "x")), []), (Id (I "x")))), - (Arr ((Con ((I "int"), [])), (Con ((I "int"), []))))))) - ] - |}] - -let%expect_test _ = - run {| let f x y : int = 1 in f |} ; - [%expect - {| - [(Eval - (Let (Nonrec, - ({ pat = (Var (I "f")); - expr = - (Fun (((Var (I "x")), [(Var (I "y"))]), - (Constraint ((Const (Int 1)), (Con ((I "int"), [])))))) - }, - []), - (Id (I "f"))))) - ] - |}] - -(* ======= Types ======= *) - -let%expect_test _ = - run {| type foo = A of int |} ; - [%expect - {| - [(Type - { id = (I "foo"); params = []; - variants = [{ id = (I "A"); arg = (Some (Con ((I "int"), []))) }] }) - ] - |}] - -let%expect_test _ = - run {| type foo = A of int list |} ; - [%expect - {| - [(Type - { id = (I "foo"); params = []; - variants = - [{ id = (I "A"); - arg = (Some (Con ((I "list"), [(Con ((I "int"), []))]))) } - ] - }) - ] - |}] - -let%expect_test _ = - run {| type foo = A of (int, string) map |} ; - [%expect - {| - [(Type - { id = (I "foo"); params = []; - variants = - [{ id = (I "A"); - arg = - (Some (Con ((I "map"), - [(Con ((I "int"), [])); (Con ((I "string"), []))]))) - } - ] - }) - ] - |}] - -let%expect_test _ = - run {| type foo = A of 'a -> 'b -> 'c |} ; - [%expect - {| - [(Type - { id = (I "foo"); params = []; - variants = - [{ id = (I "A"); - arg = - (Some (Arr ((Var (I "a")), (Arr ((Var (I "b")), (Var (I "c"))))))) } - ] - }) - ] - |}] - -let%expect_test _ = - run {| type foo = A of 'a * 'b * 'c |} ; - [%expect - {| - [(Type - { id = (I "foo"); params = []; - variants = - [{ id = (I "A"); - arg = (Some (Tuple ((Var (I "a")), (Var (I "b")), [(Var (I "c"))]))) - } - ] - }) - ] - |}] - -let%expect_test _ = - run {| type foo = A of 'some_type_var |} ; - [%expect - {| - [(Type - { id = (I "foo"); params = []; - variants = [{ id = (I "A"); arg = (Some (Var (I "some_type_var"))) }] }) - ] - |}] + Stdio.prerr_endline "syntax error" + | Some x -> + PPrint.ToChannel.pretty 1. 50 Stdio.stdout (Pat.pp x) let%expect_test _ = run - {| type foo = A of - ('a -> int * (string, unit, 'b -> 'c) foo bar option) -> e |} ; - [%expect - {| - [(Type - { id = (I "foo"); params = []; - variants = - [{ id = (I "A"); - arg = - (Some (Arr ( - (Arr ((Var (I "a")), - (Tuple - ((Con ((I "int"), [])), - (Con ((I "option"), - [(Con ((I "bar"), - [(Con ((I "foo"), - [(Con ((I "string"), [])); - (Con ((I "unit"), [])); - (Arr ((Var (I "b")), (Var (I "c"))))] - )) - ] - )) - ] - )), - [])) - )), - (Con ((I "e"), []))))) - } - ] - }) - ] - |}] - -(* ======= Some other stuff ======= *) - -let%expect_test _ = - run {| let (f, s) = (f + s, f - s) |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = (Tuple ((Var (I "f")), (Var (I "s")), [])); - expr = - (Tuple - ((Apply ((Apply ((Id (I "+")), (Id (I "f")))), (Id (I "s")))), - (Apply ((Apply ((Id (I "-")), (Id (I "f")))), (Id (I "s")))), - [])) - }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let (>>=) a b = a ** b |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = (Var (I ">>=")); - expr = - (Fun (((Var (I "a")), [(Var (I "b"))]), - (Apply ((Apply ((Id (I "**")), (Id (I "a")))), (Id (I "b")))))) - }, - []) - )) - ] - |}] - -let%expect_test _ = - run {| let (++) a b = a + b |} ; + {| 33|1|2|3|1|2|3|(1|2|3)|1|2|3|1|2|3|1|2|3|1|2|(3|2|3|1|2|3|1|2|3|1|2|3|1|2|3|1)|2|1|2|3|(22|3|2|3|2|3|2|3|2|3|2|3|2|3|2|3|2|3|2|3|2|3|2|3|2|3|3|4)|} ; [%expect {| - [(Let (Nonrec, - ({ pat = (Var (I "++")); - expr = - (Fun (((Var (I "a")), [(Var (I "b"))]), - (Apply ((Apply ((Id (I "+")), (Id (I "a")))), (Id (I "b")))))) - }, - []) - )) - ] + 33 | 1 | 2 | 3 | 1 | 2 | 3 | (1 | 2 | 3) | 1 | 2 + | 3 | 1 | 2 | 3 | 1 | 2 | 3 | 1 | 2 + | ( + 3 | 2 | 3 | 1 | 2 | 3 | 1 | 2 | 3 | 1 | 2 | 3 + | 1 | 2 | 3 | 1 + ) | 2 | 1 | 2 | 3 + | ( + 22 | 3 | 2 | 3 | 2 | 3 | 2 | 3 | 2 | 3 | 2 | 3 + | 2 | 3 | 2 | 3 | 2 | 3 | 2 | 3 | 2 | 3 | 2 | 3 + | 2 | 3 | 3 | 4 + ) |}] let%expect_test _ = run - {| let(*sus*)rec(*firstcomment*)f n = (* second comment *) (* third - comment*) n + 1 |} ; + {|1,2,3,4,5,6,(7,8,98,98,98,98,98,98,98,98,98,98,98,98,98,98,98,98,98,98,98,9),10,(11|2),12,13,14,15,16|} ; [%expect {| - [(Let (Rec, - ({ pat = (Var (I "f")); - expr = - (Fun (((Var (I "n")), []), - (Apply ((Apply ((Id (I "+")), (Id (I "n")))), (Const (Int 1)))))) - }, - []) - )) - ] + 1, 2, 3, 4, 5, 6, + ( + 7, 8, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, + 98, 98, 98, 98, 98, 98, 98, 98, 9 + ), 10, (11 | 2), 12, 13, 14, 15, 16 |}] let%expect_test _ = - run {| letrec f n = n + 1 |} ; + run + {|a::b, f::(c::dd::e,ed::eed::eed::eed::eed::eed::eed::eed::eed::eed::eed::eed::eed::eed::eed::eed::eed::eed::eed::ee::ee::f::f)::g::h::jh::jh::jh::jh::jh::jh::jh::jh::jh::jh::j|} ; [%expect {| - [(Eval - (Apply ( - (Apply ((Id (I "=")), - (Apply ((Apply ((Id (I "letrec")), (Id (I "f")))), (Id (I "n")))))), - (Apply ((Apply ((Id (I "+")), (Id (I "n")))), (Const (Int 1))))))) - ] + a :: b, + f :: ( + c :: dd :: e, + ed :: eed :: eed :: eed :: eed :: eed :: eed + :: eed :: eed :: eed :: eed :: eed :: eed + :: eed :: eed :: eed :: eed :: eed :: eed + :: ee :: ee :: f :: f + ) :: g :: h :: jh :: jh :: jh :: jh :: jh :: jh + :: jh :: jh :: jh :: jh :: j |}] let%expect_test _ = - run {| let reca = 1 |} ; - [%expect - {| [(Let (Nonrec, ({ pat = (Var (I "reca")); expr = (Const (Int 1)) }, [])))] |}] - -let%expect_test _ = - run {| type 'a list = Nil | Cons of 'a * 'a list |} ; + run + {|Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some Some (1,2,3,3,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5)|} ; [%expect {| - [(Type - { id = (I "list"); params = [(I "a")]; - variants = - [{ id = (I "Nil"); arg = None }; - { id = (I "Cons"); - arg = - (Some (Tuple - ((Var (I "a")), (Con ((I "list"), [(Var (I "a"))])), []))) - } - ] - }) - ] + Some Some Some Some Some Some Some Some Some Some Some + Some Some Some Some Some Some Some Some Some Some Some + Some Some Some Some Some Some Some Some Some Some Some + ( + 1, 2, 3, 3, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5 + ) |}] - -let%expect_test _ = run {| 1a |} ; [%expect {| syntax error |}] - -let%expect_test _ = - run {| 1 ;; a |} ; - [%expect {| [(Eval (Const (Int 1))); (Eval (Id (I "a")))] |}]