Migrate to OCaml 5.4.1

.devcontainer/Dockerfile

@@ -0,0 +1,39 @@
+FROM alpine:3.20
+
+RUN apk add --no-cache \
+    bash \
+    sudo \
+    build-base \
+    opam \
+    m4 \
+    pkgconfig \
+    openssl-dev \
+    libev-dev \
+    linux-headers \
+    git \
+    curl
+
+ARG USERNAME=vscode
+ARG USER_UID=1000
+ARG USER_GID=1000
+
+RUN addgroup -g $USER_GID $USERNAME \
+    && adduser -u $USER_UID -G $USERNAME -D -s /bin/bash $USERNAME \
+    && echo "$USERNAME ALL=(ALL) NOPASSWD:ALL" >> /etc/sudoers
+
+USER $USERNAME
+ENV HOME=/home/$USERNAME
+
+RUN opam init --disable-sandboxing --shell-setup -y \
+    && opam switch create 5.4.1 ocaml-base-compiler.5.4.1 \
+    && eval $(opam env)
+
+WORKDIR /workspaces/app
+COPY --chown=$USERNAME:$USERNAME *.opam dune-project* ./
+
+# Install project deps and tools
+# TODO: this might not work properly
+RUN opam exec -- opam install . --deps-only -y \
+    && opam exec -- opam install ocaml-lsp-server dune utop -y
+
+RUN echo 'eval $(opam env)' >> ~/.bashrc

.devcontainer/devcontainer.json

@@ -0,0 +1,26 @@
+// For format details, see https://aka.ms/devcontainer.json. For config options, see the
+// README at: https://github.com/devcontainers/templates/tree/main/src/alpine
+{
+	"name": "Camelot Alpine OCaml 5.4.1",
+	// Or use a Dockerfile or Docker Compose file. More info: https://containers.dev/guide/dockerfile
+	"dockerFile": "Dockerfile",
+
+	// Features to add to the dev container. More info: https://containers.dev/features.
+	// "features": {},
+
+	// Use 'forwardPorts' to make a list of ports inside the container available locally.
+	// "forwardPorts": [],
+
+	// Use 'postCreateCommand' to run commands after the container is created.
+	// "postCreateCommand": "uname -a",
+
+	// Configure tool-specific properties.
+	"customizations": {
+		"vscode": {
+			"extensions": ["ocamllabs.ocaml-platform"]
+		}
+	},
+
+	// Uncomment to connect as root instead. More info: https://aka.ms/dev-containers-non-root.
+	"remoteUser": "vscode"
+}

.github/workflows/workflow.yml

@@ -12,20 +12,19 @@ jobs:
         os:
           - macos-latest
           - ubuntu-latest
-        ocaml-version:
-          - 4.13.0
-          - 4.13.1
+        ocaml-compiler:
+          - 5
 
     runs-on: ${{ matrix.os }}
 
     steps:
       - name: Checkout code
         uses: actions/checkout@v2
 
-      - name: Use OCaml ${{ matrix.ocaml-version }}
-        uses: avsm/setup-ocaml@v1
+      - name: Setup OCaml
+        uses: avsm/setup-ocaml@v3
         with:
-          ocaml-version: ${{ matrix.ocaml-version }}
+          ocaml-compiler: ${{ matrix.ocaml-compiler }}
 
       - name: Set git user
         run: |

camelot.opam

@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "2.0.1"
+version: "2.1.1"
 synopsis: "An OCaml Linter / Style Checker"
 maintainer: ["William Goeller <william@williamgoeller.com>"]
 authors: ["Vighnesh Vijay" "Daniel Like" "William Goeller"]
@@ -9,11 +9,11 @@ homepage: "https://github.com/upenn-cis1xx/camelot"
 bug-reports: "https://github.com/upenn-cis1xx/camelot/issues"
 depends: [
   "dune" {>= "2.5"}
-  "ocaml" {>= "4.13.0" & < "4.14.0"}
+  "ocaml" {>= "5.4.1" & < "5.5.0"}
   "ANSITerminal" {>= "0.8"}
   "yojson" {>= "1.7.0"}
   "camlp-streams" {>= "5.0.1"}
-  "ppx_expect" {with-test & <= "v0.15.1"}
+  "ppx_expect" {with-test & >= "v0.17.3"}
   "odoc" {with-doc & >= "1.5.0"}
 ]
 dev-repo: "git+https://github.com/upenn-cis1xx/camelot.git"

dune-project

@@ -2,7 +2,7 @@
 (name camelot)
 (generate_opam_files true)
 
-(version 2.0.1)
+(version 2.1.1)
 
 (source (github upenn-cis1xx/camelot))
 (license "Apache-2.0")
@@ -14,11 +14,11 @@
  (synopsis "An OCaml Linter / Style Checker")
  (depends
   (dune (>= 2.5))
-  (ocaml (and (>= 4.13.0) (< 4.14.0)))
+  (ocaml (and (>= 5.4.1) (< 5.5.0)))
   (ANSITerminal (>= 0.8))
   (yojson (>= 1.7.0))
   (camlp-streams (>= 5.0.1))
-  (ppx_expect (and :with-test (<= v0.15.1)))
+  (ppx_expect (and :with-test (>= v0.17.3)))
   (odoc (and :with-doc (>= 1.5.0)))
  )
 )

lib/style/match.ml

@@ -12,7 +12,7 @@ let make_check (pred: Parsetree.pattern -> bool) gen_error override_len enable_u
 
   let rec unwrap_tuple (p : Parsetree.pattern) : Parsetree.pattern list =
     begin match p.ppat_desc with
-      | Ppat_tuple pat_list -> List.concat_map unwrap_tuple pat_list
+      | Ppat_tuple (pat_list, _) -> List.concat_map (fun (_, pat) -> unwrap_tuple pat) pat_list
       | _ -> [p]
     end
   in
@@ -96,7 +96,7 @@ module MatchListVerbose : EXPRCHECK = struct
     begin match pat.ppat_desc with
       | Ppat_construct ({txt = Lident "::";_}, Some (_, matchcase)) ->
         begin match matchcase.ppat_desc with
-          | Ppat_tuple ([_; cons_case]) -> is_pat_constr cons_case "[]"
+          | Ppat_tuple ([_; (_, cons_case)], _) -> is_pat_constr cons_case "[]"
           | _ -> false
         end
       | _ -> false 

lib/traverse/descent.ml

@@ -49,7 +49,9 @@ module T = struct
     | Ptyp_var _ -> ()
     | Ptyp_arrow (_lab, t1, t2) ->
       sub.typ sub t1; sub.typ sub t2
-    | Ptyp_tuple tyl -> List.iter (sub.typ sub) tyl
+    (* Unpack the label tuple for 5.4.1 *)
+    | Ptyp_tuple tyl -> 
+      List.iter (fun (_, t) -> sub.typ sub t) tyl
     | Ptyp_constr (lid, tl) ->
       iter_loc sub lid; List.iter (sub.typ sub) tl
     | Ptyp_object (ol, _o) ->
@@ -60,10 +62,13 @@ module T = struct
     | Ptyp_variant (rl, _b, _ll) ->
       List.iter (row_field sub) rl
     | Ptyp_poly (_, t) -> sub.typ sub t
-    | Ptyp_package (lid, l) ->
+    (* Unpack the new package_type record for 5.4.1 *)
+    | Ptyp_package { ppt_path = lid; ppt_cstrs = l; _ } ->
       iter_loc sub lid;
       List.iter (iter_tuple (iter_loc sub) (sub.typ sub)) l
     | Ptyp_extension x -> sub.extension sub x
+    | Ptyp_open (lid, t) ->
+      iter_loc sub lid; sub.typ sub t
 
   let iter_type_declaration sub
       {ptype_name; ptype_params; ptype_cstrs;
@@ -113,7 +118,7 @@ module T = struct
     sub.attributes sub ptyexn_attributes
 
   let iter_extension_constructor_kind sub = function
-      Pext_decl(ctl, cto) ->
+      Pext_decl(_, ctl, cto) ->
       iter_constructor_arguments sub ctl; iter_opt (sub.typ sub) cto
     | Pext_rebind li ->
       iter_loc sub li
@@ -244,6 +249,7 @@ module M = struct
       sub.module_expr sub body
     | Pmod_apply (m1, m2) ->
       sub.module_expr sub m1; sub.module_expr sub m2
+    | Pmod_apply_unit m -> sub.module_expr sub m
     | Pmod_constraint (m, mty) ->
       sub.module_expr sub m; sub.module_type sub mty
     | Pmod_unpack e -> sub.expr sub e
@@ -284,17 +290,35 @@ module E = struct
     | Pexp_let (_r, vbs, e) ->
       List.iter (sub.value_binding sub) vbs;
       sub.expr sub e
-    | Pexp_fun (_lab, def, p, e) ->
-      iter_opt (sub.expr sub) def;
-      sub.pat sub p;
-      sub.expr sub e
-    | Pexp_function pel -> sub.cases sub pel
+    (* Handle consolidated Pexp_function in >=5.2 *)
+    | Pexp_function (params, constraint_opt, body) ->
+      List.iter
+        (fun param ->
+           match param.pparam_desc with
+           | Pparam_val (_lab, def, p) ->
+             iter_opt (sub.expr sub) def;
+             sub.pat sub p
+           | Pparam_newtype _ -> ()
+        ) params;
+
+      begin match constraint_opt with
+        | Some (Pconstraint ty) -> sub.typ sub ty
+        | Some (Pcoerce (ty1_opt, ty2)) ->
+            iter_opt (sub.typ sub) ty1_opt;
+            sub.typ sub ty2
+        | None -> ()
+      end;
+
+      begin match body with
+        | Pfunction_body e -> sub.expr sub e
+        | Pfunction_cases (cases, _loc, _attrs) -> sub.cases sub cases
+      end
     | Pexp_apply (e, l) ->
       sub.expr sub e; List.iter (iter_snd (sub.expr sub)) l
     | Pexp_match (e, pel) ->
       sub.expr sub e; sub.cases sub pel
     | Pexp_try (e, pel) -> sub.expr sub e; sub.cases sub pel
-    | Pexp_tuple el -> List.iter (sub.expr sub) el
+    | Pexp_tuple el -> List.iter (fun (_, pat) -> (sub.expr sub pat)) el
     | Pexp_construct (lid, arg) ->
       iter_loc sub lid; iter_opt (sub.expr sub) arg
     | Pexp_variant (_lab, eo) ->
@@ -341,7 +365,15 @@ module E = struct
       sub.expr sub e; iter_opt (sub.typ sub) t
     | Pexp_object cls -> sub.class_structure sub cls
     | Pexp_newtype (_s, e) -> sub.expr sub e
-    | Pexp_pack me -> sub.module_expr sub me
+    | Pexp_pack (me, pt_opt) ->
+      sub.module_expr sub me;
+      (* Unpack and traverse the optional package_type record *)
+      begin match pt_opt with
+        | Some { ppt_path = lid; ppt_cstrs = l; _ } ->
+          iter_loc sub lid;
+          List.iter (iter_tuple (iter_loc sub) (sub.typ sub)) l
+        | None -> ()
+      end
     | Pexp_open (o, e) ->
       sub.open_declaration sub o; sub.expr sub e
     | Pexp_letop {let_; ands; body} ->
@@ -371,7 +403,7 @@ module P = struct
     | Ppat_alias (p, s) -> sub.pat sub p; iter_loc sub s
     | Ppat_constant _ -> ()
     | Ppat_interval _ -> ()
-    | Ppat_tuple pl -> List.iter (sub.pat sub) pl
+    | Ppat_tuple (pl, _) -> List.iter (fun (_, pat) -> sub.pat sub pat) pl
     | Ppat_construct (l, p) ->
       iter_loc sub l; iter_opt (sub.pat sub) (Option.map snd p)
     | Ppat_variant (_l, p) -> iter_opt (sub.pat sub) p
@@ -388,6 +420,7 @@ module P = struct
     | Ppat_extension x -> sub.extension sub x
     | Ppat_open (lid, p) ->
       iter_loc sub lid; sub.pat sub p
+    | Ppat_effect (p1, p2) -> sub.pat sub p1; sub.pat sub p2
 
 end
 

lib/utils/astutils.ml

@@ -62,7 +62,7 @@ let is_singleton_list : exp -> bool = fun e ->
   begin match e.pexp_desc with
     | Pexp_construct ({txt = Lident "::";_}, Some cons) ->
       begin match cons.pexp_desc with
-        | Pexp_tuple [e_id; e_empty] ->
+        | Pexp_tuple [(_, e_id); (_, e_empty)] ->
           (is_exp_const e_id || is_exp_id e_id) && e_empty =| "[]"
         | _ -> false
       end
@@ -109,7 +109,7 @@ let binding_of_lcase (case: Parsetree.case) : string =
   begin match case.pc_lhs.ppat_desc with
     | Ppat_construct ({txt = Lident "::"; loc = _}, Some (_, bound)) ->
       begin match bound.ppat_desc with
-        | Ppat_tuple [_; tail] ->
+        | Ppat_tuple ([_; (_, tail)], _) ->
           begin match tail.ppat_desc with
             | Ppat_var {txt = t; loc = _} -> t
             | _ -> ""
@@ -124,7 +124,7 @@ let uses_func_recursively_list (case: Parsetree.case) func_name tail_binding : b
     | Pexp_construct ({txt = Lident "::"; loc = _},
                       Some bound) ->
       begin match bound.pexp_desc with
-        | Pexp_tuple ([_; tl]) ->
+        | Pexp_tuple ([_; (_, tl)]) ->
           begin match tl.pexp_desc with
             | Pexp_apply (func, args) ->
               func =~ func_name &&
@@ -145,12 +145,24 @@ let uses_func_recursively_list_any (case: Parsetree.case) func_name tail_binding
                                  List.exists (fun (_, arg) -> arg =~ tail_binding) args
     | _ -> false in
 
-  begin match skipped.pexp_desc with
-    | Pexp_apply ( func, l) ->
+  let is_short_circuit (func: Parsetree.expression) =
+    match func.pexp_desc with
+    | Pexp_ident {txt = lident; _} ->
+        begin match lident with
+        | Longident.Lident "||" | Longident.Ldot (_, {txt = "||"; _})
+        | Longident.Lident "&&" | Longident.Ldot (_, {txt = "&&"; _})
+        | Longident.Lident "or"  | Longident.Ldot (_, {txt = "or"; _})
+        | Longident.Lident "and" | Longident.Ldot (_, {txt = "and"; _}) -> true
+        | _ -> false
+        end
+    | _ -> false
+  in
 
-      not (func =~ "::") && List.exists (fun (_, combine_arg) ->
+  begin match skipped.pexp_desc with
+    | Pexp_apply (func, l) ->
+      not (func =~ "::") && not (is_short_circuit func) && List.exists (fun (_, combine_arg) ->
           contains_recursive_call combine_arg
-        ) l
+      ) l
     | _ -> false
   end
 
@@ -161,7 +173,7 @@ let uses_func_recursively_list_any (case: Parsetree.case) func_name tail_binding
 let rec body_of_fun (exp: Parsetree.expression) : Parsetree.expression =
   let skipped = skip_seq_let exp in
   begin match skipped.pexp_desc with
-    | Pexp_fun (_, _, _, e) -> e |> skip_seq_let |> body_of_fun
+    | Pexp_function (_, _, Pfunction_body e) -> e |> skip_seq_let |> body_of_fun
     | _ -> skipped
   end
 

lib/utils/expeq.ml

@@ -15,7 +15,8 @@ and exp_desc_eq (el: Parsetree.expression_desc) (er: Parsetree.expression_desc)
   | Pexp_apply (el,largs), Pexp_apply (er, rargs) ->
     exp_eq el er &&
     List.for_all2 (fun (_, l) (_, r) -> exp_eq l r ) largs rargs
-  | Pexp_tuple ls, Pexp_tuple rs -> List.for_all2 (exp_eq) ls rs
+  | Pexp_tuple ls, Pexp_tuple rs -> 
+    List.for_all2 (fun (_, l_exp) (_, r_exp) -> exp_eq l_exp r_exp) ls rs (* Handle labeled tuples*)
   | Pexp_construct ({txt = Lident l; _}, None), Pexp_construct ({txt = Lident r; _}, None) ->
     l = r 
   | Pexp_construct ({txt = Lident l; _}, Some el), Pexp_construct ({txt = Lident r; _}, Some er) ->
@@ -29,4 +30,5 @@ and value_binding_eq (el: Parsetree.value_binding) (er: Parsetree.value_binding)
 and pat_eq (_el: Parsetree.pattern) (_er: Parsetree.pattern) =
   false
 
-and const_eq (el: Parsetree.constant) (er: Parsetree.constant) = el = er
+and const_eq (c : Parsetree.constant) (d : Parsetree.constant) =
+  c.pconst_desc = d.pconst_desc

test/examples/hof.ml

@@ -19,3 +19,21 @@ let rec sum_verbose (l: int list) =
   | [] -> 0
   | h :: t -> h + sum_verbose t
 
+(* these functions should not be flagged because they shortcircuit *)
+let rec int_member (i : int) (l : int list) : bool =
+  match l with 
+  | [] -> false 
+  | x::xs -> (i = x) || (int_member i xs)
+
+let rec string_member (s: string) (l: string list) : bool =
+  begin match l with
+  | [] -> false
+  | x :: xs -> s = x || string_member s xs
+  end
+
+(* this function _should_ be flagged since it reimplements List.fold_right *)
+let rec fold (combine: 'a -> 'b -> 'b) (base: 'b) (l: 'a list) : 'b =
+  begin match l with
+  | [] -> base
+  | x :: xs -> combine x (fold combine base xs)
+  end

test/test.ml

@@ -642,6 +642,16 @@ let%expect_test _ =
   let to_lint = to_ast file in
   lint_and_hint to_lint;
   [%expect{|
+    (* ------------------------------------------------------------------------ *)
+    File ./examples/hof.ml, lines 35-39, columns: 0-5
+    Warning:
+    overly verbose function implementation
+    You wrote:
+    let rec fold (combine : 'a -> 'b -> 'b) (base : 'b) (l : 'a list) : 'b=
+      match l with | [] -> base | x::xs -> combine x (fold combine base xs)
+    Consider:
+    using a higher order function like fold
+
     (* ------------------------------------------------------------------------ *)
     File ./examples/hof.ml, lines 17-20, columns: 0-31
     Warning: