boot2

prelude.scm (4650B)

---

 ;; Prelude — helpers promoted out of lisp.M1 into Scheme for
 ;; reviewability. Prepended to every user script by the Makefile
 ;; (cat src/prelude.scm $user.scm > combined.scm) so these names
 ;; are in scope before user code runs.
 ;;
 ;; Only fixed-arity helpers live here — variadic lambdas aren't yet
 ;; supported by env_extend, so list/append/min/max stay as P1 primitives.
 
 ;; --- Boolean / logical ----------------------------------------------
 (define not
   (lambda (x) (if x #f #t)))
 
 ;; --- Arithmetic helpers (derivable from <, =, -) --------------------
 (define <=
   (lambda (x y) (if (< y x) #f #t)))
 
 (define >=
   (lambda (x y) (if (< x y) #f #t)))
 
 (define zero?
   (lambda (x) (= x 0)))
 
 (define negative?
   (lambda (x) (< x 0)))
 
 (define positive?
   (lambda (x) (> x 0)))
 
 (define abs
   (lambda (x) (if (< x 0) (- 0 x) x)))
 
 ;; --- Common c*r compositions ---------------------------------------
 (define caar (lambda (x) (car (car x))))
 (define cadr (lambda (x) (car (cdr x))))
 (define cdar (lambda (x) (cdr (car x))))
 (define cddr (lambda (x) (cdr (cdr x))))
 (define caddr (lambda (x) (car (cdr (cdr x)))))
 
 ;; --- List helpers (derivable from cons/car/cdr/null?/pair?/eq?) -----
 (define list?
   (lambda (x)
     (if (null? x)
         #t
         (if (pair? x) (list? (cdr x)) #f))))
 
 (define length-helper
   (lambda (xs acc)
     (if (null? xs) acc (length-helper (cdr xs) (+ acc 1)))))
 
 (define length
   (lambda (xs) (length-helper xs 0)))
 
 (define reverse-helper
   (lambda (xs acc)
     (if (null? xs) acc (reverse-helper (cdr xs) (cons (car xs) acc)))))
 
 (define reverse
   (lambda (xs) (reverse-helper xs (quote ()))))
 
 (define list-ref
   (lambda (xs n)
     (if (= n 0) (car xs) (list-ref (cdr xs) (- n 1)))))
 
 (define assoc
   (lambda (key alist)
     (if (null? alist)
         #f
         (if (eq? (car (car alist)) key)
             (car alist)
             (assoc key (cdr alist))))))
 
 (define member
   (lambda (x xs)
     (if (null? xs)
         #f
         (if (eq? (car xs) x)
             xs
             (member x (cdr xs))))))
 
 ;; --- map / filter / fold / for-each ---------------------------------
 (define map
   (lambda (f xs)
     (if (null? xs)
         (quote ())
         (cons (f (car xs)) (map f (cdr xs))))))
 
 (define filter
   (lambda (p xs)
     (if (null? xs)
         (quote ())
         (if (p (car xs))
             (cons (car xs) (filter p (cdr xs)))
             (filter p (cdr xs))))))
 
 (define fold
   (lambda (f acc xs)
     (if (null? xs)
         acc
         (fold f (f acc (car xs)) (cdr xs)))))
 
 (define for-each
   (lambda (f xs)
     (if (null? xs)
         (quote ())
         (begin
           (f (car xs))
           (for-each f (cdr xs))))))
 
 ;; --- Vector <-> list (derivable from make-vector/vector-ref/set) ----
 (define vector->list-helper
   (lambda (v i acc)
     (if (< i 0)
         acc
         (vector->list-helper v (- i 1) (cons (vector-ref v i) acc)))))
 
 (define vector->list
   (lambda (v)
     (vector->list-helper v (- (vector-length v) 1) (quote ()))))
 
 (define list->vector-helper
   (lambda (v xs i)
     (if (null? xs)
         v
         (begin
           (vector-set! v i (car xs))
           (list->vector-helper v (cdr xs) (+ i 1))))))
 
 (define list->vector
   (lambda (xs)
     (list->vector-helper (make-vector (length xs) 0) xs 0)))
 
 ;; --- Structural equality --------------------------------------------
 ;; equal? — eq? fast-path, then recurse into pairs, string contents,
 ;; and vector elements. No cycle detection (matches the pre-move P1
 ;; version's policy).
 (define equal?-string
   (lambda (a b i n)
     (if (= i n)
         #t
         (if (= (string-ref a i) (string-ref b i))
             (equal?-string a b (+ i 1) n)
             #f))))
 
 (define equal?-vector
   (lambda (a b i n)
     (if (= i n)
         #t
         (if (equal? (vector-ref a i) (vector-ref b i))
             (equal?-vector a b (+ i 1) n)
             #f))))
 
 (define equal?
   (lambda (a b)
     (if (eq? a b)
         #t
         (if (pair? a)
             (if (pair? b)
                 (if (equal? (car a) (car b))
                     (equal? (cdr a) (cdr b))
                     #f)
                 #f)
             (if (string? a)
                 (if (string? b)
                     (if (= (string-length a) (string-length b))
                         (equal?-string a b 0 (string-length a))
                         #f)
                     #f)
                 (if (vector? a)
                     (if (vector? b)
                         (if (= (vector-length a) (vector-length b))
                             (equal?-vector a b 0 (vector-length a))
                             #f)
                         #f)
                     #f))))))