core: Remove core:make-cell.
* src/gc.c (alloc, make_cell, cons): Move from mes.c * src/mes.c: (make_cell_): Remove. * src/lib.c (char_to_integer, integer_to_char): New function. * src/builtins.c (mes_builtins): Add them; remove make_cell_. * mes/module/mes/type-0.mes (char->integer, integer->char): Remove.
This commit is contained in:
parent
e0da734c8b
commit
7932d4bad7
|
@ -66,7 +66,9 @@ SCM memq (SCM x, SCM a);
|
||||||
SCM equal2_p (SCM a, SCM b);
|
SCM equal2_p (SCM a, SCM b);
|
||||||
SCM last_pair (SCM x);
|
SCM last_pair (SCM x);
|
||||||
SCM pair_p (SCM x);
|
SCM pair_p (SCM x);
|
||||||
/* src/math.c */
|
SCM char_to_integer (SCM x);
|
||||||
|
SCM integer_to_char (SCM x);
|
||||||
|
/* src/math.mes */
|
||||||
SCM greater_p (SCM x);
|
SCM greater_p (SCM x);
|
||||||
SCM less_p (SCM x);
|
SCM less_p (SCM x);
|
||||||
SCM is_p (SCM x);
|
SCM is_p (SCM x);
|
||||||
|
@ -100,6 +102,11 @@ SCM append_reverse (SCM x, SCM y);
|
||||||
SCM reverse_x_ (SCM x, SCM t);
|
SCM reverse_x_ (SCM x, SCM t);
|
||||||
SCM assq (SCM x, SCM a);
|
SCM assq (SCM x, SCM a);
|
||||||
SCM assoc (SCM x, SCM a);
|
SCM assoc (SCM x, SCM a);
|
||||||
|
SCM set_car_x (SCM x, SCM e);
|
||||||
|
SCM set_cdr_x (SCM x, SCM e);
|
||||||
|
SCM set_env_x (SCM x, SCM e, SCM a);
|
||||||
|
SCM add_formals (SCM formals, SCM x);
|
||||||
|
SCM eval_apply ();
|
||||||
/* src/module.c */
|
/* src/module.c */
|
||||||
SCM make_module_type ();
|
SCM make_module_type ();
|
||||||
SCM module_printer (SCM module);
|
SCM module_printer (SCM module);
|
||||||
|
|
|
@ -93,13 +93,13 @@ struct timeval
|
||||||
#define MAKE_BYTES0(x) make_bytes (x, strlen (x))
|
#define MAKE_BYTES0(x) make_bytes (x, strlen (x))
|
||||||
#define NAME_SYMBOL(symbol,name) {size_t s = strlen (name); CAR (symbol) = s; CDR (symbol) = make_bytes (name, s);}
|
#define NAME_SYMBOL(symbol,name) {size_t s = strlen (name); CAR (symbol) = s; CDR (symbol) = make_bytes (name, s);}
|
||||||
|
|
||||||
#define MAKE_CHAR(n) make_cell__ (TCHAR, 0, n)
|
#define MAKE_CHAR(n) make_cell (TCHAR, 0, n)
|
||||||
#define MAKE_CONTINUATION(n) make_cell__ (TCONTINUATION, n, g_stack)
|
#define MAKE_CONTINUATION(n) make_cell (TCONTINUATION, n, g_stack)
|
||||||
#define MAKE_NUMBER(n) make_cell__ (TNUMBER, 0, n)
|
#define MAKE_NUMBER(n) make_cell (TNUMBER, 0, n)
|
||||||
#define MAKE_REF(n) make_cell__ (TREF, n, 0)
|
#define MAKE_REF(n) make_cell (TREF, n, 0)
|
||||||
#define MAKE_STRING0(x) make_string (x, strlen (x))
|
#define MAKE_STRING0(x) make_string (x, strlen (x))
|
||||||
#define MAKE_STRING_PORT(x) make_cell__ (TPORT, -length__ (g_ports) - 2, x)
|
#define MAKE_STRING_PORT(x) make_cell (TPORT, -length__ (g_ports) - 2, x)
|
||||||
#define MAKE_MACRO(name, x) make_cell__ (TMACRO, x, STRING (name))
|
#define MAKE_MACRO(name, x) make_cell (TMACRO, x, STRING (name))
|
||||||
|
|
||||||
#define CAAR(x) CAR (CAR (x))
|
#define CAAR(x) CAR (CAR (x))
|
||||||
#define CADR(x) CAR (CDR (x))
|
#define CADR(x) CAR (CDR (x))
|
||||||
|
|
|
@ -61,13 +61,13 @@
|
||||||
#define MAKE_BYTES0(x) make_bytes (x, strlen (x))
|
#define MAKE_BYTES0(x) make_bytes (x, strlen (x))
|
||||||
#define NAME_SYMBOL(symbol,name) {size_t s = strlen (name); CAR (symbol) = s; CDR (symbol) = make_bytes (name, s);}
|
#define NAME_SYMBOL(symbol,name) {size_t s = strlen (name); CAR (symbol) = s; CDR (symbol) = make_bytes (name, s);}
|
||||||
|
|
||||||
#define MAKE_CHAR(n) make_cell__ (TCHAR, 0, n)
|
#define MAKE_CHAR(n) make_cell (TCHAR, 0, n)
|
||||||
#define MAKE_CONTINUATION(n) make_cell__ (TCONTINUATION, n, g_stack)
|
#define MAKE_CONTINUATION(n) make_cell (TCONTINUATION, n, g_stack)
|
||||||
#define MAKE_NUMBER(n) make_cell__ (TNUMBER, 0, (long)n)
|
#define MAKE_NUMBER(n) make_cell (TNUMBER, 0, (long)n)
|
||||||
#define MAKE_REF(n) make_cell__ (TREF, n, 0)
|
#define MAKE_REF(n) make_cell (TREF, n, 0)
|
||||||
#define MAKE_STRING0(x) make_string (x, strlen (x))
|
#define MAKE_STRING0(x) make_string (x, strlen (x))
|
||||||
#define MAKE_STRING_PORT(x) make_cell__ (TPORT, -length__ (g_ports) - 2, x)
|
#define MAKE_STRING_PORT(x) make_cell (TPORT, -length__ (g_ports) - 2, x)
|
||||||
#define MAKE_MACRO(name, x) make_cell__ (TMACRO, x, STRING (name))
|
#define MAKE_MACRO(name, x) make_cell (TMACRO, x, STRING (name))
|
||||||
|
|
||||||
#define CAAR(x) CAR (CAR (x))
|
#define CAAR(x) CAR (CAR (x))
|
||||||
#define CADR(x) CAR (CDR (x))
|
#define CADR(x) CAR (CDR (x))
|
||||||
|
|
|
@ -90,7 +90,7 @@ SCM init_symbols ();
|
||||||
SCM init_time (SCM a);
|
SCM init_time (SCM a);
|
||||||
SCM make_builtin_type ();
|
SCM make_builtin_type ();
|
||||||
SCM make_bytes (char const *s, size_t length);
|
SCM make_bytes (char const *s, size_t length);
|
||||||
SCM make_cell__ (long type, SCM car, SCM cdr);
|
SCM make_cell (long type, SCM car, SCM cdr);
|
||||||
SCM make_hash_table_ (long size);
|
SCM make_hash_table_ (long size);
|
||||||
SCM make_hashq_type ();
|
SCM make_hashq_type ();
|
||||||
SCM make_initial_module (SCM a);
|
SCM make_initial_module (SCM a);
|
||||||
|
|
|
@ -119,9 +119,3 @@
|
||||||
|
|
||||||
(define (symbol->list s)
|
(define (symbol->list s)
|
||||||
(string->list (symbol->string s)))
|
(string->list (symbol->string s)))
|
||||||
|
|
||||||
(define (integer->char x)
|
|
||||||
(core:make-cell <cell:char> 0 x))
|
|
||||||
|
|
||||||
(define (char->integer x)
|
|
||||||
(core:make-cell <cell:number> 0 x))
|
|
||||||
|
|
|
@ -42,7 +42,6 @@
|
||||||
core:display-port
|
core:display-port
|
||||||
core:exit
|
core:exit
|
||||||
core:macro-expand
|
core:macro-expand
|
||||||
core:make-cell
|
|
||||||
core:write
|
core:write
|
||||||
core:write-error
|
core:write-error
|
||||||
core:write-port
|
core:write-port
|
||||||
|
@ -105,9 +104,7 @@
|
||||||
((guile:string? x) <cell:string>)
|
((guile:string? x) <cell:string>)
|
||||||
((guile:symbol? x) <cell:symbol>)))
|
((guile:symbol? x) <cell:symbol>)))
|
||||||
(define (core:car x)
|
(define (core:car x)
|
||||||
(cond ((guile:string? x) (string->list x))))
|
(cond ((guile:string? x) (string->list x)))))
|
||||||
(define (core:make-cell type car cdr)
|
|
||||||
(cond ((eq? type <cell:string>) (list->string car)))))
|
|
||||||
(mes))
|
(mes))
|
||||||
|
|
||||||
(cond-expand
|
(cond-expand
|
||||||
|
|
|
@ -46,9 +46,6 @@
|
||||||
(if (null? rest) (core:write x)
|
(if (null? rest) (core:write x)
|
||||||
(core:write-port x (car rest))))
|
(core:write-port x (car rest))))
|
||||||
|
|
||||||
(define (integer->char x)
|
|
||||||
(core:make-cell <cell:character> 0 x))
|
|
||||||
|
|
||||||
(define (newline . rest)
|
(define (newline . rest)
|
||||||
(core:display (list->string (list (integer->char 10)))))
|
(core:display (list->string (list (integer->char 10)))))
|
||||||
|
|
||||||
|
|
|
@ -129,10 +129,10 @@ mes_builtins (SCM a) /*:((internal)) */
|
||||||
a = init_builtin (builtin_type, "set-car!", 2, &set_car_x, a);
|
a = init_builtin (builtin_type, "set-car!", 2, &set_car_x, a);
|
||||||
a = init_builtin (builtin_type, "set-cdr!", 2, &set_cdr_x, a);
|
a = init_builtin (builtin_type, "set-cdr!", 2, &set_cdr_x, a);
|
||||||
a = init_builtin (builtin_type, "set-env!", 3, &set_env_x, a);
|
a = init_builtin (builtin_type, "set-env!", 3, &set_env_x, a);
|
||||||
a = init_builtin (builtin_type, "macro-get-handle", 1, ¯o_get_handle, a);
|
|
||||||
a = init_builtin (builtin_type, "add-formals", 2, &add_formals, a);
|
a = init_builtin (builtin_type, "add-formals", 2, &add_formals, a);
|
||||||
a = init_builtin (builtin_type, "eval-apply", 0, &eval_apply, a);
|
a = init_builtin (builtin_type, "eval-apply", 0, &eval_apply, a);
|
||||||
/* src/gc.c */
|
/* src/gc.c */
|
||||||
|
a = init_builtin (builtin_type, "cons", 2, &cons, a);
|
||||||
a = init_builtin (builtin_type, "gc-check", 0, &gc_check, a);
|
a = init_builtin (builtin_type, "gc-check", 0, &gc_check, a);
|
||||||
a = init_builtin (builtin_type, "gc", 0, &gc, a);
|
a = init_builtin (builtin_type, "gc", 0, &gc, a);
|
||||||
/* src/hash.c */
|
/* src/hash.c */
|
||||||
|
@ -156,6 +156,8 @@ mes_builtins (SCM a) /*:((internal)) */
|
||||||
a = init_builtin (builtin_type, "equal2?", 2, &equal2_p, a);
|
a = init_builtin (builtin_type, "equal2?", 2, &equal2_p, a);
|
||||||
a = init_builtin (builtin_type, "last-pair", 1, &last_pair, a);
|
a = init_builtin (builtin_type, "last-pair", 1, &last_pair, a);
|
||||||
a = init_builtin (builtin_type, "pair?", 1, &pair_p, a);
|
a = init_builtin (builtin_type, "pair?", 1, &pair_p, a);
|
||||||
|
a = init_builtin (builtin_type, "char->integer", 1, &char_to_integer, a);
|
||||||
|
a = init_builtin (builtin_type, "integer->char", 1, &integer_to_char, a);
|
||||||
/* src/math.c */
|
/* src/math.c */
|
||||||
a = init_builtin (builtin_type, ">", -1, &greater_p, a);
|
a = init_builtin (builtin_type, ">", -1, &greater_p, a);
|
||||||
a = init_builtin (builtin_type, "<", -1, &less_p, a);
|
a = init_builtin (builtin_type, "<", -1, &less_p, a);
|
||||||
|
@ -171,11 +173,9 @@ mes_builtins (SCM a) /*:((internal)) */
|
||||||
a = init_builtin (builtin_type, "logxor", -1, &logxor, a);
|
a = init_builtin (builtin_type, "logxor", -1, &logxor, a);
|
||||||
a = init_builtin (builtin_type, "ash", 2, &ash, a);
|
a = init_builtin (builtin_type, "ash", 2, &ash, a);
|
||||||
/* src/mes.c */
|
/* src/mes.c */
|
||||||
a = init_builtin (builtin_type, "core:make-cell", 3, &make_cell_, a);
|
|
||||||
a = init_builtin (builtin_type, "core:type", 1, &type_, a);
|
a = init_builtin (builtin_type, "core:type", 1, &type_, a);
|
||||||
a = init_builtin (builtin_type, "core:car", 1, &car_, a);
|
a = init_builtin (builtin_type, "core:car", 1, &car_, a);
|
||||||
a = init_builtin (builtin_type, "core:cdr", 1, &cdr_, a);
|
a = init_builtin (builtin_type, "core:cdr", 1, &cdr_, a);
|
||||||
a = init_builtin (builtin_type, "cons", 2, &cons, a);
|
|
||||||
a = init_builtin (builtin_type, "car", 1, &car, a);
|
a = init_builtin (builtin_type, "car", 1, &car, a);
|
||||||
a = init_builtin (builtin_type, "cdr", 1, &cdr, a);
|
a = init_builtin (builtin_type, "cdr", 1, &cdr, a);
|
||||||
a = init_builtin (builtin_type, "list", -1, &list, a);
|
a = init_builtin (builtin_type, "list", -1, &list, a);
|
||||||
|
|
|
@ -145,17 +145,17 @@ call_lambda (SCM e, SCM x, SCM aa, SCM a) /*:((internal)) */
|
||||||
SCM
|
SCM
|
||||||
make_closure_ (SCM args, SCM body, SCM a) /*:((internal)) */
|
make_closure_ (SCM args, SCM body, SCM a) /*:((internal)) */
|
||||||
{
|
{
|
||||||
return make_cell__ (TCLOSURE, cell_f, cons (cons (cell_circular, a), cons (args, body)));
|
return make_cell (TCLOSURE, cell_f, cons (cons (cell_circular, a), cons (args, body)));
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
make_variable_ (SCM var) /*:((internal)) */
|
make_variable_ (SCM var) /*:((internal)) */
|
||||||
{
|
{
|
||||||
return make_cell__ (TVARIABLE, var, 0);
|
return make_cell (TVARIABLE, var, 0);
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
macro_get_handle (SCM name)
|
macro_get_handle (SCM name) /*:((internal)) */
|
||||||
{
|
{
|
||||||
if (TYPE (name) == TSYMBOL)
|
if (TYPE (name) == TSYMBOL)
|
||||||
return hashq_get_handle (g_macros, name, cell_nil);
|
return hashq_get_handle (g_macros, name, cell_nil);
|
||||||
|
|
29
src/gc.c
29
src/gc.c
|
@ -87,6 +87,35 @@ gc_init_news () /*:((internal)) */
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
alloc (long n)
|
||||||
|
{
|
||||||
|
SCM x = g_free;
|
||||||
|
g_free = g_free + n;
|
||||||
|
if (g_free > ARENA_SIZE)
|
||||||
|
assert_msg (0, "alloc: out of memory");
|
||||||
|
return x;
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
make_cell (long type, SCM car, SCM cdr)
|
||||||
|
{
|
||||||
|
SCM x = g_free;
|
||||||
|
g_free = g_free + 1;
|
||||||
|
if (g_free > ARENA_SIZE)
|
||||||
|
assert_msg (0, "alloc: out of memory");
|
||||||
|
TYPE (x) = type;
|
||||||
|
CAR (x) = car;
|
||||||
|
CDR (x) = cdr;
|
||||||
|
return x;
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
cons (SCM x, SCM y)
|
||||||
|
{
|
||||||
|
return make_cell (TPAIR, x, y);
|
||||||
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
gc_up_arena () /*:((internal)) */
|
gc_up_arena () /*:((internal)) */
|
||||||
{
|
{
|
||||||
|
|
12
src/lib.c
12
src/lib.c
|
@ -202,3 +202,15 @@ pair_p (SCM x)
|
||||||
return cell_t;
|
return cell_t;
|
||||||
return cell_f;
|
return cell_f;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
char_to_integer (SCM x)
|
||||||
|
{
|
||||||
|
return MAKE_NUMBER (VALUE (x));
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM
|
||||||
|
integer_to_char (SCM x)
|
||||||
|
{
|
||||||
|
return MAKE_CHAR (VALUE (x));
|
||||||
|
}
|
||||||
|
|
46
src/mes.c
46
src/mes.c
|
@ -29,46 +29,6 @@
|
||||||
|
|
||||||
// char const *MES_PKGDATADIR = "mes";
|
// char const *MES_PKGDATADIR = "mes";
|
||||||
|
|
||||||
SCM
|
|
||||||
alloc (long n)
|
|
||||||
{
|
|
||||||
SCM x = g_free;
|
|
||||||
g_free = g_free + n;
|
|
||||||
if (g_free > ARENA_SIZE)
|
|
||||||
assert_msg (0, "alloc: out of memory");
|
|
||||||
return x;
|
|
||||||
}
|
|
||||||
|
|
||||||
SCM
|
|
||||||
make_cell__ (long type, SCM car, SCM cdr)
|
|
||||||
{
|
|
||||||
SCM x = alloc (1);
|
|
||||||
TYPE (x) = type;
|
|
||||||
CAR (x) = car;
|
|
||||||
CDR (x) = cdr;
|
|
||||||
return x;
|
|
||||||
}
|
|
||||||
|
|
||||||
SCM
|
|
||||||
make_cell_ (SCM type, SCM car, SCM cdr)
|
|
||||||
{
|
|
||||||
assert_msg (TYPE (type) == TNUMBER, "TYPE (type) == TNUMBER");
|
|
||||||
long t = VALUE (type);
|
|
||||||
if (t == TCHAR || t == TNUMBER)
|
|
||||||
{
|
|
||||||
if (car != 0)
|
|
||||||
car = CAR (car);
|
|
||||||
else
|
|
||||||
car = 0;
|
|
||||||
if (cdr != 0)
|
|
||||||
cdr = CDR (cdr);
|
|
||||||
else
|
|
||||||
cdr = 0;
|
|
||||||
return make_cell__ (t, car, cdr);
|
|
||||||
}
|
|
||||||
return make_cell__ (t, car, cdr);
|
|
||||||
}
|
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
assoc_string (SCM x, SCM a) /*:((internal)) */
|
assoc_string (SCM x, SCM a) /*:((internal)) */
|
||||||
{
|
{
|
||||||
|
@ -109,12 +69,6 @@ cdr_ (SCM x)
|
||||||
return MAKE_NUMBER (CDR (x));
|
return MAKE_NUMBER (CDR (x));
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
|
||||||
cons (SCM x, SCM y)
|
|
||||||
{
|
|
||||||
return make_cell__ (TPAIR, x, y);
|
|
||||||
}
|
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
car (SCM x)
|
car (SCM x)
|
||||||
{
|
{
|
||||||
|
|
10
src/string.c
10
src/string.c
|
@ -90,7 +90,7 @@ make_string (char const *s, size_t length)
|
||||||
{
|
{
|
||||||
if (length > MAX_STRING)
|
if (length > MAX_STRING)
|
||||||
assert_max_string (length, "make_string", s);
|
assert_max_string (length, "make_string", s);
|
||||||
SCM x = make_cell__ (TSTRING, length, 0);
|
SCM x = make_cell (TSTRING, length, 0);
|
||||||
SCM v = make_bytes (s, length);
|
SCM v = make_bytes (s, length);
|
||||||
CDR (x) = v;
|
CDR (x) = v;
|
||||||
return x;
|
return x;
|
||||||
|
@ -127,19 +127,19 @@ string_equal_p (SCM a, SCM b) /*:((name . "string=?")) */
|
||||||
SCM
|
SCM
|
||||||
symbol_to_string (SCM symbol)
|
symbol_to_string (SCM symbol)
|
||||||
{
|
{
|
||||||
return make_cell__ (TSTRING, CAR (symbol), CDR (symbol));
|
return make_cell (TSTRING, CAR (symbol), CDR (symbol));
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
symbol_to_keyword (SCM symbol)
|
symbol_to_keyword (SCM symbol)
|
||||||
{
|
{
|
||||||
return make_cell__ (TKEYWORD, CAR (symbol), CDR (symbol));
|
return make_cell (TKEYWORD, CAR (symbol), CDR (symbol));
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
keyword_to_string (SCM keyword)
|
keyword_to_string (SCM keyword)
|
||||||
{
|
{
|
||||||
return make_cell__ (TSTRING, CAR (keyword), CDR (keyword));
|
return make_cell (TSTRING, CAR (keyword), CDR (keyword));
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
|
@ -154,7 +154,7 @@ string_to_symbol (SCM string)
|
||||||
SCM
|
SCM
|
||||||
make_symbol (SCM string)
|
make_symbol (SCM string)
|
||||||
{
|
{
|
||||||
SCM x = make_cell__ (TSYMBOL, LENGTH (string), STRING (string));
|
SCM x = make_cell (TSYMBOL, LENGTH (string), STRING (string));
|
||||||
hash_set_x (g_symbols, string, x);
|
hash_set_x (g_symbols, string, x);
|
||||||
return x;
|
return x;
|
||||||
}
|
}
|
||||||
|
|
|
@ -26,7 +26,7 @@ make_struct (SCM type, SCM fields, SCM printer)
|
||||||
{
|
{
|
||||||
long size = 2 + length__ (fields);
|
long size = 2 + length__ (fields);
|
||||||
SCM v = alloc (size);
|
SCM v = alloc (size);
|
||||||
SCM x = make_cell__ (TSTRUCT, size, v);
|
SCM x = make_cell (TSTRUCT, size, v);
|
||||||
SCM vt = vector_entry (type);
|
SCM vt = vector_entry (type);
|
||||||
TYPE (v) = TYPE (vt);
|
TYPE (v) = TYPE (vt);
|
||||||
CAR (v) = CAR (vt);
|
CAR (v) = CAR (vt);
|
||||||
|
|
|
@ -25,7 +25,7 @@ SCM
|
||||||
make_vector__ (long k)
|
make_vector__ (long k)
|
||||||
{
|
{
|
||||||
SCM v = alloc (k);
|
SCM v = alloc (k);
|
||||||
SCM x = make_cell__ (TVECTOR, k, v);
|
SCM x = make_cell (TVECTOR, k, v);
|
||||||
long i;
|
long i;
|
||||||
for (i = 0; i < k; i = i + 1)
|
for (i = 0; i < k; i = i + 1)
|
||||||
g_cells[v + i] = g_cells[vector_entry (cell_unspecified)];
|
g_cells[v + i] = g_cells[vector_entry (cell_unspecified)];
|
||||||
|
|
Loading…
Reference in a new issue