Added LENGTH, and vector and string constructors.

diff --git a/v8/src/compiler/midend/typedb.scm b/v8/src/compiler/midend/typedb.scm
index 005e7dd32afd8917ceac5188cf0768e0ae57a091..1fb5b2ec3dad9581e96893d63b893f14573e6ca2 100644 (file)
--- a/v8/src/compiler/midend/typedb.scm
+++ b/v8/src/compiler/midend/typedb.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: typedb.scm,v 1.7 1996/07/20 18:30:14 adams Exp $
+$Id: typedb.scm,v 1.8 1996/07/22 17:49:20 adams Exp $
 
 Copyright (c) 1996 Massachusetts Institute of Technology
 
@@ -68,13 +68,27 @@ MIT in each case. |#
        (procedure-type (list type:string type:string) type:boolean
                        'effect-sensitive effect:string-set!)))
   '(STRING<?    STRING=?    STRING>?    STRING<=?    STRING>=?
-    STRING-CI<? STRING-CI=? STRING-CI>? STRING-CI<=? STRING-CI>=?))
+    STRING-CI<? STRING-CI=? STRING-CI>? STRING-CI<=? STRING-CI>=?
+    STRING-PREFIX?     STRING-SUFFIX?
+    STRING-PREFIX-CI?  STRING-SUFFIX-CI?))
 
 (define-operator-type 'SUBSTRING?
   (procedure-type (list type:string type:string)
                  (type:or type:false type:fixnum>=0)
                  'effect-sensitive effect:string-set!))
 
+(define-operator-type 'STRING-APPEND
+  (procedure-type type:string
+                 type:string
+                 'effect-sensitive effect:string-set!
+                 'effect effect:allocation))
+
+(define-operator-type 'STRING-COPY
+  (procedure-type type:string
+                 type:string
+                 'effect-sensitive effect:string-set!
+                 'effect effect:allocation))
+
 
 ;; The following error:* procedures have return type empty, which means
 ;; the procedure never returns.  This is only true if there are no
@@ -135,17 +149,36 @@ MIT in each case. |#
                            'effect-insensitive
                            'effect effect:set-cdr!))
 
+(define-operator-type (make-primitive-procedure 'LENGTH)
+  (primitive-procedure-type (list type:list) type:fixnum>=0
+                           'effect-free
+                           'effect-sensitive (effect:union effect:set-car!
+                                                           effect:set-cdr!)))
+
 (define-operator-type (make-primitive-procedure 'SYSTEM-VECTOR-SIZE)
   (primitive-procedure-type (list type:any) type:vector-length
                            'function))
 
-;; Note: before the VECTOR definition is useful, we need to change typerew to
-;; handle rest lists:
 (define-operator-type (make-primitive-procedure 'VECTOR)
   (primitive-procedure-type type:any type:vector
                            'effect-insensitive
                            'effect effect:allocation))
 
+(define-operator-type (make-primitive-procedure 'VECTOR-CONS)
+  (primitive-procedure-type (list type:vector-length type:any)  type:vector
+                           'effect-insensitive
+                           'effect  effect:allocation))
+
+(define-operator-type %vector-cons
+  (primitive-procedure-type (list type:vector-length type:any)  type:vector
+                           'effect-insensitive
+                           'effect  effect:allocation))
+
+(define-operator-type 'MAKE-VECTOR
+  (procedure-type (cons* type:vector-length   type:any)  type:vector
+                 'effect-insensitive
+                 'effect  effect:allocation))
+
 (define-operator-type (make-primitive-procedure 'VECTOR-LENGTH)
   (primitive-procedure-type (list type:vector) type:vector-length
                            'function))
@@ -154,6 +187,27 @@ MIT in each case. |#
   (primitive-procedure-type (list type:%record) type:vector-length
                            'function))
 
+(define-operator-type 'STRING
+  (procedure-type type:any     ; should be charatcer but it doesn't check.
+                 type:string
+                 'effect-insensitive
+                 'effect effect:allocation))
+
+(define-operator-type (make-primitive-procedure 'STRING-ALLOCATE)
+  (primitive-procedure-type (list type:string-length)  type:string
+                           'effect-insensitive
+                           'effect  effect:allocation))
+
+(define-operator-type %string-allocate
+  (primitive-procedure-type (list type:string-length)  type:string
+                           'effect-insensitive
+                           'effect  effect:allocation))
+
+(define-operator-type 'MAKE-STRING
+  (procedure-type (cons* type:string-length  type:character)  type:string
+                 'effect-insensitive
+                 'effect  effect:allocation))
+
 (define-operator-type (make-primitive-procedure 'STRING-LENGTH)
   (primitive-procedure-type (list type:string) type:string-length
                            'effect-free