aboutsummaryrefslogtreecommitdiff
path: root/src/lisp/std.lisp
blob: a256125a6f84076f404257fad33b54e48c5e71e9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
(define (caar ls) (car (car ls)))
(define (caaar ls) (car (caar ls)))
(define (caaaar ls) (car (caaar ls)))
(define (caaaaar ls) (car (caaaar ls)))

(define (cddr ls) (cdr (cdr ls)))
(define (cdddr ls) (cdr (cddr ls)))
(define (cddddr ls) (cdr (cdddr ls)))
(define (cdddddr ls) (cdr (cddddr ls)))

(define (null? ls) (eq? ls '()))
(define (zero? x) (eq? x 0))

(define (remainder x y)
  (if (> y x)
      x
      (remainder (- x y) y)))

(define (quotient x y)
  (/ x y))

(define (even? x) (zero? (remainder x 2)))
(define (odd? x) (not (even? x)))

(define (length ls)
  (if (null? ls)
    0
    (+ 1 (length (cdr ls)))))

(define (fold init accumulator ls)
  (if (null? ls)
    init
    (fold (accumulator init (car ls))
          accumulator
          (cdr ls))))

(define (map func ls)
  (if (null? ls)
      '()
      (cons (func (car ls))
            (map func (cdr ls)))))

(define (zip l1 l2)
  (if (or (null? l1)
          (null? l2))
      '()
      (cons (cons (car l1) (car l2))
            (zip (cdr l1) (cdr l2)))))

(define (filter pred ls)
  (if (null? ls)
      '()
      (if (pred (car ls))
          (cons (car ls) (filter pred (cdr ls)))
          (filter pred (cdr ls)))))

(define (member? item ls)
  (fold #f 
        (lambda (acc x) (or acc (eq? item x)))
        ls))

(define (assert expr)
  (assert-eq #t expr))

(define (sum ls) (fold 0 + ls))
(define (product ls) (fold 1 * ls))

(define (reverse ls)
  (begin
    (define (rev-helper p acc)
      (if (null? p)
          acc
          (rev-helper (cdr p) (cons (car p) acc))))
    (rev-helper ls '())))