artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

core: Add struct type.

Browse source 
* src/struct.c: New file.
* build-aux/snarf.sh: Snarf it.
* src/mes.c: Include it.
This commit is contained in:
Jan Nieuwenhuizen 2018-10-13 17:34:27 +02:00
parent 8df367b3a2
commit 0068fe533d
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
8 changed files with 133 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
build-aux/snarf.sh
View file

@ -33,4 +33,5 @@ trace "SNARF$snarf math.c" ${srcdest}build-aux/mes-snarf.scm $1 src/math.c
trace "SNARF$snarf mes.c" ${srcdest}build-aux/mes-snarf.scm $1 src/mes.c
trace "SNARF$snarf posix.c" ${srcdest}build-aux/mes-snarf.scm $1 src/posix.c
trace "SNARF$snarf reader.c" ${srcdest}build-aux/mes-snarf.scm $1 src/reader.c
trace "SNARF$snarf struct.c" ${srcdest}build-aux/mes-snarf.scm $1 src/struct.c
trace "SNARF$snarf vector.c" ${srcdest}build-aux/mes-snarf.scm $1 src/vector.c

7
mes/module/mes/display.mes
View file

@ -143,6 +143,13 @@
(if (keyword? x) (display "#:" port))
(for-each (display-cut2 display-char <> port write?) (string->list x))
(if (and (string? x) write?) (write-char #\" port)))
((struct? x)
(display "#<" port)
(for-each (lambda (i)
(let ((x (struct-ref x i)))
(d x #f (if (= i 0) "" " "))))
(iota (struct-length x)))
(display ")" port))
((vector? x)
(display "#(" port)
(for-each (lambda (i)

4
mes/module/mes/type-0.mes
View file

@ -37,6 +37,7 @@
(cons <cell:ref> (quote <cell:ref>))
(cons <cell:special> (quote <cell:special>))
(cons <cell:string> (quote <cell:string>))
(cons <cell:struct> (quote <cell:struct>))
(cons <cell:symbol> (quote <cell:symbol>))
(cons <cell:values> (quote <cell:values>))
(cons <cell:variable> (quote <cell:variable>))
@ -86,6 +87,9 @@
(define (string? x)
(eq? (core:type x) <cell:string>))
(define (struct? x)
(eq? (core:type x) <cell:struct>))
(define (symbol? x)
(eq? (core:type x) <cell:symbol>))

4
scaffold/mini-mes.c
View file

@ -57,7 +57,7 @@ SCM r2 = 0;
// continuation
SCM r3 = 0;
enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TPORT, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVARIABLE, TVECTOR, TBROKEN_HEART};
enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TPORT, TREF, TSPECIAL, TSTRING, TSTRUCT, TSYMBOL, TVALUES, TVARIABLE, TVECTOR, TBROKEN_HEART};
struct scm {
enum type_t type;
@ -189,6 +189,7 @@ struct scm scm_type_port = {TSYMBOL, "<cell:port>",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_struct = {TSYMBOL, "<cell:struct>",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};
@ -234,6 +235,7 @@ SCM gc_init_news ();
#define LENGTH(x) g_cells[x].car
#define REF(x) g_cells[x].car
#define STRING(x) g_cells[x].car
#define STRUCT(x) g_cells[x].cdr
#define VARIABLE(x) g_cells[x].car
#define CLOSURE(x) g_cells[x].cdr

3
src/gc.c
View file

@ -70,7 +70,8 @@ gc_copy (SCM old) ///((internal))
return g_cells[old].car;
SCM new = g_free++;
g_news[new] = g_cells[old];
if (NTYPE (new) == TVECTOR)
if (NTYPE (new) == TSTRUCT
|| NTYPE (new) == TVECTOR)
{
NVECTOR (new) = g_free;
for (long i=0; i<LENGTH (old); i++)

23
src/lib.c
View file

@ -166,6 +166,29 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
if (TYPE (x) == TPORT)
fdputs (">", fd);
}
else if (t == TREF)
fdisplay_ (REF (x), fd, write_p);
else if (t == TSTRUCT)
{
SCM printer = STRUCT (x) + 1;
if (TYPE (printer) == TREF)
printer = REF (printer);
if (printer != cell_unspecified)
apply (printer, cons (x, cell_nil), r0);
else
{
fdputs ("#<", fd);
fdisplay_ (STRUCT (x), fd, write_p);
SCM t = CAR (x);
long size = LENGTH (x);
for (long i=2; i<size; i++)
{
fdputc (' ', fd);
fdisplay_ (STRUCT (x) + i, fd, write_p);
}
fdputc ('>', fd);
}
}
else if (t == TVECTOR)
{
fdputs ("#(", fd);

26
src/mes.c
View file

@ -69,13 +69,14 @@ CONSTANT TPORT 8
CONSTANT TREF 9
CONSTANT TSPECIAL 10
CONSTANT TSTRING 11
CONSTANT TSYMBOL 12
CONSTANT TVALUES 13
CONSTANT TVARIABLE 14
CONSTANT TVECTOR 15
CONSTANT TBROKEN_HEART 16
CONSTANT TSTRUCT 12
CONSTANT TSYMBOL 13
CONSTANT TVALUES 14
CONSTANT TVARIABLE 15
CONSTANT TVECTOR 16
CONSTANT TBROKEN_HEART 17
#else // !__M2_PLANET__
enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TPORT, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVARIABLE, TVECTOR, TBROKEN_HEART};
enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TPORT, TREF, TSPECIAL, TSTRING, TSTRUCT, TSYMBOL, TVALUES, TVARIABLE, TVECTOR, TBROKEN_HEART};
#endif // !__M2_PLANET__
typedef SCM (*function0_t) (void);
@ -252,6 +253,7 @@ struct scm scm_type_port = {TSYMBOL, "<cell:port>",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_struct = {TSYMBOL, "<cell:struct>",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};
@ -279,6 +281,7 @@ int g_function = 0;
#include "mes.mes.h"
#include "posix.mes.h"
#include "reader.mes.h"
#include "struct.mes.h"
#include "vector.mes.h"
#else
#include "gc.h"
@ -287,6 +290,7 @@ int g_function = 0;
#include "mes.h"
#include "posix.h"
#include "reader.h"
#include "struct.h"
#include "vector.h"
#endif
@ -311,6 +315,7 @@ int g_function = 0;
#define FUNCTION0(x) g_functions[g_cells[x].cdr].function
#define MACRO(x) g_cells[x].cdr
#define PORT(x) g_cells[x].cdr
#define STRUCT(x) g_cells[x].cdr
#define VALUE(x) g_cells[x].cdr
#define VECTOR(x) g_cells[x].cdr
@ -331,6 +336,7 @@ int g_function = 0;
#define MACRO(x) g_cells[x].macro
#define PORT(x) g_cells[x].port
#define REF(x) g_cells[x].ref
#define STRUCT(x) g_cells[x].vector
#define VALUE(x) g_cells[x].value
#define VECTOR(x) g_cells[x].vector
#define FUNCTION(x) g_functions[g_cells[x].function]
@ -626,6 +632,8 @@ check_apply (SCM f, SCM e) ///((internal))
type = "number";
if (TYPE (f) == TSTRING)
type = "string";
if (TYPE (f) == TSTRUCT)
type = "#<...>";
if (TYPE (f) == TBROKEN_HEART)
type = "<3";
@ -2043,6 +2051,7 @@ g_cells[cell_vm_return].car = cstring_to_list (scm_vm_return.car);
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_struct, MAKE_NUMBER (TSTRUCT), 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);
@ -2196,6 +2205,7 @@ a = acons (lookup_symbol_ (scm_getenv_.string), cell_getenv_, a);
#include "math.mes.i"
#include "lib.mes.i"
#include "vector.mes.i"
#include "struct.mes.i"
#include "gc.mes.i"
#include "reader.mes.i"
@ -2205,6 +2215,7 @@ a = acons (lookup_symbol_ (scm_getenv_.string), cell_getenv_, a);
#include "mes.mes.environment.i"
#include "posix.mes.environment.i"
#include "reader.mes.environment.i"
#include "struct.mes.environment.i"
#include "vector.mes.environment.i"
#else
#include "mes.i"
@ -2214,6 +2225,7 @@ a = acons (lookup_symbol_ (scm_getenv_.string), cell_getenv_, a);
#include "math.i"
#include "lib.i"
#include "vector.i"
#include "struct.i"
#include "gc.i"
#include "reader.i"
@ -2223,6 +2235,7 @@ a = acons (lookup_symbol_ (scm_getenv_.string), cell_getenv_, a);
#include "mes.environment.i"
#include "posix.environment.i"
#include "reader.environment.i"
#include "struct.environment.i"
#include "vector.environment.i"
#endif
@ -2403,6 +2416,7 @@ bload_env (SCM a) ///((internal))
}
#include "vector.c"
#include "struct.c"
#include "gc.c"
#include "reader.c"

71
src/struct.c Normal file
View file

@ -0,0 +1,71 @@
/* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software
* Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of GNU Mes.
*
* GNU Mes is free software; you can redistribute it and/or modify it
* under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 3 of the License, or (at
* your option) any later version.
*
* GNU Mes is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
*/
SCM
make_struct (SCM type, SCM fields, SCM printer)
{
long size = 2 + length__ (fields);
SCM v = alloc (size);
SCM x = make_cell__ (TSTRUCT, size, v);
g_cells[v] = g_cells[vector_entry (type)];
g_cells[v+1] = g_cells[vector_entry (printer)];
for (long i=2; i<size; i++)
{
SCM e = cell_unspecified;
if (fields != cell_nil)
{
e = CAR (fields);
fields = CDR (fields);
}
g_cells[v+i] = g_cells[vector_entry (e)];
}
return x;
}
SCM
struct_length (SCM x)
{
assert (TYPE (x) == TSTRUCT);
return MAKE_NUMBER (LENGTH (x));
}
SCM
struct_ref (SCM x, SCM i)
{
assert (TYPE (x) == TSTRUCT);
assert (VALUE (i) < LENGTH (x));
SCM e = STRUCT (x) + VALUE (i);
if (TYPE (e) == TREF)
e = REF (e);
if (TYPE (e) == TCHAR)
e = MAKE_CHAR (VALUE (e));
if (TYPE (e) == TNUMBER)
e = MAKE_NUMBER (VALUE (e));
return e;
}
SCM
struct_set_x (SCM x, SCM i, SCM e)
{
assert (TYPE (x) == TSTRUCT);
assert (VALUE (i) < LENGTH (x));
g_cells[STRUCT (x)+VALUE (i)] = g_cells[vector_entry (e)];
return cell_unspecified;
}