~ chicken-core (chicken-5) fe083f47bdf4da86e8e3e7d62233d9b70a46f3b1

commit fe083f47bdf4da86e8e3e7d62233d9b70a46f3b1
Author:     megane <meganeka@gmail.com>
AuthorDate: Tue May 29 10:51:37 2018 +0300
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Mon Nov 12 13:24:18 2018 +1300

    Add quoted symbols as shorthand for forall
    
    Signed-off-by: Peter Bex <peter@more-magic.net>
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/NEWS b/NEWS
index 18eefd7f..31fded0f 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,10 @@
+5.0.1
+
+- Type system
+  - It is now possible to quote free variables in type declarations,
+     which acts as shorthand for `forall' (thanks to "megane")
+
+
 5.0.0
 
 - Runtime system
diff --git a/manual/Types b/manual/Types
index c87ea431..587cdaa5 100644
--- a/manual/Types
+++ b/manual/Types
@@ -161,6 +161,16 @@ or {{:}} should follow the syntax given below:
 
 (*) Note: no type-variables are bound inside {{(not TYPE)}}.
 
+You can use a shorthand {{'SYMBOL}} for introducing free variables in
+{{forall}} types, for example:
+
+  ('a -> 'a) is translated to (forall (a) (a -> a))
+
+If a {{forall}} already exists, quotes around the free variables
+introduced by it will be stripped:
+
+  (forall (a) ('a -> a)) is translated to (forall (a) (a -> a))
+
 Note that type-variables in {{forall}} types may be given "constraint" types, i.e.
 
   (: sort (forall (e (s (or (vector-of e) (list-of e))))
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 8209ae38..3d621de5 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -1972,6 +1972,15 @@
 				(second t))
 			       constraints))
 		     (validate (third t) rec)))))
+	    ((and (eq? 'quote (car t))
+		  (pair? (cdr t))
+		  (symbol? (second t))
+		  (null? (cddr t))
+		  (second t))
+	     => (lambda (v)
+		  (unless (memq v typevars)
+		    (set! typevars (cons v typevars)))
+		  v))
 	    ((eq? 'or (car t)) 
 	     (and (list? t)
 		  (let ((ts (map validate (cdr t))))
diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm
index 4d8f40cd..97b83289 100644
--- a/tests/typematch-tests.scm
+++ b/tests/typematch-tests.scm
@@ -255,6 +255,7 @@
 (infer (forall (a) (procedure (#!rest a) a)) +)
 (infer (list fixnum) '(1))
 
+(define something)
 
 (infer port (open-input-string "foo"))
 (infer input-port (open-input-string "bar"))
@@ -398,4 +399,24 @@
   (length a) ; refine (or pair null) with list (= (list-of *))
   (infer list a))
 
+
+(assert
+ (compiler-typecase 1
+   ('a #t)))
+
+(assert
+ (compiler-typecase (the (list fixnum string string) something)
+   ((list 'a 'a 'b) #f)
+   ((list 'a 'b 'b) #t)))
+
+(assert
+ (compiler-typecase (the (list fixnum string string) something)
+   ((forall (a) (list a 'a 'b)) #f)
+   ((forall (b) (list 'a 'b b)) #t)))
+
+(assert
+ (compiler-typecase (the (list string (list string fixnum)) something)
+   ((list 'a (forall (a) (list 'b a))) #f)
+   ((list 'b (forall (b) (list b 'a))) #t)))
+
 (test-exit)