Switch to using OS.Path in Compiler

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

diff --git a/src/compiler.sml b/src/compiler.sml
index 6e31f5a..cd03d6c 100644 (file)
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -21,6 +21,8 @@
 
 structure Compiler :> COMPILER =
 struct
+    open Settings
+
     exception Error
 
     val cgiMode = Posix.FileSys.S.flags [Posix.FileSys.S.irwxu,
@@ -31,48 +33,14 @@ struct
                    flush = fn () => TextIO.flushOut TextIO.stdOut,
                    linewidth = 80}
 
-    fun getFname path =
-       let
-           fun look i =
-               if i < 0 then
-                   path
-               else if String.sub (path, i) = #"/" then
-                   String.extract (path, i+1, NONE)
-               else
-                   look (i-1)
-       in
-           look (size path - 1)
-       end
+    val getFname = OS.Path.file
 
-    fun removeExt path =
-       let
-           val len = size path
-
-           fun look i =
-               if i >= len then
-                   path
-               else if String.sub (path, i) = #"." then
-                   String.substring (path, 0, i)
-               else
-                   look (i+1)
-       in
-           look 0
-       end
+    val removeExt = OS.Path.base
 
     fun getExt path =
-       let
-           val len = size path
-
-           fun look i =
-               if i >= len then
-                   path
-               else if String.sub (path, i) = #"." then
-                   String.extract (path, i+1, NONE)
-               else
-                   look (i+1)
-       in
-           look 0
-       end
+       case OS.Path.ext path of
+           NONE => path
+         | SOME ext => ext
 
     val upperOffset = ord #"A" - ord #"a"
     fun toUpper ch =
@@ -112,8 +80,8 @@ struct
 
            fun loop (smls, mlts) =
                (case Posix.FileSys.readdir dir of
-                    "" => (smls, mlts)
-                  | fname =>
+                    NONE => (smls, mlts)
+                  | SOME fname =>
                     (case getExt fname of
                          "mlt" => loop (smls, (path ^ "/" ^ fname) :: mlts)
                        | ("sml"|"sig") =>
@@ -169,7 +137,6 @@ struct
            val outPath = Config.outPath config 
            val pubPath = Config.pubPath config
            val sml = Config.sml config
-           val arch = "x86-linux"
 
            val loc = Environment.staticPart (#get (EnvRef.loc ()) ())
            val base = Environment.staticPart (#get (EnvRef.base ()) ())
@@ -242,7 +209,7 @@ struct
            val _ = TextIO.closeOut outf
 
            val outf = TextIO.openOut (outPath ^ "/.build.sml")
-           val _ = TextIO.output (outf, "Control.printWarnings := false;\nCM.make \"sources.cm\";\nSMLofNJ.exportFn (\"" ^ outPath ^ "/heap\", Main.main);\n")
+           val _ = TextIO.output (outf, "Control.printWarnings := false;\nprint \"Here we go\"\n;\nCM.make \"sources.cm\";\nSMLofNJ.exportFn (\"" ^ outPath ^ "/heap\", Main.main);\n")
            val _ = TextIO.closeOut outf
 
            val outf = TextIO.openOut (outPath ^ "/sources.cm")
@@ -272,7 +239,7 @@ struct
                 printNames outputs;
                 TextIO.output (outf, "\n\t(* Driver *)\n\n\t_main.sml\n");
                 TextIO.closeOut outf;
-                if OS.Process.system ("cat " ^ outPath ^ "/.build.sml | " ^ sml ^ "/sml") = OS.Process.success then
+                if OS.Process.system ("cd " ^ outPath ^ " ; cat .build.sml | " ^ sml ^ "/sml") = OS.Process.success then
                     (ListPair.app makeScript (scripts, exports);
                      OS.Process.success)
                 else