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/spec-db/c-type.sml
ViewVC logotype

View of /trunk/sml3d/gen/spec-parser/spec-db/c-type.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: 4553 byte(s)
  Working on spec parser/database
(* c-type.sml
 *
 * COPYRIGHT (c) 2011 The SML3d Project (http://sml3d.cs.uchicago.edu)
 * All rights reserved.
 *)

structure CType =
  struct

    datatype ty
      = VoidTy                          (* "void" *)
      | NamedTy of Atom.atom            (* id *)
      | StructTy of Atom.atom           (* "struct" id *)
      | PtrTy of ty                     (* ty "*" *)

  (* parameter directions; INOUT is not currently used *)
    and direction = IN | OUT | INOUT

  (* calling-convention mechanism used to pass values; note that VALUE
   * is only use for the IN direction.
   *)
    and transfer_ty = ARRAY | REF | VALUE

    fun same (VoidTy, VoidTy) = true
      | same (NamedTy a, NamedTy b) = Atom.same(a, b)
      | same (StructTy a, StructTy b) = Atom.same(a, b)
      | same (PtrTy a, PtrTy b) = same(a, b)

    fun toString VoidTy = "void"
      | toString (NamedTy ty) = Atom.toString ty
      | toString (StructTy id) = "struct " ^ Atom.toString id
      | toString (PtrTy ty) = toString ty ^ "*"

  (* a parser for simple C types *)
    fun fromString 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 orelse (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("struct", ss) => (case scanId(skipWS ss)
                       of SOME(id, ss) => parse1 (StructTy(Atom.atom id), ss)
                        | NONE => NONE
                      (* end case *))
		  | SOME(id, ss) => parse1 (NamedTy(Atom.atom id), ss)
		  | NONE => NONE
		(* end case *))
	  and parse1 (ty, ss) = (case Substring.getc(skipWS ss)
		 of NONE => SOME ty
		  | SOME(#"*", ss) => parse1 (PtrTy ty, ss)
                  | _ => NONE
		(* end case *))
	  in
	    parse (Substring.full ty)
	  end

    local
      fun mkTypemap mapping = 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)) mapping;
              lookup
            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 ptrMap = mkTypemap [
              ("GLboolean",     "glboolean"),
              ("GLbyte",        "glbyte"),
              ("GLenum",        "glenum"),
              ("GLfloat",       "glfloat"),
              ("GLsizeiptr",	"glsizeiptr"),
              ("GLdouble",      "gldouble"),
              ("GLubyte",       "glubyte"),
              ("GLuint",        "gluint"),
              ("GLclampd",      "glclampd"),
              ("GLclampf",      "glclampf"),
              ("GLsizei",       "glsizei"),
              ("GLushort",      "glushort"),
              ("GLshort",       "glshort"),
              ("GLint",	        "glint"),
              ("GLchar",        "glchar"),
              ("GLuint",        "gluint"),
              ("GLintptr",      "glintptr"),
              ("GLbitfield",	"glbitfield"),
              ("GLushort",      "glushort"),
            (* older names for some types *)
              ("GLsizeiptrARB", "glsizeiptr"),
              ("GLintptrARB",	"glintptr")
            ]
    (* mapping from pointers to OpenGL base types to their ML array types. *)
      val typeMap = mkTypemap [
              ("GLubyte",       "string")
            ]
    in
  (* convert a C type to an ML type string *)
    fun toMLString ty = (case ty
	   of VoidTy => "unit"
	    | NamedTy bty => typeMap bty
            | StructTy _ => raise Fail "non-pointer struct type"
            | PtrTy(NamedTy bty) => ptrMap bty
	    | PtrTy _ => "ptr"	(* MLton.Pointer.t *)
	  (* end case *))
    end

  end

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