mes/tests/gc-2.test

#! /bin/sh
# -*-scheme-*-
MES=${MES-$(dirname $0)/../scripts/mes}
echo ' ()' | cat $(dirname $0)/../module/mes/base-0.mes $0 /dev/stdin | $MES $MES_FLAGS "$@"
#paredit:||
exit $?
!#

;;; -*-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/>.

;; (define *top-define-a* '*top-define-a*)
;; (display (eq? *top-define-a* '*top-define-a*))
;; (newline)
;; (begin (define *top-begin-define-a* '*top-begin-define-a*))
;; (display (eq? *top-begin-define-a* '*top-begin-define-a*))
;; (newline)

(display 'HALLO) (newline)
(define (result r)
  (display 'result:) (display r) (newline))

(define (cadr x) (car (cdr x)))
(define (simple-map f l)
  (if (null? l) '()
      (cons (f (car l)) (simple-map f (cdr l)))))

(define-macro (simple-let bindings . rest)
  (cons (cons 'lambda (cons (simple-map car bindings) rest))
        (simple-map cadr bindings)))

(define-macro (let bindings . rest)
  (cons 'simple-let (cons bindings rest)))

(define blub? #t)
;; (define result
;;   (let ((pass 0)
;;         (fail 0))
;;     (lambda (. t)
;;       (display 'result:) (display t) (newline)
;;       (set! pass (+ pass 1)))))

(display "OKAY\n")

(define-macro (or . x)
  (if (null? x) #f
      (if (null? (cdr x)) (car x)
          (list 'if (car x) (car x)
                (cons 'or (cdr x))))))

(define-macro (cond . clauses)
  (list 'if (null? clauses) *unspecified*
        (if (null? (cdr clauses))
           (list 'if (car (car clauses))
                 (list (cons 'lambda (cons '() (cons (car (car clauses)) (cdr (car clauses))))))
                 *unspecified*)
           (if (eq? (car (cadr clauses)) 'else)
               (list 'if (car (car clauses))
                   (list (cons 'lambda (cons '() (car clauses))))
                   (list (cons 'lambda (cons '() (cons *unspecified* (cdr (cadr clauses)))))))
               (list 'if (car (car clauses))
                   (list (cons 'lambda (cons '() (car clauses))))
                   (cons 'cond (cdr clauses)))))))

(define result
  (let ((pass 0)
        (fail 0))
    (lambda (. t)
      (display 'result:) (display t) (newline)
      (set! pass (+ pass 1)))))

(define result
  (let ((pass 0)
        (fail 0))
    (lambda (. t)
      (cond ((or (null? t) (eq? (car t) result)) (list pass fail))
            ((eq? (car t) 'report)
             (newline)
             (display "passed: ") (display pass) (newline)
             (display "failed: ") (display fail) (newline)
             (display "total: ") (display (+ pass fail)) (newline)
             ;;(exit fail)
             )
            ((car t)
             #t
             #t
             #t
             ;;(blaat)
             (display ": pass")
             ;;(newline)
             ;;(set! pass (+ pass 1))
             #t
             )
            (#t (display ": fail") (newline) (set! fail (+ fail 1)))))))

(define-macro (pass-if name t)
  (list
   'begin
   (list display ''xxxtest:) (list display name)
   (list result t)))

(display 'foo-test:) (newline)
(display 1)(newline)
(display 2)(newline)
(display 3)(newline)
(display 4)(newline)
(display 5)(newline)
(display 6)(newline)
(display 7)(newline)
(display 8)(newline)
(display 9)(newline)

(pass-if "if" (eq? (if #t 'true) 'true))
(pass-if "if 2" (eq? (if #f #f) *unspecified*))
(pass-if "if 3" (eq? (if (eq? 0 '0) 'true 'false) 'true))
(pass-if "if 4" (eq? (if (= 1 2) 'true 'false) 'false))

(display 10)(newline)
(display 11)(newline)
(display 12)(newline)
(display 13)(newline)
(display 14)(newline)
(display 15)(newline)
(display 16)(newline)
(display 17)(newline)
(display 18)(newline)
(display 19)(newline)

(display 14)(newline)
(display 15)(newline)
(display 16)(newline)
(display 17)(newline)
(display 18)(newline)
(display 19)(newline)

(define (m x) (* 2 x))
(display 'multiply:)
(display (m 1)) (newline)
(display (m 2)) (newline)
(display (m 3)) (newline)
(display (m 4)) (newline)

;; (define (result r)
;;   (display 'result:) (display r) (newline))

(define-macro (pass-if name t)
  (list
   'begin
   (list display ''xxxtest:) (list display name)
   (list result t)))

(pass-if 'first-dummy: #t)

(display 20)(newline)
(display 21)(newline)
(display 22)(newline)
(display 23)(newline)
(display 24)(newline)
(display 25)(newline)
(display 26)(newline)
(display 27)(newline)
(display 28)(newline)
(display 29)(newline)
(display 30)(newline)

(define *top-define-a* '*top-define-a*)
(display (eq? *top-define-a* '*top-define-a*))
(newline)
(begin (define *top-begin-define-a* '*top-begin-define-a*))
(display (eq? *top-begin-define-a* '*top-begin-define-a*))
(newline)

(display 31)(newline)
(display 32)(newline)
(display 33)(newline)
(display 34)(newline)
(display 35)(newline)
(display 36)(newline)
(display 37)(newline)
(display 38)(newline)
(display 39)(newline)
(display 40)(newline)

;; (display 41)(newline)
;; (display 42)(newline)
;; (display 43)(newline)
;; (display 44)(newline)
;; (display 45)(newline)
;; (display 46)(newline)
;; (display 47)(newline)
;; (display 48)(newline)
;; (display 49)(newline)
;; (display 50)(newline)
;; (display 51)(newline)
;; (display 52)(newline)
;; (display 53)(newline)
;; (display 54)(newline)
;; (display 55)(newline)
;; (display 56)(newline)
;; (display 57)(newline)
;; (display 58)(newline)
;; (display 59)(newline)
;; (display 60)(newline)
;; (display 61)(newline)
;; (display 62)(newline)
;; (display 63)(newline)
;; (display 64)(newline)
;; (display 65)(newline)
;; (display 66)(newline)
;; (display 67)(newline)
;; (display 68)(newline)
;; (display 69)(newline)
;; (display 70)(newline)
;; (display 71)(newline)
;; (display 72)(newline)
;; (display 73)(newline)
;; (display 74)(newline)
;; (display 75)(newline)
;; (display 76)(newline)
;; (display 77)(newline)
;; (display 78)(newline)
;; (display 79)(newline)
;; (display 80)(newline)
;; (display 81)(newline)
;; (display 82)(newline)
;; (display 83)(newline)
;; (display 84)(newline)
;; (display 85)(newline)
;; (display 86)(newline)
;; (display 87)(newline)
;; (display 88)(newline)
;; (display 89)(newline)
;; (display 90)(newline)
;; (display 91)(newline)
;; (display 92)(newline)
;; (display 93)(newline)
;; (display 94)(newline)
;; (display 95)(newline)
;; (display 96)(newline)
;; (display 97)(newline)
;; (display 98)(newline)
;; (display 99)(newline)
;; (display 100)(newline)
;; (display 101)(newline)
;; (display 102)(newline)
;; (display 103)(newline)
;; (display 104)(newline)
;; (display 105)(newline)
;; (display 106)(newline)
;; (display 107)(newline)
;; (display 108)(newline)
;; (display 109)(newline)
;; (display 110)(newline)
;; (display 111)(newline)
;; (display 112)(newline)
;; (display 113)(newline)
;; (display 114)(newline)
;; (display 115)(newline)
;; (display 116)(newline)
;; (display 117)(newline)
;; (display 118)(newline)
;; (display 119)(newline)
;; (display 120)(newline)
;; (display 121)(newline)
;; (display 122)(newline)
;; (display 123)(newline)
;; (display 124)(newline)
;; (display 125)(newline)
;; (display 126)(newline)
;; (display 127)(newline)
;; (display 128)(newline)
;; (display 129)(newline)
;; (display 130)(newline)
;; (display 131)(newline)
;; (display 132)(newline)
;; (display 133)(newline)
;; (display 134)(newline)
;; (display 135)(newline)
;; (display 136)(newline)
;; (display 137)(newline)
;; (display 138)(newline)
;; (display 139)(newline)
;; (display 140)(newline)
;; (display 141)(newline)
;; (display 142)(newline)
;; (display 143)(newline)
;; (display 144)(newline)
;; (display 145)(newline)
;; (display 146)(newline)
;; (display 147)(newline)
;; (display 148)(newline)
;; (display 149)(newline)
;; (display 150)(newline)
;; (display 151)(newline)
;; (display 152)(newline)
;; (display 153)(newline)
;; (display 154)(newline)
;; (display 155)(newline)
;; (display 156)(newline)
;; (display 157)(newline)
;; (display 158)(newline)
;; (display 159)(newline)
;; (display 160)(newline)
;; (display 161)(newline)
;; (display 162)(newline)
;; (display 163)(newline)
;; (display 164)(newline)
;; (display 165)(newline)
;; (display 166)(newline)
;; (display 167)(newline)
;; (display 168)(newline)
;; (display 169)(newline)
;; (display 170)(newline)
;; (display 171)(newline)
;; (display 172)(newline)
;; (display 173)(newline)
;; (display 174)(newline)
;; (display 175)(newline)
;; (display 176)(newline)
;; (display 177)(newline)
;; (display 178)(newline)
;; (display 179)(newline)
;; (display 180)(newline)
;; (display 181)(newline)
;; (display 182)(newline)
;; (display 183)(newline)
;; (display 184)(newline)
;; (display 185)(newline)
;; (display 186)(newline)
;; (display 187)(newline)
;; (display 188)(newline)
;; (display 189)(newline)
;; (display 190)(newline)
;; (display 191)(newline)
;; (display 192)(newline)
;; (display 193)(newline)
;; (display 194)(newline)
;; (display 195)(newline)
;; (display 196)(newline)
;; (display 197)(newline)
;; (display 198)(newline)
;; (display 199)(newline)
;; (display 200)(newline)