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 (<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.
This commit is contained in:
parent
a56d5e3efe
commit
8911af4aa8
|
@ -42,10 +42,6 @@
|
|||
;; 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)))))
|
||||
|
|
|
@ -32,10 +32,6 @@
|
|||
;; 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)))))
|
||||
|
|
|
@ -42,10 +42,6 @@
|
|||
;; 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)))))
|
||||
|
|
|
@ -24,6 +24,14 @@
|
|||
|
||||
(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
|
||||
|
@ -61,42 +67,22 @@
|
|||
(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>)))
|
||||
((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))
|
||||
|
||||
;; (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
|
||||
|
|
|
@ -25,23 +25,6 @@
|
|||
|
||||
;;; 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>))
|
||||
|
@ -151,7 +134,7 @@
|
|||
(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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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>))
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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>))
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
|
@ -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>))
|
||||
|
||||
|
@ -68,11 +67,9 @@
|
|||
(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>))
|
||||
|
||||
|
|
37
src/mes.c
37
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;
|
||||
|
|
Loading…
Reference in a new issue