; Scheme In One Define.
; 
; The garbage collector, the name and other parts of this program are
;
; *                     COPYRIGHT (c) 1989 BY                              *
; *      PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS.       *
;
; Conversion  to  full scheme standard, characters, vectors, ports, complex &
; rational numbers, debug utils, and other major enhancments by
;
; *      Scaglione Ermanno, v. Pirinoli 16 IMPERIA P.M. 18100 ITALY        * 
;
; Permission  to use, copy, modify, distribute and sell this software and its
; documentation  for  any purpose and without fee is hereby granted, provided
; that  the  above  copyright  notice appear in all copies and that both that
; copyright   notice   and   this  permission  notice  appear  in  supporting
; documentation,  and that the name of Paradigm Associates Inc not be used in
; advertising or publicity pertaining to distribution of the software without
; specific, written prior permission.
;
; Small runtime library for version 2.6


(define (caar x) (cxr x "aa"))
(define (cadr x) (cxr x "da"))
(define (cdar x) (cxr x "ad"))
(define (cddr x) (cxr x "dd"))

(define (caaar x) (cxr x "aaa"))
(define (caadr x) (cxr x "daa"))
(define (cadar x) (cxr x "ada"))
(define (caddr x) (cxr x "dda"))

(define (cdaar x) (cxr x "aad"))
(define (cdadr x) (cxr x "dad"))
(define (cddar x) (cxr x "add"))
(define (cdddr x) (cxr x "ddd"))

(macro delay (lambda (x)
                 `(cons #f
                       (lambda () ,(cadr x)))))

(define (force x) 
        (if (car x)
            (cdr x) 
            (begin (set-cdr! x ((cdr x)))
                   (set-car! x #t)
                   (cdr x))))
(macro cons-stream 
       (lambda (x)
               `(cons ,(cadr x)
                      (delay ,(caddr x)))))

(define head car)

(define (tail x) (force (cdr x)))

(define the-empty-stream 'the-empty-stream)

(define (empty-stream? x) (eq? x 'the-empty-stream))

(define (stream->list z)
        (if (empty-stream? z)
            '()
            (cons (head z) (stream->list (tail z)))))

(define (list->stream z)
        (if (null? z)
            the-empty-stream
            (cons-stream (car z) (list->stream (cdr z)))))

(define (open-input-file x) (open-port x "r" 1))

(define (open-output-file x) (open-port x "w" 1))

(define (newline . x) (display #\newline (car x)))

(define (page . x) (display #\page (car x)))

(define (string<? x y)
        (< (string-cmp x y) 0))        

(define (string>? x y)
        (> (string-cmp x y) 0))

(define (string=? x y)
        (= (string-cmp x y) 0))

(define (string<=? x y)
        (<= (string-cmp x y) 0))

(define (string>=? x y)
        (>= (string-cmp x y) 0))

(define (substring<? x y z a b c)
        (string<? (substring x y z) (substring a b c)))

(define (substring=? x y z a b c)
        (string=? (substring x y z) (substring a b c)))

(define (substring-fill! x y z a)
        (while (< y z)
               (string-set! x y a)
               (set! y (1+ y)))
        x)

(define (char<? x y)
        (< (char-cmp x y) 0))   
     
(define (char>? x y)
        (> (char-cmp x y) 0))
                   
(define (char=? x y)
        (= (char-cmp x y) 0))

(define (char<=? x y)
        (<= (char-cmp x y) 0))

(define (char>=? x y)
        (>= (char-cmp x y) 0))

(define #\newline (integer->char 10))

(define #\page (integer->char 12))

(define #\space (integer->char 32))

(macro make-environment (lambda (x)
                                `(let () 
                                      ,@(cdr x) 
                                      (the-environment))))

(define (ced)
        (dos-call "ced"))