~ chicken-core (chicken-5) 646dcdd8db9772a83abd01a825da34608fdb387a
commit 646dcdd8db9772a83abd01a825da34608fdb387a
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Sep 6 13:15:57 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Tue Sep 6 13:15:57 2011 +0200
use type-abbrevs; documented define-type; don't wrap iface and type defs into begin-for-syntax (just do at elaboration-time)
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index 3d2f3ba8..0363b238 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -1115,7 +1115,7 @@
(when (eq? '* name)
(syntax-error-hook
'define-interface "`*' is not allowed as a name for an interface"))
- `(,(r 'begin-for-syntax)
+ `(##core#elaborationtimeonly
(##sys#put/restore!
(,%quote ,name)
(,%quote ##core#interface)
@@ -1293,12 +1293,12 @@
(let ((name (##sys#strip-syntax (cadr x)))
(%quote (r 'quote))
(t0 (##sys#strip-syntax (caddr x))))
- (let-values (((t pred pure) (##compiler#validate-type t0 #f)))
+ (let-values (((t pred pure) (##compiler#validate-type t0 name)))
(if t
- `(,(r 'begin-for-syntax)
+ `(##core#elaborationtimeonly
(##sys#put/restore!
(,%quote ,name)
- (,%quote '##compiler#type-abbreviation)
+ (,%quote ##compiler#type-abbreviation)
(,%quote ,t)))
(syntax-error-hook 'define-type "invalid type" name t0)))))))))
diff --git a/manual/Modules b/manual/Modules
index 1e0cd0d3..9b32b895 100644
--- a/manual/Modules
+++ b/manual/Modules
@@ -209,7 +209,8 @@ module-definitions using the {{(interface: INTERFACE)}} syntax.
See the definition of {{module}} above for an explanation of
{{EXPORT}} specifications.
-Interface names use a distinct global namespace.
+Interface names use a distinct global namespace. Interfaces defined
+inside modules are not visible outside of the module body.
=== import libraries
diff --git a/manual/Types b/manual/Types
index 6208ee20..2d7f7dc4 100644
--- a/manual/Types
+++ b/manual/Types
@@ -76,6 +76,15 @@ be of the given types. This is equivalent to
</enscript>
+===== define-type
+
+<syntax>(define-type NAME TYPE)</syntax>
+
+Defines a type-abbreviation {{NAME}} that can be used in place of
+{{TYPE}}. Type-abbreviations defined inside a module are not visible
+outside of that module.
+
+
==== Type syntax
Types declared with the {{type}} declaration (see [[Declarations]])
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 72b4b8d6..ee62c259 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -1829,7 +1829,7 @@
'(or eof null fixnum char boolean))
((eq? t 'any) '*)
((eq? t 'void) 'undefined)
- ((##sys#get t '##compiler#type-abbreviation) => cdr)
+ ((and (symbol? t) (##sys#get t '##compiler#type-abbreviation)))
((not (pair? t))
(cond ((memq t typevars) t)
(else #f)))
diff --git a/tests/scrutiny-tests.scm b/tests/scrutiny-tests.scm
index dfa87ba6..48bddff9 100644
--- a/tests/scrutiny-tests.scm
+++ b/tests/scrutiny-tests.scm
@@ -89,7 +89,9 @@
(+ x 1)) ; will warn about "x" being a string
;; declared procedure types are enforcing
-(: foo8 (string -> symbol))
+(define-type s2s (string -> symbol))
+
+(: foo8 s2s)
(define (foo8 x) (string->symbol x))
(define (foo9 x)
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index d3d2bbd9..649a027b 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -37,7 +37,7 @@ Warning: at toplevel:
scrutiny-tests.scm:28: in procedure call to `+', expected argument #2 of type `number', but was given an argument of type `symbol'
Warning: at toplevel:
- assignment of value of type `fixnum' to toplevel variable `car' does not match declared type `(forall (a99) (procedure car ((pair a99 *)) a99))'
+ assignment of value of type `fixnum' to toplevel variable `car' does not match declared type `(forall (a100) (procedure car ((pair a100 *)) a100))'
Warning: at toplevel:
expected in `let' binding of `g8' a single result, but were given 2 results
@@ -64,13 +64,13 @@ Warning: at toplevel:
scrutiny-tests.scm:89: in procedure call to `+', expected argument #1 of type `number', but was given an argument of type `string'
Warning: in toplevel procedure `foo9':
- scrutiny-tests.scm:97: in procedure call to `+', expected argument #1 of type `number', but was given an argument of type `string'
+ scrutiny-tests.scm:99: in procedure call to `+', expected argument #1 of type `number', but was given an argument of type `string'
Note: in toplevel procedure `foo10':
expression returns a result of type `string', but is declared to return `pair', which is not a subtype
Warning: in toplevel procedure `foo10':
- scrutiny-tests.scm:101: in procedure call to `string-append', expected argument #1 of type `string', but was given an argument of type `pair'
+ scrutiny-tests.scm:103: in procedure call to `string-append', expected argument #1 of type `string', but was given an argument of type `pair'
Warning: in toplevel procedure `foo10':
expression returns 2 values but is declared to have a single result
@@ -82,6 +82,6 @@ Warning: in toplevel procedure `foo10':
expression returns zero values but is declared to have a single result of type `*'
Warning: in toplevel procedure `foo10':
- scrutiny-tests.scm:104: in procedure call to `*', expected argument #1 of type `number', but was given an argument of type `string'
+ scrutiny-tests.scm:106: in procedure call to `*', expected argument #1 of type `number', but was given an argument of type `string'
Warning: redefinition of standard binding: car
Trap