2016-10-16 17:53:31 +01:00
|
|
|
;;; -*-scheme-*-
|
|
|
|
|
|
|
|
;;; Mes --- Maxwell Equations of Software
|
|
|
|
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
|
|
|
|
;;;
|
2016-12-07 19:26:41 +00:00
|
|
|
;;; This file is part of Mes.
|
2016-10-16 17:53:31 +01:00
|
|
|
;;;
|
|
|
|
;;; 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/>.
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
;;; loop-0.mes - bootstrap into Scheme from minimal -DBOOT=1 core.
|
|
|
|
|
|
|
|
;;; When compiling mes.c with -DBOOT=1, eval/apply et al. are lacking
|
|
|
|
;;; features wrt the fat-c variant, e.g., define and define-macro are
|
|
|
|
;;; not available; instead label is supplied. Before loading
|
|
|
|
;;; boot-0.mes, loop-0.mes is loaded to provide a richer eval/apply.
|
|
|
|
|
|
|
|
;;; This might enable moving more functionality from C to Scheme,
|
2016-10-21 09:39:13 +01:00
|
|
|
;;; making the entirely-from-source bootstrap process more feasible.
|
|
|
|
;;; However, currently performance is 400x worse. Also several tests
|
|
|
|
;;; in the test suite fail and the REPL does not work yet.
|
2016-10-16 17:53:31 +01:00
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
((label loop-0
|
|
|
|
(lambda (r e a)
|
|
|
|
;; (display "***LOOP-0*** ... e=") (display e) (newline)
|
core: Integrate garbage collector/jam scraper.
* mes.c (r0, r1, r2, r3, stack): New globals.
(gc_loop): Handle MACRO and SCM.
(gc_copy): Handle FUNCTION, allow for pre-allocated SCM and SYMBOL.
(assq): Flag any BROKEN_HEARTs.
(vm_call): New function. Enables moving C stack to GC stack.
(evlis_env, apply_env, eval_env, expand_macro_env, begin_env,
if_env): Use vm_call-indirection.
(call_lambda): New function.
(vm_apply_env): Rename from apply_env. Remove parameters, instead
use r1, r2 and r0.
(vm_evlis_env, vm_eval_env, vm_expand_macro_env, vm_begin_env,
vm_if_env): Likewise.
(acons): New function.
(mes_environment) [!MES_FULL, MES_MINI]: Add cpp switches to create minimally
filled environment, for debugging.
(main): Print free value at exit.
* define.c (define_env): Use vm_call-indirection.
(vm_define_env): Rename from define_env.
* quasiquote.c (eval_quasiquote): Use vm_call-indirection.
(vm_eval_quasiquote): Rename from eval_quasiquote.
* tests/gc-2.test: New test.
tests/gc-2a.test: New test.
tests/gc-3.test: New test.
2016-10-28 17:42:03 +01:00
|
|
|
(if (null? e) (eval-env (cons 'begin (read-input-file-env (read-env a) a)) a)
|
2016-11-03 20:43:01 +00:00
|
|
|
(if (atom? e) (loop-0 (eval-env e a) (read-env a) a)
|
2016-10-16 17:53:31 +01:00
|
|
|
(if (eq? (car e) 'define)
|
|
|
|
((lambda (aa) ; env:define
|
|
|
|
;; (display "0DEFINE name=") (display (cadr e)) (newline)
|
|
|
|
(set-cdr! aa (cdr a))
|
|
|
|
(set-cdr! a aa)
|
|
|
|
(set-cdr! (assq '*closure* a) a)
|
|
|
|
(loop-0 *unspecified* (read-env a) a))
|
|
|
|
(cons ; sexp:define
|
2016-11-03 20:43:01 +00:00
|
|
|
(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)))
|
2016-10-16 17:53:31 +01:00
|
|
|
'()))
|
|
|
|
(if (eq? (car e) 'define-macro)
|
|
|
|
((lambda (name+entry) ; env:macro
|
|
|
|
;; (display "0MACRO name=") (display (car name+entry)) (newline)
|
|
|
|
((lambda (aa) ; env:define
|
|
|
|
(set-cdr! aa (cdr a))
|
|
|
|
(set-cdr! a aa)
|
|
|
|
(set-cdr! (assq '*closure* a) a)
|
|
|
|
(loop-0 *unspecified* (read-env a) a))
|
|
|
|
(cons
|
|
|
|
(cons (car name+entry)
|
|
|
|
(make-macro (car name+entry)
|
|
|
|
(cdr name+entry)))
|
|
|
|
'())))
|
|
|
|
; sexp:define
|
2016-11-03 20:43:01 +00:00
|
|
|
(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)))
|
2016-10-16 17:53:31 +01:00
|
|
|
'())
|
2016-11-03 20:43:01 +00:00
|
|
|
(loop-0 (eval-env e a) (read-env a) a)))))))
|
2016-10-16 17:53:31 +01:00
|
|
|
*unspecified* (read-env '()) (current-module))
|
|
|
|
|
|
|
|
()
|
|
|
|
;; enter reading loop-0
|
|
|
|
(display "loop-0 ...\n")
|