From 30beb65af34b323c62a3c0031f5661c5bca6f1a8 Mon Sep 17 00:00:00 2001
From: Gustavo Massaccesi <gustavo@oma.org.ar>
Date: Sat, 7 Dec 2019 16:59:23 -0300
Subject: [PATCH] add  uninterned-symbols to cptypes

original commit: e85c19895bd47126a434364ae8007b6c40a87393
---
 s/cptypes.ss  | 13 ++++++++++++-
 s/primdata.ss |  4 ++--
 2 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/s/cptypes.ss b/s/cptypes.ss
index cf3a84b99c..0ee0f4a7e3 100644
--- a/s/cptypes.ss
+++ b/s/cptypes.ss
@@ -268,7 +268,7 @@ Notes:
                  (and (predicate-implies? x t)
                       (predicate-implies? y t)))
                '(char null-or-pair $record
-                 gensym symbol
+                 gensym uninterned-symbol interned-symbol symbol
                  fixnum exact-integer flonum real number
                  boolean true ptr))] ; ensure they are order from more restrictive to less restrictive
         [else #f]))
@@ -382,6 +382,8 @@ Notes:
       [bytevector? 'bytevector]
       [fxvector? 'fxvector]
       [gensym? 'gensym]
+      [uninterned-symbol? 'uninterned-symbol]
+      #;[interned-symbol? 'interned-symbol]
       [symbol? 'symbol]
       [char? 'char]
       [boolean? 'boolean]
@@ -416,6 +418,8 @@ Notes:
       [bytevector 'bytevector]
       [fxvector 'fxvector]
       [gensym 'gensym]
+      [uninterned-symbol 'uninterned-symbol]
+      [interned-symbol 'interned-symbol]
       [symbol 'symbol]
       [char 'char]
       [bottom 'bottom] ;pseudo-predicate
@@ -502,7 +506,14 @@ Notes:
                                 (eq? x 'real)
                                 (check-constant-is? x number?))]
                   [(gensym) (check-constant-is? x gensym?)]
+                  [(uninterned-symbol) (check-constant-is? x uninterned-symbol?)]
+                  [(interned-symbol) (check-constant-is? x (lambda (x)
+                                                             (and (symbol? x)
+                                                                  (not (gensym? x))
+                                                                  (not (uninterned-symbol? x)))))]
                   [(symbol) (or (eq? x 'gensym)
+                                (eq? x 'uninterned-symbol)
+                                (eq? x 'interned-symbol)
                                 (check-constant-is? x symbol?))]
                   [(char) (check-constant-is? x char?)]
                   [(boolean) (check-constant-is? x boolean?)]
diff --git a/s/primdata.ss b/s/primdata.ss
index 3d2a93442c..f317c58ae9 100644
--- a/s/primdata.ss
+++ b/s/primdata.ss
@@ -299,8 +299,8 @@
   (symbol? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard ieee r5rs])
   (symbol->string [sig [(symbol) -> (string)]] [flags true mifoldable discard safeongoodargs ieee r5rs])
   (symbol=? [sig [(symbol symbol symbol ...) -> (boolean)]] [flags pure mifoldable discard cp03 safeongoodargs])
-  (string->symbol [sig [(string) -> (symbol)]] [flags true mifoldable discard safeongoodargs ieee r5rs])
-  (string->uninterned-symbol [sig [(string) -> (symbol)]] [flags true discard])
+  (string->symbol [sig [(string) -> (interned-symbol)]] [flags true mifoldable discard safeongoodargs ieee r5rs])
+  (string->uninterned-symbol [sig [(string) -> (uninterned-symbol)]] [flags true discard safeongoodargs])
   (uninterned-symbol? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard])
   (char? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard ieee r5rs])
   (char->integer [sig [(char) -> (fixnum)]] [flags pure mifoldable discard safeongoodargs true ieee r5rs])