;;; -*-scheme-*-

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

(define (interaction-environment) (current-module))

(define (eval x . environment)
  (core:eval (if (and (pair? x) (equal? (car x) "noexpand")) (cadr x) x)
             (if (null? environment) (current-module) (car environment))))

(define annotation? (lambda (x) #f))
(define (self-evaluating? x)
  (or (null? x) (boolean? x) (char? x) (closure? x) (keyword? x) (number? x) (string? x)))

(define (void) (if #f #f))

(define macro-expand #f)
(define sc-expand #f)
(define sc-chi #f)
(define sc-expand3 #f)
(define $sc-put-cte #f)
(define $make-environment #f)
(define environment? #f)
(define syntax->list #f)
(define syntax->vector #f)
(define literal-identifier=? #f)
(define $syntax-dispatch #f)
(define eval-when #f)
(define install-global-transformer #f)
(define syntax-dispatch #f)
(define syntax-error #f)

(define bound-identifier=? #f)
(define datum->syntax-object #f)
(define define-syntax (void))
(define fluid-let-syntax #f)
(define free-identifier=? #f)
(define generate-temporaries #f)
(define identifier? #f)
(define identifier-syntax #f)
(define let-syntax #f)
(define letrec-syntax #f)
(define syntax #f)
(define syntax-case #f)
(define syntax-object->datum #f)
(define syntax-rules #f)
(define with-syntax #f)

(define andmap
  (lambda (f . lists)
    (if (null? (car lists)) (and)
        (if (null? (cdr (car lists))) (apply f (map car lists))
            (and (apply f (map car lists))
                 (apply andmap f (map cdr lists)))))))

(define ormap
  (lambda (proc list1)
    (and (not (null? list1))
         (or (proc (car list1)) (ormap proc (cdr list1))))))

(define *sc-expander-alist* '())

(define putprop #f)
(define getprop #f)
(define remprop #f)
(define properties-alist #f)

(let ((properties '()))
  (set! putprop
        (lambda (symbol key value)
          (let ((plist (assq symbol *sc-expander-alist*)))
            (if (pair? plist)
                (let ((couple (assq key (cdr plist))))
                  (if (pair? couple)
                      (set-cdr! couple value)
                      (set-cdr! plist (cons (cons key value)
                                            (cdr plist)))))
                (let ((plist (list symbol (cons key value))))
                  (set! *sc-expander-alist* (cons plist *sc-expander-alist*)))))
          value))
  (set! getprop
        (lambda (symbol key)
          (let ((plist (assq symbol *sc-expander-alist*)))
            (if (pair? plist)
                (let ((couple (assq key (cdr plist))))
                  (if (pair? couple)
                      (cdr couple)
                      #f))
                #f))))
  (set! remprop
        (lambda (symbol key)
          (putprop symbol key #f)))
  (set! properties-alist (lambda () *sc-expander-alist*)))

;; (define fx+ +)
;; (define fx- -)
;; (define fx= =)
;; (define fx< <)