else
ch
- fun compileTemplate (config, env, templates) path =
+ fun makeName name =
let
- val fname = getFname path
- val name = removeExt fname
val name =
if size name >= 1 then
str (toUpper (String.sub (name, 0))) ^ String.extract (name, 1, NONE)
else
raise Error
val name = name ^ "_"
+ in
+ name
+ end
+
+ fun compileTemplate (config, env, templates) path =
+ let
+ val fname = getFname path
+ val name = removeExt fname
+ val name = makeName name
in
(name, Mlt.trans (config, env, templates, name, Parse.parse path))
end
val outf = TextIO.openOut (outPath ^ "/_main.sml")
- val _ = TextIO.output (outf, "structure Templates :> TEMPLATES =\nstruct\n\tval templates = [")
+ fun isTemplate x =
+ let
+ val x = makeName x
+ in
+ if List.exists (fn y => x = y) exports then
+ SOME x
+ else
+ NONE
+ end
+ fun decide NONE = "(fn () => ())"
+ | decide (SOME t) =
+ (case isTemplate t of
+ SOME t => t ^ ".exec"
+ | _ => (err_flag := true;
+ print ("Template " ^ t ^ " specified in mlt.conf does not exist!\n");
+ "(fn () => ())"))
+ val beforeT = decide (Config.beforeT config)
+ val afterT = decide (Config.afterT config)
+ val exnT = decide (Config.exnT config)
+
+ val _ = (TextIO.output (outf, "structure Templates :> TEMPLATES =\nstruct\n\tval beforeFn =");
+ TextIO.output (outf, beforeT);
+ TextIO.output (outf, "\n\tval afterFn = ");
+ TextIO.output (outf, afterT);
+ TextIO.output (outf, "\n\tval exnFn = ");
+ TextIO.output (outf, exnT);
+ TextIO.output (outf, "\n\n\tval templates = ["))
val _ = (case exports of
[] => ()
| (exp::rest) => (TextIO.output (outf, "(\"" ^ exp ^ "\", " ^ exp ^ ".exec)");
sml : string, (* Path to sml program *)
printFn : string StringMap.map, (* Map from SML type names to text for functions to print
* their values *)
- cm : string list (* List of extra SML/CM files to use with this project *)}
+ cm : string list, (* List of extra SML/CM files to use with this project *)
+ beforeT : string option, (* Template to run before every template execution *)
+ afterT : string option, (* Template to run after every successful template execution *)
+ exnT : string option (* Template to run after every template execution
+ * ending in an uncaught exception *)}
fun inPath (CONFIG {inPath, ...}) = inPath
fun outPath (CONFIG {outPath, ...}) = outPath
fun lib (CONFIG {lib, ...}) = lib
fun sml (CONFIG {sml, ...}) = sml
fun compiler (CONFIG {compiler, ...}) = compiler
+ fun beforeT (CONFIG {beforeT, ...}) = beforeT
+ fun afterT (CONFIG {afterT, ...}) = afterT
+ fun exnT (CONFIG {exnT, ...}) = exnT
fun cm (CONFIG {cm, ...}) = cm
fun printFn (CONFIG {printFn, ...}) s = StringMap.find (printFn, s)
let
val inf = TextIO.openIn fname
- fun read (fields as {inPath, outPath, pubPath, lib, compiler, cm, sml, printFn}) =
+ fun read (fields as {inPath, outPath, pubPath, lib, compiler, cm, sml, printFn, beforeT, afterT, exnT}) =
(case TextIO.inputLine inf of
"" => CONFIG fields
| line =>
[] => read fields
| ["in", inPath] => read {inPath = expandPath inPath, outPath = outPath, pubPath = pubPath,
lib = lib, compiler = compiler, printFn = printFn,
- cm = cm, sml = sml}
+ cm = cm, sml = sml,
+ beforeT = beforeT, afterT = afterT, exnT = exnT}
| ["out", outPath] => read {inPath = inPath, outPath = expandPath outPath, pubPath = pubPath,
lib = lib, compiler = compiler, printFn = printFn,
- cm = cm, sml = sml}
+ cm = cm, sml = sml,
+ beforeT = beforeT, afterT = afterT, exnT = exnT}
| ["pub", pubPath] => read {inPath = inPath, outPath = outPath, pubPath = expandPath pubPath,
lib = lib, compiler = compiler, printFn = printFn,
- cm = cm, sml = sml}
+ cm = cm, sml = sml,
+ beforeT = beforeT, afterT = afterT, exnT = exnT}
| ["lib", lib] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
lib = lib, compiler = compiler, printFn = printFn,
- cm = cm, sml = sml}
+ cm = cm, sml = sml,
+ beforeT = beforeT, afterT = afterT, exnT = exnT}
| ["compiler", compiler] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
lib = lib, compiler = compiler, printFn = printFn,
- cm = cm, sml = sml}
+ cm = cm, sml = sml,
+ beforeT = beforeT, afterT = afterT, exnT = exnT}
| ["sml", sml] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
lib = lib, compiler = compiler, printFn = printFn,
- cm = cm, sml = sml}
+ cm = cm, sml = sml,
+ beforeT = beforeT, afterT = afterT, exnT = exnT}
+ | ["before", beforeT] => read {inPath = inPath, outPath = expandPath outPath, pubPath = pubPath,
+ lib = lib, compiler = compiler, printFn = printFn,
+ cm = cm, sml = sml,
+ beforeT = SOME beforeT, afterT = afterT, exnT = exnT}
+ | ["after", afterT] => read {inPath = inPath, outPath = outPath, pubPath = expandPath pubPath,
+ lib = lib, compiler = compiler, printFn = printFn,
+ cm = cm, sml = sml,
+ beforeT = beforeT, afterT = SOME afterT, exnT = exnT}
+ | ["exn", exnT] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
+ lib = lib, compiler = compiler, printFn = printFn,
+ cm = cm, sml = sml,
+ beforeT = beforeT, afterT = afterT, exnT = SOME exnT}
| "print"::rest =>
let
fun split ([], _) = (print "Bad printFn directive\n";
in
read {inPath = inPath, outPath = outPath, pubPath = pubPath,
lib = lib, compiler = compiler, printFn = printFn,
- cm = cm, sml = sml}
+ cm = cm, sml = sml,
+ beforeT = beforeT, afterT = afterT, exnT = exnT}
end
| split (h::after, befor) = split (after, h::befor)
in
end
| ["cm", fname] => read {inPath = inPath, outPath = outPath, pubPath = pubPath,
lib = lib, compiler = compiler, printFn = printFn,
- cm = fname::cm, sml = sml}
+ cm = fname::cm, sml = sml,
+ beforeT = beforeT, afterT = afterT, exnT = exnT}
| _ => (print "Unknown config directive\n";
read fields)))
in
val cwd = OS.FileSys.getDir ()
val base = CONFIG {lib = "/usr/local/share/mlt/src/lib/sources.cm",
- compiler = "/usr/local/share/mlt/src/sources.cm",
- sml = "/usr/local/sml/bin",
- inPath = cwd,
- outPath = cwd,
- pubPath = cwd,
- printFn = StringMap.empty,
- cm = []}
+ compiler = "/usr/local/share/mlt/src/sources.cm",
+ sml = "/usr/local/sml/bin",
+ inPath = cwd,
+ outPath = cwd,
+ pubPath = cwd,
+ printFn = StringMap.empty,
+ cm = [],
+ beforeT = NONE,
+ afterT = NONE,
+ exnT = NONE}
in
read defaultFile base
end