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/spec-loader.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1377 - (download) (annotate)
Fri Apr 4 20:45:22 2014 UTC (5 years, 1 month ago) by jhr
File size: 14583 byte(s)
  Working on FI generation tools
(* spec-loader.sml
 *
 * COPYRIGHT (c) 2014 The SML3d Project (http://sml3d.cs.uchicago.edu)
 * All rights reserved.
 *
 * Loads an OpenGL registry from an XML file and filters out the parts that we don't want
 * based on the API, profile, and supported extensions.  We also convert the representation
 * of the basic definitions to match the database representation (structure DBXMLRep).
 *
 * TODO: filter enums (currently all emums are included in the result)
 *)

structure SpecLoader : sig

    type ty = DBXMLRep.ty
    type enum = DBXMLRep.enum

  (* corresponds to either a <group> or a <enums> element in the registry file *)
    type group = DBXMLRep.enum_grp

  (* a function parameter *)
    type param = DBXMLRep.param

  (* a function prototype *)
    type proto = DBXMLRep.proto

    type command = DBXMLRep.cmd

    type feature = DBXMLRep.feature

  (* the registry represents the filtered view of the specification file.  It consists
   * of tables of definitions, plus a list of features, which includes extensions.
   *)
    type registry = {
	types : ty AtomTable.hash_table,
	enums : enum AtomTable.hash_table,
	groups : group AtomTable.hash_table,
	commands : command AtomTable.hash_table,
	features : feature list
      }

    val load : {
	  regFile : string,
	  api : string option,		(* optional api to filter the registry *)
	  profile : string option,	(* optional profile to filter the registry *)
	  extensions : string option	(* string that is matched against "supported" attribute *)
	} -> registry

    val test : unit -> registry

  end = struct

    structure Rep = SpecRep
    structure ATbl = AtomTable
    structure ASet = AtomSet

    type ty = DBXMLRep.ty
    type enum = DBXMLRep.enum

  (* corresponds to either a <group> or a <enums> element in the registry file *)
    datatype group = datatype DBXMLRep.enum_grp

  (* a function parameter *)
    datatype param = datatype DBXMLRep.param

  (* a function prototype *)
    datatype proto = datatype DBXMLRep.proto

    datatype command = datatype DBXMLRep.cmd

    datatype feature = datatype DBXMLRep.feature

    type registry = {
	types : ty ATbl.hash_table,
	enums : enum ATbl.hash_table,
	groups : group ATbl.hash_table,
	commands : command ATbl.hash_table,
	features : feature list
      }

  (* some standard OpenGL types that we want to ensure are included, since the specification
   * does not require them (even for OpenGL 1.0).
   *)
    val stdTypes = List.map Atom.atom [
	    "GLenum",
	    "GLboolean",
	    "GLbitfield",
	    "GLbyte",
	    "GLubyte",
	    "GLshort",
	    "GLushort",
	    "GLint",
	    "GLuint",
	    "GLint64",
	    "GLuint64",
	    "GLsizei",
	    "GLfloat",
	    "GLdouble",
	    "GLchar",
	    "GLintptr",
	    "GLsizeiptr"
	  ]

  (* integer types for enum constants *)
    val glint = CType.NamedTy(Atom.atom "GLint")
    val glenum = CType.NamedTy(Atom.atom "GLenum")
    val gluint64 = CType.NamedTy(Atom.atom "GLuint64")

  (* Load a registry from a XML file and filter out the parts that are not part of the
   * specified api and profile.
   *)
    fun load {regFile, api, profile, extensions} = let
	(* get the value of an attribute *)
	  fun getAttr (cxt, attr, attrs) = (case Rep.findAttr(attr, attrs)
		 of SOME value => value
		  | NONE => raise Fail(concat[
			"missing '", Atom.toString attr, "' attribute in '", cxt
		      ])
		(* end case *))
	(* get the name attribute as an atom *)
	  fun getName (cxt, attrs) = Atom.atom(getAttr(cxt, Rep.attr_name, attrs))
	(* load the registry info from the registry file *)
	  val Rep.Registry regContent = SpecParser.load regFile
	(********** PASS 1 **********
	 * In pass 1, we filter out elements that belong to other APIs/profiles and
	 * we accumulate the sets of elements to remove.
	 *)
	(* various tables to gather the contents of the registry *)
	  val tyTbl : Rep.ty ATbl.hash_table = ATbl.mkTable(256, Fail "tyTbl")
	  val cmdTbl : Rep.command ATbl.hash_table = ATbl.mkTable(16384, Fail "cmdTbl")
	  val removeTypes = ref ASet.empty	(* set of types to remove *)
	  val removeEnums = ref ASet.empty	(* set of enums to remove *)
	  val removeCmds = ref ASet.empty	(* set of commands to remove *)
	(* record that an interface element needs to be removed *)
	  fun removeInterfaceElem elem = let
		fun remove (cxt, setRef, attrs) =
		      setRef := ASet.add(!setRef, getName (cxt, attrs))
		in
		  case elem
		   of Rep.TypeElem attrs => remove ("feature.remove.type", removeTypes, attrs)
		    | Rep.EnumElem attrs => remove ("feature.remove.enum", removeEnums, attrs)
		    | Rep.CommandElem attrs => remove ("feature.remove.command", removeCmds, attrs)
		  (* end case *)
		end
	(* group parts by element type *)
	  fun doItem (Rep.Comment _, items) = items
	    | doItem (item as Rep.Types tys, items) = let
		fun doTy (tydef as Rep.Ty(attrs, SOME id, allText)) =
		      if Rep.matchAPIProfile {api=api, profile=profile} attrs
			then ATbl.insert tyTbl (Atom.atom id, tydef)
			else ()
		  | doTy _ = ()
		in
		  List.app doTy tys;
		  items
		end
	    | doItem (item as Rep.Groups _, items) = item :: items
	    | doItem (item as Rep.Enums(attrs, enums, _), items) =
		if Rep.matchAPIProfile {api=api, profile=profile} attrs
		  then item :: items
		  else items
	    | doItem (item as Rep.Commands(attrs, cmds), items) = let
		fun doCmd cmd = ATbl.insert cmdTbl (Atom.atom(Rep.nameOfCmd cmd), cmd)
		in
		(* add commands to the table of commands *)
		  List.app doCmd cmds;
		  items
		end
	    | doItem (feature as Rep.Feature(attrs, reqs, rems), items) =
		if Rep.matchAPIProfile {api=api, profile=profile} attrs
		  then let
		    fun doRemove (Rep.Remove(attrs, elems)) =
			  if Rep.matchAPIProfile {api=api, profile=profile} attrs
			    then List.app removeInterfaceElem elems
			    else ()
		    in
		      List.app doRemove rems;
		      feature :: items
		    end
		  else items
	    | doItem (item as Rep.Extensions _, items) = item :: items
	  val items = List.rev (List.foldl doItem [] regContent)
	(********** PASS 2 **********
	 * In pass 2, we process the registry using the remove sets to filter out
	 * stuff that we do not want.
	 *)
	  val typeTbl : ty ATbl.hash_table = ATbl.mkTable(64, Fail "typeTbl")
	  val enumTbl : enum ATbl.hash_table = ATbl.mkTable(8192, Fail "enumTbl")
	  val groupTbl : group ATbl.hash_table = ATbl.mkTable(512, Fail "groupTbl")
	  val commandTbl : command ATbl.hash_table = ATbl.mkTable(1024, Fail "commandTbl")
	  val features = ref []
	(* partition the contents of a <require> element into types, enums, and commands *)
	  fun doReq (Rep.Require(attrs, elems)::reqs, tys, enums, cmds) =
		if Rep.matchAPIProfile {api=api, profile=profile} attrs
		  then let
		    fun require (elem::elems, tys, enums, cmds) = (case elem
			   of Rep.TypeElem attrs =>
				require(
				  elems,
				  getName("require.type", attrs)::tys,
				  enums, cmds)
			    | Rep.EnumElem attrs =>
				require(
				  elems, tys,
				  getName("require.enum", attrs)::enums,
				  cmds)
			    | Rep.CommandElem attrs =>
				require(
				  elems, tys, enums,
				  getName("require.command", attrs)::cmds)
			  (* end case *))
		      | require ([], tys, enums, cmds) = (tys, enums, cmds)
		    val (tys, enums, cmds) = require (elems, tys, enums, cmds)
		    in
		      doReq (reqs, tys, enums, cmds)
		    end
		  else doReq (reqs, tys, enums, cmds)
	    | doReq ([], tys, enums, cmds) = (List.rev tys, List.rev enums, List.rev cmds)
	(* for the named required type, check to see if we have already added it to
	 * the typeTbl.  If not, then get its definition from the tyTbl (constructed
	 * in the first pass) and convert it.
	 *)
	  fun addTy id = (case ATbl.find typeTbl id
		 of NONE => (case ATbl.find tyTbl id
		       of SOME(Rep.Ty(_, _, allText)) => (case CType.typedefFromString allText
			     of SOME(name, def) => if Atom.same(id, name)
				  then ATbl.insert typeTbl (id, {name=id, def=def})
				  else raise Fail(concat[
				      "type name mismatch: \"", Atom.toString id, "\" vs. \"",
				      Atom.toString name, "\""
				    ])
			      | NONE => raise Fail "unable to parse typedef"
			    (* end case *))
			| NONE => raise Fail(concat["missing type \"", Atom.toString id, "\""])
		      (* end case *))
		  | SOME _ => ()
		(* end case *))
	(* for the named required command, check to see if we have already added it
	 * to the commandTbl.  If not, then get its definition from the cmdTbl
	 * (constructed in the first pass) and convert it.
	 *)
	  fun addCmd id = (case ATbl.find commandTbl id
		 of NONE => (case ATbl.find cmdTbl id
		       of SOME(Rep.Command(_, Rep.Proto(_, _, _, allText), params, _)) => let
(* FIXME: at some point, we should take advantage of the "group" attribute *)
			    fun getTy s = (case CType.fromString s
				   of SOME cty => cty
				    | NONE => raise Fail(concat[
					  "bad C type \"", s, "\" for command \"",
					  Atom.toString id, "\""
					])
				  (* end case *))
			    fun doParam (Rep.Param(attrs, _, pName, allText)) = Param{
				    name = Atom.atom pName,
				    group = (case Rep.findAttr(Rep.attr_group, attrs)
				       of SOME grp => SOME(Atom.atom grp)
					| NONE => NONE
				      (* end case *)),
				    cty = getTy allText,
				    mlty = NONE
				  }
			    val cmd = Cmd{
				    name = id,
				    protos = [
					Proto{
					    name = id,
					    retTy = {cty = getTy allText, mlty = NONE},
					    params = List.map doParam params
					  }
				      ]
				  }
			    in
			      ATbl.insert commandTbl (id, cmd)
			    end
			| NONE => raise Fail(concat["missing command \"", Atom.toString id, "\""])
		      (* end case *))
		  | SOME _ => ()
		(* end case *))
	  fun filterItem (Rep.Groups grps) = let
		fun keepEnum (Rep.Enum attrs) = let
		      val name = getName("impossible", attrs)
		      in
			if ASet.member(!removeEnums, name)
			  then NONE
			  else SOME name
		      end
		fun filterGrp (Rep.Group(attrs, enums)) =
		      (case List.mapPartial keepEnum enums
		       of [] => () (* nothing left *)
			| enums => let
			    val name = getName("groups.group", attrs)
			    val group = EnumGrp{name = name, bitmask = false, consts = enums}
			    in
(* FIXME: we should check to see if the group has already been defined (not expected, but possible) *)
			      ATbl.insert groupTbl (name, group)
			    end
		      (* end case *))
		in
		  List.app filterGrp grps
		end
	    | filterItem (Rep.Enums(attrs, enums, _)) = let
		fun keepEnum (Rep.Enum attrs) = let
		      val name = getName("enums.enum", attrs)
		      in
			if ASet.member(!removeEnums, name)
			  then NONE
			  else SOME{
			      name = name,
			      value = let
				val v = getAttr("enums.enum", Rep.attr_value, attrs)
				in
				  if (String.isPrefix "0x" v) orelse (String.isPrefix "0X" v)
				    then valOf(StringCvt.scanString (IntInf.scan StringCvt.HEX) v)
				    else valOf(IntInf.fromString v)
				end,
			      ty = (case Rep.findAttr(Rep.attr_type, attrs)
				 of NONE => NONE
				  | SOME "u" => SOME glenum
				  | SOME "ull" => SOME gluint64
				  | SOME ty => raise Fail(concat[
					"enum ", Atom.toString name, " has unrecognized type \"",
					ty, "\""
				      ])
				(* end case *))
			    }
		      end
		in
		  case List.mapPartial keepEnum enums
		   of [] => () (* nothing left *)
		    | enums => let
			val bitmask = (case Rep.findAttr(Rep.attr_type, attrs)
			       of SOME "bitmask" => true
				| _ => false
			      (* end case *))
			val optGrpName = Option.map Atom.atom (Rep.findAttr(Rep.attr_group, attrs))
			in
			  case optGrpName
			   of NONE => () (* no named group, so we just record the enums below *)
			    | SOME grpName => (case ATbl.find groupTbl grpName
				 of NONE => ATbl.insert groupTbl (grpName, EnumGrp{
					name = grpName,
					bitmask = bitmask,
					consts = List.map #name enums
				      })
				  | SOME(EnumGrp{consts, ...}) => if bitmask
					then ATbl.insert groupTbl (grpName, EnumGrp{ (* update with bitmask info *)
					  name = grpName,
					  bitmask = true,
					  consts = consts
					})
				      else ()
				(* end case *))
			  (* end case *);
			(* record the enums *)
			  List.app (fn enum => ATbl.insert enumTbl (#name enum, enum)) enums
			end
		  (* end case *)
		end
	    | filterItem (Rep.Feature(attrs, reqs, _)) = let
		val (tys, enums, cmds) = doReq (reqs, [], [], [])
		val feature = Feature{
			name = getName("feature", attrs),
			version = let
			  val num = getAttr ("feature", Rep.attr_number, attrs)
			  fun atoi n = (case Int.fromString n
				 of SOME n => n
				  | NONE => raise Fail "invalid number attribute"
				(* end case *))
			  in
			    List.map atoi (String.fields (fn #"." => true | _ => false) num)
			  end,
			types = tys,
			enums = enums,
			commands = cmds
		      }
		in
		  List.app addTy tys;
		  List.app addCmd cmds;
		  features := feature :: !features
		end
	    | filterItem (Rep.Extensions exts) = let
		fun doExtension (Rep.Extension(_, [], _)) = () (* ignore empty extensions *)
		  | doExtension (Rep.Extension(attrs, reqs, _)) = let
		    (* filter out extensions that do not match the extensions string *)
		      val isSupported = (case (Rep.findAttr(Rep.attr_supported, attrs), extensions)
			     of (_, NONE) => false
			      | (NONE, _) => true
			      | (SOME re, SOME ext) => let
				(* we are assuming that the supported RE is just a choice between
				 * constant strings (e.g., "gl|gles1")
				 *)
				  val strs = String.tokens (fn #"|" => true | _ => false) re
				  in
				    List.exists (fn s => (s = ext)) strs
				  end
			    (* end case *))
		      in
			if isSupported
			  then let
			    val (tys, enums, cmds) = doReq (reqs, [], [], [])
			    val feature = Feature{
				    name = getName("extension", attrs),
				    version = [],
				    types = tys,
				    enums = enums,
				    commands = cmds
				  }
			    in
			      List.app addTy tys;
			      List.app addCmd cmds;
			      features := feature :: !features
			    end
			  else ()
		      end (* doExtension *)
		in
		  List.app doExtension exts
		end
	    | filterItem _ = raise Fail "impossible"
	  val _ = List.app filterItem items
	(* add standard types, if the API is "gl" *)
	  val _ = if (api = SOME "gl")
		then List.app addTy stdTypes
		else ()
	  in {
	    types = typeTbl,
	    enums = enumTbl,
	    groups = groupTbl,
	    commands = commandTbl,
	    features = List.rev (!features)
	  } end

    fun test () = load{
	    regFile = "../specs/gl.xml",
	    api = SOME "gl",
	    profile = SOME "core",
	    extensions = SOME "glcore"
	  }

  end

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