mes/mes/module/mes/module.mes

;;; -*-scheme-*-

;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017,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/>.

;;; Commentary:

;;; Code:

(define (module->file o)
  (string-append (string-join (map symbol->string o) "/") ".mes"))

(define *modules* '(mes/base-0.mes))
(define-macro (mes-use-module module)
  (list 'if (list not (list memq (list string->symbol (module->file module)) '*modules*))
        (list
         'begin
         (list 'set! '*modules* (list cons (list string->symbol (module->file module)) '*modules*))
         (list 'load (list string-append '%moduledir (module->file module))))
        (list 'if (and (getenv "MES_DEBUG") (list '> (list 'core:cdr (list 'car (list 'string->list (getenv "MES_DEBUG")))) 50))
              (list 'begin
                    (list core:display-error ";;; already loaded: ")
                    (list core:display-error (list 'quote module))
                    (list core:display-error "\n")))))

(define *input-ports* '())
(define-macro (push! stack o)
  (cons
   'begin
   (list
    (list 'set! stack (list cons o stack))
    stack)))
(define-macro (pop! stack)
  (list 'let (list (list 'o (list car stack)))
        (list 'set! stack (list cdr stack))
        'o))
(define (mes-load-module-env module a)
  (push! *input-ports* (current-input-port))
  (set-current-input-port (open-input-file (string-append %moduledir (module->file module))))
  (let ((x (core:eval (append2 (cons 'begin (read-input-file-env a))
                               '((current-module)))
                      a)))
    (set-current-input-port (pop! *input-ports*))
    x))
(define (mes-load-module-env module a)
  ((lambda (file-name)
     (core:write-error file-name) (core:display-error "\n")
     (primitive-load file-name))
   (string-append %moduledir (module->file module))))