* base-0.mes (cons*): Refactor.
* module/mes/read-0.mes: Implement define, define-macro using macros.
* define.c: Remove.
* mes.c: Remove callers.
* GNUmakefile (mes.o): Remove dependency on define.
mes.o: GNUmakefile
mes.o: mes.c
mes.o: mes.c mes.h mes.i mes.environment.i mes.symbols.i
-mes.o: define.c define.h define.i define.environment.i
mes.o: display.c display.h display.i display.environment.i
mes.o: lib.c lib.h lib.i lib.environment.i
mes.o: math.c math.h math.i math.environment.i
+++ /dev/null
-/* -*-comment-start: "//";comment-end:""-*-
- * Mes --- Maxwell Equations of Software
- * Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
- *
- * This file is part of Mes.
- *
- * 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.
- *
- * 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 Mes. If not, see <http://www.gnu.org/licenses/>.
- */
-
-#if !BOOT
-SCM
-define_env (SCM e, SCM a)
-{
- return vm_call (vm_define_env, e, cell_undefined, a);
-}
-
-SCM
-vm_define_env ()
-{
- SCM x;
- r2 = cadr (r1);
- if (TYPE (r2) != PAIR)
- x = eval_env (caddr (r1), cons (cons (cadr (r1), cadr (r1)), r0));
- else {
- r2 = car (r2);
- SCM p = pairlis (cadr (r1), cadr (r1), r0);
- x = eval_env (make_lambda (cdadr (r1), cddr (r1)), p);
- }
- if (eq_p (car (r1), cell_symbol_define_macro) == cell_t)
- x = make_macro (r2, x);
-
- SCM entry = cons (r2, x);
- SCM aa = cons (entry, cell_nil);
- set_cdr_x (aa, cdr (r0));
- set_cdr_x (r0, aa);
- SCM cl = assq (cell_closure, r0);
- set_cdr_x (cl, aa);
- return entry;
-}
-#else // BOOT
-SCM define_env (SCM r1, SCM a){}
-SCM vm_define_env (SCM r1, SCM a){}
-#endif
-
-SCM
-define_macro (SCM r1, SCM a)
-{
-}
SCM r2 = 0; // param 2
SCM r3 = 0; // param 3
-#include "define.h"
#include "display.h"
#include "lib.h"
#include "math.h"
return make_closure (cadr (r1), cddr (r1), assq (cell_closure, r0));
case cell_closure: return r1;
case cell_symbol_if: return if_env (cdr (r1), r0);
-#if !BOOT
- case cell_symbol_define: return define_env (r1, r0);
- case cell_symbol_define_macro: return define_env (r1, r0);
-#endif
#if 1 //!BOOT
case cell_symbol_set_x: {
SCM x = eval_env (caddr (r1), r0); return set_env_x (cadr (r1), x, r0);
{
#include "mes.i"
-#include "define.i"
#include "display.i"
#include "lib.i"
#include "math.i"
#include "string.i"
#include "type.i"
-#include "define.environment.i"
#include "display.environment.i"
#include "lib.environment.i"
#include "math.environment.i"
load_env (SCM a) ///((internal))
{
r0 =a;
-#if !READER
+#if 1 //!READER
g_stdin = fopen ("module/mes/read-0.mes", "r");
g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mes", "r");
#endif
}
#include "type.c"
-#include "define.c"
#include "display.c"
#include "lib.c"
#include "math.c"
(define (ftell port) 0)
(define (false-if-exception x) x)
-(define (cons* x . rest)
- (define (loop rest)
- (if (null? (cdr rest)) (car rest)
- (cons (car rest) (loop (cdr rest)))))
- (loop (cons x rest)))
+(define (cons* . rest)
+ (if (null? (cdr rest)) (car rest)
+ (cons (car rest) (apply-env cons* (cdr rest) (current-module)))))
(define (apply f h . t) (apply-env f (cons h t) (current-module)))
(define (apply f h . t)
(mes-use-module (mes scm))
-(define (env:define a+ a)
+(define (f:env:define a+ a)
(set-cdr! a+ (cdr a))
(set-cdr! a a+)
;;(set-cdr! (assq '*closure* a) a+)
)
-(define (env:escape-closure a)
- (let loop ((a a) (n 1))
- (if (eq? (caar a) '*closure*) (if (= 0 n) a
- (loop (cdr a) (- n 1)))
- (loop (cdr a) n))))
-
-(define (sexp:define e a)
- (if (atom? (cadr e)) (cons (cadr e) (eval-env (caddr e) a))
- (cons (caadr e) (eval-env (cons 'lambda (cons (cdadr e) (cddr e))) a))))
+(define (env:escape-closure a n)
+ (if (closure? (car a)) (if (= 0 n) a
+ (env:escape-closure (cdr a) (- n 1)))
+ (env:escape-closure (cdr a) n)))
(define-macro (module-define! name value a)
- `(env:define (cons (sexp:define (cons 'define (cons ',name (cons ,value '()))) ,a) '()) (env:escape-closure ,a)))
+ `(f:env:define (cons (sexp:define (cons 'define (cons ',name (cons ,value '()))) ,a) '()) (env:escape-closure ,a 1)))
(define-macro (make-fluid . default)
`(begin
;;; to use this reader to read and run the minimal gc-3.test
;;; TODO: complete this reader, remove reader from C.
+;;; copy of mes/read-0.mes, comment-out read-input-file
+
;;; Code:
(begin
+ ((lambda (a+ a)
+ (set-cdr! a+ (cdr a))
+ (set-cdr! a a+)
+ (set-cdr! (assq (quote *closure*) a) a+)
+ (car a+))
+ (cons (cons (quote env:define) #f) (list))
+ (current-module))
+
+ (set! env:define
+ (lambda (a+ a)
+ (set-cdr! a+ (cdr a))
+ (set-cdr! a a+)
+ (set-cdr! (assq (quote *closure*) a) a+)
+ (car a+)))
+
+ (env:define (cons (cons (quote sexp:define) #f) (list)) (current-module))
+ (env:define (cons (cons (quote env:macro) #f) (list)) (current-module))
+ (env:define (cons (cons (quote cons*) #f) (list)) (current-module))
+
+ (set! sexp:define
+ (lambda (e a)
+ (if (atom? (cadr e)) (cons (cadr e) (eval-env (caddr e) a))
+ (cons (caadr e) (eval-env (cons (quote lambda) (cons (cdadr e) (cddr e))) a)))))
+
+ (set! env:macro
+ (lambda (name+entry)
+ (cons
+ (cons (car name+entry)
+ (make-macro (car name+entry)
+ (cdr name+entry)))
+ (list))))
+
+ (set! cons*
+ (lambda (. rest)
+ (if (null? (cdr rest)) (car rest)
+ (cons (car rest) (apply-env cons* (cdr rest) (current-module))))))
+
+ (env:define
+ (env:macro
+ (sexp:define
+ (quote
+ (define-macro (define ARGS . BODY)
+ (cons* (quote env:define)
+ (cons* (quote cons)
+ (cons* (quote sexp:define)
+ (list (quote quote)
+ (cons (quote DEFINE) (cons ARGS BODY)))
+ (quote ((current-module))))
+ (quote ((list))))
+ (quote ((current-module))))))
+ (current-module))) (current-module))
+
+ (env:define
+ (env:macro
+ (sexp:define
+ (quote
+ (define-macro (define-macro ARGS . BODY)
+ (cons* (quote env:define)
+ (list (quote env:macro)
+ (cons* (quote sexp:define)
+ (list (quote quote)
+ (cons (quote DEFINE-MACRO) (cons ARGS BODY)))
+ (quote ((current-module)))))
+ (quote ((current-module))))))
+ (current-module))) (current-module))
+
;; (define car (make-function 'car 0))
;; (define cdr (make-function 'cdr 1))
;; (define cons (make-function 'cons 1))
(helper (read)))
(define-macro (cond . clauses)
- (list 'if (pair? clauses)
- (list 'if (car (car clauses))
+ (list (quote if) (pair? clauses)
+ (list (quote if) (car (car clauses))
(if (pair? (cdar clauses))
- (if (eq? (cadar clauses) '=>)
+ (if (eq? (cadar clauses) (quote =>))
(append2 (cddar clauses) (list (caar clauses)))
- (list (cons 'lambda (cons '() (car clauses)))))
- (list (cons 'lambda (cons '() (car clauses)))))
+ (list (cons (quote lambda) (cons (list) (car clauses)))))
+ (list (cons (quote lambda) (cons (list) (car clauses)))))
(if (pair? (cdr clauses))
- (cons 'cond (cdr clauses))))))
-
+ (cons (quote cond) (cdr clauses))))))
+
(define (eat-whitespace)
(cond
((eq? (peek-byte) 9) (read-byte) (eat-whitespace))
projects / mes.git / commitdiff