15.4.423  src/lib/compiler/back/low/tools/line-number-db/adl-error.pkg

## adl-error.pkg

# Compiled by:
#     src/lib/compiler/back/low/tools/line-number-database.lib

stipulate
    package fil =  file__premicrothread;                        # file__premicrothread          is from   src/lib/std/src/posix/file--premicrothread.pkg
    package lnd =  line_number_database;                        # line_number_database          is from   src/lib/compiler/back/low/tools/line-number-db/line-number-database.pkg
herein

    package   adl_error
    : (weak)  Adl_Error                                         # Adl_Error                     is from   src/lib/compiler/back/low/tools/line-number-db/adl-error.api
    {
        loc = REF lnd::dummy_loc;

        error_count   = REF 0;
        warning_count = REF 0;

        fun init ()
            = 
            {   error_count   := 0;
                warning_count := 0;
                 #
                loc := lnd::dummy_loc;
            };

        fun errors_and_warnings_summary ()
            =
            {   fun count_and_tense (0, s) =>  ("no "  + s + "s",                 "were");
                    count_and_tense (1, s) =>  ("one " + s,                       "was" );
                    count_and_tense (n, s) =>  (int::to_string n + " " + s + "s", "were");
                end;

                my (errors_string,   tense) = count_and_tense (*error_count,   "error"  );
                my (warnings_string, _    ) = count_and_tense (*warning_count, "warning");

                sprintf "There %s %s and %s."  tense  errors_string  warnings_string;
            };

        log_file_name   =  REF ""; 
        log_file_stream =  REF NULL:   Ref( Null_Or( fil::Output_Stream ) );

        fun close_log_file ()
            =
            case *log_file_stream
                #
                THE s
                    => 
                    {   fil::close_output  s;
                        log_file_stream := NULL;
                        log_file_name := "";
                    };

                NULL => ();
            esac;

        fun open_log_file filename
            =
            {   close_log_file();
                log_file_name := filename;
                log_file_stream := THE (fil::open_for_write filename);
            };

        fun logfile ()
            =
            *log_file_name;

        fun write_to_log text
            = 
            case *log_file_stream
                #
                NULL  =>  ();
                THE s =>  fil::write (s, text);
            esac;

        exception ERROR;

        fun set_loc l = loc := l;

        fun with_loc l f x
            =
            {   p = *loc;
                #  print (SourceMapping::to_string l + "\n") 
                set_loc l;
                y = f x;
                set_loc p;
                y;
            };

        fun write_to_log_and_stderr  msg
            = 
            {   text = msg + "\n";
                fil::write (fil::stderr, text);
                write_to_log text;
            };

        fun error msg
            =
            {   write_to_log_and_stderr (lnd::to_string *loc + ": " + msg); 
                #
                error_count := *error_count + 1;
            };

        fun error_pos (l, msg)
            =
            {   set_loc l;
                error msg;
            };

        fun warning msg
            =
            {   write_to_log_and_stderr (lnd::to_string (*loc) + ": warning: " + msg);
                #
                warning_count := *warning_count + 1;
            }; 

        fun warning_pos (l, msg)
            =
            {   set_loc l;
                warning msg;
            };

        fun fail msg
            =
            {   error msg;
                raise exception ERROR;
            };
    };
end;