andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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:
Jan (janneke) Nieuwenhuizen 2020-05-18 00:40:50 +02:00
parent e0da734c8b
commit 7932d4bad7
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
15 changed files with 76 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
include/mes/builtins.h
View File

@ -66,7 +66,9 @@ SCM memq (SCM x, SCM a);
SCM equal2_p (SCM a, SCM b);
SCM last_pair (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 less_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 assq (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 */
SCM make_module_type ();
SCM module_printer (SCM module);

12
include/mes/m2.h
View File

@ -93,13 +93,13 @@ struct timeval
#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 MAKE_CHAR(n) make_cell__ (TCHAR, 0, n)
#define MAKE_CONTINUATION(n) make_cell__ (TCONTINUATION, n, g_stack)
#define MAKE_NUMBER(n) make_cell__ (TNUMBER, 0, n)
#define MAKE_REF(n) make_cell__ (TREF, n, 0)
#define MAKE_CHAR(n) make_cell (TCHAR, 0, n)
#define MAKE_CONTINUATION(n) make_cell (TCONTINUATION, n, g_stack)
#define MAKE_NUMBER(n) make_cell (TNUMBER, 0, n)
#define MAKE_REF(n) make_cell (TREF, n, 0)
#define MAKE_STRING0(x) make_string (x, strlen (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_STRING_PORT(x) make_cell (TPORT, -length__ (g_ports) - 2, x)
#define MAKE_MACRO(name, x) make_cell (TMACRO, x, STRING (name))
#define CAAR(x) CAR (CAR (x))
#define CADR(x) CAR (CDR (x))

12
include/mes/macros.h
View File

@ -61,13 +61,13 @@
#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 MAKE_CHAR(n) make_cell__ (TCHAR, 0, n)
#define MAKE_CONTINUATION(n) make_cell__ (TCONTINUATION, n, g_stack)
#define MAKE_NUMBER(n) make_cell__ (TNUMBER, 0, (long)n)
#define MAKE_REF(n) make_cell__ (TREF, n, 0)
#define MAKE_CHAR(n) make_cell (TCHAR, 0, n)
#define MAKE_CONTINUATION(n) make_cell (TCONTINUATION, n, g_stack)
#define MAKE_NUMBER(n) make_cell (TNUMBER, 0, (long)n)
#define MAKE_REF(n) make_cell (TREF, n, 0)
#define MAKE_STRING0(x) make_string (x, strlen (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_STRING_PORT(x) make_cell (TPORT, -length__ (g_ports) - 2, x)
#define MAKE_MACRO(name, x) make_cell (TMACRO, x, STRING (name))
#define CAAR(x) CAR (CAR (x))
#define CADR(x) CAR (CDR (x))

2
include/mes/mes.h
View File

@ -90,7 +90,7 @@ SCM init_symbols ();
SCM init_time (SCM a);
SCM make_builtin_type ();
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_hashq_type ();
SCM make_initial_module (SCM a);

6
mes/module/mes/type-0.mes
View File

@ -119,9 +119,3 @@
(define (symbol->list 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))

5
module/mes/guile.scm
View File

@ -42,7 +42,6 @@
core:display-port
core:exit
core:macro-expand
core:make-cell
core:write
core:write-error
core:write-port
@ -105,9 +104,7 @@
((guile:string? x) <cell:string>)
((guile:symbol? x) <cell:symbol>)))
(define (core:car x)
(cond ((guile:string? x) (string->list x))))
(define (core:make-cell type car cdr)
(cond ((eq? type <cell:string>) (list->string car)))))
(cond ((guile:string? x) (string->list x)))))
(mes))
(cond-expand

3
scaffold/boot/60-let-syntax-expanded.scm
View File

@ -46,9 +46,6 @@
(if (null? rest) (core:write x)
(core:write-port x (car rest))))
(define (integer->char x)
(core:make-cell <cell:character> 0 x))
(define (newline . rest)
(core:display (list->string (list (integer->char 10)))))

6
src/builtins.c
View File

@ -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-cdr!", 2, &set_cdr_x, a);
a = init_builtin (builtin_type, "set-env!", 3, &set_env_x, a);
a = init_builtin (builtin_type, "macro-get-handle", 1, &macro_get_handle, a);
a = init_builtin (builtin_type, "add-formals", 2, &add_formals, a);
a = init_builtin (builtin_type, "eval-apply", 0, &eval_apply, a);
/* 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", 0, &gc, a);
/* 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, "last-pair", 1, &last_pair, 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 */
a = init_builtin (builtin_type, ">", -1, &greater_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, "ash", 2, &ash, a);
/* 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:car", 1, &car_, 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, "cdr", 1, &cdr, a);
a = init_builtin (builtin_type, "list", -1, &list, a);

6
src/eval-apply.c
View File

@ -145,17 +145,17 @@ call_lambda (SCM e, SCM x, SCM aa, SCM a) /*:((internal)) */
SCM
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
make_variable_ (SCM var) /*:((internal)) */
{
return make_cell__ (TVARIABLE, var, 0);
return make_cell (TVARIABLE, var, 0);
}
SCM
macro_get_handle (SCM name)
macro_get_handle (SCM name) /*:((internal)) */
{
if (TYPE (name) == TSYMBOL)
return hashq_get_handle (g_macros, name, cell_nil);

29
src/gc.c
View File

@ -87,6 +87,35 @@ gc_init_news () /*:((internal)) */
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
gc_up_arena () /*:((internal)) */
{

12
src/lib.c
View File

@ -202,3 +202,15 @@ pair_p (SCM x)
return cell_t;
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
View File

@ -29,46 +29,6 @@
// 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
assoc_string (SCM x, SCM a) /*:((internal)) */
{
@ -109,12 +69,6 @@ cdr_ (SCM x)
return MAKE_NUMBER (CDR (x));
}
SCM
cons (SCM x, SCM y)
{
return make_cell__ (TPAIR, x, y);
}
SCM
car (SCM x)
{

10
src/string.c
View File

@ -90,7 +90,7 @@ make_string (char const *s, size_t length)
{
if (length > MAX_STRING)
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);
CDR (x) = v;
return x;
@ -127,19 +127,19 @@ string_equal_p (SCM a, SCM b) /*:((name . "string=?")) */
SCM
symbol_to_string (SCM symbol)
{
return make_cell__ (TSTRING, CAR (symbol), CDR (symbol));
return make_cell (TSTRING, CAR (symbol), CDR (symbol));
}
SCM
symbol_to_keyword (SCM symbol)
{
return make_cell__ (TKEYWORD, CAR (symbol), CDR (symbol));
return make_cell (TKEYWORD, CAR (symbol), CDR (symbol));
}
SCM
keyword_to_string (SCM keyword)
{
return make_cell__ (TSTRING, CAR (keyword), CDR (keyword));
return make_cell (TSTRING, CAR (keyword), CDR (keyword));
}
SCM
@ -154,7 +154,7 @@ string_to_symbol (SCM string)
SCM
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);
return x;
}

2
src/struct.c
View File

@ -26,7 +26,7 @@ make_struct (SCM type, SCM fields, SCM printer)
{
long size = 2 + length__ (fields);
SCM v = alloc (size);
SCM x = make_cell__ (TSTRUCT, size, v);
SCM x = make_cell (TSTRUCT, size, v);
SCM vt = vector_entry (type);
TYPE (v) = TYPE (vt);
CAR (v) = CAR (vt);

2
src/vector.c
View File

@ -25,7 +25,7 @@ SCM
make_vector__ (long k)
{
SCM v = alloc (k);
SCM x = make_cell__ (TVECTOR, k, v);
SCM x = make_cell (TVECTOR, k, v);
long i;
for (i = 0; i < k; i = i + 1)
g_cells[v + i] = g_cells[vector_entry (cell_unspecified)];