Source file errors.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
open UtilsLib.Error
module Lexing_o = Lexing
module Syntax_l =
struct
type t =
| UnexpectedEOI
| TrailingChars
| SyntaxError of int
let kind = "Script syntax"
let get_menhir_error_message state =
match ParserMessages.message state with
| message -> message
| exception Not_found -> "Unknown syntax error"
let pp fmt err =
match err with
| UnexpectedEOI -> Format.fprintf fmt "Unexpected@ end@ of@ input"
| TrailingChars -> Format.fprintf fmt "Trailing@ chars"
| SyntaxError s -> Format.fprintf fmt "%a" UtilsLib.Error.pp_text (String.trim (get_menhir_error_message s))
end
module SyntaxErrors = ErrorManager(Syntax_l)
module Lexing_l =
struct
type t =
| Unclosed of string
| BadChar of string
| Malformed
let kind = "Script lexing"
let pp fmt err =
match err with
| Unclosed tok -> Format.fprintf fmt "Unclosed@ \'%s\'" tok
| UnterminatedComment -> Format.fprintf fmt "Unterminated@ comment"
| UnstartedComment -> Format.fprintf fmt "Unstarted@ comment"
| BadChar tok -> Format.fprintf fmt "Bad@ character@ \'%s\'" tok
| Malformed -> Format.fprintf fmt "Malformed@ UTF-8@ input"
end
module LexingErrors = ErrorManager(Lexing_l)
module Type_l =
struct
type t =
| Variable of string * string * string * string * string
| Literal of string * string * string * string
| DefaultValue of string * string * string * string
| Other
let kind = "Script type"
let pp fmt err =
match err with
| Variable (f, p, v, t_exp, t_act) ->
Format.fprintf fmt "Expecting@ %s@ for@ paramater@ \"%s\"@ of@ function@ \"%s\",@ but@ got@ %s.@ The@ type@ of@ variable@ \"%s\"@ was@ inferred@ to@ %s" t_exp p f t_act v t_act
| Literal (f, p, t_exp, t_act) -> Format.fprintf fmt "Expecting@ %s@ for@ parameter@ \"%s\"@ of@ function@ \"%s\",@ but@ got@ %s" t_exp p f t_act
| DefaultValue (f, p, t_exp, t_act) -> Format.fprintf fmt "Expecting@ %s@ for@ the@ default@ value@ of@ parameter@ \"%s\"@ of@ function@ \"%s\",@ but@ got@ %s.@ The@ type@ of@ variable@ \"%s\"@ was@ inferred@ to@ %s" t_exp p f t_act p t_exp
| Other -> Format.fprintf fmt "Unknown@ error"
end
module TypeErrors = ErrorManager(Type_l)
module Script_l =
struct
type t =
| NoSignatureType of string
| NoSignatureTerm
| WrongSignature of string * string
| OnlyLexicon of string
| ArgumentMissing of string * string
| DifferentSig of string * (AcgData.Signature.Data_Signature.t * AcgData.Signature.Data_Signature.t) option
| AlreadyExistingFun of string
| UnusedVariable of string
| UnknownFunction of string
| UnknownParameter of string * string
| ParameterRepeated of string * string
| TooMuchArgs of string
| NoLastValue
| InvalidSpecialFuncCall of string
| MissingFuncTermList of string
| TermListNotAllowed of string
| EmptyPipe of string
| EmptyHelp of string
| AbsSigMismatch of AcgData.Acg_lexicon.Data_Lexicon.(t * t)
| Other
let kind = "Script"
let pp fmt err =
match err with
| NoSignatureType t -> Format.fprintf fmt "No@ signature@ to@ interpret@ type@ \"%s\"" t
| NoSignatureTerm -> Format.fprintf fmt "No@ signature@ to@ interpret@ the@ resulting@ term"
| WrongSignature (sig1, sig2) -> Format.fprintf fmt "This@ term@ is@ in@ the@ signature@ \"%s\"@ but@ is@ used@ with@ an@ other@ signature@ (\"%s\")" sig1 sig2
| OnlyLexicon s -> Format.fprintf fmt "This@ function@ only@ accepts@ a@ lexicon.@ \"%s\"@ is@ a@ signature" s
| ArgumentMissing (a, f) -> Format.fprintf fmt "No@ value@ given@ for@ parameter@ \"%s\"@ of@ function@ \"%s\"" a f
| DifferentSig (v, Some (sig1, sig2)) -> Format.fprintf fmt "Different@ signatures@ used@ for@ the@ type@ variable@ \"%s\"@ (\"%s\"@ and@ \"%s\")" v (fst (AcgData.Signature.Data_Signature.name sig1)) (fst (AcgData.Signature.Data_Signature.name sig2))
| DifferentSig (v, None) -> Format.fprintf fmt "Different@ signatures@ used@ for@ the@ type@ variable@ \"%s\"" v
| AlreadyExistingFun f -> Format.fprintf fmt "The@ function@ \"%s\"@ already@ exists@ in@ the@ environment" f
| UnusedVariable v -> Format.fprintf fmt "Unused@ variable@ \"%s\"" v
| UnknownFunction f -> Format.fprintf fmt "Unknown@ function@ \"%s\"" f
| UnknownParameter (f, p) -> Format.fprintf fmt "Unknown@ parameter@ \"%s\"@ for@ the@ function@ \"%s\"" p f
| ParameterRepeated (f, p) -> Format.fprintf fmt "Parameter@ \"%s\"@ of@ function@ \"%s\"@ given@ twice" p f
| TooMuchArgs f -> Format.fprintf fmt "Too@ many@ arguments@ for@ function@ \"%s\"" f
| NoLastValue -> Format.fprintf fmt "No@ last@ value@ in@ the@ current@ environment"
| InvalidSpecialFuncCall f -> Format.fprintf fmt "The@ function@ \"%s\"@ can@ only@ be@ called@ alone@ in@ a@ command" f
| MissingFuncTermList f -> Format.fprintf fmt "The@ function@ \"%s\"@ requires@ terms@ as@ input" f
| TermListNotAllowed f -> Format.fprintf fmt "The@ function@ \"%s\"@ must@ be@ called@ without@ terms@ as@ input" f
| EmptyPipe f -> Format.fprintf fmt "The@ pipe@ before@ the@ function@ \"%s\"@ is@ invalid,@ because@ the@ previous@ function@ does@ not@ output@ terms" f
| EmptyHelp f_pattern -> Format.fprintf fmt "No@ functions@ starting@ with@ \"%s\"@ found" f_pattern
| AbsSigMismatch (lex1, lex2) ->
Format.fprintf
fmt
"The@ abstract@ signature@ of lexicon@ %a@ is@ not@ \
the@ same@ as@ the@ abstract@ signature@ of@ lexicon@ \
%a.@ The@ %a@ function@ requires@ all@ the@ lexicons@ \
to@ share@ the@ same@ abstract@ signature"
AcgData.Acg_lexicon.Data_Lexicon.short_pp
lex2
AcgData.Acg_lexicon.Data_Lexicon.short_pp
lex1
UtilsLib.PPUtils.fun_pp
"realize"
| Other -> Format.fprintf fmt "Unknown@ error"
end
module ScriptErrors = ErrorManager(Script_l)