139 lines
4.6 KiB
OCaml
139 lines
4.6 KiB
OCaml
(* Localization support *)
|
|
|
|
open Format
|
|
open Yanais_syntax.Tys
|
|
|
|
module type LocaleT = sig
|
|
val pp_loc_span : formatter -> loc_span -> unit
|
|
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 pp_loc_span (fmtp : formatter) (s : loc_span) =
|
|
Asai.Range.dump fmtp s;
|
|
pp_print_string fmtp "; "
|
|
|
|
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"
|
|
| XTagGroupItem -> "tag-group-item"
|
|
| XIdent -> "identifier"
|
|
|
|
let pp_error fmtp (k,s) =
|
|
pp_open_box fmtp 0;
|
|
pp_print_string fmtp "error; ";
|
|
pp_loc_span fmtp s;
|
|
(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 pp_loc_span (fmtp : formatter) (s : loc_span) =
|
|
let source_name (src : Asai.Range.source) = match src with
|
|
| `File s -> s
|
|
| `String s -> Option.value s.title ~default:"<none>"
|
|
in let tr_pos (p : Asai.Range.position) = (p.line_num - 1, p.offset - p.start_of_line)
|
|
in match Asai.Range.view s with
|
|
| `Range (startp, endp) ->
|
|
let (startl, startc) = tr_pos startp in
|
|
let (endl, endc) = tr_pos endp in
|
|
Format.fprintf fmtp "File: @,%s %@@ (line %d col %d@ - line %d col %d)"
|
|
(source_name startp.source) startl startc endl endc
|
|
| `End_of_file p ->
|
|
let (pl, pc) = tr_pos p in
|
|
Format.fprintf fmtp "File: @,%s, EOF %@@ (line %d col %d)"
|
|
(source_name p.source) pl pc
|
|
|
|
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"
|
|
| XTagGroupItem -> "tag group item"
|
|
| XIdent -> "identifier"
|
|
|
|
let pp_error fmtp (k,s) =
|
|
pp_open_box fmtp 0;
|
|
pp_print_string fmtp "Error: ";
|
|
pp_loc_span fmtp s;
|
|
(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)
|