15.4.425  src/lib/compiler/back/low/tools/line-number-db/line-number-database.pkg

# line-number-database.pkg -- derived from  ~/src/sml/nj/smlnj-110.60/MLRISC/Tools/SourceMap/sourceMap.sml 

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

package   line_number_database
:         Line_Number_Database                          # Line_Number_Database  is from   src/lib/compiler/back/low/tools/line-number-db/line-number-database.api
{
    Charpos = Int;

    Region = (Charpos, Charpos);

    Location
        =
        LOC {
          src_file:    unique_symbol::Symbol,
          begin_line:  Int,
          begin_col:   Int,
          end_line:    Int,
          end_col:     Int
        };

    State
        =
        STATE  {
          line_num:  Int,
          file:      unique_symbol::Symbol, 
          char_pos:  Charpos
        };

    Sourcemap
        =
        SOURCEMAP {
          line_pos:   Ref( List(  Charpos ) ),
          line_num:   Ref( Int ),
          file_pos:   Ref( List { line_pos: List( Charpos ), 
                                  line:       Int,
                                  src_file: unique_symbol::Symbol
                                }
                         )
        };

    dummy_loc
        =
        LOC {
          src_file   => unique_symbol::from_string "???", 
          begin_line => 1,
          begin_col  => 1,
          end_line   => 1,
          end_col    => 1
        };

    fun newmap { src_file }
        =
        SOURCEMAP {
          line_pos => REF [0],
          line_num => REF 1,
          file_pos => REF [{ line_pos => [], line => 1,
                          src_file=>unique_symbol::from_string src_file } ]
        };

    fun newline (SOURCEMAP { line_pos, line_num, ... } ) pos
        =
        {    line_pos :=  pos ! *line_pos;
             line_num :=  1 + *line_num;
        };

    fun state (SOURCEMAP { line_pos, line_num, file_pos, ... } )
        =
        {   my { src_file, ... } =  head *file_pos;
            char_pos            =  head *line_pos;
            line_num            =  *line_num;

            STATE { file=>src_file, char_pos, line_num };
        };

    fun resynch (SOURCEMAP { line_pos, file_pos, line_num, ... } ) { pos, src_file, line }
        =
        {   file_pos := { line_pos=> *line_pos,
                          line=> *line_num,
                          src_file=>unique_symbol::from_string src_file
                        }
                        !
                        *file_pos;

            line_pos := [pos];
            line_num := line;
        };

    fun reset src_map (STATE { file, line_num, char_pos } )
        =
        {   print (unique_symbol::to_string file + " " + int::to_string line_num + "\n");

            resynch src_map { pos=>char_pos,
                        src_file=>unique_symbol::to_string file, line=>line_num };
        };

    fun parse_directive line_number_db (pos, directive)
        =
        {   fun sep ' '   =>  TRUE;
                sep '"'   =>  TRUE;
                sep '#'   =>  TRUE;
                sep '\n'  =>  TRUE;

                sep _     =>  FALSE;
            end;

            case (string::tokens sep directive)
              
                 line ! src_file ! _
                     =>
                     case (int::from_string line)
                       
                          THE line
                              => 
                              resynch line_number_db { pos, src_file, line };

                          _   =>
                              newline line_number_db pos;
                     esac;

                 _   =>
                     newline line_number_db pos;
            esac;
        };


    fun curr_pos (SOURCEMAP { line_pos, ... } )
        =
        head *line_pos;


    fun location
            (SOURCEMAP { line_pos, file_pos, line_num, ... } )
            (x, y)
        =
        {   fun find_pos (p, curr_pos, curr_file, pos ! rest, file_pos, line)
                    =>
                    if   (p > pos)
                        
                         { src_file =>  curr_file,
                           line,
                           column   =>  p - pos
                         };
                    else
                         find_pos (p, pos, curr_file, rest, file_pos, line - 1);
                    fi;

                find_pos (p, curr_pos, curr_file,[],{ line_pos, line, src_file } ! file_pos, _)
                    =>
                    find_pos (p, curr_pos, src_file, line_pos, file_pos, line);

                find_pos (p, curr_pos, curr_file,[],[], line)
                    => 
                    { src_file =>  curr_file,
                      line,
                      column   =>  0
                    };
            end;

            my { src_file=>curr_file, ... }
                =
                head *file_pos;

            my { src_file, line=>l1, column=>c1 }
                = 
                find_pos (x, x, curr_file,*line_pos,*file_pos,*line_num);

            my { src_file, line=>l2, column=>c2 }
                = 
                find_pos (y, y, curr_file,*line_pos,*file_pos,*line_num);

            LOC {
              src_file,
              begin_line => l1,
              begin_col  => c1,
              end_line   => l2,
              end_col    => c2
           };
        };

    fun to_string (LOC { src_file, begin_line, begin_col, end_line, end_col } )
        =
        {   int = int::to_string;

            unique_symbol::to_string src_file + ":" + int begin_line + "." + int begin_col +
                 (if (begin_line == end_line and begin_col == end_col ) "";
                  else "-" + int end_line + "." + int end_col;fi);
        };

    fun directive (LOC { src_file, begin_line, begin_col, end_line, end_col } )
        =
        {   int = int::to_string;

            "###line " + int begin_line + "." + int begin_col + " \"" +
              unique_symbol::to_string src_file + "\"";
        };
};