core: Use single definition rule for cell-type.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 29 Apr 2018 11:22:02 +0000 (13:22 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 29 Apr 2018 11:22:02 +0000 (13:22 +0200)
* src/mes.c (scm_type_char, scm_type_closure, scm_type_continuation,
  scm_type_function, scm_type_keyword, scm_type_macro,
  scm_type_number, scm_type_pair, scm_type_ref, scm_type_special,
  scm_type_string, scm_type_symbol, scm_type_values,
  scm_type_variable, scm_type_vector): New symbol.
  (mes_symbols): Add them.
* module/mes/type-0.mes (<cell:char>, <cell:char>, <cell:closure>,
  <cell:continuation>, <cell:function>, <cell:keyword>, <cell:macro>,
  <cell:number>, <cell:pair>, <cell:ref>, <cell:special>,
  <cell:string>, <cell:symbol>, <cell:values>, <cell:variable>,
  <cell:vector>, <cell:broken-heart): Remove.
* module/mes/boot-0.scm: Likewise.
* module/mes/boot-01.scm: Likewise.
* module/mes/boot-02.scm: Likewise.
* scaffold/boot/20-define-quote.scm: Likewise.
* scaffold/boot/37-closure-lambda.scm: Likewise.
* scaffold/boot/38-simple-format.scm: Likewise.
* scaffold/boot/4c-quasiquote.scm:
* scaffold/boot/4e-string-split.scm: Likewise.
* scaffold/boot/51-module.scm: Likewise.
* scaffold/boot/52-define-module.scm: Likewise.
* scaffold/boot/60-let-syntax.scm: Likewise.
* module/mes/guile.scm: Add some of them.

14 files changed:
module/mes/boot-0.scm
module/mes/boot-01.scm
module/mes/boot-02.scm
module/mes/guile.scm
module/mes/type-0.mes
scaffold/boot/20-define-quote.scm
scaffold/boot/37-closure-lambda.scm
scaffold/boot/38-simple-format.scm
scaffold/boot/4c-quasiquote.scm
scaffold/boot/4e-string-split.scm
scaffold/boot/51-module.scm
scaffold/boot/52-define-module.scm
scaffold/boot/60-let-syntax.scm
src/mes.c

index ade835ba9f907604b51b295f310c0b7599b6736b..062ba6f9e7fd226ec27a38dbd2a3c81bdfca6716 100644 (file)
 ;; end boot-00.scm
 
 ;; boot-01.scm
-(define <cell:character> 0)
-(define <cell:pair> 7)
-(define <cell:string> 10)
-
 (define (pair? x) (eq? (core:type x) <cell:pair>))
 (define (not x) (if x #f #t))
 
@@ -61,7 +57,7 @@
   (core:make-cell <cell:string> lst 0))
 
 (define (integer->char x)
-  (core:make-cell <cell:character> 0 x))
+  (core:make-cell <cell:char> 0 x))
 
 (define (newline . rest)
   (core:display (list->string (list (integer->char 10)))))
index e2cc1c659c909cd9b7174b14d9772c389bd3a71d..d8d9a62fad6b8f5df165c1cfe66cde603bc1a023 100644 (file)
 ;; end boot-00.scm
 
 ;; boot-01.scm
-(define <cell:character> 0)
-(define <cell:pair> 7)
-(define <cell:string> 10)
-
 (define (pair? x) (eq? (core:type x) <cell:pair>))
 (define (not x) (if x #f #t))
 
@@ -51,7 +47,7 @@
   (core:make-cell <cell:string> lst 0))
 
 (define (integer->char x)
-  (core:make-cell <cell:character> 0 x))
+  (core:make-cell <cell:char> 0 x))
 
 (define (newline . rest)
   (core:display (list->string (list (integer->char 10)))))
index b2d00297fe85f3faf5e93308758c83120241834a..c051f7450a2621f8686ad998ef25063881e3c413 100644 (file)
 ;; end boot-00.scm
 
 ;; boot-01.scm
-(define <cell:character> 0)
-(define <cell:pair> 7)
-(define <cell:string> 10)
-
 (define (pair? x) (eq? (core:type x) <cell:pair>))
 (define (not x) (if x #f #t))
 
@@ -61,7 +57,7 @@
   (core:make-cell <cell:string> lst 0))
 
 (define (integer->char x)
-  (core:make-cell <cell:character> 0 x))
+  (core:make-cell <cell:char> 0 x))
 
 (define (newline . rest)
   (core:display (list->string (list (integer->char 10)))))
index 3e71de678d39e4368dea555382f382bef9eb1113..b519dc52f58628815fcf37af1afd7c0d80a47dd9 100644 (file)
 
 (define-module (mes guile)
   #:export (
+            <cell:char>
+            <cell:keyword>
+            <cell:number>
+            <cell:pair>
+            <cell:string>
+            <cell:symbol>
+            <cell:vector>
+
             append2
             core:apply
             core:display
@@ -37,9 +45,7 @@
             core:type
             pmatch-car
             pmatch-cdr
-            )
-  ;;#:re-export (open-input-file open-input-string with-input-from-string)
-  )
+            ))
 
 (cond-expand
  (guile
   (define guile:pair? pair?)
   (define guile:string? string?)
   (define guile:symbol? symbol?)
+
+  (define <cell:char> 0)
+  (define <cell:keyword> 4)
+  (define <cell:number> 6)
+  (define <cell:pair> 7)
+  (define <cell:string> 9)
+  (define <cell:symbol> 10)
+  (define <cell:vector> 14)
+
   (define (core:type x)
-    (define <cell:keyword> 4)
-    (define <cell:number> 6)
-    (define <cell:pair> 7)
-    (define <cell:string> 10)
-    (define <cell:symbol> 11)
     (cond ((guile:keyword? x) <cell:keyword>)
           ((guile:number? x) <cell:number>)
           ((guile:pair? x) <cell:pair>)
           ((guile:string? x) <cell:string>)
-          ((guile:symbol? x) <cell:symbol>)))
-
-;;   (define core:open-input-file open-input-file)
-;;   (define (open-input-file file)
-;;     (let ((port (core:open-input-file file)))
-;;       (when (getenv "MES_DEBUG")
-;;         (core:display-error (string-append "open-input-file: `" file " port="))
-;;         (core:display-error port)
-;;         (core:display-error "\n"))
-;;       port))
-
-;;   (define core:open-input-string open-input-string)
-;;   (define (open-input-string string)
-;;     (let ((port (core:open-input-string string)))
-;;       (when (getenv "MES_DEBUG")
-;;         (core:display-error (string-append "open-input-string: `" string " port="))
-;;         (core:display-error port)
-;;         (core:display-error "\n"))
-;;       port))
+          ((guile:symbol? x) <cell:symbol>))))
 
-;;   (define core:with-input-from-string with-input-from-string)
-;;   (define (with-input-from-string string thunk)
-;;     (if (getenv "MES_DEBUG")
-;;         (core:display-error (string-append "with-input-from-string: `" string "'\n")))
-;;     (core:with-input-from-string string thunk))
-  )
  (mes))
 
 (cond-expand
index dc83b054c55f37e8fed26334375cd800adfc813c..18d7dbde2b44167d8c585257ce8bd82012296e9c 100644 (file)
 
 ;;; Code:
 
-(define <cell:char> 0)
-(define <cell:closure> 1)
-(define <cell:continuation> 2)
-(define <cell:function> 3)
-(define <cell:keyword> 4)
-(define <cell:macro> 5)
-(define <cell:number> 6)
-(define <cell:pair> 7)
-(define <cell:ref> 8)
-(define <cell:special> 9)
-(define <cell:string> 10)
-(define <cell:symbol> 11)
-(define <cell:values> 12)
-(define <cell:variable> 13)
-(define <cell:vector> 14)
-(define <cell:broken-heart> 15)
-
 (define cell:type-alist
   (list (cons <cell:char> (quote <cell:char>))
         (cons <cell:closure> (quote <cell:closure>))
   (core:car s))
 
 (define (integer->char x)
-  (core:make-cell <cell:character> 0 x))
+  (core:make-cell <cell:char> 0 x))
 
 (define (char->integer x)
   (core:make-cell <cell:number> 0 x))
index 236bba5985b73ef3c7627301ebf5fd30b85cd998..b355670ec36a4da0ccd8222e87eacf85666e618d 100644 (file)
@@ -16,7 +16,6 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-(define <cell:char> 0)
 (define cell:type-alist
   (list (cons <cell:char> (quote <cell:char>))))
 cell:type-alist
index 7b759fcb83c183129c37756dfaa865001cf887b8..9d8ec46f8a7c4c4eb2d457465208c0fea34757ab 100644 (file)
@@ -16,8 +16,6 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-(define <cell:pair> 7)
-
 (define (pair? x)
   (eq? (core:type x) <cell:pair>))
 
index f2fcab903bde91f54de267540ca62f522332502b..39ec5ad97e89a563dfdcb053931aaf20861694de 100644 (file)
@@ -16,7 +16,6 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-(define <cell:pair> 7)
 (define (pair? x) (eq? (core:type x) <cell:pair>))
 
 (define (not x) (if x #f #t))
index f2a48b8e56bb19457dc96ad8c5e8133f085c99cc..16442eb62867149110a64d100a573c21ba2cc29b 100644 (file)
@@ -16,9 +16,7 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-(define <cell:pair> 7)
 (define (pair? x) (eq? (core:type x) <cell:pair>))
-(define <cell:vector> 14)
 (define (vector? x)
   (eq? (core:type x) <cell:vector>))
 
index d3d41a368b4f149e5cf4ebb5f7fa1db0f29cdcc4..c2ebb3e12e2114ae1e0dcd8c1b93ad48f645e538 100644 (file)
@@ -8,7 +8,6 @@
 (define (cdar x) (cdr (car x)))
 (define (cddr x) (cdr (cdr x)))
 
-(define <cell:symbol> 11)
 (define (symbol? x)
   (eq? (core:type x) <cell:symbol>))
 
@@ -78,8 +77,6 @@
 (define (string->list s)
   (core:car s))
 
-(define <cell:string> 10)
-
 (define (list->string lst)
   (core:make-cell <cell:string> lst 0))
 
index f5e856e99c0b0f2306c473603b3119ba43c62453..981a4248bc1e374818ab0003b6be79a8bfaa1d0f 100644 (file)
@@ -44,8 +44,6 @@
   (define (string->list s)
     (core:car s))
 
-  (define <cell:string> 10)
-
   (define (string . lst)
     (core:make-cell <cell:string> lst 0))
 
@@ -89,8 +87,6 @@
   (define (symbol->list s)
     (core:car s))
 
-  (define <cell:string> 10)
-
   (define (string . lst)
     (core:make-cell <cell:string> lst 0))
 
index 81fa9ee837a367c3844d7102db68f80c7377ce3d..67aad1170f26d7969d24338150c6742ffe09f3db 100644 (file)
@@ -43,8 +43,6 @@
   (define (string->list s)
     (core:car s))
 
-  (define <cell:string> 10)
-
   (define (string . lst)
     (core:make-cell <cell:string> lst 0))
 
index b3d61040d8d655373d0ed98719a5aa33c5564324..f670d25acd266c20cf99cce55d29b4804f98b964 100644 (file)
@@ -60,7 +60,6 @@
 ;;   (define (core:apply f a m) (f a))
 ;;   )
 ;;  (mes
-  (define <cell:symbol> 11)
   (define (symbol? x)
     (eq? (core:type x) <cell:symbol>))
 
     (if (not (pair? (core:car s))) '()
         (core:lookup-symbol (core:car s))))
 
-  (define <cell:string> 10)
   (define (string? x)
     (eq? (core:type x) <cell:string>))
   
-  (define <cell:vector> 14)
   (define (vector? x)
     (eq? (core:type x) <cell:vector>))
  
index ec17ca6382d3fb15469e9bffae89d29f7cf40932..46544f7000344b02d84fb7dfad7a4c43eaf4d5e8 100644 (file)
--- a/src/mes.c
+++ b/src/mes.c
@@ -216,6 +216,23 @@ struct scm scm_vm_call_with_values2 = {TSPECIAL, "*vm-call-with-values2*",0};
 struct scm scm_vm_call_with_current_continuation2 = {TSPECIAL, "*vm-call-with-current-continuation2*",0};
 struct scm scm_vm_return = {TSPECIAL, "*vm-return*",0};
 
+struct scm scm_type_char = {TSYMBOL, "<cell:char>",0};
+struct scm scm_type_closure = {TSYMBOL, "<cell:closure>",0};
+struct scm scm_type_continuation = {TSYMBOL, "<cell:continuation>",0};
+struct scm scm_type_function = {TSYMBOL, "<cell:function>",0};
+struct scm scm_type_keyword = {TSYMBOL, "<cell:keyword>",0};
+struct scm scm_type_macro = {TSYMBOL, "<cell:macro>",0};
+struct scm scm_type_number = {TSYMBOL, "<cell:number>",0};
+struct scm scm_type_pair = {TSYMBOL, "<cell:pair>",0};
+struct scm scm_type_ref = {TSYMBOL, "<cell:ref>",0};
+struct scm scm_type_special = {TSYMBOL, "<cell:special>",0};
+struct scm scm_type_string = {TSYMBOL, "<cell:string>",0};
+struct scm scm_type_symbol = {TSYMBOL, "<cell:symbol>",0};
+struct scm scm_type_values = {TSYMBOL, "<cell:values>",0};
+struct scm scm_type_variable = {TSYMBOL, "<cell:variable>",0};
+struct scm scm_type_vector = {TSYMBOL, "<cell:vector>",0};
+struct scm scm_type_broken_heart = {TSYMBOL, "<cell:broken-heart>",0};
+
 struct scm scm_symbol_gnuc = {TSYMBOL, "%gnuc",0};
 struct scm scm_symbol_mesc = {TSYMBOL, "%mesc",0};
 
@@ -1946,9 +1963,27 @@ g_cells[cell_test].car = cstring_to_list (scm_test.name);
   a = acons (cell_symbol_mesc, cell_f, a);
 #else
   a = acons (cell_symbol_gnuc, cell_f, a);
-  a = acons (cell_symbol_mesc, cell_t, a);
+
 #endif
 #endif // !MES_MINI
+
+  a = acons (cell_type_char, MAKE_NUMBER (TCHAR), a);
+  a = acons (cell_type_closure, MAKE_NUMBER (TCLOSURE), a);
+  a = acons (cell_type_continuation, MAKE_NUMBER (TCONTINUATION), a);
+  a = acons (cell_type_function, MAKE_NUMBER (TFUNCTION), a);
+  a = acons (cell_type_keyword, MAKE_NUMBER (TKEYWORD), a);
+  a = acons (cell_type_macro, MAKE_NUMBER (TMACRO), a);
+  a = acons (cell_type_number, MAKE_NUMBER (TNUMBER), a);
+  a = acons (cell_type_pair, MAKE_NUMBER (TPAIR), a);
+  a = acons (cell_type_ref, MAKE_NUMBER (TREF), a);
+  a = acons (cell_type_special, MAKE_NUMBER (TSPECIAL), a);
+  a = acons (cell_type_string, MAKE_NUMBER (TSTRING), a);
+  a = acons (cell_type_symbol, MAKE_NUMBER (TSYMBOL), a);
+  a = acons (cell_type_values, MAKE_NUMBER (TVALUES), a);
+  a = acons (cell_type_variable, MAKE_NUMBER (TVARIABLE), a);
+  a = acons (cell_type_vector, MAKE_NUMBER (TVECTOR), a);
+  a = acons (cell_type_broken_heart, MAKE_NUMBER (TBROKEN_HEART), a);
+
   a = acons (cell_closure, a, a);
 
   return a;