From 8911af4aa8da385e4b9dd49daa24e9025b316461 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 29 Apr 2018 13:22:02 +0200 Subject: [PATCH] core: Use single definition rule for cell-type. * 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 (, , , , , , , , , , , , , , , , 0) -(define 7) -(define 10) - (define (pair? x) (eq? (core:type x) )) (define (not x) (if x #f #t)) @@ -61,7 +57,7 @@ (core:make-cell lst 0)) (define (integer->char x) - (core:make-cell 0 x)) + (core:make-cell 0 x)) (define (newline . rest) (core:display (list->string (list (integer->char 10))))) diff --git a/module/mes/boot-01.scm b/module/mes/boot-01.scm index e2cc1c65..d8d9a62f 100644 --- a/module/mes/boot-01.scm +++ b/module/mes/boot-01.scm @@ -32,10 +32,6 @@ ;; end boot-00.scm ;; boot-01.scm -(define 0) -(define 7) -(define 10) - (define (pair? x) (eq? (core:type x) )) (define (not x) (if x #f #t)) @@ -51,7 +47,7 @@ (core:make-cell lst 0)) (define (integer->char x) - (core:make-cell 0 x)) + (core:make-cell 0 x)) (define (newline . rest) (core:display (list->string (list (integer->char 10))))) diff --git a/module/mes/boot-02.scm b/module/mes/boot-02.scm index b2d00297..c051f745 100644 --- a/module/mes/boot-02.scm +++ b/module/mes/boot-02.scm @@ -42,10 +42,6 @@ ;; end boot-00.scm ;; boot-01.scm -(define 0) -(define 7) -(define 10) - (define (pair? x) (eq? (core:type x) )) (define (not x) (if x #f #t)) @@ -61,7 +57,7 @@ (core:make-cell lst 0)) (define (integer->char x) - (core:make-cell 0 x)) + (core:make-cell 0 x)) (define (newline . rest) (core:display (list->string (list (integer->char 10))))) diff --git a/module/mes/guile.scm b/module/mes/guile.scm index 3e71de67..b519dc52 100644 --- a/module/mes/guile.scm +++ b/module/mes/guile.scm @@ -24,6 +24,14 @@ (define-module (mes guile) #:export ( + + + + + + + + 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 @@ -61,42 +67,22 @@ (define guile:pair? pair?) (define guile:string? string?) (define guile:symbol? symbol?) + + (define 0) + (define 4) + (define 6) + (define 7) + (define 9) + (define 10) + (define 14) + (define (core:type x) - (define 4) - (define 6) - (define 7) - (define 10) - (define 11) (cond ((guile:keyword? x) ) ((guile:number? x) ) ((guile:pair? x) ) ((guile:string? x) ) - ((guile:symbol? x) ))) + ((guile:symbol? x) )))) -;; (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)) - -;; (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 diff --git a/module/mes/type-0.mes b/module/mes/type-0.mes index dc83b054..18d7dbde 100644 --- a/module/mes/type-0.mes +++ b/module/mes/type-0.mes @@ -25,23 +25,6 @@ ;;; Code: -(define 0) -(define 1) -(define 2) -(define 3) -(define 4) -(define 5) -(define 6) -(define 7) -(define 8) -(define 9) -(define 10) -(define 11) -(define 12) -(define 13) -(define 14) -(define 15) - (define cell:type-alist (list (cons (quote )) (cons (quote )) @@ -151,7 +134,7 @@ (core:car s)) (define (integer->char x) - (core:make-cell 0 x)) + (core:make-cell 0 x)) (define (char->integer x) (core:make-cell 0 x)) diff --git a/scaffold/boot/20-define-quote.scm b/scaffold/boot/20-define-quote.scm index 236bba59..b355670e 100644 --- a/scaffold/boot/20-define-quote.scm +++ b/scaffold/boot/20-define-quote.scm @@ -16,7 +16,6 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with Mes. If not, see . -(define 0) (define cell:type-alist (list (cons (quote )))) cell:type-alist diff --git a/scaffold/boot/37-closure-lambda.scm b/scaffold/boot/37-closure-lambda.scm index 7b759fcb..9d8ec46f 100644 --- a/scaffold/boot/37-closure-lambda.scm +++ b/scaffold/boot/37-closure-lambda.scm @@ -16,8 +16,6 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with Mes. If not, see . -(define 7) - (define (pair? x) (eq? (core:type x) )) diff --git a/scaffold/boot/38-simple-format.scm b/scaffold/boot/38-simple-format.scm index f2fcab90..39ec5ad9 100644 --- a/scaffold/boot/38-simple-format.scm +++ b/scaffold/boot/38-simple-format.scm @@ -16,7 +16,6 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with Mes. If not, see . -(define 7) (define (pair? x) (eq? (core:type x) )) (define (not x) (if x #f #t)) diff --git a/scaffold/boot/4c-quasiquote.scm b/scaffold/boot/4c-quasiquote.scm index f2a48b8e..16442eb6 100644 --- a/scaffold/boot/4c-quasiquote.scm +++ b/scaffold/boot/4c-quasiquote.scm @@ -16,9 +16,7 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with Mes. If not, see . -(define 7) (define (pair? x) (eq? (core:type x) )) -(define 14) (define (vector? x) (eq? (core:type x) )) diff --git a/scaffold/boot/4e-string-split.scm b/scaffold/boot/4e-string-split.scm index d3d41a36..c2ebb3e1 100644 --- a/scaffold/boot/4e-string-split.scm +++ b/scaffold/boot/4e-string-split.scm @@ -8,7 +8,6 @@ (define (cdar x) (cdr (car x))) (define (cddr x) (cdr (cdr x))) -(define 11) (define (symbol? x) (eq? (core:type x) )) @@ -78,8 +77,6 @@ (define (string->list s) (core:car s)) -(define 10) - (define (list->string lst) (core:make-cell lst 0)) diff --git a/scaffold/boot/51-module.scm b/scaffold/boot/51-module.scm index f5e856e9..981a4248 100644 --- a/scaffold/boot/51-module.scm +++ b/scaffold/boot/51-module.scm @@ -44,8 +44,6 @@ (define (string->list s) (core:car s)) - (define 10) - (define (string . lst) (core:make-cell lst 0)) @@ -89,8 +87,6 @@ (define (symbol->list s) (core:car s)) - (define 10) - (define (string . lst) (core:make-cell lst 0)) diff --git a/scaffold/boot/52-define-module.scm b/scaffold/boot/52-define-module.scm index 81fa9ee8..67aad117 100644 --- a/scaffold/boot/52-define-module.scm +++ b/scaffold/boot/52-define-module.scm @@ -43,8 +43,6 @@ (define (string->list s) (core:car s)) - (define 10) - (define (string . lst) (core:make-cell lst 0)) diff --git a/scaffold/boot/60-let-syntax.scm b/scaffold/boot/60-let-syntax.scm index b3d61040..f670d25a 100644 --- a/scaffold/boot/60-let-syntax.scm +++ b/scaffold/boot/60-let-syntax.scm @@ -60,7 +60,6 @@ ;; (define (core:apply f a m) (f a)) ;; ) ;; (mes - (define 11) (define (symbol? x) (eq? (core:type x) )) @@ -68,11 +67,9 @@ (if (not (pair? (core:car s))) '() (core:lookup-symbol (core:car s)))) - (define 10) (define (string? x) (eq? (core:type x) )) - (define 14) (define (vector? x) (eq? (core:type x) )) diff --git a/src/mes.c b/src/mes.c index ec17ca63..46544f70 100644 --- 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, "",0}; +struct scm scm_type_closure = {TSYMBOL, "",0}; +struct scm scm_type_continuation = {TSYMBOL, "",0}; +struct scm scm_type_function = {TSYMBOL, "",0}; +struct scm scm_type_keyword = {TSYMBOL, "",0}; +struct scm scm_type_macro = {TSYMBOL, "",0}; +struct scm scm_type_number = {TSYMBOL, "",0}; +struct scm scm_type_pair = {TSYMBOL, "",0}; +struct scm scm_type_ref = {TSYMBOL, "",0}; +struct scm scm_type_special = {TSYMBOL, "",0}; +struct scm scm_type_string = {TSYMBOL, "",0}; +struct scm scm_type_symbol = {TSYMBOL, "",0}; +struct scm scm_type_values = {TSYMBOL, "",0}; +struct scm scm_type_variable = {TSYMBOL, "",0}; +struct scm scm_type_vector = {TSYMBOL, "",0}; +struct scm scm_type_broken_heart = {TSYMBOL, "",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;