Add before, after, and exn config directives

[bpt/mlt.git] / src / compiler.sml

diff --git a/src/compiler.sml b/src/compiler.sml
index e87cb57..0b6d484 100644 (file)
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -81,16 +81,23 @@ struct
        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
@@ -199,7 +206,33 @@ struct
 
            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)");