~ chicken-core (chicken-5) f1a45fd97f06111c0109680ccf1068ec386cc5e0
commit f1a45fd97f06111c0109680ccf1068ec386cc5e0
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Mon Apr 18 23:12:28 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon Apr 18 23:12:28 2011 +0200
-O5 does not -strict-types; started type-stuff documentation; type-checks for all valid types
diff --git a/chicken.scm b/chicken.scm
index 27e3739b..8c0147f0 100644
--- a/chicken.scm
+++ b/chicken.scm
@@ -121,7 +121,6 @@
'inline
'inline-global
'unboxing
- 'strict-types
options) ) ) ) )
(loop (cdr rest)) ) )
((eq? 'debug-level o)
diff --git a/manual/Data representation b/manual/Data representation
index 53b462c3..3a6ba788 100644
--- a/manual/Data representation
+++ b/manual/Data representation
@@ -53,7 +53,7 @@ collection or internal data type dispatching.
; C_GC_FORWARDING_BIT : Flag used for forwarding garbage collected object pointers.
-; C_BYTEBLOCK_BIT : Flag that specifies whether this data object contains raw bytes (a string or byte-vector) or pointers to other data objects.
+; C_BYTEBLOCK_BIT : Flag that specifies whether this data object contains raw bytes (a string or blob) or pointers to other data objects.
; C_SPECIALBLOCK_BIT : Flag that specifies whether this object contains a ''special'' non-object pointer value in its first slot. An example for this kind of objects are closures, which are a vector-type object with the code-pointer as the first item.
@@ -93,8 +93,11 @@ contain housekeeping data used for this port.
specifies the kind of structure this record is an instance of. The other
slots contain the actual record items.
-'''pointers''': special vector objects with type bits
-{{C_POINTER_TYPE}}, currently 1001. The single slot contains a machine pointer.
+'''blob''': a raw sequence of bytes with type bits {{C_BYTEVECTOR_TYPE}}.
+
+'''pointer-vectors''': vector objects of native pointers - these are
+actually structures where the first slot holds a blob containing the 32- or 64-bit
+pointer values.
'''locatives''': special vector objects with type bits
{{C_LOCATIVE_TYPE}}, currently 1010. A locative object holds 4 slots:
@@ -105,18 +108,19 @@ object slot that holds a pointer to Scheme data) and a flag indicating
whether this locative is "weak". If the locative is non-weak, slot #4 holds
a pointer to the object referred to.
+'''pointers''': special vector objects with type bits
+{{C_POINTER_TYPE}}, currently 1001. The single slot contains a machine pointer.
+
'''tagged pointers''': special vector objects with type bits
{{C_TAGGED_POINTER_TYPE}}, currently 1011, Tagged pointers are similar to pointers,
but the object contains an additional
slot with a tag (an arbitrary data object) that identifies the type
of the pointer.
-'''SWIG pointers''': special vector objects with type bits {{C_SWIG_POINTER_TYPE}}, currently
-1100.
-
'''lambda infos''': byte-vector objects with type-bits {{C_LAMBDA_INFO_TYPE}}, currently 1101.
-'''buckets''': vector objects with type-bits {{C_BUCKET_TYPE}}, currently 1111.
+'''buckets''': vector objects with type-bits {{C_BUCKET_TYPE}}, currently 1111. These are
+only used internally for the implementation of symbol tables.
The actual data follows immediately after the header. Note that
block addresses are always aligned to the native machine-word
diff --git a/manual/Declarations b/manual/Declarations
index d35d3dfc..2f42f84a 100644
--- a/manual/Declarations
+++ b/manual/Declarations
@@ -320,6 +320,8 @@ given here:
| VAL
A type-declaration overrides any previous declaration for the same identifier.
+See also [[Types]] for more information about using type-information and
+a more convenient type-declaration syntax ({{:}}).
=== extended-bindings
@@ -396,6 +398,6 @@ levels 2 and higher).
---
-Previous: [[Modules]]
+Previous: [[Types]]
Next: [[Parameters]]
diff --git a/manual/Modules b/manual/Modules
index 6b91f329..c3d7b5a8 100644
--- a/manual/Modules
+++ b/manual/Modules
@@ -464,4 +464,4 @@ functor body.
---
Previous: [[Macros]]
-Next: [[Declarations]]
+Next: [[Types]]
diff --git a/manual/Supported language b/manual/Supported language
index d7be9c82..7905da01 100644
--- a/manual/Supported language
+++ b/manual/Supported language
@@ -9,6 +9,7 @@
* [[Non-standard macros and special forms]]
* [[Macros]]
* [[Modules]]
+* [[Types]]
* [[Declarations]]
* [[Parameters]]
* [[Exceptions]]
diff --git a/manual/Types b/manual/Types
new file mode 100644
index 00000000..e6806873
--- /dev/null
+++ b/manual/Types
@@ -0,0 +1,84 @@
+[[tags: manual]]
+[[toc:]]
+
+
+=== Types
+
+A dynamically typed language like Scheme does not restrict the type of
+values bound or assigned to variables to be constant troughout the
+run-time of a program. This provides a lot of flexibility and makes it
+easy to get code up and running quickly, but can make maintenance of
+larger code bases more difficult as the implicit assignment of types
+to variables done by the programmer has to be "recovered" when the
+code is inspected or debugged again. Statically typed languages
+enforce distinct types for all variables, optionally providing
+type-inference to compute types without requiring the user to specify
+explicit type declarations in many cases.
+
+If the compiler has some knowledge of the types of local or global
+variables then it can help in catching type-related errors like
+passing a value of the wrong type to a user-defined or built-in
+procedure. Type-information also can be used to generate more
+efficient code by omitting unnecessary type-checks.
+
+CHICKEN provides an intra-procedural flow-analysis pass and two
+compiler options for using type-information in this manner:
+
+{{-scrutinize}} will look for possibly incorrectly typed arguments to
+library procedure calls and generate warnings in such cases.
+
+{{-specialize}} will replace certain generic library procedure calls
+with faster type-specific operations.
+
+Note that the interpreter will always ignore type-declarations
+and will not perform any flow-analysis of interpreted code.
+
+
+==== Declaring types
+
+Type information for all core library units is available by default.
+User-defined global variables can be declared to have a type using
+the {{(declare (type ...))}} or {{:}} syntax.
+
+
+===== :
+
+<syntax>(: IDENTIFIER TYPE)</syntax>
+
+Declares that the global variable {{IDENTIFIER}} is of the given type.
+
+If {{IDENTIFIER}} names a {{define}}d procedure, then all required
+arguments are checked at runtime on procedure-entry whether they have
+the correct types (type for optional or "rest" arguments are currently
+not checked). If the code is compiled with the {{-strict-types}}
+option or if it is compiled in unsafe mode, then no type-checks will
+be generated.
+
+
+==== Type syntax
+
+XXX ...
+
+
+==== Using type information in extensions
+
+XXX ... -emit-type-file, -types
+
+
+==== Optimizations done by specialization
+
+If argument types are known, then calls to known library procedures
+are replaced with non-checking variants (if available). Additionally,
+procedure checks can be omitted in cases where the value in operator
+position of a procedure call is known to be a procedure. Performance
+results will vary greatly depending on the nature of the compiled
+code. In general, specialization will not make code that is compiled
+in unsafe mode any faster: compilation in unsafe mode will omit most
+type checks anyway. But specialization can often improve the
+performance of code compiled in safe (default) mode.
+
+
+---
+Previous: [[Modules]]
+
+Next: [[Declarations]]
diff --git a/manual/Using the compiler b/manual/Using the compiler
index b9c0db45..31334746 100644
--- a/manual/Using the compiler
+++ b/manual/Using the compiler
@@ -56,6 +56,8 @@ the source text should be read from standard input.
; -emit-inline-file FILENAME : Write procedures that can be globally inlined in internal form to {{FILENAME}}, if global inlining is enabled. Implies {{-inline -local}}. If the inline-file would be empty (because no procedure would be inlinable) no file is generated and any existing inline-file with that name is deleted.
+; -emit-type-file FILENAME : Write type-information for declarations of user-defined and globally visible variables to a file of the given name. The generated file is suitable for use with the {{-types}} option.
+
; -explicit-use : Disables automatic use of the units {{library, eval}} and {{extras}}. Use this option if compiling a library unit instead of an application unit.
; -extend FILENAME : Loads a Scheme source file or compiled Scheme program (on systems that support it) before compilation commences. This feature can be used to extend the compiler. This option may be given multiple times. The file is also searched in the current include path and in the extension-repository.
@@ -128,7 +130,7 @@ the source text should be read from standard input.
-optimize-level 2 is equivalent to -optimize-leaf-routines -inline -unboxing
-optimize-level 3 is equivalent to -optimize-leaf-routines -local -inline -inline-global -unboxing -specialize
-optimize-level 4 is equivalent to -optimize-leaf-routines -local -inline -inline-global -unboxing -specialize -unsafe
- -optimize-level 5 is equivalent to -optimize-leaf-routines -block -inline -inline-global -unboxing -specialize -unsafe -disable-interrupts -no-trace -no-lambda-info -strict-types
+ -optimize-level 5 is equivalent to -optimize-leaf-routines -block -inline -inline-global -unboxing -specialize -unsafe -disable-interrupts -no-trace -no-lambda-info
; -output-file FILENAME : Specifies the pathname of the generated C file. Default is {{FILENAME.c}}.
diff --git a/scrutinizer.scm b/scrutinizer.scm
index fd683e56..529e2319 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -203,8 +203,8 @@
" OR "))
((struct)
(sprintf "a structure of type ~a" (cadr t)))
- (else (bomb "invalid type: ~a" t))))
- (else (bomb "invalid type: ~a" t))))))
+ (else (bomb "invalid type" t))))
+ (else (bomb "invalid type" t))))))
(define (argument-string args)
(let* ((len (length args))
@@ -683,12 +683,12 @@
(mark-variable var '##compiler#type rt))))
(when b
(cond ((eq? 'undefined (cdr b)) (set-cdr! b rt))
- (strict-variable-types
+ #;(strict-variable-types
(let ((ot (or (blist-type var flow) (cdr b))))
;;XXX compiler-syntax for "map" will introduce
;; assignments that trigger this warning, so this
;; is currently disabled
- #;(unless (compatible-types? ot rt)
+ (unless (compatible-types? ot rt)
(report
loc
(sprintf
@@ -762,7 +762,7 @@
(cons fn (nth-value 0 (procedure-argument-types fn (sub1 len)))))
r)))
((##core#switch ##core#cond)
- (bomb "unexpected node class: ~a" class))
+ (bomb "unexpected node class" class))
(else
(for-each (lambda (n) (walk n e loc #f #f flow #f)) subs)
'*))))
@@ -884,7 +884,7 @@
(cond ((null? rt) '())
((eq? '* rt) (return '*))
(else (cons (car rt) (loop (cdr rt)))))))))
- (else (bomb "not a procedure type: ~a" t))))
+ (else (bomb "not a procedure type" t))))
(define (named? t)
(and (pair? t)
@@ -1080,6 +1080,69 @@
;;; generate type-checks for formal variables
(define (generate-type-checks! node loc vars inits)
+ ;; assumes type is validated
+ (define (test t v)
+ (case t
+ ((null) `(##core#inline "C_eqp" ,v '()))
+ ((eof) `(##core#inline "C_eofp" ,v))
+ ((string) `(if (##core#inline "C_blockp" ,v)
+ (##core#inline "C_stringp" ,v)
+ '#f))
+ ((float) `(if (##core#inline "C_blockp" ,v)
+ (##core#inline "C_flonump" ,v)
+ '#f))
+ ((char) `(##core#inline "C_charp" ,v))
+ ((fixnum) `(##core#inline "C_fixnump" ,v))
+ ((number) `(##core#inline "C_i_numberp" ,v))
+ ((list) `(##core#inline "C_i_listp" ,v))
+ ((symbol) `(if (##core#inline "C_blockp" ,v)
+ (##core#inline "C_symbolp" ,v)
+ '#f))
+ ((pair) `(if (##core#inline "C_blockp" ,v)
+ (##core#inline "C_pairp" ,v)
+ '#f))
+ ((boolean) `(##core#inline "C_booleanp" ,v))
+ ((procedure) `(if (##core#inline "C_blockp" ,v)
+ (##core#inline "C_closurep" ,v)
+ '#f))
+ ((vector) `(if (##core#inline "C_blockp" ,v)
+ (##core#inline "C_vectorp" ,v)
+ '#f))
+ ((pointer) `(if (##core#inline "C_blockp" ,v)
+ (##core#inline "C_pointerp" ,v)
+ '#f))
+ ((blob) `(if (##core#inline "C_blockp" ,v)
+ (##core#inline "C_byteblockp" ,v)
+ '#f))
+ ((pointer-vector) `(##core#inline "C_i_structurep" ,v 'pointer-vector))
+ ((port) `(if (##core#inline "C_blockp" ,v)
+ (##core#inline "C_portp" ,v)
+ '#f))
+ ((locative) `(if (##core#inline "C_blockp" ,v)
+ (##core#inline "C_locativep" ,v)
+ '#f))
+ (else
+ (case (car t)
+ ((procedure) `(if (##core#inline "C_blockp" ,v)
+ (##core#inline "C_closurep" ,v)
+ '#f))
+ ((or)
+ (cond ((null? (cdr t)) '(##core#undefined))
+ ((null? (cddr t)) (test (cadr t) v))
+ (else
+ `(if ,(test (cadr t) v)
+ '#t
+ ,(test `(or ,@(cddr t)) v)))))
+ ((and)
+ (cond ((null? (cdr t)) '(##core#undefined))
+ ((null? (cddr t)) (test (cadr t) v))
+ (else
+ `(if ,(test (cadr t) v)
+ ,(test `(and ,@(cddr t)) v)
+ '#f))))
+ ((not)
+ `(not ,(test (cadr t) v)))
+ (else (bomb "invalid type" t v))))))
(let ((body (first (node-subexpressions node))))
(let loop ((vars (reverse vars)) (inits (reverse inits)) (b body))
(cond ((null? inits)
@@ -1095,42 +1158,19 @@
(loop (cdr vars) (cdr inits) b))
(else
(loop
- (cdr vars)
- (cdr inits)
+ (cdr vars) (cdr inits)
(make-node
'let (list (gensym))
(list
(build-node-graph
(let ((t (car inits))
(v (car vars)))
- (case t
- ((null) `(if (not (null? ,v))
- (##core#app ##sys#error ',loc "bad argument type - not null" v)))
- ((eof) `(if (not (eof-object? ,v))
- (##core#app ##sys#error ',loc "bad argument type - not eof" v)))
- ((string) `(##core#app ##sys#check-string ,v ',loc))
- ((fixnum) `(##core#app ##sys#check-exact ,v ',loc))
- ((float) `(##core#app ##sys#check-inexact ,v ',loc))
- ((char) `(##core#app ##sys#check-char ,v ',loc))
- ((number) `(##core#app ##sys#check-number ,v ',loc))
- ((list) `(##core#app ##sys#check-list ,v ',loc))
- ((symbol) `(##core#app ##sys#check-symbol ,v ',loc))
- ((pair) `(##core#app ##sys#check-pair ,v ',loc))
- ((boolean) `(##core#app ##sys#check-boolean ,v ',loc))
- ((procedure) `(##core#app ##sys#check-closure ,v ',loc))
- ((vector) `(##core#app ##sys#check-vector ,v ',loc))
- ((pointer) `(##core#app ##sys#check-pointer ,v ',loc))
- ((blob) `(##core#app ##sys#check-blob ,v ',loc))
- ((locative) `(##core#app ##sys#check-locative ,v ',loc))
- ((port) `(##core#app ##sys#check-port ,v ',loc))
- ((pointer-vector) `(##core#app ##sys#check-structure ,v 'pointer-vector ',loc))
- (else
- (if (pair? t)
- (case (car t)
- ((procedure) `(##core#app ##sys#check-closure ,v ',loc))
- ((struct) `(##core#app ##sys#check-structure ,v ',(cadr t) ',loc))
- (else (bomb "can not generate type-check for `~a'" t)))
- (bomb "can not generate type-check for `~a'" t))))))
+ `(if ,(test t v)
+ (##core#undefined)
+ (##core#app
+ ##sys#error ',loc
+ '"type check failed"
+ ',t ',v))))
b))))))))
diff --git a/tests/fft.scm b/tests/fft.scm
index 1e692aa6..6f6a4235 100644
--- a/tests/fft.scm
+++ b/tests/fft.scm
@@ -2082,7 +2082,9 @@
(let ((a
(make-f64vector (fx* two^n 2) 0.)))
(do ((i 0 (fx+ i 1)))
- ((fx= i iters)); (write table) (newline))
+ ((fx= i iters)
+ (write table) (newline)
+ )
(direct-fft-recursive-4 a table)
(inverse-fft-recursive-4 a table)))))
Trap