From 45db6551fd1860159e9babd53b68a67302e57e37 Mon Sep 17 00:00:00 2001 From: Paweł Dybiec Date: Sat, 24 Nov 2018 17:52:48 +0100 Subject: Upgrade base --- source/xi_lib/typechecker_errors.ml | 119 +++++++++++++++++++++++++++++------- 1 file changed, 97 insertions(+), 22 deletions(-) (limited to 'source/xi_lib/typechecker_errors.ml') diff --git a/source/xi_lib/typechecker_errors.ml b/source/xi_lib/typechecker_errors.ml index f3ee529..4799a6b 100644 --- a/source/xi_lib/typechecker_errors.ml +++ b/source/xi_lib/typechecker_errors.ml @@ -2,12 +2,15 @@ open Ast open Types type type_checking_error = + + (* Ogólny błąd, że oczekiwany typ się nie zgadza z rzeczywistym *) | TCERR_TypeMismatch of { loc: location ; expected: normal_type ; actual: normal_type } + (* Błąd typu przy multireturn *) | TCERR_BindingTypeMismatch of { loc: location ; expected: normal_type @@ -15,48 +18,57 @@ type type_checking_error = ; id: identifier } + (* Wywołaliśmy procedurę/funkcję ze złą liczbą argumentów *) | TCERR_BadNumberOfActualArguments of { loc: location ; expected: int ; actual: int } + (* Return dostał złą liczbę parametrów *) | TCERR_BadNumberOfReturnValues of { loc: location ; expected: int ; actual: int } + (* Nieznany identyfikator *) | TCERR_UnknownIdentifier of { loc: location ; id: identifier } + (* Identyfikator nie jest zmienną (a np jest funkcją) *) | TCERR_IdentifierIsNotVariable of { loc: location ; id: identifier } + (* Generyczny błąd gdyby inne nie pasowały *) | TCERR_OtherError of { loc: location ; descr: string } + (* Wywołujemy identyfikator, który nie jest funkcją/procedurą *) | TCERR_IdentifierIsNotCallable of { loc: location ; id: identifier } + (* Brakuje return gdzieś *) | TCERR_NotAllControlPathsReturnValue of { loc: location ; id: identifier } + (* Użyliśmy w wyrażeniu multireturnowej funkcji *) | TCERR_ExpectedFunctionReturningOneValue of { loc: location ; id: identifier } + (* Użyliśmy w multireturnie zywkłej funkcji *) | TCERR_ExpectedFunctionReturningManyValues of { loc: location ; expected: int @@ -64,33 +76,33 @@ type type_checking_error = ; id: identifier } + (* Return w procedurze *) | TCERR_ProcedureCannotReturnValue of { loc: location } + (* Brakuje parametru w return *) | TCERR_FunctionMustReturnValue of { loc: location } + (* Typ miał być tablicą *) | TCERR_ExpectedArray of { loc: location ; actual: normal_type } - | TCERR_InvalidRedeclaration of - { loc: location - ; id: identifier - ; previous: env_type - } - + (* Przykryliśmy nazwę *) | TCERR_ShadowsPreviousDefinition of { loc: location ; id: identifier } + (* W wyrażeniu typowym pojawiło się wyrażenie oznaczające rozmiar *) | TCERR_ArrayInitializationForbidden of { loc: location } + (* Generyczny błąd, że nie dało się zrekonstruować typu *) | TCERR_CannotInferType of { loc: location } @@ -169,12 +181,6 @@ let string_of_type_checking_error = function Format.sprintf "%s: procedure cannot return value" (string_of_location loc) - | TCERR_InvalidRedeclaration {loc; id; previous} -> - Format.sprintf "%s: invalid redeclaration: %s: previous type: %s" - (string_of_location loc) - (string_of_identifier id) - (string_of_env_type previous) - | TCERR_ShadowsPreviousDefinition {loc; id} -> Format.sprintf "%s: shadows previous definition: %s" (string_of_location loc) @@ -188,19 +194,30 @@ let string_of_type_checking_error = function Format.sprintf "%s: cannot infer type" (string_of_location loc) - module MakeErrorReporter () = struct + + + + module MakeCollectingErrorReporter () = struct let r = ref [] let add e = r := e :: !r + let wrap f x = + let result = f x in + let errors = List.rev !r in + r := []; + match errors with + | [] -> Ok result + | xs -> Error xs + let report_type_mismatch ~loc ~expected ~actual = add @@ TCERR_TypeMismatch {loc;expected;actual} let report_binding_type_mismatch ~loc ~expected ~actual ~id = add @@ TCERR_BindingTypeMismatch {loc;expected;actual; id} - let report_error ~loc ~descr = + let report_other_error ~loc ~descr = add @@ TCERR_OtherError {loc; descr} let report_identifier_is_not_variable ~loc ~id = @@ -239,19 +256,77 @@ let string_of_type_checking_error = function let report_shadows_previous_definition ~loc ~id = add @@ TCERR_ShadowsPreviousDefinition {loc; id} - let report_invalid_redeclaration ~loc ~id ~previous = - add @@ TCERR_InvalidRedeclaration {loc; id; previous} - let report_array_initialization_forbidden ~loc = add @@ TCERR_ArrayInitializationForbidden {loc} let report_cannot_infer ~loc = add @@ TCERR_CannotInferType {loc} - let flush () = - let result = List.rev !r in - r := []; - result + end + + (* Kopia poniewaz chcemy aby typ wyniku funkcji `add` był dowolny bo sterowanie się kończy przez raise *) + module MakeOneShotErrorReporter() = struct + + exception TypeCheckingError of type_checking_error + + let add e = raise (TypeCheckingError e) - end \ No newline at end of file + let wrap f x = + try + Ok (f x) + with (TypeCheckingError e) -> + Error [e] + + let report_type_mismatch ~loc ~expected ~actual = + add @@ TCERR_TypeMismatch {loc;expected;actual} + + let report_binding_type_mismatch ~loc ~expected ~actual ~id = + add @@ TCERR_BindingTypeMismatch {loc;expected;actual; id} + + let report_other_error ~loc ~descr = + add @@ TCERR_OtherError {loc; descr} + + let report_identifier_is_not_variable ~loc ~id = + add @@ TCERR_IdentifierIsNotVariable {loc; id} + + let report_unknown_identifier ~loc ~id = + add @@ TCERR_UnknownIdentifier {loc; id} + + let report_identifier_is_not_callable ~loc ~id = + add @@ TCERR_IdentifierIsNotCallable {loc; id} + + let report_bad_number_of_arguments ~loc ~expected ~actual = + add @@ TCERR_BadNumberOfActualArguments {loc; expected; actual} + + let report_bad_number_of_return_values ~loc ~expected ~actual = + add @@ TCERR_BadNumberOfReturnValues {loc; expected; actual} + + let report_expected_function_returning_one_value ~loc ~id = + add @@ TCERR_ExpectedFunctionReturningOneValue {loc;id} + + let report_expected_function_returning_many_values ~loc ~id ~expected ~actual = + add @@ TCERR_ExpectedFunctionReturningManyValues {loc;id; expected;actual} + + let report_function_must_return_something ~loc = + add @@ TCERR_FunctionMustReturnValue {loc} + + let report_procedure_cannot_return_value ~loc = + add @@ TCERR_ProcedureCannotReturnValue {loc} + + let report_expected_array ~loc ~actual = + add @@ TCERR_ExpectedArray {loc; actual} + + let report_not_all_control_paths_return_value ~loc ~id = + add @@ TCERR_NotAllControlPathsReturnValue {loc; id} + + let report_shadows_previous_definition ~loc ~id = + add @@ TCERR_ShadowsPreviousDefinition {loc; id} + + let report_array_initialization_forbidden ~loc = + add @@ TCERR_ArrayInitializationForbidden {loc} + + let report_cannot_infer ~loc = + add @@ TCERR_CannotInferType {loc} + + end -- cgit 1.4.1