Source file errors.ml

open UtilsLib.Error

module Lexing_l =
  struct
    type t =
      | UnstartedBracket
      | MismatchParentheses of char
      | UnterminatedComment
      | UnstartedComment
      | BadChar of string
      | Malformed

    let kind = "ACG lexing"

    let pp fmt err =
      match err with
      | UnstartedBracket -> Format.fprintf fmt "No@ bracket@ opened@ before@ this@ right@ bracket"
      | MismatchParentheses c -> Format.fprintf fmt "Unclosed@ parenthesis@ \"%c\"" c
      | UnterminatedComment -> Format.fprintf fmt "Unclosed@ comment"
      | UnstartedComment -> Format.fprintf fmt "No@ comment@ opened@ before@ this@ closing@ of@ comment"
      | BadChar tok -> Format.fprintf fmt "Bad@ char:@ \"%s\"" tok
      | Malformed -> Format.fprintf fmt "Malformed@ UTF-8@ input"
  end

module LexingErrors = ErrorManager(Lexing_l)

module Parsing_l =
  struct
    type t =
      | MenhirError of int
      | TypeExpected
      | ArrowExpected
      | ArrowOrRParenthesisExpected
      | LessThanExpected
      | AssociativitySpecExpected
      | TermNotArrowExpected
      | InfixMissingFirstArg of string
      | InfixMissingSecondArg of string
      | NotAssociative of string
      | NotInfix of string
      | PrefixMissingArg of string
      | UnknownConstant of string
      | UnknownType of string
      | UnknownBinder of string
      | UnknownConstantNorVariable of string
      | UnknownConstantNorType of string
      | NotDefAsInfix of string
      | DuplicatedTerm of string
      | DuplicatedType of string
      | Other

    let kind = "ACG parsing"

    let pp fmt err =
      match err with
      | MenhirError s -> Format.fprintf fmt "%a" UtilsLib.Error.pp_text (String.trim (Messages.message s))
      | TypeExpected -> Format.fprintf fmt "A@ type@ identifier@ is@ expected"
      | ArrowExpected -> Format.fprintf fmt "An@ arrow@ ('→'@ or@ '⇒')@ is@ expected"
      | ArrowOrRParenthesisExpected -> Format.fprintf fmt "An@ arrow@ ('→'@ or@ '⇒')@ or@ a@ right@ parenthesis@ ')'@ is@ expected"
      | LessThanExpected -> Format.fprintf fmt "The@ less@ than@ symbol@ '<'@ is@ expected@ in@ a@ precedence@ specification"
      | TermNotArrowExpected -> Format.fprintf fmt "A@ term@ is@ expected,@ but an@ arrow@ ('→'@ or@ '⇒')@ was@ found"
      | AssociativitySpecExpected -> Format.fprintf fmt "An@ associativity@ specification@ (one@ of@ the@ keywords@ 'Left',@ 'Right',@ or@ 'NonAssoc')@ is@ expected"
      | InfixMissingFirstArg s -> Format.fprintf fmt "The@ infix@ operator@ \"%s\"@ is@ missing@ its@ first@ argument" s
      | InfixMissingSecondArg s -> Format.fprintf fmt "The@ infix@ operator@ \"%s\"@ is@ missing@ its@ second@ argument" s
      | NotAssociative s -> Format.fprintf fmt "Operator@ \"%s\"@ is@ not@ associative@ but@ is@ used@ without@ parenthesis" s
      | NotInfix s -> Format.fprintf fmt "Operator@ \"%s\"@ is@ not@ infix@ but@ is@ used@ as@ infix" s
      | PrefixMissingArg s -> Format.fprintf fmt "The@ prefix@ operator@ \"%s\"@ is@ missing@ its@ argument" s
      | UnknownConstant s -> Format.fprintf fmt "Unknown@ constant:@ \"%s\"" s
      | UnknownType s -> Format.fprintf fmt "Unknown@ atomic@ type:@ \"%s\"" s
      | UnknownBinder s -> Format.fprintf fmt "Unknown@ binder@ \"%s\"" s
      | UnknownConstantNorVariable s -> Format.fprintf fmt "Unknown@ constant@ or@ variable:@ \"%s\"" s
      | UnknownConstantNorType s -> Format.fprintf fmt "Unknown@ constant@ or@ type:@ \"%s\"" s
      | NotDefAsInfix s -> Format.fprintf fmt "\"%s\"@ is@ not@ an@ infix@ operator" s
      | DuplicatedTerm s -> Format.fprintf fmt "Term@ \"%s\"@ has@ already@ been@ defined" s
      | DuplicatedType s -> Format.fprintf fmt "Type@ \"%s\"@ has@ already@ been@ defined" s
      | Other -> Format.fprintf fmt "Unknown@ syntax@ error"
  end

module ParsingErrors = ErrorManager(Parsing_l)