Home My Page Projects Code Snippets Project Openings 3D graphics for Standard ML
Summary Activity SCM

SCM Repository

[sml3d] View of /trunk/sml3d/gen/spec-parser/driver.sml
ViewVC logotype

View of /trunk/sml3d/gen/spec-parser/driver.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1228 - (download) (annotate)
Mon Aug 8 12:28:32 2011 UTC (6 years, 4 months ago) by jhr
File size: 3522 byte(s)
  Working on spec parser/database
(* driver.sml
 *
 * COPYRIGHT (c) 2011 The SML3d Project (http://sml3d.cs.uchicago.edu)
 * All rights reserved.
 *)

structure Driver =
  struct

    structure X = XMLRep

    val parseEnumSpec = Util.withParser SpecParser.parseEnumSpec
    val parseFunctionSpec = Util.withParser SpecParser.parseFunctionSpec
    val parseTypemapSpec = Util.withParser SpecParser.parseTypemapSpec
    val parseXMLSpec = XMLParser.parseFile

    fun err s = TextIO.output (TextIO.stdErr, s)

    fun usage sts = (
          TextIO.output(TextIO.stdErr, "usage: gldb cmd ...\n");
          OS.Process.exit sts)

  (* create an initial (and empty) database file from command-line parameters *)
    fun initDB (db, typemap, enums, functs, prefix) = let
        (* first, check to make sure that the database file does not already exist *)
          val _ = if OS.FileSys.access(db, [])
                    then (
                      err (concat["gldb: database file \"", db, "\" already exists\n"]);
                      OS.Process.exit OS.Process.failure)
                    else ();
        (* create the XML representation *)
          val xml = X.DB{
                  typemap = typemap,       (* typemap pathname *)
                  enums = enums,
                  functs = functs,
                  constprefix = (CharVector.map Char.toUpper prefix) ^ "_",
                  functprefix = prefix,
                  constants = [],
                  types = [],
                  functions = []
                }
        (* write out the database *)
          val outS = TextIO.openOut db
          in
            PrintXML.print (outS, xml);
            TextIO.closeOut outS;
            OS.Process.success
          end

  (* check the specification files used to seed the database. *)
    fun checkSpecs db = let
        (* first we load the database to get the paths the specifications *)
          val X.DB{typemap, enums, functs, ...} = XMLParser.parseFile db
        (* load and check specification *)
          val tm = Typemap.load typemap
          val enums = Enums.load enums
(* FIXME: we should also check for internal consistency *)
          val _ = parseFunctionSpec functs
          in
            OS.Process.success
          end

    fun updateDB dbFile = let
        (* first we load the database to get the paths the specifications *)
          val db = DB.fromXML(XMLParser.parseFile dbFile)
        (* clone the database and load the specifications *)
          val newDB = DB.clone db
          val _ = DB.load newDB
          in
            DB.extend (db, newDB);
          (* we save the database by first writing it to a temp file and then renaming it *)
            let
            val {file=tmpFile, ...} = OS.Path.splitDirFile (OS.FileSys.tmpName())
            val outS = TextIO.openOut tmpFile
            fun atomicWrite () = (
                  PrintXML.print(outS, DB.toXML db);
                  TextIO.closeOut outS;
                  OS.FileSys.rename {old = tmpFile, new = dbFile})
            in
              (atomicWrite (); OS.Process.success)
                handle ex => (TextIO.closeOut outS; OS.FileSys.remove tmpFile; raise ex)
            end
          end
        
    fun dispatch ["help"] = usage OS.Process.success
      | dispatch ["init", db, typemap, enums, functs, prefix] =
          initDB (db, typemap, enums, functs, prefix)
      | dispatch ["check", db] = checkSpecs db
      | dispatch ["update", db] = updateDB db
      | dispatch _ = usage OS.Process.failure

  end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0