Skip to content

Commit b666155

Browse files
grouzengrouzen
committed
Functions can take no arguments
1 parent a14e721 commit b666155

File tree

9 files changed

+52
-19
lines changed

9 files changed

+52
-19
lines changed

‎include/subr.h

+1
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,7 @@ struct lispobj *subr_eql(struct lispobj*);
3333
struct lispobj *subr_list(struct lispobj*);
3434
struct lispobj *subr_plus(struct lispobj*);
3535
struct lispobj *subr_multi(struct lispobj*);
36+
struct lispobj *subr_mod(struct lispobj*);
3637
struct lispobj *subr_compar(struct lispobj*);
3738
struct lispobj *subr_greatthan(struct lispobj*);
3839
struct lispobj *subr_lessthan(struct lispobj*);

‎lispcode/core.lisp

+2-3
Original file line numberDiff line numberDiff line change
@@ -43,12 +43,11 @@
4343
(fold-right proc start (cdr seq))))))
4444

4545
;; Find
46-
;; I really don't know why it don't work!
4746
(label find
4847
(lambda (item seq)
4948
(cond ((null seq) nil)
5049
((equal item (car seq)) (car seq))
51-
(find item (cdr seq)))))
50+
(t (find item (cdr seq))))))
5251

5352
;; Length
5453
(label length
@@ -75,7 +74,7 @@
7574
(label find-if
7675
(lambda (pred seq)
7776
(cond ((null seq) nil)
78-
((pred (car seq)) (car seq))
77+
((pred (car seq)) (cons (car seq) (find-if pred (cdr seq))))
7978
(t (find-if pred (cdr seq))))))
8079

8180
;; Reverse

‎lispcode/math.lisp

+7
Original file line numberDiff line numberDiff line change
@@ -43,3 +43,10 @@
4343
;; Cube
4444
(label cube
4545
(lambda (x) (* x x x)))
46+
47+
(label gcd
48+
(lambda (a b)
49+
(if (= b 0)
50+
a
51+
(gcd b (mod a b)))))
52+

‎lispcode/metacycle-interpreter.lisp

+3-2
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@
5252
(error "Wrong number of arguments"))))
5353

5454
(label mrepl
55-
(lambda (noarg) ; non-argument functions are not supported yet
55+
(lambda ()
5656
(display "meta-fflisp> ")
5757
(let ((input (read)))
5858
(if (eq input 'exit)
@@ -65,7 +65,7 @@
6565
'proc-env))
6666
(display output))
6767
(newline)
68-
(mrepl noarg))))))
68+
(mrepl))))))
6969

7070
;; User defined case.
7171
(label compound-procedure-p
@@ -89,6 +89,7 @@
8989
(list '- -)
9090
(list '* *)
9191
(list '/ /)
92+
(list 'mod mod)
9293
(list '= =)
9394
(list '> >)
9495
(list '< <)))

‎src/environment.c

+2-1
Original file line numberDiff line numberDiff line change
@@ -216,6 +216,7 @@ struct lispobj *env_init(void)
216216
{">", subr_greatthan},
217217
{"<", subr_lessthan},
218218
{"/", subr_divide},
219+
{"MOD", subr_mod},
219220
{"HEAP", subr_heap},
220221
{"HEAP-OBJECT", subr_heap_object},
221222
{"LOAD", subr_load},
@@ -235,7 +236,7 @@ struct lispobj *env_init(void)
235236

236237
env_var_define(NEW_SYMBOL("T"), NEW_SYMBOL("T"), env);
237238
env_var_define(NEW_SYMBOL("NIL"), NULL, env);
238-
239+
239240
return env;
240241
}
241242

‎src/eval.c

+6-5
Original file line numberDiff line numberDiff line change
@@ -147,7 +147,7 @@ struct lispobj *eval(struct lispobj *obj, struct lispobj *env)
147147
}
148148

149149
struct lispobj *apply(struct lispobj *proc, struct lispobj *args)
150-
{
150+
{
151151
if(proc != NULL && OBJ_TYPE(proc) == CONS) {
152152
struct lispobj *ret;
153153

@@ -156,7 +156,8 @@ struct lispobj *apply(struct lispobj *proc, struct lispobj *args)
156156
struct lispobj *body, *(*subr)(struct lispobj *);
157157

158158
body = CADR(proc);
159-
subr = (void *) NUMBER_VALUE(body);
159+
subr = (struct lispobj *) NUMBER_VALUE(body);
160+
//subr = (struct lispobj *) body;
160161

161162
ret = heap_grab(subr(args));
162163
} else if(NEW_SYMBOL("PROC") == CAR(proc)) {
@@ -166,14 +167,14 @@ struct lispobj *apply(struct lispobj *proc, struct lispobj *args)
166167
body = CADDR(proc);
167168
params = CADR(proc);
168169
penv = CADDDR(proc);
169-
170+
170171
if(length(params) == length(args)) {
171172
struct lispobj *env;
172173

173-
if(params == NULL) {
174+
if(params == NULL || params == NEW_SYMBOL("NIL")) {
174175
env = penv;
175176

176-
ret = eval(body, env);
177+
ret = eval_progn(body, env);
177178
} else {
178179
env = heap_grab(NEW_CONS(env_frame_make(params, args), penv));
179180

‎src/heap.c

+5-3
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ void heap_debug_object(struct lispobj *obj)
1717
if(obj == NULL) {
1818
printf(" null pointer");
1919
} else {
20-
printf(" [0x%x ", obj);
20+
printf(" [%p ", obj);
2121
if(OBJ_TYPE(obj) == SYMBOL) {
2222
printf("(symbol %s) ", SYMBOL_VALUE(obj));
2323
} else if(OBJ_TYPE(obj) == NUMBER) {
@@ -39,7 +39,7 @@ void heap_debug(void)
3939
i++;
4040
}
4141

42-
printf("\nTotal: %d objects (%d bytes).\n",
42+
printf("\nTotal: %d objects (%z bytes).\n",
4343
i,
4444
i * sizeof(struct lispobj));
4545

@@ -156,9 +156,11 @@ void symbol_table_debug(void)
156156
{
157157
struct lispobj *tmp_symt;
158158
tmp_symt = symbol_table;
159+
160+
printf("__DEBUG_SYMT__: symbol table:\n");
159161

160162
while(tmp_symt != NULL) {
161-
printf(" [%s %d] ",
163+
printf("[%s %d]\n",
162164
SYMBOL_VALUE(CAR(tmp_symt)),
163165
OBJ_REFS(CAR(tmp_symt)));
164166
tmp_symt = CDR(tmp_symt);

‎src/print.c

+3-3
Original file line numberDiff line numberDiff line change
@@ -26,14 +26,14 @@ void print(struct lispobj *obj)
2626
} else {
2727
if(CAR(obj) == NEW_SYMBOL("PROC")) {
2828
printf("<procedure ");
29-
if(CADR(obj) != NULL) {
29+
if(CADR(obj) != NEW_SYMBOL("NIL")) {
3030
print_list(CADR(obj));
3131
} else {
3232
printf("()");
3333
}
34-
printf(" 0x%x>", CADDDR(obj));
34+
printf(" %p>", CADDDR(obj));
3535
} else if(CAR(obj) == NEW_SYMBOL("SUBR")) {
36-
printf("<primitive-procedure 0x%x>", CADR(obj));
36+
printf("<primitive-procedure %p>", CADR(obj));
3737
} else {
3838
print_list(obj);
3939
}

‎src/subr.c

+23-2
Original file line numberDiff line numberDiff line change
@@ -50,8 +50,8 @@ struct lispobj *list(int n, ...)
5050
int length(struct lispobj *list)
5151
{
5252
int n = 0;
53-
54-
while(list != NULL) {
53+
54+
while(list != NULL && list != NEW_SYMBOL("NIL")) {
5555
list = CDR(list);
5656
n++;
5757
}
@@ -458,6 +458,27 @@ struct lispobj *subr_divide(struct lispobj *args)
458458
return num;
459459
}
460460

461+
struct lispobj *subr_mod(struct lispobj *args)
462+
{
463+
if(length(args) != 2)
464+
return ERROR_ARGS;
465+
466+
struct lispobj *number, *div;
467+
468+
number = CAR(args);
469+
div = CADR(args);
470+
471+
if(OBJ_TYPE(number) == NUMBER && OBJ_TYPE(div) == NUMBER) {
472+
char mod[30];
473+
474+
snprintf(mod, 30, "%d", NUMBER_VALUE(number) % NUMBER_VALUE(div));
475+
return NEW_NUMBER(mod);
476+
} else {
477+
return NEW_ERROR("Arguments must be numbers.\n");
478+
}
479+
480+
}
481+
461482
struct lispobj *subr_greatthan(struct lispobj *args)
462483
{
463484
if(length(args) != 2)

0 commit comments

Comments
 (0)