diff --git a/dune-project b/dune-project index 03dbd9e..197aea5 100644 --- a/dune-project +++ b/dune-project @@ -25,7 +25,6 @@ (depends (ocaml (>= 4.12)) - fmt dune pprint crunch diff --git a/lib/01_diagnostics/Location.ml b/lib/01_diagnostics/Location.ml index 2b1165d..e6d0b74 100644 --- a/lib/01_diagnostics/Location.ml +++ b/lib/01_diagnostics/Location.ml @@ -63,5 +63,5 @@ let to_string loc = let pp ppf loc = match (Pinc_Source.name loc.loc_start.source, loc = none) with | None, _ | _, true -> () - | Some _, _ -> Fmt.pf ppf "%a" Fmt.(styled `Faint string) (to_string loc) + | Some _, _ -> Format.fprintf ppf "%s" (Style.faint (to_string loc)) ;; diff --git a/lib/01_diagnostics/Pinc_Diagnostics.ml b/lib/01_diagnostics/Pinc_Diagnostics.ml index eeab77f..3c4713e 100644 --- a/lib/01_diagnostics/Pinc_Diagnostics.ml +++ b/lib/01_diagnostics/Pinc_Diagnostics.ml @@ -28,26 +28,17 @@ let print_code ~color ~loc source_code = let buf = Buffer.create 400 in let ppf = Format.formatter_of_buffer buf in - Fmt.set_style_renderer - ppf - (if color <> `None then - `Ansi_tty - else - `None); let () = lines |> List.iter @@ fun (line_number, line) -> - if line_number >= highlight_line_start && line_number <= highlight_line_end then - Fmt.pf - ppf - "%a" - Fmt.(styled `Bold (styled color (fun ppf -> Fmt.pf ppf "%4d"))) - line_number + if line_number >= highlight_line_start && line_number <= highlight_line_end then ( + let num_str = Printf.sprintf "%4d" line_number in + Format.fprintf ppf "%s" (Style.wrap ~bold:true ?color num_str)) else - Fmt.pf ppf "%4d" line_number; + Format.fprintf ppf "%4d" line_number; - Fmt.pf ppf " %a " Fmt.(styled `Faint string) "│"; + Format.fprintf ppf " %s " (Style.faint "│"); let did_highlight = ref false in @@ -73,22 +64,23 @@ let print_code ~color ~loc source_code = |> String.iteri @@ fun column_index ch -> let column_number = column_index + 1 in if should_highlight column_number then ( - Fmt.pf ppf "%a" Fmt.(styled `Bold (styled color char)) ch; + let ch_str = String.make 1 ch in + Format.fprintf ppf "%s" (Style.wrap ~bold:true ?color ch_str); did_highlight := true) else - Fmt.pf ppf "%a" Fmt.(styled `None char) ch + Format.fprintf ppf "%c" ch in let () = - if !did_highlight && color = `None then ( + if !did_highlight && color = None then ( Format.pp_print_newline ppf (); - Fmt.pf ppf " %a " Fmt.(styled `Faint string) "│"; + Format.fprintf ppf " %s " (Style.faint "│"); line |> String.iteri @@ fun column_index _ch -> if should_highlight (succ column_index) then - Fmt.pf ppf "^" + Format.fprintf ppf "^" else - Fmt.pf ppf " ") + Format.fprintf ppf " ") in Format.pp_print_newline ppf () @@ -98,15 +90,15 @@ let print_code ~color ~loc source_code = ;; let print_header ppf ~color text = - Fmt.pf ppf "%a" Fmt.(styled `Bold (styled color string)) text + Format.fprintf ppf "%s" (Style.wrap ~bold:true ?color text) ;; let print ~kind ppf (loc : Location.t) = let color = match (Sys.getenv_opt "NO_COLOR", kind) with - | (None | Some ""), `warning -> `Yellow - | (None | Some ""), `error -> `Red - | _ -> `None + | (None | Some ""), `warning -> Some `Yellow + | (None | Some ""), `error -> Some `Red + | _ -> None in let header = @@ -114,24 +106,17 @@ let print ~kind ppf (loc : Location.t) = | `warning -> "WARNING" | `error -> "ERROR" in - Fmt.pf ppf "@[%a@] " (print_header ~color) header; - Fmt.pf ppf "@[%a@]@," Location.pp loc; + Format.fprintf ppf "@[%a@] " (print_header ~color) header; + Format.fprintf ppf "@[%a@]@," Location.pp loc; let source_code = loc |> Location.get_source |> Source.content in if source_code <> "" then - Fmt.pf ppf "@,%s" (print_code ~color ~loc source_code) -;; - -let set_renderer ppf = - match Sys.getenv_opt "NO_COLOR" with - | None | Some "" -> Fmt.set_style_renderer ppf `Ansi_tty - | Some _ -> Fmt.set_style_renderer ppf `None + Format.fprintf ppf "@,%s" (print_code ~color ~loc source_code) ;; let print_error location message = let ppf = Format.err_formatter in - set_renderer ppf; - Fmt.pf ppf "@[@,%a@,%s@,@]" (print ~kind:`error) location message + Format.fprintf ppf "@[@,%a@,%s@,@]" (print ~kind:`error) location message ;; let raise_error location message = @@ -141,6 +126,10 @@ let raise_error location message = let warn location message = let ppf = Format.err_formatter in - set_renderer ppf; - Fmt.pf ppf "@[@,%a@,%s@,@]" (print ~kind:`warning) location message + Format.fprintf ppf "@[@,%a@,%s@,@]" (print ~kind:`warning) location message +;; + +let flush () = + let ppf = Format.err_formatter in + Format.fprintf ppf "%!" ;; diff --git a/lib/01_diagnostics/Pinc_Diagnostics.mli b/lib/01_diagnostics/Pinc_Diagnostics.mli index 255687f..95ce1fd 100644 --- a/lib/01_diagnostics/Pinc_Diagnostics.mli +++ b/lib/01_diagnostics/Pinc_Diagnostics.mli @@ -5,3 +5,4 @@ exception Pinc_error val raise_error : Location.t -> string -> 'a val print_error : Location.t -> string -> unit val warn : Location.t -> string -> unit +val flush : unit -> unit diff --git a/lib/01_diagnostics/Style.ml b/lib/01_diagnostics/Style.ml new file mode 100644 index 0000000..b013041 --- /dev/null +++ b/lib/01_diagnostics/Style.ml @@ -0,0 +1,24 @@ +let code_of_color = function + | Some `Red -> "31" + | Some `Yellow -> "33" + | None -> "" +;; + +let wrap ~bold ?color text = + let styles = [] in + let styles = + match code_of_color color with + | "" -> styles + | color -> color :: styles + in + let styles = + if bold then + "1" :: styles + else + styles + in + let style_codes = String.concat ";" styles in + Printf.sprintf "\027[%sm%s\027[0m" style_codes text +;; + +let faint = Printf.sprintf "\027[2m%s\027[22m" diff --git a/lib/01_diagnostics/dune b/lib/01_diagnostics/dune index 58fabd1..1e1c28c 100644 --- a/lib/01_diagnostics/dune +++ b/lib/01_diagnostics/dune @@ -2,4 +2,4 @@ (name Pinc_Diagnostics) (public_name pinc-lang.diagnostics) (flags :standard -open Pinc_Core) - (libraries Pinc_Core Pinc_Source fmt)) + (libraries Pinc_Core Pinc_Source)) diff --git a/pinc-lang.opam b/pinc-lang.opam index 7ed46f6..482af7b 100644 --- a/pinc-lang.opam +++ b/pinc-lang.opam @@ -8,7 +8,6 @@ homepage: "https://github.com/pinc-official/pinc-lang" bug-reports: "https://github.com/pinc-official/pinc-lang/issues" depends: [ "ocaml" {>= "4.12"} - "fmt" "dune" {>= "3.17"} "pprint" "crunch" diff --git a/pinc-lang.opam.locked b/pinc-lang.opam.locked index 79536c0..52e2c14 100644 --- a/pinc-lang.opam.locked +++ b/pinc-lang.opam.locked @@ -30,7 +30,6 @@ depends: [ "either" {= "1.0.0" & with-dev-setup} "fiber" {= "3.7.0" & with-dev-setup} "fix" {= "20250919" & with-dev-setup} - "fmt" {= "0.11.0"} "fpath" {= "0.7.3" & with-dev-setup} "fs-io" {= "3.23.1" & with-dev-setup} "gen" {= "1.1"}