From 755b7a32037c94e1b2a87b43e17775612ed89d82 Mon Sep 17 00:00:00 2001 From: Andrei Date: Mon, 11 Nov 2024 02:20:46 +0300 Subject: [PATCH] WIP --- NeML.opam | 1 + dune-project | 2 +- lib/ast/LAst.ml | 272 ++++++++++- lib/ast/dune | 4 +- lib/misc/LMisc.ml | 16 +- lib/misc/dune | 2 +- lib/misc/pp.ml | 72 +++ lib/misc/pp.mli | 50 ++ lib/parse/test/test.ml | 1044 ++++++++++++++++------------------------ 9 files changed, 824 insertions(+), 639 deletions(-) create mode 100644 lib/misc/pp.ml create mode 100644 lib/misc/pp.mli 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..8479ef3 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,40 @@ module Ty = struct - [T tconstr] when [l=[T]] - [(T1, ..., Tn) tconstr] when [l=[T1, ..., Tn]] *) - [@@deriving show {with_path= false}] + + module Prec = struct + type t = Arr | Tuple | Con | Highest [@@deriving enum] + let parens = Pp.parens + end + + let pp = + let open Pp.PrecedencePrinter (Prec) in + let rec p = + let open PPrint in + function + | Var id -> + return Prec.Highest (Id.pp id) + | Con (id, []) -> + return Prec.Highest (Id.pp id) + | Con (id, [arg]) -> + let op arg = group @@ arg ^^ space ^^ Id.pp id in + rprefix Prec.Con op (p arg) + | Con (id, args) -> + let args = List.map args ~f:(runf p) in + let doc = + group + @@ Pp.parens (flow (comma ^^ break 1) args) + ^^ space ^^ Id.pp id + in + return Prec.Con doc + | Tuple list2 -> + let op docs = group @@ flow (break 1 ^^ string "* ") docs in + rinfixn Prec.Tuple op (List.map (List2.to_list list2) ~f:p) + | Arr (l, r) -> + rinfixr Prec.Arr (Pp.infixr (string "-> ")) (p l) (p r) + in + + runf p end module Pat = struct @@ -45,17 +82,54 @@ 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 | Highest [@@deriving enum] + let parens = Pp.parens + end + + let pp = + let open Pp.PrecedencePrinter (Prec) in + let rec p = + let open PPrint in + function + | Any -> + return Prec.Highest (char '_') + | Var id -> + return Prec.Highest (Id.pp id) + | Const x -> + return Prec.Highest (Const.pp x) + | Construct (I "::", Some (Tuple (l, r, []))) -> + rinfixr Prec.List (Pp.infixr (string ":: ")) (p l) (p r) + | Construct (id, Some arg) -> + rinfixr Prec.Construct (Pp.infixr empty) + (return Prec.Highest (Id.pp id)) + (p arg) + | Construct (id, None) -> + return Prec.Construct (Id.pp id) + | Tuple list2 -> + let op docs = group @@ flow (comma ^^ break 1) docs in + rinfixn Prec.Tuple op (List.map (List2.to_list list2) ~f:p) + | Or (x, y) -> + rinfixl Prec.Or (Pp.infixl (string "| ")) (p x) (p y) + | Constraint (pat, ty) -> + let pat = runf p pat in + let ty = Ty.pp ty in + + let doc = Pp.parens @@ pat ^/^ string ": " ^^ ty in + return Prec.Highest doc + in + + runf p 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 +154,139 @@ 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}] + + module Prec = struct + type t = Open | Seq | Tuple | Apply | Highest [@@deriving enum] + let parens = Pp.parens + end + + let pcase left right = + let open PPrint in + group @@ left ^^ string " ->" ^^ group (nest 2 (break 1 ^^ right)) + + let pp = + let open Pp.PrecedencePrinter (Prec) in + let rec p = + let open PPrint in + function + | Id id -> + return Prec.Highest (Id.pp id) + | Const x -> + return Prec.Highest (Const.pp x) + | Let (rec_flag, bindings, expr) -> + let rec_flag = + match rec_flag with Rec -> string " rec" | Nonrec -> empty + in + + let bindings = + let docs = + List.map (List1.to_list bindings) ~f:(fun {pat; expr} -> + group @@ Pat.pp pat ^^ group (string " =" ^/^ runf p expr) ) + in + separate (break 1 ^^ string "and" ^^ break 1) docs + in + let expr = runf p expr in + + let doc = + group @@ string "let" ^^ rec_flag + ^^ group (nest 2 (group (break 1) ^^ bindings) ^/^ string "in") + ^/^ expr + in + return Prec.Open doc + | Fun (args, expr) -> + let args = List.map (List1.to_list args) ~f:Pat.pp in + let expr = runf p expr in + + let doc = + group @@ string "fun" + ^^ group (break 1) + ^^ flow (break 1) args + ^^ string " ->" + ^^ nest 2 (break 1 ^^ expr) + in + return Prec.Open doc + | Function cases -> + let cases = + List.map (List1.to_list cases) ~f:(fun {left; right} -> + pcase (Pat.pp left) (runf p right) ) + in + + let doc = + group @@ string "function" + ^/^ ifflat empty (string "| ") + ^^ separate (break 1 ^^ string "| ") cases + in + return Prec.Open doc + | Match (expr, cases) -> + let expr = runf p expr in + let cases = + List.map (List1.to_list cases) ~f:(fun {left; right} -> + pcase (Pat.pp left) (runf p right) ) + in + + let doc = + group @@ string "match" + ^^ nest 2 (break 1 ^^ expr) + ^/^ string "with" + ^^ group + ( break 1 + ^^ ifflat empty (string "| ") + ^^ separate (break 1 ^^ string "| ") cases ) + in + return Prec.Open doc + | Apply (expr, arg) -> + let op expr arg = group @@ expr ^^ group (nest 2 (break 1 ^^ arg)) in + rinfixl Prec.Apply op (p expr) (p arg) + | If (if_, then_, else_) -> + let if_ = runf p if_ in + let then_ = runf p then_ in + let else_ = Option.map ~f:(runf p) else_ in + + let pelse = + optional + (fun else_ -> + group @@ break 1 ^^ string "else" + ^^ group (nest 2 (break 1 ^^ else_)) ) + else_ + in + + let doc = + group @@ string "if" + ^^ group (nest 2 (break 1 ^^ if_)) + ^/^ string "then" + ^^ group (nest 2 (break 1 ^^ then_)) + ^^ pelse + in + return Prec.Open doc + | Seq list2 -> + let op docs = group @@ flow (semi ^^ break 1) docs in + rinfixn Prec.Seq op (List.map (List2.to_list list2) ~f:p) + | Tuple list2 -> + let op docs = group @@ flow (comma ^^ break 1) docs in + rinfixn Prec.Tuple op (List.map (List2.to_list list2) ~f:p) + | Construct (id, None) -> + return Prec.Apply (Id.pp id) + | Construct (id, Some arg) -> + rinfixl Prec.Apply (Pp.infixl empty) + (return Prec.Highest (Id.pp id)) + (p arg) + | Constraint (expr, ty) -> + let pat = runf p expr in + let ty = Ty.pp ty in + + let doc = Pp.parens @@ pat ^/^ string ": " ^^ ty in + return Prec.Highest doc + in + + runf p 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 +296,61 @@ 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}] + + let pp = + let open PPrint in + function + | Eval expr -> + Expr.pp expr + | Let (rec_flag, bindings) -> + let rec_flag = + match rec_flag with Rec -> string " rec" | Nonrec -> empty + in + + let bindings = + let docs = + List.map (List1.to_list bindings) ~f:(fun {pat; expr} -> + group @@ Pat.pp pat ^^ group (string " =" ^/^ Expr.pp expr) ) + in + separate (break 1 ^^ string "and" ^^ break 1) docs + in + + group @@ string "let" ^^ rec_flag ^^ nest 2 (group (break 1) ^^ bindings) + | Type {id; params; variants} -> + let id = Id.pp id in + let params = + let pparam id = string "'" ^^ Id.pp id in + + match params with + | [] -> + empty + | [id] -> + pparam id ^^ space + | _ -> + let params = List.map params ~f:pparam in + Pp.parens (flow (comma ^^ break 1) params) ^^ space + in + + let variants = + List.map variants ~f:(fun {id; arg} -> + group @@ Id.pp id + ^^ optional + (fun ty -> string " of" ^^ nest 2 (break 1 ^^ Ty.pp ty)) + arg ) + in + + group @@ string "type" + ^^ group (break 1) + ^^ params ^^ id ^^ string " =" + ^^ group + ( break 1 + ^^ ifflat empty (string "| ") + ^^ separate (break 1 ^^ string "| ") variants ) end -type structure = StrItem.t list [@@deriving show {with_path= false}] +type structure = StrItem.t list + +let pp_structure str = + let open PPrint in + let str = List.map str ~f:(fun item -> StrItem.pp item) in + flow (string ";;" ^^ twice hardline) str 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..d225dcb 100644 --- a/lib/misc/LMisc.ml +++ b/lib/misc/LMisc.ml @@ -10,27 +10,37 @@ 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 Pp = Pp 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/misc/pp.ml b/lib/misc/pp.ml new file mode 100644 index 0000000..e8f3f53 --- /dev/null +++ b/lib/misc/pp.ml @@ -0,0 +1,72 @@ +[@@@ocaml.text "/*"] + +(** Copyright 2024, Andrei, PavlushaSource *) + +(** SPDX-License-Identifier: MIT *) + +[@@@ocaml.text "/*"] + +open! Base +open PPrint + +let parens p = + group @@ align @@ char '(' ^^ align (break 0 ^^ p) ^^ break 0 ^^ char ')' + +let infixl op l r = group @@ l ^^ group (break 1 ^^ op ^^ r) +let infixr op l r = group @@ l ^^ group (break 1) ^^ op ^^ r + +module PrecedencePrinter (Prec : sig + type t + val min : int + val to_enum : t -> int + + val parens : document -> document +end) = +struct + type 'a t = P of (int -> 'a) + + let run' (P f) = f + let run (P f) = f Prec.min + let runf p x = run (p x) + + let ( let* ) p f = P (fun lvl -> run' (f (run' p lvl)) lvl) + + let cur_lvl = P Fn.id + + let pure x = P (fun _ -> x) + + let return' lvl doc = + let* cur = cur_lvl in + pure @@ if cur > lvl then Prec.parens doc else doc + + let return lvl = return' (Prec.to_enum lvl) + + let with_lvl lvl p = pure @@ run' p lvl + + let rprefix lvl op p = + let lvl = Prec.to_enum lvl in + let* doc = with_lvl (lvl + 1) p in + return' lvl (op doc) + + let rinfixl 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 rinfixr 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 rinfixn 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/pp.mli b/lib/misc/pp.mli new file mode 100644 index 0000000..cc7fdf2 --- /dev/null +++ b/lib/misc/pp.mli @@ -0,0 +1,50 @@ +[@@@ocaml.text "/*"] + +(** Copyright 2024, Andrei, PavlushaSource *) + +(** SPDX-License-Identifier: MIT *) + +[@@@ocaml.text "/*"] + +open! Base +open PPrint + +val parens : document -> document +val infixl : document -> document -> document -> document +val infixr : document -> document -> document -> document + +module PrecedencePrinter : functor + (Prec : sig + type t + val min : int + val to_enum : t -> int + + val parens : document -> document + end) + -> sig + type 'a t + + val run : document t -> document + val runf : ('a -> document t) -> 'a -> document + + val return : Prec.t -> document -> document t + + val rprefix : Prec.t -> (document -> document) -> document t -> document t + + val rinfixl : + Prec.t + -> (document -> document -> document) + -> document t + -> document t + -> document t + + val rinfixr : + Prec.t + -> (document -> document -> document) + -> document t + -> document t + -> document t + + val rinfixn : + Prec.t -> (document list -> document) -> document t list -> document t +end diff --git a/lib/parse/test/test.ml b/lib/parse/test/test.ml index dc7e779..6aac6e0 100644 --- a/lib/parse/test/test.ml +++ b/lib/parse/test/test.ml @@ -15,853 +15,655 @@ let run s = | None -> print_endline "syntax error" | Some str -> - print_endline (show_structure str) + PPrint.ToChannel.pretty 1. 40 stdout (pp_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)))) - )) - ))) - )) - )) - }, - []) - )) - ] + let rec fact = + fun n -> + if <= n 1 + then 1 else * n (fact (- n 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)) }, - []) - )) - ] - |}] + [%expect {| let Cons (hd, tl) = () |}] 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)) }, - []) - )) - ] - |}] + [%expect {| let C _ | a, b = () |}] 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)) }, - []) - )) - ] - |}] + [%expect {| let a | (b | c) | d = () |}] 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)) }, - []) - )) - ] - |}] + [%expect {| let a, (b, c), d = () |}] 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)) }, - []) - )) - ] - |}] + [%expect {| let a, b | c, d = () |}] 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)) }, - []) - )) - ] - |}] + [%expect {| let a :: (b :: c) :: d = () |}] 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)) }, - []) - )) - ] - |}] + [%expect {| let a :: b :: c, d | e = () |}] 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)) }, - []) - )) - ] - |}] + run {| let [a;b;c] = () |} ; [%expect {| let a :: b :: c :: [] = () |}] -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 [a] = () |} ; [%expect {| let a :: [] = () |}] -let%expect_test _ = - run {| let [] = () |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = (Construct ((I "[]"), None)); - expr = (Construct ((I "()"), None)) }, - []) - )) - ] - |}] +let%expect_test _ = run {| let [] = () |} ; [%expect {| let [] = () |}] 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)) }, - []) - )) - ] - |}] + [%expect {| let hd1 :: hd2 :: tl = () |}] let%expect_test _ = run {| let ( x : int ) = 1 |} ; - [%expect - {| - [(Let (Nonrec, - ({ pat = (Constraint ((Var (I "x")), (Con ((I "int"), [])))); - expr = (Const (Int 1)) }, - []) - )) - ] - |}] + [%expect {| let (x : 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)))))))) - }, - []) - )) - ] - |}] + [%expect {| let Some Some (x : int) = Some (Some 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)))))))) - }, - []) - )) - ] + let (Some Some x : (int option) option) = + Some (Some 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)) }]))) - ] - |}] + [%expect {| function a -> true | b -> false |}] 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"))))))) - ] - |}] + run {| fun x y -> x + y |} ; [%expect {| fun x y -> + x y |}] -let%expect_test _ = - run {| a0b'c_d |} ; [%expect {| [(Eval (Id (I "a0b'c_d")))] |}] +let%expect_test _ = run {| a0b'c_d |} ; [%expect {| 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")))))))) - )) - ))) - ] - |}] + [%expect {| >>= a (++ b (** c (d (!+ 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")))) - ))) - ] + [%expect {| + let rec a = 1 and b = 2 in + let e = 3 in 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")))))) - ] - |}] + [%expect {| if a then if b then c else 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))) - ] - |}] + [%expect {| if a; b then c; 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))) - ] - |}] + [%expect {| if a; b then c; d |}] 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")) }]) - ))) - ] - |}] + [%expect {| match a with b -> c | d -> 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")) }]) - ))) - ] - |}] + [%expect {| match a with b | c | d -> e | f -> g |}] + +let%expect_test _ = run {| Nil |} ; [%expect {| Nil |}] + +let%expect_test _ = run {| Some x |} ; [%expect {| Some x |}] + +let%expect_test _ = run {| Cons (1, Nil) |} ; [%expect {| Cons (1, Nil) |}] let%expect_test _ = - run {| Nil |} ; [%expect {| [(Eval (Construct ((I "Nil"), None)))] |}] + run {| [a;b;c] |} ; [%expect {| :: (a, :: (b, :: (c, []))) |}] let%expect_test _ = - run {| Some x |} ; - [%expect {| [(Eval (Construct ((I "Some"), (Some (Id (I "x"))))))] |}] + run {| [a;(b;c)] |} ; [%expect {| :: (a, :: ((b; c), [])) |}] + +let%expect_test _ = run {| [a] |} ; [%expect {| :: (a, []) |}] + +let%expect_test _ = run {| [] |} ; [%expect {| [] |}] let%expect_test _ = - run {| Cons (1, Nil) |} ; - [%expect - {| - [(Eval - (Construct ((I "Cons"), - (Some (Tuple ((Const (Int 1)), (Construct ((I "Nil"), None)), [])))))) - ] - |}] + run {| (a :: b) :: c :: d :: [] |} ; + [%expect {| :: (:: (a, b), :: (c, :: (d, []))) |}] 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)), []))) - ))) - ] - |}] + run {| (a ; b) ; c ; d ; e |} ; + [%expect {| (a; b); c; d; e |}] + +let%expect_test _ = run {| a, (b, c), d, e |} ; [%expect {| a, (b, c), d, e |}] + +let%expect_test _ = run {| a, (b, c) |} ; [%expect {| a, (b, c) |}] + +let%expect_test _ = run {| (a, b), c |} ; [%expect {| (a, b), c |}] + +let%expect_test _ = run {| 1 + - + + 3 |} ; [%expect {| + 1 (~- (~+ (~+ 3))) |}] + +let%expect_test _ = run {| !%< 123; !0 |} ; [%expect {| !%< 123; ! 0 |}] + +let%expect_test _ = run {| --+1 |} ; [%expect {| ~- (~- (~+ 1)) |}] + +let%expect_test _ = run {| f(1+2+3) |} ; [%expect {| f (+ (+ 1 2) 3) |}] 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)), []))) - ))) - ] - |}] + run {| if(a && b) then(1+2) else(3) |} ; + [%expect {| if && a b then + 1 2 else 3 |}] let%expect_test _ = - run {| [a] |} ; - [%expect - {| - [(Eval - (Construct ((I "::"), - (Some (Tuple ((Id (I "a")), (Construct ((I "[]"), None)), [])))))) - ] - |}] + run {| id let a = 1 in a |} ; + [%expect {| id (let a = 1 in a) |}] let%expect_test _ = - run {| [] |} ; [%expect {| [(Eval (Construct ((I "[]"), None)))] |}] + run {| ! let a = 1 in a |} ; [%expect {| ! (let a = 1 in a) |}] 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)), - []))) - )), - []))) - )), - []))) - ))) - ] - |}] + run {| 1 + let a = 1 in a |} ; + [%expect {| + 1 (let a = 1 in a) |}] + +let%expect_test _ = run {| ( a : int ) |} ; [%expect {| (a : int) |}] 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"))]))) - ] - |}] + run {| (fun x -> x : int -> int) |} ; + [%expect {| (fun x -> x : int -> int) |}] let%expect_test _ = - run {| a, (b, c), d, e |} ; + run {| let f x y : int = 1 in f |} ; + [%expect {| let f = fun x y -> (1 : int) in f |}] + +(* ======= Types ======= *) + +let%expect_test _ = + run {| type foo = A of int |} ; + [%expect {| type foo = A of int |}] + +let%expect_test _ = + run {| type foo = A of int list |} ; + [%expect {| type foo = A of int list |}] + +let%expect_test _ = + run {| type foo = A of (int, string) map |} ; + [%expect {| type foo = A of (int, string) map |}] + +let%expect_test _ = + run {| type foo = A of 'a -> 'b -> 'c |} ; + [%expect {| type foo = A of a -> b -> c |}] + +let%expect_test _ = + run {| type foo = A of 'a * 'b * 'c |} ; + [%expect {| type foo = A of a * b * c |}] + +let%expect_test _ = + run {| type foo = A of 'some_type_var |} ; + [%expect {| type foo = A of some_type_var |}] + +let%expect_test _ = + run + {| type foo = A of + ('a -> int * (string, unit, 'b -> 'c) foo bar option) -> e |} ; [%expect {| - [(Eval - (Tuple - ((Id (I "a")), (Tuple ((Id (I "b")), (Id (I "c")), [])), - [(Id (I "d")); (Id (I "e"))]))) - ] + type foo = + | A of + ( + a -> int + * (((string, unit, b -> c) foo) bar) option + ) -> e |}] +(* ======= Some other stuff ======= *) + let%expect_test _ = - run {| a, (b, c) |} ; - [%expect - {| [(Eval (Tuple ((Id (I "a")), (Tuple ((Id (I "b")), (Id (I "c")), [])), [])))] |}] + run {| let (f, s) = (f + s, f - s) |} ; + [%expect {| let f, s = + f s, - f s |}] let%expect_test _ = - run {| (a, b), c |} ; - [%expect - {| [(Eval (Tuple ((Tuple ((Id (I "a")), (Id (I "b")), [])), (Id (I "c")), [])))] |}] + run {| let (>>=) a b = a ** b |} ; + [%expect {| let >>= = fun a b -> ** a b |}] let%expect_test _ = - run {| 1 + - + + 3 |} ; + run {| let (++) a b = a + b |} ; + [%expect {| let ++ = fun a b -> + a b |}] + +let%expect_test _ = + run + {| let(*sus*)rec(*firstcomment*)f n = (* second comment *) (* third + comment*) n + 1 |} ; + [%expect {| let rec f = fun n -> + n 1 |}] + +let%expect_test _ = + run {| letrec f n = n + 1 |} ; + [%expect {| = (letrec f n) (+ n 1) |}] + +let%expect_test _ = run {| let reca = 1 |} ; [%expect {| let reca = 1 |}] + +let%expect_test _ = + run {| type 'a list = Nil | Cons of 'a * 'a list |} ; + [%expect {| type 'a list = Nil | Cons of a * a list |}] + +let%expect_test _ = run {| 1a |} ; [%expect {| syntax error |}] + +let%expect_test _ = + run {| 1 ;; a |} ; [%expect {| - [(Eval - (Apply ((Apply ((Id (I "+")), (Const (Int 1)))), - (Apply ((Id (I "~-")), - (Apply ((Id (I "~+")), (Apply ((Id (I "~+")), (Const (Int 3)))))))) - ))) - ] - |}] + 1;; + + a + |}] let%expect_test _ = - run {| !%< 123; !0 |} ; + run + {|let (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 {| - [(Eval - (Tuple - ((Apply ((Id (I "!%<")), (Const (Int 123)))), - (Apply ((Id (I "!")), (Const (Int 0)))), []))) - ] + let 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 {| --+1 |} ; + run + {|let 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 {| - [(Eval - (Apply ((Id (I "~-")), - (Apply ((Id (I "~-")), (Apply ((Id (I "~+")), (Const (Int 1))))))))) - ] + let 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 {| f(1+2+3) |} ; + run + {|let 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 ((Id (I "f")), - (Apply ( - (Apply ((Id (I "+")), - (Apply ((Apply ((Id (I "+")), (Const (Int 1)))), (Const (Int 2)) - )) - )), - (Const (Int 3)))) - ))) - ] + let 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 {| if(a && b) then(1+2) else(3) |} ; + run + {|let 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 {| - [(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 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 {| id let a = 1 in a |} ; + run + {|(a, b, (c, d) e, f, e, ef, e, e,f, e, e,f, e, e,f, e, e,f, e, e,f, e, e,f, e, e,f, e, e,f, e, e,f, e, e,f, e, e,f, e, e,f, e, e,f, e, e) e|} ; [%expect {| - [(Eval - (Apply ((Id (I "id")), - (Let (Nonrec, ({ pat = (Var (I "a")); expr = (Const (Int 1)) }, []), - (Id (I "a")))) - ))) - ] + ( + a, b, (c, d) e, f, e, ef, e, e, f, e, e, + f, e, e, f, e, e, f, e, e, f, e, e, f, + e, e, f, e, e, f, e, e, f, e, e, f, e, + e, f, e, e, f, e, e, f, e, e + ) e |}] let%expect_test _ = - run {| ! let a = 1 in a |} ; + run + {|(a : a->b->cb->cb->cb->cb->cb->cb->cb->ccb->cbcb->cbcb->cbcb->(cbcb->cbcb->cbcb->cbcb->cbcb->cbcb->cbcb->cbcb->cbcb->cbcb->cbcb->cbcb->cbcb)->cbcb->cbcb->cb)|} ; + [%expect + {| + ( + a + : a -> b -> cb -> cb -> cb -> cb -> cb -> cb + -> cb -> ccb -> cbcb -> cbcb -> cbcb -> ( + cbcb + -> cbcb + -> cbcb + -> cbcb + -> cbcb + -> cbcb + -> cbcb + -> cbcb + -> cbcb + -> cbcb + -> cbcb + -> cbcb + -> cbcb + ) + -> cbcb -> cbcb -> cb + ) + |}] + +let%expect_test _ = + run + {|(a: (a -> b) * cc*cc*cc*cc*cc*cc*cc*cc*cc*cc*cc*cc*(cc*cc*cc*cc*cc*cc)*cc*cc*cc*cc*cc*cc*cc*cc*cc*cc*cc*cc*cc*cc*cc*c*c)|} ; [%expect {| - [(Eval - (Apply ((Id (I "!")), - (Let (Nonrec, ({ pat = (Var (I "a")); expr = (Const (Int 1)) }, []), - (Id (I "a")))) - ))) - ] + ( + a + : (a -> b) * cc * cc * cc * cc * cc + * cc * cc * cc * cc * cc * cc * cc + * (cc * cc * cc * cc * cc * cc) * cc + * cc * cc * cc * cc * cc * cc * cc * cc + * cc * cc * cc * cc * cc * cc * c * c + ) |}] let%expect_test _ = - run {| 1 + let a = 1 in a |} ; + run + {|let a,b,c,d,e,f,c,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a = 1 and a,b,c,d,e,f,c,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a = a,b,c,d,e,f,c,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a and b =2 and c =3 in a,b,c,d,e,f,c,a,a,a,let b= a in 1,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a|} ; [%expect {| - [(Eval - (Apply ((Apply ((Id (I "+")), (Const (Int 1)))), - (Let (Nonrec, ({ pat = (Var (I "a")); expr = (Const (Int 1)) }, []), - (Id (I "a")))) - ))) - ] + let a, b, c, d, e, f, c, a, a, a, a, a, + a, a, a, a, a, a, a, a, a, a, a, a, a, + a, a = 1 + and + a, b, c, d, e, f, c, a, a, a, a, a, a, + a, a, a, a, a, a, a, a, a, a, a, a, a, + a = + a, b, c, d, e, f, c, a, a, a, a, a, a, + a, a, a, a, a, a, a, a, a, a, a, a, a, + a + and + b = 2 + and + c = 3 + in + a, b, c, d, e, f, c, a, a, a, + ( + let b = a in + 1, a, a, a, a, a, a, a, a, a, a, a, a, + a, a, a, a + ) |}] let%expect_test _ = - run {| ( a : int ) |} ; - [%expect {| [(Eval (Constraint ((Id (I "a")), (Con ((I "int"), [])))))] |}] + run {|let a = 1 and b=2 in b|} ; + [%expect {| let a = 1 and b = 2 in b |}] let%expect_test _ = - run {| (fun x -> x : int -> int) |} ; + run + {|1,2,3,4,5,let a = let a = 1 and b = 2 in b,b,b,b,b,b,b,(let a= 2 in b,c),c,c,c,c,c,c,c,c,c,c,c,c in b|} ; [%expect {| - [(Eval - (Constraint ((Fun (((Var (I "x")), []), (Id (I "x")))), - (Arr ((Con ((I "int"), [])), (Con ((I "int"), []))))))) - ] + 1, 2, 3, 4, 5, + ( + let a = + let a = 1 and b = 2 in + b, b, b, b, b, b, b, + (let a = 2 in b, c), c, c, c, c, c, c, + c, c, c, c, c, c + in + b + ) |}] let%expect_test _ = - run {| let f x y : int = 1 in f |} ; + run + {|fun a b c d b c d b c d b c d b c d b c d b c d b c d b c d b c d b c d b c d -> aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa|} ; [%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"))))) - ] + fun a b c d b c d b c d b c d b c d b c + d b c d b c d b c d b c d b c d b c d -> + aaaa, aaaa, aaaa, aaaa, aaaa, aaaa, + aaaa, aaaa, aaaa, aaaa, aaaa, aaaa, + aaaa, aaaa |}] -(* ======= Types ======= *) - let%expect_test _ = - run {| type foo = A of int |} ; + run + {|fun a b c d d,dd,d d,d d,d d,d d,d d,d d,d d,d d,d d,d d,d d,d d,d d,d ,d -> aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa,aaaa|} ; [%expect {| - [(Type - { id = (I "foo"); params = []; - variants = [{ id = (I "A"); arg = (Some (Con ((I "int"), []))) }] }) - ] + fun a b c d d, dd, d d, d d, d d, d d, d + d, d d, d d, d d, d d, d d, d d, d d, d + d, d, d -> + aaaa, aaaa, aaaa, aaaa, aaaa, aaaa, + aaaa, aaaa, aaaa, aaaa, aaaa, aaaa, + aaaa, aaaa |}] let%expect_test _ = - run {| type foo = A of int list |} ; + run + {|f x y d x x x x x x (xx,xx,xx,xx,xx,xx,xx,xx,xx,xx,xx,xx,xx,xx,xx,xx,xx,x,x) x x x x x x x x x x x x x x x x x x|} ; [%expect {| - [(Type - { id = (I "foo"); params = []; - variants = - [{ id = (I "A"); - arg = (Some (Con ((I "list"), [(Con ((I "int"), []))]))) } - ] - }) - ] + f x y d x x x x x x + ( + xx, xx, xx, xx, xx, xx, xx, xx, xx, + xx, xx, xx, xx, xx, xx, xx, xx, x, x + ) x x x x x x x x x x x x x x x x x x |}] +let%expect_test _ = run {|function a -> b|} ; [%expect {| function a -> b |}] + let%expect_test _ = - run {| type foo = A of (int, string) map |} ; + run {|function a -> b | c -> d|} ; + [%expect {| function a -> b | c -> d |}] + +let%expect_test _ = + run + {|function a,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d -> a,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d | a,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d -> a,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d | a,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d -> a,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d|} ; [%expect {| - [(Type - { id = (I "foo"); params = []; - variants = - [{ id = (I "A"); - arg = - (Some (Con ((I "map"), - [(Con ((I "int"), [])); (Con ((I "string"), []))]))) - } - ] - }) - ] + function + | a, d, d, d, d, d, d, d, d, d, d, d, d, + d, d, d, d, d, d -> + a, d, d, d, d, d, d, d, d, d, d, d, d, + d, d, d, d, d, d + | a, d, d, d, d, d, d, d, d, d, d, d, d, + d, d, d, d, d, d -> + a, d, d, d, d, d, d, d, d, d, d, d, d, + d, d, d, d, d, d + | a, d, d, d, d, d, d, d, d, d, d, d, d, + d, d, d, d, d, d -> + a, d, d, d, d, d, d, d, d, d, d, d, d, + d, d, d, d, d, d |}] let%expect_test _ = - run {| type foo = A of 'a -> 'b -> 'c |} ; + run + {|match a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a with a,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d -> a,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d | a,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d -> a,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d | a,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d -> a,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d,d|} ; [%expect {| - [(Type - { id = (I "foo"); params = []; - variants = - [{ id = (I "A"); - arg = - (Some (Arr ((Var (I "a")), (Arr ((Var (I "b")), (Var (I "c"))))))) } - ] - }) - ] + match + a, a, a, a, a, a, a, a, a, a, a, a, a, + a, a, a, a, a, a, a, a, a, a, a, a, a, + a + with + | a, d, d, d, d, d, d, d, d, d, d, d, d, + d, d, d, d, d, d -> + a, d, d, d, d, d, d, d, d, d, d, d, d, + d, d, d, d, d, d + | a, d, d, d, d, d, d, d, d, d, d, d, d, + d, d, d, d, d, d -> + a, d, d, d, d, d, d, d, d, d, d, d, d, + d, d, d, d, d, d + | a, d, d, d, d, d, d, d, d, d, d, d, d, + d, d, d, d, d, d -> + a, d, d, d, d, d, d, d, d, d, d, d, d, + d, d, d, d, d, d |}] let%expect_test _ = - run {| type foo = A of 'a * 'b * 'c |} ; + run {| match a with a -> b | c -> d|} ; + [%expect {| match a with a -> b | c -> d |}] + +let%expect_test _ = + run + {| match aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa with b -> c | c-> d|} ; [%expect {| - [(Type - { id = (I "foo"); params = []; - variants = - [{ id = (I "A"); - arg = (Some (Tuple ((Var (I "a")), (Var (I "b")), [(Var (I "c"))]))) - } - ] - }) - ] + match + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + with b -> c | c -> d |}] let%expect_test _ = - run {| type foo = A of 'some_type_var |} ; + run + {| match aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa with b -> c | c-> d|} ; [%expect {| - [(Type - { id = (I "foo"); params = []; - variants = [{ id = (I "A"); arg = (Some (Var (I "some_type_var"))) }] }) - ] + match + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + with b -> c | c -> d |}] let%expect_test _ = run - {| type foo = A of - ('a -> int * (string, unit, 'b -> 'c) foo bar option) -> e |} ; + {|if aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa then aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa else aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa|} ; [%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"), []))))) - } - ] - }) - ] + if + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + then + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + else + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa |}] -(* ======= Some other stuff ======= *) +let%expect_test _ = + run {|if a then b else c|} ; [%expect {| if a then b else c |}] let%expect_test _ = - run {| let (f, s) = (f + s, f - s) |} ; + run {|if aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa then b|} ; [%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")))), - [])) - }, - []) - )) - ] + if + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + then b |}] let%expect_test _ = - run {| let (>>=) a b = a ** b |} ; + run + {|if aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa then bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb else c|} ; [%expect {| - [(Let (Nonrec, - ({ pat = (Var (I ">>=")); - expr = - (Fun (((Var (I "a")), [(Var (I "b"))]), - (Apply ((Apply ((Id (I "**")), (Id (I "a")))), (Id (I "b")))))) - }, - []) - )) - ] + if + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + then + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + else c |}] let%expect_test _ = - run {| let (++) a b = a + b |} ; + run + {|a;b;c;d;e;f;g;hf;g;hf;g;hf;g;hf;g;hf;g;hf;g;hf;g;hf;g;hf;g;hf;g;hf;g;hf;g;h|} ; [%expect {| - [(Let (Nonrec, - ({ pat = (Var (I "++")); - expr = - (Fun (((Var (I "a")), [(Var (I "b"))]), - (Apply ((Apply ((Id (I "+")), (Id (I "a")))), (Id (I "b")))))) - }, - []) - )) - ] + a; b; c; d; e; f; g; hf; g; hf; g; hf; g; + hf; g; hf; g; hf; g; hf; g; hf; g; hf; g; + hf; g; hf; g; hf; g; h |}] let%expect_test _ = run - {| let(*sus*)rec(*firstcomment*)f n = (* second comment *) (* third - comment*) n + 1 |} ; + {|let x = A (1,2,3,4,5,6,3,4,5,6,3,4,5,6,3,4,5,6,3,4,5,6,3,4,5,6,3,4,5,6,3,4,5,6,3,4,5,6,7) in x|} ; [%expect {| - [(Let (Rec, - ({ pat = (Var (I "f")); - expr = - (Fun (((Var (I "n")), []), - (Apply ((Apply ((Id (I "+")), (Id (I "n")))), (Const (Int 1)))))) - }, - []) - )) - ] + let x = + A + ( + 1, 2, 3, 4, 5, 6, 3, 4, 5, 6, 3, 4, 5, + 6, 3, 4, 5, 6, 3, 4, 5, 6, 3, 4, 5, 6, + 3, 4, 5, 6, 3, 4, 5, 6, 3, 4, 5, 6, 7 + ) + in + x |}] let%expect_test _ = - run {| letrec f n = n + 1 |} ; + run + {|(avvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv: aa->ba->ba->ba->ba->ba->ba->ba->ba->ba->ba->ba->ba->ba->ba->ba->ba->ba->ba->ba->ba->b->b)|} ; [%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))))))) - ] + ( + avvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv + : aa -> ba -> ba -> ba -> ba -> ba -> ba + -> ba -> ba -> ba -> ba -> ba -> ba -> ba + -> ba -> ba -> ba -> ba -> ba -> ba -> ba + -> b -> b + ) |}] let%expect_test _ = - run {| let reca = 1 |} ; + run + {|type foo = A of string -> string -> string -> string -> string -> string | B of int |} ; [%expect - {| [(Let (Nonrec, ({ pat = (Var (I "reca")); expr = (Const (Int 1)) }, [])))] |}] + {| + type foo = + | A of + string -> string -> string -> string -> string + -> string + | B of int + |}] let%expect_test _ = - run {| type 'a list = Nil | Cons of 'a * 'a list |} ; + run + {|type ('a, 'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a)foo = A of string -> string -> string -> string -> string -> string | B of int |} ; [%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"))])), []))) - } - ] - }) - ] + type ( + 'a, 'a, 'a, 'a, 'a, 'a, 'a, 'a, 'a, + 'a, 'a, 'a, 'a, 'a, 'a, 'a, 'a, 'a, + 'a + ) foo = + | A of + string -> string -> string -> string -> string + -> string + | B of int |}] -let%expect_test _ = run {| 1a |} ; [%expect {| syntax error |}] - let%expect_test _ = - run {| 1 ;; a |} ; - [%expect {| [(Eval (Const (Int 1))); (Eval (Id (I "a")))] |}] + run + {|type ('a, 'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a,'a) foo = A of string |} ; + [%expect + {| + type ( + 'a, 'a, 'a, 'a, 'a, 'a, 'a, 'a, 'a, + 'a, 'a, 'a, 'a, 'a, 'a, 'a, 'a, 'a + ) foo = A of string + |}]