76 lines
3.5 KiB
Scheme
76 lines
3.5 KiB
Scheme
;;; -*-scheme-*-
|
|
|
|
;;; 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/>.
|
|
|
|
;;; 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,
|
|
;;; 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.
|
|
|
|
;;; Code:
|
|
|
|
((label loop-0
|
|
(lambda (r e a)
|
|
;; (display "***LOOP-0*** ... e=") (display e) (newline)
|
|
(if (null? e) (eval-env (cons 'begin (read-input-file-env (read-env a) a)) a)
|
|
(if (atom? e) (loop-0 (eval-env e a) (read-env a) a)
|
|
(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
|
|
(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)))
|
|
'()))
|
|
(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
|
|
(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)))
|
|
'())
|
|
(loop-0 (eval-env e a) (read-env a) a)))))))
|
|
*unspecified* (read-env '()) (current-module))
|
|
|
|
()
|
|
;; enter reading loop-0
|
|
(display "loop-0 ...\n")
|