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

SCM Repository

[sml3d] View of /gen/gl-types.sml
ViewVC logotype

View of /gen/gl-types.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 243 - (download) (annotate)
Wed Sep 24 08:12:22 2008 UTC (11 years, 4 months ago) by jhr
File size: 2608 byte(s)
  Working on generator tool
(* gl-types.sml
 *
 * COPYRIGHT (c) 2008 John Reppy (http://cs.uchicago.edu/~jhr)
 * All rights reserved.
 *)

structure GLTypes =
  struct

    datatype c_type
      = VoidTy
      | BaseTy of Atom.atom
      | PtrTy of c_type

  (* a parser for simple C types *)
    fun parseCType ty = let
	  fun scanId start = let
		fun scan (ss, n) = (case Substring.getc ss
		       of SOME(c, ss') => if Char.isAlphaNum c orelse (c = #"_")
			    then scan(ss', n+1)
			    else SOME(Substring.string(Substring.slice(start, 0, SOME n)), ss)
			| NONE => SOME(Substring.string(Substring.slice(start, 0, SOME n)), ss)
		      (* end case *))
		in
		  case Substring.getc start
		   of SOME(c, ss) => if Char.isAlpha c
			then scan (ss, 1)
			else NONE
		    | NONE => NONE
		  (* end case *)
		end
	  val skipWS = StringCvt.skipWS Substring.getc
	  fun parse ss = (case scanId ss
		 of SOME("const", ss) => parse(skipWS ss)
		  | SOME("void", ss) => parse1 (VoidTy, ss)
		  | SOME("GLvoid", ss) => parse1 (VoidTy, ss)
		  | SOME(id, ss) => parse1 (BaseTy(Atom.atom id), ss)
		  | NONE => raise Fail "bogus C type"
		(* end case *))
	  and parse1 (ty, ss) = (case Substring.getc(skipWS ss)
		 of NONE => ty
		  | SOME(#"*", ss) => parse1 (PtrTy ty, ss)
		(* end case *))
	  in
	    parse (Substring.full ty)
	  end

  (* mapping from OpenGL base types to their ML names.  Note that we assume these
   * types are in the context of "open GLTypes".  Also, we assume that "ptr" has been
   * defined to be MLton.Pointer.t.
   *)
    val typeMap = let
	  val tbl = AtomTable.mkTable (32, Fail "typeMap")
	  val ins = AtomTable.insert tbl
	  fun lookup ty = (case AtomTable.find tbl ty
		 of NONE => raise Fail("unknown C type " ^ Atom.toString ty)
		  | SOME ty => ty
		(* end case *))
	  in
	    List.app (fn (a, b) => ins(Atom.atom a, b)) [
		("GLboolean",	"glboolean"),
		("GLbyte",	"glbyte"),
		("GLenum",	"glenum"),
		("GLfloat",	"glfloat"),
		("GLsizeiptr",	"glsizeiptr"),
		("GLdouble",	"gldouble"),
		("GLubyte",	"glubyte"),
		("GLuint",	"gluint"),
		("GLclampd",	"glclampd"),
		("GLvoid",	"glvoid"),
		("GLclampf",	"glclampf"),
		("GLsizei",	"glsizei"),
		("GLushort",	"glushort"),
		("GLshort",	"glshort"),
		("GLint",	"glint"),
		("GLchar",	"glchar"),
		("GLuint",	"gluint"),
		("GLintptr",	"glintptr"),
		("GLbitfield",	"glbitfield"),
		("GLushort",	"glushort")
	      ];
	    lookup
	  end

  (* convert a C type string to an ML type string *)
    fun cToML ty = (case parseCType ty
	   of VoidTy =>"unit"
	    | BaseTy bty => typeMap bty
	    | PtrTy _ => "ptr"	(* MLton.Pointer.t *)
	  (* end case *))

  end

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