From 48aa147804890e9bb24ce23a7e58da40e3bc5aa7 Mon Sep 17 00:00:00 2001 From: Brian Ward Date: Mon, 3 Aug 2026 12:06:17 -0400 Subject: [PATCH] Start 'Std' module, move Common over --- src/common/Files.ml | 4 ++-- src/common/dune | 2 +- src/frontend/Semantic_error.ml | 12 ++++++------ src/frontend/Typechecker.ml | 2 +- src/{common => std}/Nonempty_list.ml | 3 +-- src/{common => std}/Nonempty_list.mli | 0 src/std/dune | 6 ++++++ src/std/std.ml | 26 ++++++++++++++++++++++++++ 8 files changed, 43 insertions(+), 12 deletions(-) rename src/{common => std}/Nonempty_list.ml (68%) rename src/{common => std}/Nonempty_list.mli (100%) create mode 100644 src/std/dune create mode 100644 src/std/std.ml diff --git a/src/common/Files.ml b/src/common/Files.ml index 755aca109..c09494203 100644 --- a/src/common/Files.ml +++ b/src/common/Files.ml @@ -1,4 +1,4 @@ -open Core +open Std let stanfunctions_suffix = ".stanfunctions" @@ -8,4 +8,4 @@ let remove_dotstan s = (String.chop_suffix ~suffix:".stan" s) |> Option.value ~default:s -let is_stanfunctions = String.is_suffix ~suffix:stanfunctions_suffix +let is_stanfunctions = String.ends_with ~suffix:stanfunctions_suffix diff --git a/src/common/dune b/src/common/dune index 101550e18..131a0da9d 100644 --- a/src/common/dune +++ b/src/common/dune @@ -1,6 +1,6 @@ (library (name common) (public_name stanc.common) - (libraries core fmt) + (libraries std fmt) (instrumentation (backend bisect_ppx))) diff --git a/src/frontend/Semantic_error.ml b/src/frontend/Semantic_error.ml index d31ba7374..9fa5d6ab8 100644 --- a/src/frontend/Semantic_error.ml +++ b/src/frontend/Semantic_error.ml @@ -14,7 +14,7 @@ let quoted = SignatureMismatch.quoted let found_type ppf = Fmt.pf ppf "@ Instead found type %a." (actual_style UnsizedType.pp) -let rec expected_types : UnsizedType.t Common.Nonempty_list.t Fmt.t = +let rec expected_types : UnsizedType.t Std.Nonempty_list.t Fmt.t = let ust = expected_style UnsizedType.pp in fun ppf l -> match l with @@ -23,7 +23,7 @@ let rec expected_types : UnsizedType.t Common.Nonempty_list.t Fmt.t = | [t1; t2; t3] -> Fmt.pf ppf "%a,@ %a,@ or %a" ust t1 ust t2 ust t3 | t :: ts -> Fmt.pf ppf "%a,@ %a" ust t expected_types - (ts |> Common.Nonempty_list.of_list_exn) + (ts |> Std.Nonempty_list.of_list_exn) module TypeError = struct type t = @@ -138,7 +138,7 @@ module TypeError = struct quoted name name pp_lik_args ellipsis ellipsis pp_laplace_tols pp_supplied_tys info () - let rec expected_types : UnsizedType.t Common.Nonempty_list.t Fmt.t = + let rec expected_types : UnsizedType.t Std.Nonempty_list.t Fmt.t = let ust = expected_style UnsizedType.pp in fun ppf l -> match l with @@ -147,7 +147,7 @@ module TypeError = struct | [t1; t2; t3] -> Fmt.pf ppf "%a,@ %a,@ or %a" ust t1 ust t2 ust t3 | t :: ts -> Fmt.pf ppf "%a,@ %a" ust t expected_types - (ts |> Common.Nonempty_list.of_list_exn) + (ts |> Std.Nonempty_list.of_list_exn) let pp ppf = function | IncorrectReturnType (t1, t2) -> @@ -210,7 +210,7 @@ module TypeError = struct Fmt.pf ppf "The inner type in reduce_sum array must be %a.%a" expected_types (Stan_math_signatures.reduce_sum_slice_types - |> Common.Nonempty_list.of_list_exn) + |> Std.Nonempty_list.of_list_exn) found_type ty | IllTypedReduceSum (name, arg_tys, expected_args, error, _callback_location) -> @@ -764,7 +764,7 @@ module StatementError = struct lt.type_ found_type rt.type_ | IllTypedAssignment (op, lt, rt) -> let pp_expected_types ppf signatures = - match Common.Nonempty_list.of_list signatures with + match Std.Nonempty_list.of_list signatures with | None -> Fmt.pf ppf "There are no valid right hand sides for the given left hand \ diff --git a/src/frontend/Typechecker.ml b/src/frontend/Typechecker.ml index 5da35b5b3..c6a1be141 100644 --- a/src/frontend/Typechecker.ml +++ b/src/frontend/Typechecker.ml @@ -280,7 +280,7 @@ let check_id cf tenv id = let loc = id.id_loc in let (value :: _) = Env.find tenv (Utils.stdlib_distribution_name id.name) - |> Common.Nonempty_list.of_list + |> Std.Nonempty_list.of_list |> Option.value_or_thunk ~default:(fun () -> Semantic_error.ident_not_in_scope loc id.name (Env.nearest_ident tenv id.name) diff --git a/src/common/Nonempty_list.ml b/src/std/Nonempty_list.ml similarity index 68% rename from src/common/Nonempty_list.ml rename to src/std/Nonempty_list.ml index ec08eabff..9457d1adf 100644 --- a/src/common/Nonempty_list.ml +++ b/src/std/Nonempty_list.ml @@ -5,6 +5,5 @@ let of_list : _ list -> _ t option = function | hd :: tl -> Some (hd :: tl) let of_list_exn : _ list -> _ t = function - | [] -> - ICE.internal_error "Nonempty_list.of_list_exn: empty list" [@coverage off] + | [] -> raise (Invalid_argument "Nonempty_list.of_list_exn: empty list") | hd :: tl -> hd :: tl diff --git a/src/common/Nonempty_list.mli b/src/std/Nonempty_list.mli similarity index 100% rename from src/common/Nonempty_list.mli rename to src/std/Nonempty_list.mli diff --git a/src/std/dune b/src/std/dune new file mode 100644 index 000000000..b95d9f7db --- /dev/null +++ b/src/std/dune @@ -0,0 +1,6 @@ +(library + (name std) + (public_name stanc.std) + (libraries sexplib0) + (instrumentation + (backend bisect_ppx))) diff --git a/src/std/std.ml b/src/std/std.ml new file mode 100644 index 000000000..cd67322fc --- /dev/null +++ b/src/std/std.ml @@ -0,0 +1,26 @@ +(** Extensions to the standard library. Most files in the project should begin + [open Std]. *) + +(** New modules *) + +module Nonempty_list = Nonempty_list + +(** OCaml Stdlib with labeled functions *) + +include StdLabels +include MoreLabels + +(** A few extensions to builtin modules *) + +module Option = struct + include Option + + let first_some a b = Option.blend Fun.const a b +end + +module String = struct + include String + + let chop_suffix ~suffix s = + if ends_with ~suffix s then Some (drop_last (length suffix) s) else None +end