core: Add module type.
* src/module.c: New file. * build-aux/snarf.sh: Snarf it. * src/mes.c: Include it.
This commit is contained in:
parent
96ca5b4e4b
commit
79c1fe0466
|
@ -146,8 +146,8 @@ exec ${GUILE-guile} --no-auto-compile -L $(dirname $0) -C $(dirname $0) -e '(mes
|
||||||
(format #f "g_cells[cell_~a].string = MAKE_STRING (scm_~a.string);\n" (function.name f) (function.name f))
|
(format #f "g_cells[cell_~a].string = MAKE_STRING (scm_~a.string);\n" (function.name f) (function.name f))
|
||||||
(format #f "g_cells[cell_~a].car = MAKE_STRING (scm_~a.car);\n" (function.name f) (function.name f)))
|
(format #f "g_cells[cell_~a].car = MAKE_STRING (scm_~a.car);\n" (function.name f) (function.name f)))
|
||||||
(if %gcc?
|
(if %gcc?
|
||||||
(format #f "a = acons (make_symbol (scm_~a.string), ~a, a);\n\n" (function.name f) (function-cell-name f))
|
(format #f "a = acons (list_to_symbol (scm_~a.string), ~a, a);\n\n" (function.name f) (function-cell-name f))
|
||||||
(format #f "a = acons (make_symbol (scm_~a.car), ~a, a);\n\n" (function.name f) (function-cell-name f)))))
|
(format #f "a = acons (list_to_symbol (scm_~a.car), ~a, a);\n\n" (function.name f) (function-cell-name f)))))
|
||||||
|
|
||||||
(define (disjoin . predicates)
|
(define (disjoin . predicates)
|
||||||
(lambda (. arguments)
|
(lambda (. arguments)
|
||||||
|
|
|
@ -31,6 +31,7 @@ trace "SNARF$snarf gc.c" ${srcdest}build-aux/mes-snarf.scm $1 src/gc.c
|
||||||
trace "SNARF$snarf lib.c" ${srcdest}build-aux/mes-snarf.scm $1 src/lib.c
|
trace "SNARF$snarf lib.c" ${srcdest}build-aux/mes-snarf.scm $1 src/lib.c
|
||||||
trace "SNARF$snarf math.c" ${srcdest}build-aux/mes-snarf.scm $1 src/math.c
|
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 mes.c" ${srcdest}build-aux/mes-snarf.scm $1 src/mes.c
|
||||||
|
trace "SNARF$snarf module.c" ${srcdest}build-aux/mes-snarf.scm $1 src/module.c
|
||||||
trace "SNARF$snarf posix.c" ${srcdest}build-aux/mes-snarf.scm $1 src/posix.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 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 struct.c" ${srcdest}build-aux/mes-snarf.scm $1 src/struct.c
|
||||||
|
|
|
@ -123,7 +123,7 @@
|
||||||
|
|
||||||
(define (string->symbol s)
|
(define (string->symbol s)
|
||||||
(if (not (pair? (core:car s))) '()
|
(if (not (pair? (core:car s))) '()
|
||||||
(core:lookup-symbol (core:car s))))
|
(list->symbol (core:car s))))
|
||||||
|
|
||||||
(define (symbol->keyword s)
|
(define (symbol->keyword s)
|
||||||
(core:make-cell <cell:keyword> (symbol->list s) 0))
|
(core:make-cell <cell:keyword> (symbol->list s) 0))
|
||||||
|
|
|
@ -81,7 +81,7 @@
|
||||||
(list 'load (list string-append %moduledir file)))
|
(list 'load (list string-append %moduledir file)))
|
||||||
|
|
||||||
(define (string->symbol s)
|
(define (string->symbol s)
|
||||||
(core:lookup-symbol (core:car s)))
|
(list->symbol (core:car s)))
|
||||||
|
|
||||||
(define (symbol->list s)
|
(define (symbol->list s)
|
||||||
(core:car s))
|
(core:car s))
|
||||||
|
|
|
@ -69,7 +69,7 @@
|
||||||
;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(define (string->symbol s)
|
(define (string->symbol s)
|
||||||
(core:lookup-symbol (core:car s)))
|
(list->symbol (core:car s)))
|
||||||
|
|
||||||
(define-macro (load file)
|
(define-macro (load file)
|
||||||
(list 'primitive-load file))
|
(list 'primitive-load file))
|
||||||
|
|
|
@ -153,7 +153,7 @@
|
||||||
|
|
||||||
(define (string->symbol s)
|
(define (string->symbol s)
|
||||||
(if (not (pair? (core:car s))) '()
|
(if (not (pair? (core:car s))) '()
|
||||||
(core:lookup-symbol (core:car s))))
|
(list->symbol (core:car s))))
|
||||||
|
|
||||||
(define <cell:string> 10)
|
(define <cell:string> 10)
|
||||||
(define (string? x)
|
(define (string? x)
|
||||||
|
@ -560,5 +560,3 @@
|
||||||
(if (not condition)
|
(if (not condition)
|
||||||
(begin exp ...))))))
|
(begin exp ...))))))
|
||||||
(xwhen #f 42)))
|
(xwhen #f 42)))
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -65,7 +65,7 @@
|
||||||
|
|
||||||
(define (string->symbol s)
|
(define (string->symbol s)
|
||||||
(if (not (pair? (core:car s))) '()
|
(if (not (pair? (core:car s))) '()
|
||||||
(core:lookup-symbol (core:car s))))
|
(list->symbol (core:car s))))
|
||||||
|
|
||||||
(define (string? x)
|
(define (string? x)
|
||||||
(eq? (core:type x) <cell:string>))
|
(eq? (core:type x) <cell:string>))
|
||||||
|
@ -470,4 +470,3 @@
|
||||||
(if (not condition)
|
(if (not condition)
|
||||||
(begin exp ...))))))
|
(begin exp ...))))))
|
||||||
(xwhen #f 42)))
|
(xwhen #f 42)))
|
||||||
|
|
||||||
|
|
|
@ -279,6 +279,7 @@ int g_function = 0;
|
||||||
#include "lib.mes.h"
|
#include "lib.mes.h"
|
||||||
#include "math.mes.h"
|
#include "math.mes.h"
|
||||||
#include "mes.mes.h"
|
#include "mes.mes.h"
|
||||||
|
#include "module.mes.h"
|
||||||
#include "posix.mes.h"
|
#include "posix.mes.h"
|
||||||
#include "reader.mes.h"
|
#include "reader.mes.h"
|
||||||
#include "struct.mes.h"
|
#include "struct.mes.h"
|
||||||
|
@ -288,6 +289,7 @@ int g_function = 0;
|
||||||
#include "lib.h"
|
#include "lib.h"
|
||||||
#include "math.h"
|
#include "math.h"
|
||||||
#include "mes.h"
|
#include "mes.h"
|
||||||
|
#include "module.h"
|
||||||
#include "posix.h"
|
#include "posix.h"
|
||||||
#include "reader.h"
|
#include "reader.h"
|
||||||
#include "struct.h"
|
#include "struct.h"
|
||||||
|
@ -1611,6 +1613,7 @@ mes_g_stack (SCM a) ///((internal))
|
||||||
|
|
||||||
// Environment setup
|
// Environment setup
|
||||||
|
|
||||||
|
#include "module.c"
|
||||||
#include "posix.c"
|
#include "posix.c"
|
||||||
#include "math.c"
|
#include "math.c"
|
||||||
#include "lib.c"
|
#include "lib.c"
|
||||||
|
@ -2207,6 +2210,7 @@ a = acons (list_to_symbol (scm_getenv_.string), cell_getenv_, a);
|
||||||
#include "mes.mes.i"
|
#include "mes.mes.i"
|
||||||
|
|
||||||
// Do not sort: Order of these includes define builtins
|
// Do not sort: Order of these includes define builtins
|
||||||
|
#include "module.mes.i"
|
||||||
#include "posix.mes.i"
|
#include "posix.mes.i"
|
||||||
#include "math.mes.i"
|
#include "math.mes.i"
|
||||||
#include "lib.mes.i"
|
#include "lib.mes.i"
|
||||||
|
@ -2219,6 +2223,7 @@ a = acons (list_to_symbol (scm_getenv_.string), cell_getenv_, a);
|
||||||
#include "lib.mes.environment.i"
|
#include "lib.mes.environment.i"
|
||||||
#include "math.mes.environment.i"
|
#include "math.mes.environment.i"
|
||||||
#include "mes.mes.environment.i"
|
#include "mes.mes.environment.i"
|
||||||
|
#include "module.mes.environment.i"
|
||||||
#include "posix.mes.environment.i"
|
#include "posix.mes.environment.i"
|
||||||
#include "reader.mes.environment.i"
|
#include "reader.mes.environment.i"
|
||||||
#include "struct.mes.environment.i"
|
#include "struct.mes.environment.i"
|
||||||
|
@ -2227,6 +2232,7 @@ a = acons (list_to_symbol (scm_getenv_.string), cell_getenv_, a);
|
||||||
#include "mes.i"
|
#include "mes.i"
|
||||||
|
|
||||||
// Do not sort: Order of these includes define builtins
|
// Do not sort: Order of these includes define builtins
|
||||||
|
#include "module.i"
|
||||||
#include "posix.i"
|
#include "posix.i"
|
||||||
#include "math.i"
|
#include "math.i"
|
||||||
#include "lib.i"
|
#include "lib.i"
|
||||||
|
@ -2239,6 +2245,7 @@ a = acons (list_to_symbol (scm_getenv_.string), cell_getenv_, a);
|
||||||
#include "lib.environment.i"
|
#include "lib.environment.i"
|
||||||
#include "math.environment.i"
|
#include "math.environment.i"
|
||||||
#include "mes.environment.i"
|
#include "mes.environment.i"
|
||||||
|
#include "module.environment.i"
|
||||||
#include "posix.environment.i"
|
#include "posix.environment.i"
|
||||||
#include "reader.environment.i"
|
#include "reader.environment.i"
|
||||||
#include "struct.environment.i"
|
#include "struct.environment.i"
|
||||||
|
|
40
src/module.c
Normal file
40
src/module.c
Normal file
|
@ -0,0 +1,40 @@
|
||||||
|
/* -*-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_initial_module (SCM a)
|
||||||
|
{
|
||||||
|
SCM fields = cell_nil;
|
||||||
|
fields = cons (cstring_to_symbol ("globals"), fields);
|
||||||
|
fields = cons (cstring_to_symbol ("locals"), fields);
|
||||||
|
fields = cons (cstring_to_symbol ("name"), fields);
|
||||||
|
fields = cons (cstring_to_symbol ("<module>"), fields);
|
||||||
|
SCM module_type = make_struct (cstring_to_symbol ("record-type"), fields, cell_unspecified);
|
||||||
|
SCM module_type_name = cstring_to_symbol ("<module>");
|
||||||
|
a = acons (module_type_name, module_type, a);
|
||||||
|
SCM values = cell_nil;
|
||||||
|
SCM name = cons (cstring_to_symbol ("boot"), cell_nil);
|
||||||
|
SCM globals = cell_nil;
|
||||||
|
values = cons (a, values);
|
||||||
|
values = cons (globals, values);
|
||||||
|
values = cons (name, values);
|
||||||
|
SCM module = make_struct (module_type_name, values, cell_unspecified);
|
||||||
|
return module;
|
||||||
|
}
|
Loading…
Reference in a new issue