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

SCM Repository

[sml3d] View of /trunk/sml3d/gen/gen-from-xml/gldb/driver.sml
ViewVC logotype

View of /trunk/sml3d/gen/gen-from-xml/gldb/driver.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1377 - (download) (annotate)
Fri Apr 4 20:45:22 2014 UTC (4 years, 11 months ago) by jhr
File size: 4323 byte(s)
  Working on FI generation tools
(* driver.sml
 *
 * COPYRIGHT (c) 2014 The SML3d Project (http://sml3d.cs.uchicago.edu)
 * All rights reserved.
 *)

structure Driver =
  struct

    structure X = DBXMLRep

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

    fun usage sts = (
          TextIO.output(TextIO.stdErr,
            "usage:\n\
            \  gldb help\n\
            \    -- print this message\n\
            \  gldb init [options] <db> <registry>\n\
            \    -- create a new empty database <db>\n\
            \  gldb check <db>\n\
            \    -- check the specification files used to generate the database <db>\n\
            \  gldb update <db>\n\
            \    -- update the database <db> from its specification files\n\
            \");
          OS.Process.exit sts)

  (* create an initial (and empty) database file from command-line parameters *)
    fun initDB (db, regFile, api, profile, extensions) = 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{
                  registry = regFile,       (* specfile pathname *)
		  api = api,
		  profile = profile,
		  extensions = extensions,
		  types = [],
		  enums = [],
		  commands = [],
		  groups = [],
		  features = []
                }
        (* write out the database *)
          val outS = TextIO.openOut db
          in
            DBXMLPrint.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 content = DBXMLParser.parseFile db
          in
	  (* load and check specification *)
	   (DB.load {
		regFile = #registry content,
		api = #api content,
		profile = #profile content,
		extensions = #extensions content
	      }) handle Fail msg => (
		TextIO.output (TextIO.stdErr, msg^"\n");
		OS.Process.exit OS.Process.failure);
            OS.Process.success
          end

    fun updateDB dbFile = let
        (* first we load the database to get the paths the specifications *)
	  val xmlDB as DBXMLRep.DB content = DBXMLParser.parseFile dbFile
	  val db = DB.fromXML xmlDB
        (* load the specifications into a new DB *)
          val newDB = DB.load {
		  regFile = #registry content,
		  api = #api content,
		  profile = #profile content,
		  extensions = #extensions content
		}
          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 () = (
                  DBXMLPrint.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" :: args) = let
	  val api = ref "gl"
	  val profile = ref "core"
	  val extensions = ref "glcore"
	  fun processOpts [] = usage OS.Process.failure
	    | processOpts [_] = usage OS.Process.failure
	    | processOpts [db, regFile] = initDB (db, regFile, !api, !profile, !extensions)
	    | processOpts (opt::rest) = if String.isPrefix "--" opt
		then (
		  case String.fields (fn #"=" => true | _ => false) opt
		   of ["--api", v] => api := v
		    | ["--profile", v] => profile := v
		    | ["--extensions", v] => extensions := v
		    | _ => usage OS.Process.failure
		  (* end case *);
		  processOpts rest)
		else usage OS.Process.failure
	  in
	    processOpts args
	  end
      | 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