139 lines
4.5 KiB
OCaml
139 lines
4.5 KiB
OCaml
(* Localization support *)
|
|
|
|
open Format
|
|
open Yanais_syntax.Tys
|
|
|
|
module type LocaleT = sig
|
|
val fmt_loc_span : loc_span_full -> string
|
|
val fmt_error_ctx : error_ctx -> string
|
|
val pp_error : formatter -> error -> unit
|
|
end
|
|
|
|
(* TODO:
|
|
* print locations as lines and columns
|
|
*)
|
|
|
|
module Bare : LocaleT = struct
|
|
let fmt_loc_span ((file, s) : loc_span_full) =
|
|
let b = Buffer.create 64 in
|
|
Buffer.add_string b "file=";
|
|
Buffer.add_string b file;
|
|
Buffer.add_string b "; start=";
|
|
Buffer.add_string b (string_of_int s.start);
|
|
Buffer.add_string b "; len=";
|
|
Buffer.add_string b (Unsigned.UInt32.to_int s.length |> string_of_int);
|
|
Buffer.add_string b "; ";
|
|
Buffer.contents b
|
|
|
|
let fmt_error_ctx = function
|
|
| XComment -> "comment"
|
|
| XExpression -> "expression"
|
|
| XLambda -> "[ty]lambda"
|
|
| XLet -> "let-expresssion"
|
|
| XLiteral -> "literal"
|
|
| XParens -> "parentheses"
|
|
| XSemiColon -> "semi-colon"
|
|
| XPattern -> "pattern"
|
|
| XRecord -> "record"
|
|
| XRefOf -> "ref-of"
|
|
| XSelect -> "selection"
|
|
| XString -> "string"
|
|
| XTagGroup -> "tag-group"
|
|
| XIdent -> "identifier"
|
|
|
|
let pp_error fmtp (k,file,s) =
|
|
pp_open_box fmtp 0;
|
|
pp_print_string fmtp "error; ";
|
|
fmt_loc_span (file, s) |> pp_print_string fmtp;
|
|
(match k with
|
|
| EExpected x ->
|
|
pp_print_string fmtp "#expected; ctx=";
|
|
pp_print_string fmtp (fmt_error_ctx x)
|
|
| EUnexpectedEof x ->
|
|
pp_print_string fmtp "#unexpected_eof; ctx=";
|
|
pp_print_string fmtp (fmt_error_ctx x)
|
|
| EUnexpectedToken (x, t) ->
|
|
pp_print_string fmtp "#unexpected_eof; ctx=";
|
|
pp_print_string fmtp (fmt_error_ctx x);
|
|
pp_print_string fmtp "; token=";
|
|
pp_print_string fmtp (token_to_string t)
|
|
| EUnhandled x ->
|
|
pp_print_string fmtp "#unhandled; ";
|
|
pp_print_string fmtp (String.escaped x)
|
|
| ERecordDupIdent x ->
|
|
pp_print_string fmtp "#record_dup_ident; ident=";
|
|
pp_print_string fmtp x
|
|
| EPatternDupIdent x ->
|
|
pp_print_string fmtp "#pattern_dup_ident; ident=";
|
|
pp_print_string fmtp x
|
|
| EUnknownIdent x ->
|
|
pp_print_string fmtp "#unknown_ident; ident=";
|
|
pp_print_string fmtp x
|
|
);
|
|
pp_close_box fmtp ()
|
|
end
|
|
|
|
module En : LocaleT = struct
|
|
let fmt_loc_span ((file, s) : loc_span_full) =
|
|
let b = Buffer.create 64 in
|
|
Buffer.add_string b "File ";
|
|
Buffer.add_string b file;
|
|
Buffer.add_string b ": Span ";
|
|
Buffer.add_string b (string_of_int s.start);
|
|
Buffer.add_string b "..+";
|
|
Buffer.add_string b (Unsigned.UInt32.to_int s.length |> string_of_int);
|
|
Buffer.add_string b ": ";
|
|
Buffer.contents b
|
|
|
|
let fmt_error_ctx = function
|
|
| XComment -> "comment"
|
|
| XExpression -> "expression"
|
|
| XLambda -> "(ty)lambda"
|
|
| XLet -> "let expresssion"
|
|
| XLiteral -> "literal"
|
|
| XParens -> "parentheses"
|
|
| XSemiColon -> "semi-colon"
|
|
| XPattern -> "pattern"
|
|
| XRecord -> "record"
|
|
| XRefOf -> "ref-of"
|
|
| XSelect -> "selection"
|
|
| XString -> "string"
|
|
| XTagGroup -> "tag group"
|
|
| XIdent -> "identifier"
|
|
|
|
let pp_error fmtp (k,file,s) =
|
|
pp_open_box fmtp 0;
|
|
pp_print_string fmtp "Error: ";
|
|
fmt_loc_span (file, s) |> pp_print_string fmtp;
|
|
(match k with
|
|
| EExpected x ->
|
|
pp_print_string fmtp "expected ";
|
|
pp_print_string fmtp (fmt_error_ctx x)
|
|
| EUnexpectedEof x ->
|
|
pp_print_string fmtp "end of file encountered inside ";
|
|
pp_print_string fmtp (fmt_error_ctx x)
|
|
| EUnexpectedToken (x, t) ->
|
|
pp_print_string fmtp "unexpected token inside ";
|
|
pp_print_string fmtp (fmt_error_ctx x);
|
|
pp_print_string fmtp ": ";
|
|
pp_print_string fmtp (token_to_string t)
|
|
| EUnhandled x ->
|
|
pp_print_string fmtp "unhandled charachter: ";
|
|
pp_print_string fmtp (String.escaped x)
|
|
| ERecordDupIdent x ->
|
|
pp_print_string fmtp "duplicated record field identifier: ";
|
|
pp_print_string fmtp x
|
|
| EPatternDupIdent x ->
|
|
pp_print_string fmtp "duplicated pattern field identifier: ";
|
|
pp_print_string fmtp x
|
|
| EUnknownIdent x ->
|
|
pp_print_string fmtp "unknown identifier: ";
|
|
pp_print_string fmtp x
|
|
);
|
|
pp_close_box fmtp ()
|
|
end
|
|
|
|
let get = function
|
|
| "en" -> (module En: LocaleT)
|
|
| _ -> (module Bare: LocaleT)
|