# 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;
};