PreviousUpNext

15.4.552  src/lib/compiler/front/basics/source/line-number-db.pkg

# XXX BUGGO FIXME This seems severely redundant with at least     src/lib/c-kit/src/parser/stuff/line-number-db.pkg
#
#  I can imagine at least three implementations:
#      One that doesn't support resynchronization,
#      one that supports resynchronization only at Column 1, and
#      one that supports arbitrary resynchronization.             
#                                                                           
#                                                                           
#  \section { Implementation }                                                 
#  This implementation supports arbitary resynchronization.                 
#                                                                           
#  <line-number-db.pkg>=                                                         
#  line-number-db.pkg 
#  <RCS log>=                                                               

# Compiled by:
#     src/lib/compiler/front/basics/basics.sublib

#
# Changed error_message to use line_number_db to get source locations; only the
# formatting is done internally
#
# added line_number_db package
#
# .sig and .sml for sourcemap, source, and errormsg are derived from .nw
# files.  to extract, try
#   for base in sourcemap source errormsg
#   do
#     for suffix in sml sig
#     do
#       $cmd -L'/*#line %L "%F"*/' -R$base.$suffix $base.nw > $base.$suffix
#     done
#   done
# where
#   cmd=notangle
# or
#   cmd="nountangle -ml"
#
# At some point, it may be desirable to move noweb support into Makelib


package   line_number_db
: (weak)  Line_Number_Db                                # Line_Number_Db        is from   src/lib/compiler/front/basics/source/line-number-db.api
{
    # A character position is an integer.
    #
    # A region is delimited by the position of
    # the start character and one beyond the end.                  
    #
    # It might help to think of Icon- or emacs-style
    # positions, which fall between characters.                                                              
    #                                                                           
    #  <toplevel>=                                                              

    Charpos   =  Int;
    Pair(X) =  (X, X);

    Source_Code_Region
        =
        Pair( Charpos );

    my null_region:  Source_Code_Region
        =
        (0, 0);

    Sourceloc = { file_name: String, line: Int, column: Int };

    #  The empty region is conventional.                                        
    #                                                                           
    #  <toplevel>=                                                              
    fun span ((0, 0), r) => r;
        span (r, (0, 0)) => r;
        span ((l1, h1), (l2, h2)) => if (l1 < h2 ) (l1, h2); else (l2, h1);fi;
    end;



    # The representation is a pair of lists.                                   
    #
    # [[line_pos]] records line numbers for newlines \emph { and }                 
    # resynchronization.                                                       
    #
    # [[resynch_pos]] records file name and column for resynchronization.       
    #
    # The representation satisfies these invariants:                           
    # \begin { itemize }                                                          
    # \item                                                                    
    # The lists are never empty (initialization is treated as a resynchronization). 
    # \item                                                                    
    # Positions decrease as we walk down the lists.                            
    # \item                                                                    
    # The last element in each list contains the smallest valid position.      
    # \item                                                                    
    # For every element in [[resynch_pos]], there is a corresponding element in 
    # [[line_pos]] with the same position.                                      
    # \end { itemize }                                                            
    #
    # We could get even more clever and store file names only when they        
    # differ, but it doesn't seem worth it---we would have to get very         
    # clever about tracking column numbers and resynchronizations.             
    #                                                                           
    # <toplevel>=                                                              

    Sourcemap
        =
        { resynch_pos:   Ref( List ((Charpos, String, Int)) ),
          line_pos:      Ref( List( (Charpos,          Int)) )
        };

    fun newmap (pos, { file_name, line, column }: Sourceloc) : Sourcemap
        =
        { resynch_pos =>  REF [(pos, file_name, column)],
          line_pos    =>  REF [(pos, line)]
        };

    fun resynch ( { resynch_pos, line_pos }: Sourcemap) (pos, { file_name, line, column } )
        =
        {   cur_file =   #2 (head *resynch_pos);

            fun thefile (THE file)
                    =>
                    if   (file == cur_file   )   cur_file;
                                            else   file;       fi;
                                            # Simple form of hash-consing 


                thefile NULL
                    =>
                    #2 (head *resynch_pos);
            end;

            fun thecol NULL    =>   1;
                thecol (THE c) =>   c;
            end;

            resynch_pos :=  (pos, thefile file_name, thecol column) ! *resynch_pos;
            line_pos    :=  (pos, line) ! *line_pos;
        };


    # Since [[pos]] is the position of the newline,
    # the next line doesn't start until the succeeding position.                                     
    #                                                                           
    #  <toplevel>=                                                              

    fun newline ( { resynch_pos, line_pos }: Sourcemap) pos
        =
        {   my (_, line)
                =
                head  *line_pos;

            line_pos :=   (pos+1, line+1) ! *line_pos;
        };

    fun last_change ( { line_pos, ... }: Sourcemap)
        =
        #1  (head  *line_pos);



    # A generally useful thing to do is to remove
    # from the lists the initial sequences of tuples                                                      
    # whose positions satisfy some predicate:                                  
    #                                                                           
    #  <toplevel>=                                                              

    fun remove p ( { resynch_pos, line_pos }: Sourcemap)
        =
        ( strip' *resynch_pos,
          strip  *line_pos
        )
        where
            fun strip  (l as (pos, _   ) ! rest)
                    =>
                    if   (p pos   )   strip rest;
                                 else   l;            fi;
                strip []
                    =>
                    [];
            end;

            fun strip' (l as (pos, _, _) ! rest)
                    =>
                    if   (p pos   )   strip' rest;
                                 else   l;             fi;

                strip' []
                    =>
                    [];
            end;
        end;

    #  We find file and line number by linear search.                           
    #  The first position less than [[p]] is what we want.                      
    #  The initial column depends on whether we resynchronized.                 
    #                                                                           
    #  <toplevel>=                                                              

    fun column ((pos, file, col), (pos', line), p)
        =
        if   (pos == pos')
             p - pos  + col;
        else p - pos' + 1;   fi;


    fun filepos smap p:  Sourceloc
        =
        { file_name => file,
          line,
          column   => column (xx, yy, p)
        }
        where
            my (files, lines)
                =
                remove
                    (\\ pos:  Int =  pos > p)
                    smap;

            my xx as (_, file, _) =  head files;
            my yy as (_, line)    =  head lines;
        end;


    # Searching regions is a bit trickier,
    # since we track file and line simultaneously.
    #
    # We exploit the invariant that every file entry
    # has a corresponding line entry.                                                
    #
    # We also exploit the invariant that
    # only file entries correspond to new regions.        
    #                                                                           
    #  <toplevel>=                                                              

    fun fileregion smap (lo, hi)
        =
        if   ((lo, hi) == null_region)
             [];
        else

             exception IMPOSSIBLE;

             fun gather ((p, file, col) ! files, (p', line) ! lines, region_end, answers)
                     =>
                     if  (p' <= lo)           #  Last item? 

                          ( { file_name => file,
                              line,
                              column   => column((p, file, col), (p', line), lo)
                            }, 
                            region_end
                          ) ! answers;
                     else
                          if   (p < p')
                              
                               gather((p, file, col) ! files, lines, region_end, answers);
                          else
                               #  p = p'; new region 

                               gather (files, lines, end_of (p, head files, head lines), 
                               ( { file_name => file,
                                   line,
                                   column   => col
                                 },
                                 region_end) ! answers
                               );
                          fi;
                     fi;

                 gather _
                     =>
                     raise exception IMPOSSIBLE;
             end 

             also
             fun end_of
                     ( lastpos,
                       xx as (p, file, col),
                       yy as (p', line)
                     )
                 = 
                 { file_name => file,
                   line,
                   column   => column (xx, yy, lastpos)
                 };

             my  (files, lines)
                 =
                 remove
                     (\\ pos: Int =   pos >= hi  and  pos > lo)
                     smap;

             if  (null files
             or   null lines
             )
                  raise exception IMPOSSIBLE;
             fi;

             answer =   gather (files, lines, end_of (hi, head files, head lines), []);

             fun validate ( ( { file_name=>f,  line=>l,  column=>c }:Sourceloc, 
                              { file_name=>f', line=>l', column=>c'}
                            ) ! rest
                          )
                     => 
                     if   (f == f' and (l' > l or (l' == l and c' >= c)))
                          validate rest; 
                     else raise exception IMPOSSIBLE;  fi;

                 validate []
                     =>
                     ();
             end;

             validate answer;

             answer;
        fi;

    #  [[validate]] checks the invariant that single regions occupy a           
    #  single source file and that coordinates are nondecreasing.               
    #  We have to be careful not to remove the entry for [[lo]] when            
    #  [[pos = hi = lo]].                                                       
    #                                                                           
    #                                                                           
    #                                                                           
    #  <toplevel>=                                                              

    fun positions ( { resynch_pos, line_pos }: Sourcemap) (src: Sourceloc)
        =
        {   exception UNIMPLEMENTED;

            raise exception UNIMPLEMENTED;
        };

    #  When discarding old positions, we have to be careful to maintain the     
    #  last part of the invariant.                                              
    #                                                                           
    #  <toplevel>=                                                              

    fun forget_old_positions ( { resynch_pos, line_pos } : Sourcemap)
        =
        {   my r as (p,  file, col) =  head *resynch_pos;
            my l as (p', line)      =  head *line_pos;

            line_pos :=  [l];

            resynch_pos :=   [   p == p'   ??   r
                                           ::   (p', file, 1)  ];
        };

    #  <toplevel>=                                                              

    fun newline_count smap (lo, hi)
        =
        length hilines - length hifiles - (length lolines - length lofiles)
        where
            my (hifiles, hilines)   =   remove   (\\ pos: Int =  pos >= hi and pos > lo)   smap;
            my (lofiles, lolines)   =   remove   (\\ pos: Int =                pos > lo)   smap;

        end;
};



Comments and suggestions to: bugs@mythryl.org

PreviousUpNext