Fix up for MLton build.

[snipe.git] / type / type.sml

diff --git a/type/type.sml b/type/type.sml
index 69f35f8c27c6b7487890c67c30a4e0afab14c251..82bc8b1a054bfa46b42298f940b2e30c7a431bf4 100644 (file)
--- a/type/type.sml
+++ b/type/type.sml
@@ -1,7 +1,7 @@
 signature TYPE =
 sig
   type ident = Symbol.symbol
-  datatype vtype = Int | Typedef of ident | Pointer of vtype | Array of vtype | TNull
+  datatype vtype = Int | String | Typedef of ident | Pointer of vtype | Array of vtype | TNull
   type variable = ident * vtype
   datatype typedef = MarkedTypedef of typedef Mark.marked | Struct of variable list
 
@@ -28,14 +28,15 @@ end
 structure Type :> TYPE =
 struct
   type ident = Symbol.symbol
-  datatype vtype = Int | Typedef of ident | Pointer of vtype | Array of vtype | TNull
+  datatype vtype = Int | String | Typedef of ident | Pointer of vtype | Array of vtype | TNull
   type variable = ident * vtype
   datatype typedef = MarkedTypedef of typedef Mark.marked | Struct of variable list
 
-  fun size (Int) = 4
-    | size (Pointer _) = 8
-    | size (Array _) = 8
-    | size (TNull) = 8
+  fun size (Int) = 1
+    | size (String) = 1
+    | size (Pointer _) = 1
+    | size (Array _) = 1
+    | size (TNull) = 1
     | size _ = raise ErrorMsg.InternalError "Type.size on non-small type..."
 
   (************************************************)
@@ -48,9 +49,10 @@ struct
     (* determine size of items *)
     fun sizeof_reset () = ( size_memotable := Symbol.empty )
     fun alignment_reset () = ( align_memotable := Symbol.empty )
-    fun sizeof _ (Int) = 4
-      | sizeof _ (Pointer _) = 8
-      | sizeof _ (Array _) = 8
+    fun sizeof _ (Int) = 1
+      | sizeof _ (String) = 1
+      | sizeof _ (Pointer _) = 1
+      | sizeof _ (Array _) = 1
       | sizeof _ (TNull) = raise ErrorMsg.InternalError "Type.sizeof on TNull?"
       | sizeof d (Typedef id) =
           (case (Symbol.look (!size_memotable) id)
@@ -70,9 +72,10 @@ struct
       | sizeof_s d (MarkedTypedef(a)) = sizeof_s d (Mark.data a)
 
     (* determine alignment of items *)
-    and alignment _ (Int) = 4
-      | alignment _ (Pointer _) = 8
-      | alignment _ (Array _) = 8
+    and alignment _ (Int) = 1
+      | alignment _ (String) = 1
+      | alignment _ (Pointer _) = 1
+      | alignment _ (Array _) = 1
       | alignment d (Typedef id) =
           (case Symbol.look (!align_memotable) id
           of SOME(r) => r
@@ -104,12 +107,14 @@ struct
 
 
   fun issmall (Int) = true
+    | issmall (String) = true
     | issmall (Pointer _) = true
     | issmall (Array _) = true
     | issmall (TNull) = true
     | issmall _ = false
 
   fun typeeq (Int, Int) = true
+    | typeeq (String, String) = true
     | typeeq (Typedef a, Typedef b) = (Symbol.name a) = (Symbol.name b)
     | typeeq (Pointer a, Pointer b) = typeeq (a, b)
     | typeeq (Array a, Array b) = typeeq (a, b)
@@ -131,6 +136,7 @@ struct
     fun pp_ident i = Symbol.name i
 
     fun pp_type (Int) = "int"
+      | pp_type (String) = "string"
       | pp_type (Pointer t) = pp_type t ^ "*"
       | pp_type (Array t) = pp_type t ^ "[]"
       | pp_type (TNull) = "{NULL type}"