    --  Compiler Toolkit: basic error management
    --
    --  Author : Manuel M. T. Chakravarty
    --  Created: 20 February 95
    --
    --  Version $Revision: 1.2 $ from $Date: 2004/11/13 17:26:50 $
    --
    --  Copyright (c) [1995..2000] Manuel M. T. Chakravarty
    --
    --  This library is free software; you can redistribute it and/or
    --  modify it under the terms of the GNU Library General Public
    --  License as published by the Free Software Foundation; either
    --  version 2 of the License, or (at your option) any later version.
    --
    --  This library is distributed in the hope that it will be useful,
    --  but WITHOUT ANY WARRANTY; without even the implied warranty of
    --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    --  Library General Public License for more details.
    --
    --- DESCRIPTION ---------------------------------------------------------------
    --
    --  This modules exports some auxilliary routines for error handling.
    --
    --- DOCU ----------------------------------------------------------------------
    --
    --  language: Haskell 98
    --
    --  *  the single lines of error messages shouldn't be to long as file name
    --     and position are prepended at each line
    --
    --- TODO ----------------------------------------------------------------------
    --

    module Errors (
      -- handling of internal error
      --
      interr, todo,
      --
      -- errors in the compiled program
      --
      ErrorLvl(..), Error, makeError, errorLvl, showError, errorAtPos
    ) where

    import Position (Position(..), isInternalPos)

    -- internal errors
    -- ---------------

    -- raise a fatal internal error; message may have multiple lines (EXPORTED)
    --
    interr     :: String -> a
    interr :: String -> a
    interr msg :: String
    msg  = String -> a
    forall a. HasCallStack => String -> a
    error ("INTERNAL COMPILER ERROR:\n"
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    indentMultilineString 2 String
    msg
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\n")

    -- raise a error due to a implementation restriction; message may have multiple
    -- lines (EXPORTED)
    --
    todo     :: String -> a
    todo :: String -> a
    todo msg :: String
    msg  = String -> a
    forall a. HasCallStack => String -> a
    error ("Feature not yet implemented:\n"
                       String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    indentMultilineString 2 String
    msg
                       String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\n")

    -- errors in the compiled program
    -- ------------------------------

    -- the higher the level of an error, the more critical it is (EXPORTED)
    --
    data ErrorLvl = WarningErr              -- does not affect compilation
                  | ErrorErr                -- cannot generate code
                  | FatalErr                -- abort immediately
                  deriving (ErrorLvl -> ErrorLvl -> Bool
    (ErrorLvl -> ErrorLvl -> Bool)
    -> (ErrorLvl -> ErrorLvl -> Bool) -> Eq ErrorLvl
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: ErrorLvl -> ErrorLvl -> Bool
    $c/= :: ErrorLvl -> ErrorLvl -> Bool
    == :: ErrorLvl -> ErrorLvl -> Bool
    $c== :: ErrorLvl -> ErrorLvl -> Bool
    Eq, Eq ErrorLvl
    Eq ErrorLvl =>
    (ErrorLvl -> ErrorLvl -> Ordering)
    -> (ErrorLvl -> ErrorLvl -> Bool)
    -> (ErrorLvl -> ErrorLvl -> Bool)
    -> (ErrorLvl -> ErrorLvl -> Bool)
    -> (ErrorLvl -> ErrorLvl -> Bool)
    -> (ErrorLvl -> ErrorLvl -> ErrorLvl)
    -> (ErrorLvl -> ErrorLvl -> ErrorLvl)
    -> Ord ErrorLvl
    ErrorLvl -> ErrorLvl -> Bool
    ErrorLvl -> ErrorLvl -> Ordering
    ErrorLvl -> ErrorLvl -> ErrorLvl
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    min :: ErrorLvl -> ErrorLvl -> ErrorLvl
    $cmin :: ErrorLvl -> ErrorLvl -> ErrorLvl
    max :: ErrorLvl -> ErrorLvl -> ErrorLvl
    $cmax :: ErrorLvl -> ErrorLvl -> ErrorLvl
    >= :: ErrorLvl -> ErrorLvl -> Bool
    $c>= :: ErrorLvl -> ErrorLvl -> Bool
    > :: ErrorLvl -> ErrorLvl -> Bool
    $c> :: ErrorLvl -> ErrorLvl -> Bool
    <= :: ErrorLvl -> ErrorLvl -> Bool
    $c<= :: ErrorLvl -> ErrorLvl -> Bool
    < :: ErrorLvl -> ErrorLvl -> Bool
    $c< :: ErrorLvl -> ErrorLvl -> Bool
    compare :: ErrorLvl -> ErrorLvl -> Ordering
    $ccompare :: ErrorLvl -> ErrorLvl -> Ordering
    $cp1Ord :: Eq ErrorLvl
    Ord)

    data Error = Error ErrorLvl Position [String]  -- (EXPORTED ABSTRACTLY)

    -- note that the equality to on errors takes into account only the error level
    -- and position (not the error text)
    --
    -- note that these comparisions are expensive (the positions contain the file
    -- names as strings)
    --
    instance Eq Error where
      (Error lvl1 :: ErrorLvl
    lvl1 pos1 :: Position
    pos1 _) == :: Error -> Error -> Bool
    == (Error lvl2 :: ErrorLvl
    lvl2 pos2 :: Position
    pos2 _) = ErrorLvl
    lvl1 ErrorLvl -> ErrorLvl -> Bool
    forall a. Eq a => a -> a -> Bool
    == ErrorLvl
    lvl2 Bool -> Bool -> Bool
    && Position
    pos1 Position -> Position -> Bool
    forall a. Eq a => a -> a -> Bool
    == Position
    pos2

    instance Ord Error where
      (Error lvl1 :: ErrorLvl
    lvl1 pos1 :: Position
    pos1 _) < :: Error -> Error -> Bool
    <  (Error lvl2 :: ErrorLvl
    lvl2 pos2 :: Position
    pos2 _) = Position
    pos1 Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    < Position
    pos2
                                                   Bool -> Bool -> Bool
    || (Position
    pos1 Position -> Position -> Bool
    forall a. Eq a => a -> a -> Bool
    == Position
    pos2 Bool -> Bool -> Bool
    && ErrorLvl
    lvl1 ErrorLvl -> ErrorLvl -> Bool
    forall a. Ord a => a -> a -> Bool
    < ErrorLvl
    lvl2)
      e1 :: Error
    e1                  <= :: Error -> Error -> Bool
    <= e2 :: Error
    e2                  = Error
    e1 Error -> Error -> Bool
    forall a. Ord a => a -> a -> Bool
    < Error
    e2 Bool -> Bool -> Bool
    || Error
    e1 Error -> Error -> Bool
    forall a. Eq a => a -> a -> Bool
    == Error
    e2

    -- produce an `Error', given its level, position, and a list of lines of
    -- the error message that must not be empty (EXPORTED)
    --
    makeError :: ErrorLvl -> Position -> [String] -> Error
    makeError :: ErrorLvl -> Position -> [String] -> Error
    makeError  = ErrorLvl -> Position -> [String] -> Error
    Error

    -- inquire the error level (EXPORTED)
    --
    errorLvl                 :: Error -> ErrorLvl
    errorLvl :: Error -> ErrorLvl
    errorLvl (Error lvl :: ErrorLvl
    lvl _ _)  = ErrorLvl
    lvl

    -- converts an error into a string using a fixed format (EXPORTED)
    --
    --  * the list of lines of the error message must not be empty
    --
    --  * the format is
    --
    --     <fname>:<row>: (column <col>) [<err lvl>]
    --       >>> <line_1>
    --       <line_2>
    --         ...
    --       <line_n>
    --
    --  * internal errors (identified by a special position value) are formatted as
    --
    --     INTERNAL ERROR!
    --       >>> <line_1>
    --       <line_2>
    --         ...
    --       <line_n>
    --
    showError :: Error -> String
    showError :: Error -> String
    showError (Error _   pos :: Position
    pos               (l :: String
    l:ls :: [String]
    ls))  | Position -> Bool
    isInternalPos Position
    pos =
      "INTERNAL ERROR!\n"
      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "  >>> " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\n"
      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Int -> String -> String
    indentMultilineString 2 (String -> String) -> ([String] -> String) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    unlines) [String]
    ls
    showError (Error lvl :: ErrorLvl
    lvl (Position fname :: String
    fname row :: Int
    row col :: Int
    col) (l :: String
    l:ls :: [String]
    ls))  =
      let
        prefix :: String
    prefix = String
    fname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ":" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Int
    row::Int) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ": "
                 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "(column "
                 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Int
    col::Int)
                 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ") ["
                 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ErrorLvl -> String
    showErrorLvl ErrorLvl
    lvl
                 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "] "
        showErrorLvl :: ErrorLvl -> String
    showErrorLvl WarningErr = "WARNING"
        showErrorLvl ErrorErr   = "ERROR"
        showErrorLvl FatalErr   = "FATAL"
      in
      String
    prefix String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\n"
      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "  >>> " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\n"
      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Int -> String -> String
    indentMultilineString 2 (String -> String) -> ([String] -> String) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    unlines) [String]
    ls
    showError (Error _  _                  []   )   = String -> String
    forall a. String -> a
    interr "Errors: showError:\
                                                            \ Empty error message!"

    errorAtPos         :: Position -> [String] -> a
    errorAtPos :: Position -> [String] -> a
    errorAtPos pos :: Position
    pos msg :: [String]
    msg  = (String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> ([String] -> String) -> [String] -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Error -> String
    showError (Error -> String) -> ([String] -> Error) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ErrorLvl -> Position -> [String] -> Error
    makeError ErrorLvl
    ErrorErr Position
    pos) [String]
    msg

    -- indent the given multiline text by the given number of spaces
    --
    indentMultilineString   :: Int -> String -> String
    indentMultilineString :: Int -> String -> String
    indentMultilineString n :: Int
    n  = [String] -> String
    unlines ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    spacesString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines
                               where
                                 spaces :: String
    spaces = Int -> String -> String
    forall a. Int -> [a] -> [a]
    take Int
    n (Char -> String
    forall a. a -> [a]
    repeat ' ')