Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 979d35b8b8
Fetching contributors…

Cannot retrieve contributors at this time

323 lines (276 sloc) 10.295 kb
structure Codegen :> CODEGEN =
struct
exception Error
val () =
if Word.wordSize < 16 then
raise (Fail "Word size too small.")
else
()
fun appSeparated f g l =
(case l of
[] =>
()
| h :: t =>
(
f h;
app (fn x => (g (); f x)) t
))
fun appArraySeparated f g a =
let
val n = Array.length a
fun loop i =
if i >= n then
()
else
(
g ();
f (Array.sub (a, i));
loop (i+1)
)
in
if n = 0 then
()
else
(
f (Array.sub (a, 0));
loop 1
)
end
(* Converts a word to a big-endian byte list. *)
fun wordToBytelist w acc =
if w = 0w0 then
acc
else
let
val lo = Word.andb (w, 0wxff)
val hi = Word.>> (w, 0w8)
in
wordToBytelist hi (lo :: acc)
end
fun duplicateOnto n x acc =
if n = 0 then
acc
else
duplicateOnto (n-1) x (x :: acc)
(* intToChars size n
if 0 <= n < 2^(8 * size)
then l is a big-endian character list representing n
|l| = stateSize
and
return l
*)
fun intToChars size n =
let
val l =
map
(fn w => Char.chr (Word.toInt w))
(wordToBytelist (Word.fromInt n) [])
in
duplicateOnto (size - length l) (Char.chr 0) l
end
(* genTransTable stateSize symbolLimit count trans
if 0 <= count < 2^(8*stateSize)
|trans| = count
for each 0 <= i < count . |trans[i]| = n_i <= symbolLimit
for each 0 <= i < count, 0 <= j < n_i . 0 <= trans[i][j] < 2^(8*stateSize)
then charlist is a representation of trans
- laid out state-major
- each entry is big-endian and consists of stateSize bytes
and
returns charlist
*)
fun genTransTable stateSize symbolLimit count trans =
let
fun loop i j acc =
if i < 0 then
acc
else if j < 0 then
loop (i-1) (symbolLimit-1) acc
else
let
val state =
Array.sub (Array.sub (trans, i), j)
handle Subscript =>
(* Symbol out of range of array means illegal character. *)
0
in
loop i (j-1) (intToChars stateSize state @ acc)
end
in
loop (count-1) (symbolLimit-1) []
end
(* genEosTable stateSize count trans
if 0 <= count < 2^(8*stateSize)
|trans| = count
for each 0 <= i < count . 0 <= trans[i] < 2^(8*stateSize)
then charlist is a representation of trans
- each entry is big-endian and consists of stateSize bytes
and
returns charlist
*)
fun genEosTable stateSize count trans =
let
fun loop i acc =
if i < 0 then
acc
else
let
val state =
Array.sub (trans, i)
in
loop (i-1) (intToChars stateSize state @ acc)
end
in
loop (count-1) []
end
(* The maximum value (1024) is hardcoded to correspond to symbolLimitMax in process.sml. *)
fun tableSizeMinor limit =
if limit <= 128 then
(128, "7")
else if limit <= 256 then
(256, "8")
else if limit <= 512 then
(512, "9")
else if limit <= 1024 then
(1024, "10")
else
raise (Fail "Alphabet too large.")
(* The maximum value (65536) is hardcoded to correspond to stateCountMax in process.sml. *)
fun tableSizeMajor count =
if count <= 256 then
1
else if count <= 65536 then
2
else
raise (Fail "Table too large.")
fun writeTable outs symbolLimit functions (name, tp, (count, initial, lastFinalSink, lastFinal, final, trans, transEos)) =
let
fun write str = TextIO.output (outs, str)
val (symbolLimit', minorstr) = tableSizeMinor symbolLimit
val stateSize = tableSizeMajor count
val majorstr = Int.toString stateSize
in
write "val ";
write name;
write " = (";
write (Int.toString initial);
write ", ";
write (Int.toString lastFinalSink);
write ", ";
write (Int.toString lastFinal);
write ", Vector.fromList [";
appArraySeparated
(fn name =>
if name = "" then
write "epsilon"
else
(
write "Arg.";
write name
))
(fn () => write ",")
final;
write "], LexEngine.next";
write minorstr;
write "x";
write majorstr;
write " ";
write (Int.toString symbolLimit');
write " \"";
app (fn ch => write (Char.toString ch)) (genTransTable stateSize symbolLimit' count trans);
write "\", LexEngine.next0x";
write majorstr;
write " \"";
app (fn ch => write (Char.toString ch)) (genEosTable stateSize count transEos);
write "\")\n";
()
end
fun writeFunction outs functions keyword (name, _, _) =
let
fun write str = TextIO.output (outs, str)
in
write keyword;
write name;
write " s = LexEngine.lex {";
appSeparated
(fn (fname, _, _) =>
(
write fname;
write "=";
write fname
))
(fn () => write ", ")
functions;
write "} Tables.";
write name;
write " s\n"
end
fun writeProgram filename (options, symbolLimit, types, actions, functions) =
let
val functorName =
(case StringDict.find options "name" of
SOME name => name
| NONE =>
(
print "Error: no functor name specified.\n";
raise Error
))
val outs = TextIO.openOut filename
fun write str = TextIO.output (outs, str)
in
write "\nfunctor ";
write functorName;
write "\n (structure Streamable : STREAMABLE\n structure Arg :\n sig\n type symbol\n val ord : symbol -> int\n\n";
app
(fn typeName =>
(
write " type ";
write typeName;
write "\n"
))
types;
write "\n type self = { ";
appSeparated
(fn (fname, tp, _) =>
(
write fname;
write " : symbol Streamable.t -> ";
write tp
))
(fn () => write ",\n ")
functions;
write " }\n type info = { match : symbol list,\n len : int,\n start : symbol Streamable.t,\n follow : symbol Streamable.t,\n self : self }\n\n";
app
(fn (actionName, actionType) =>
(
write " val ";
write actionName;
write " : info -> ";
write actionType;
write "\n"
))
actions;
write " end)\n :>\n sig\n";
app
(fn (fname, tp, _) =>
(
write " val ";
write fname;
write " : Arg.symbol Streamable.t -> Arg.";
write tp;
write "\n"
))
functions;
write " end\n=\n";
write "\n(*\n\n";
WriteAutomata.writeAutomata outs functions;
write "\n*)\n\n";
write "struct\nlocal\nstructure LexEngine = LexEngineFun (structure Streamable = Streamable\ntype symbol = Arg.symbol\nval ord = Arg.ord)\nstructure Tables = struct\nfun epsilon _ = raise (Fail \"Illegal lexeme\")\n";
app (writeTable outs symbolLimit functions) functions;
write "end\nin\n";
writeFunction outs functions "fun " (hd functions);
app (writeFunction outs functions "and ") (tl functions);
write "end\nend\n";
TextIO.closeOut outs
end
end
Jump to Line
Something went wrong with that request. Please try again.