Skip to content

Commit 201366b

Browse files
committed
Fix error messages.
Add more functions in library.lisp
1 parent ace8ad3 commit 201366b

File tree

5 files changed

+152
-127
lines changed

5 files changed

+152
-127
lines changed

README.md

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -272,22 +272,23 @@ exhaustion error.
272272

273273
`(progn expr expr ...)` executes several expressions in sequence.
274274

275-
(progn (print "I own ")
276-
(defun add(x y)(+ x y))
277-
(println (add 3 7) " cents")) ; -> prints "I own 10 cents"
275+
( progn (print "I own ")
276+
(defun add(x y)(+ x y))
277+
(println (add 3 7) " cents") ) ; -> prints "I own 10 cents"
278278

279279
### Equivalence test operators
280280

281281
`eq` takes two arguments and returns `t` if the objects are the same. What `eq`
282282
really does is a pointer comparison, so two objects happened to have the same
283283
contents but actually different are considered to not be the same by `eq`.
284+
`eq` can also compare two strings.
284285

285286
### String functions
286287

287-
`string=` compares two strings.
288+
`eq` compares two strings.
288289

289-
(string= "Hello" "Hello") ; -> t
290-
(string= "Hello" "World") ; -> ()
290+
(eq "Hello" "Hello") ; -> t
291+
(eq "Hello" "hello") ; -> ()
291292

292293
`string-concat` concatenates strings.
293294

examples/library.lisp

Lines changed: 139 additions & 108 deletions
Original file line numberDiff line numberDiff line change
@@ -1,108 +1,139 @@
1-
(defun list (x . y) (cons x y))
2-
3-
;; (let var val body ...)
4-
;; => ((lambda (var) body ...) val)
5-
(defmacro let (var val . body)
6-
(cons (cons 'lambda (cons (list var) body))
7-
(list val)))
8-
9-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10-
;;; Control structures
11-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12-
13-
(defmacro cond (rest)
14-
(if (= () rest)
15-
()
16-
(if (= (car (car rest)) t)
17-
(car (cdr (car rest)))
18-
(list 'if
19-
(car (car rest))
20-
(car (cdr (car rest)))
21-
(cond (cdr rest))))))
22-
23-
;; (and e1 e2 ...)
24-
;; => (if e1 (and e2 ...))
25-
;; (and e1)
26-
;; => e1
27-
(defmacro and (expr . rest)
28-
(if rest
29-
(list 'if expr (cons 'and rest))
30-
expr))
31-
32-
;; (or e1 e2 ...)
33-
;; => (let <tmp> e1
34-
;; (if <tmp> <tmp> (or e2 ...)))
35-
;; (or e1)
36-
;; => e1
37-
;;
38-
;; The reason to use the temporary variables is to avoid evaluating the
39-
;; arguments more than once.
40-
(defmacro or (expr . rest)
41-
(if rest
42-
(let var (gensym)
43-
(list 'let var expr
44-
(list 'if var var (cons 'or rest))))
45-
expr))
46-
47-
;; (when expr body ...)
48-
;; => (if expr (progn body ...))
49-
(defmacro when (expr . body)
50-
(cons 'if (cons expr (list (cons 'progn body)))))
51-
52-
;; (unless expr body ...)
53-
;; => (if expr () body ...)
54-
(defmacro unless (expr . body)
55-
(cons 'if (cons expr (cons () body))))
56-
57-
58-
59-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
60-
;;; List operators
61-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
62-
63-
;; Applies each element of lis to pred. If pred returns a true value, terminate
64-
;; the evaluation and returns pred's return value. If all of them return (),
65-
;; returns ().
66-
(defun any (lis pred)
67-
(when lis
68-
(or (pred (car lis))
69-
(any (cdr lis) pred))))
70-
71-
;;; Applies each element of lis to fn, and returns their return values as a list.
72-
(defun map (lis fn)
73-
(when lis
74-
(cons (fn (car lis))
75-
(map (cdr lis) fn))))
76-
77-
;; Returns nth element of lis.
78-
(defun nth (lis n)
79-
(if (= n 0)
80-
(car lis)
81-
(nth (cdr lis) (- n 1))))
82-
83-
;; Returns the nth tail of lis.
84-
(defun nth-tail (lis n)
85-
(if (= n 0)
86-
lis
87-
(nth-tail (cdr lis) (- n 1))))
88-
89-
;; Returns a list consists of m .. n-1 integers.
90-
(defun %iota (m n)
91-
(unless (<= n m)
92-
(cons m (%iota (+ m 1) n))))
93-
94-
;; Returns a list consists of 0 ... n-1 integers.
95-
(defun iota (n)
96-
(%iota 0 n))
97-
98-
;; Returns a new list whose length is len and all members are init.
99-
(defun make-list (len init)
100-
(unless (= len 0)
101-
(cons init (make-list (- len 1) init))))
102-
103-
;; Applies fn to each element of lis.
104-
(defun for-each (lis fn)
105-
(or (not lis)
106-
(progn (fn (car lis))
107-
(for-each (cdr lis) fn))))
108-
1+
;;
2+
;; Simple library of useful functions and macros
3+
;;
4+
5+
(defun list (x . y)
6+
(cons x y))
7+
8+
9+
;; (and e1 e2 ...)
10+
;; => (if e1 (and e2 ...))
11+
;; (and e1)
12+
;; => e1
13+
(defmacro and (expr . rest)
14+
(if rest
15+
(list 'if expr (cons 'and rest))
16+
expr))
17+
18+
;; (or e1 e2 ...)
19+
;; => (let <tmp> e1
20+
;; (if <tmp> <tmp> (or e2 ...)))
21+
;; (or e1)
22+
;; => e1
23+
;;
24+
;; The reason to use the temporary variables is to avoid evaluating the
25+
;; arguments more than once.
26+
(defmacro or (expr . rest)
27+
(if rest
28+
(let var (gensym)
29+
(list 'let var expr
30+
(list 'if var var (cons 'or rest))))
31+
expr))
32+
33+
;; (let var val body ...)
34+
;; => ((lambda (var) body ...) val)
35+
(defmacro let (var val . body)
36+
(cons (cons 'lambda (cons (list var) body))
37+
(list val)))
38+
39+
;; (when expr body ...)
40+
;; => (if expr (progn body ...))
41+
(defmacro when (expr . body)
42+
(cons 'if (cons expr (list (cons 'progn body)))))
43+
44+
;; (unless expr body ...)
45+
;; => (if expr () body ...)
46+
(defmacro unless (expr . body)
47+
(cons 'if (cons expr (cons () body))))
48+
49+
;;;
50+
;;; List operators
51+
;;;
52+
53+
;;; Applies each element of lis to fn, and returns their return values as a list.
54+
(defun map (lis fn)
55+
(when lis
56+
(cons (fn (car lis))
57+
(map (cdr lis) fn))))
58+
59+
;; Applies each element of lis to pred. If pred returns a true value, terminate
60+
;; the evaluation and returns pred's return value. If all of them return (),
61+
;; returns ().
62+
(defun any (lis pred)
63+
(when lis
64+
(or (pred (car lis))
65+
(any (cdr lis) pred))))
66+
67+
;; returns t if elem exists in list l
68+
(defun member (l elem)
69+
(any l (lambda (x) (or (eq x elem) (= x elem)))))
70+
71+
;; Returns nth element of lis.
72+
(defun nth (lis n)
73+
(if (= n 0)
74+
(car lis)
75+
(nth (cdr lis) (- n 1))))
76+
77+
;; Returns the nth tail of lis.
78+
(defun nth-tail (lis n)
79+
(if (= n 0)
80+
lis
81+
(nth-tail (cdr lis) (- n 1))))
82+
83+
;; Returns a list consists of m .. n-1 integers.
84+
(defun %iota (m n)
85+
(unless (<= n m)
86+
(cons m (%iota (+ m 1) n))))
87+
88+
;; Returns a list consists of 0 ... n-1 integers.
89+
(defun iota (n) (%iota 0 n))
90+
91+
;; Returns a new list whose length is len and all members are init.
92+
(defun make-list (len init)
93+
(unless (= len 0)
94+
(cons init (make-list (- len 1) init))))
95+
96+
;; Applies fn to each element of lis.
97+
(defun for-each (lis fn)
98+
(or (not lis)
99+
(progn (fn (car lis))
100+
(for-each (cdr lis) fn))))
101+
102+
; Concatenates and flattens lists into a single list
103+
(defun append (first . rest)
104+
(if (eq () rest)
105+
first
106+
(append2 first
107+
(append-reduce rest))))
108+
109+
(defun append2 (x y)
110+
(if (eq () x)
111+
y
112+
(cons (car x)
113+
(append2 (cdr x) y))))
114+
115+
(defun append-reduce (lists)
116+
(if (eq () (cdr lists))
117+
(car lists)
118+
(append2 (car lists)
119+
(append-reduce (cdr lists)))))
120+
121+
(defun filter (pred lst)
122+
(if (eq () lst)
123+
()
124+
(if (pred (car lst))
125+
(cons (car lst)
126+
(filter pred (cdr lst)))
127+
(filter pred (cdr lst)))))
128+
129+
(defun quicksort (lst)
130+
(if (eq () lst)
131+
()
132+
(if (eq () (cdr lst))
133+
lst
134+
(let pivot (car lst)
135+
(append
136+
(quicksort (filter (lambda(x) (< x pivot)) (cdr lst)))
137+
(cons pivot ())
138+
(quicksort (filter (lambda(x) (>= x pivot)) (cdr lst)))) ))))
139+

examples/nqueens.lisp

Lines changed: 1 addition & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -8,13 +8,6 @@
88
;;; This program solves N-queens puzzle by depth-first backtracking.
99
;;;
1010

11-
;;;
12-
;;; Basic macros
13-
;;;
14-
;;; Because the language does not have quasiquote, we need to construct an
15-
;;; expanded form using cons and list.
16-
;;;
17-
1811
(load "examples/library.lisp")
1912

2013
;;;
@@ -74,7 +67,7 @@
7467
;; Problem solved
7568
(progn (print board)
7669
(println '$))
77-
(for-each (iota board-size)
70+
(map (iota board-size)
7871
(lambda (y)
7972
(unless (conflict? board x y)
8073
(set board x y)

src/minilisp.c

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -377,7 +377,7 @@ static Obj *push_env(void *root, Obj **env, Obj **vars, Obj **vals) {
377377
for (; (*vars)->type == TCELL; *vars = (*vars)->cdr, *vals = (*vals)->cdr) {
378378
if ((*vals)->type != TCELL)
379379
error("Cannot apply function: number of argument does not match",
380-
(*vals)->line_num);
380+
(*vars)->line_num);
381381
*sym = (*vars)->car;
382382
*val = (*vals)->car;
383383
*map = acons(root, sym, val, map);

src/repl.c

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -108,7 +108,7 @@ static size_t read_file(char *fname, char **text) {
108108
size_t length = 0;
109109
FILE *f = fopen(fname, "r");
110110
if (!f) {
111-
error("Failed to load file %s", fname);
111+
error("Failed to load file %s", filepos.line_num, fname);
112112
return 0;
113113
}
114114

@@ -118,14 +118,14 @@ static size_t read_file(char *fname, char **text) {
118118

119119
*text = malloc(length + 1);
120120
if (!*text) {
121-
error("Out of memory.");
121+
error("Out of memory.", filepos.line_num);
122122
fclose(f);
123123
return 0;
124124
}
125125

126126
size_t read = fread(*text, 1, length, f);
127127
if (read != length) {
128-
error("Failed to read entire file");
128+
error("Failed to read entire file", filepos.line_num);
129129
free(*text);
130130
*text = NULL;
131131
fclose(f);
@@ -152,7 +152,7 @@ void process_file(char *fname, Obj **env, Obj **expr) {
152152
FILE *stream = fmemopen(text, len, "r");
153153
if (!stream) {
154154
free(text);
155-
error("Failed to create memory stream");
155+
error("Failed to create memory stream for %s", filepos.line_num, fname);
156156
return;
157157
}
158158

0 commit comments

Comments
 (0)