Author: Gianluca Guida <glguida@tlbflush.org>
Date: Wed Mar 8 01:26:24 UTC 2017
Parent: b89fc5e83f5748ee9f2bcacbd5093746b7cd5fd3
Log message:
lib: indent code
1: diff --git a/src/lib/env.c b/src/lib/env.c
2: index dab27f6..afe82c1 100644
3: --- a/src/lib/env.c
4: +++ b/src/lib/env.c
5: @@ -6,49 +6,55 @@
6: * Utterly simple hash table implementation
7: */
8:
9: -static unsigned ht_hashf(lreg_t key)
10: +static unsigned
11: +ht_hashf (lreg_t key)
12: {
13: - return ((uintptr_t)lreg_raw_ptr(key) >> 5) % HT_SIZE;
14: + return ((uintptr_t) lreg_raw_ptr (key) >> 5) % HT_SIZE;
15: }
16:
17: -static int _ht_findptr(struct ht_entry *hte, lreg_t key, struct ht_entry **e)
18: +static int
19: +_ht_findptr (struct ht_entry *hte, lreg_t key, struct ht_entry **e)
20: {
21: int i = 0;
22: struct ht_entry *ptr;
23:
24: - for (ptr = hte; ptr != NULL; ptr = ptr->next) {
25: - i++;
26: - if ( ptr->key == key )
27: - {
28: - *e = ptr;
29: - return 0;
30: - }
31: - }
32: + for (ptr = hte; ptr != NULL; ptr = ptr->next)
33: + {
34: + i++;
35: + if (ptr->key == key)
36: + {
37: + *e = ptr;
38: + return 0;
39: + }
40: + }
41: return 1;
42: }
43:
44: /* Ret values: < 0 => error, 0 => found, 1 not found */
45: -static int ht_findptr(ht_t *ht, lreg_t key, struct ht_entry **e)
46: +static int
47: +ht_findptr (ht_t * ht, lreg_t key, struct ht_entry **e)
48: {
49: - unsigned n = ht_hashf(key);
50: - return _ht_findptr(ht->table[n], key, e);
51: + unsigned n = ht_hashf (key);
52: + return _ht_findptr (ht->table[n], key, e);
53: }
54:
55: /* Ret values: < 0 => error, 0 => found, 1 not found */
56: -static int ht_find(ht_t *ht, lreg_t key, lreg_t *res)
57: +static int
58: +ht_find (ht_t * ht, lreg_t key, lreg_t * res)
59: {
60: int n;
61: struct ht_entry *hte;
62: - n = ht_findptr(ht, key, &hte);
63: - if ( n == 0 )
64: + n = ht_findptr (ht, key, &hte);
65: + if (n == 0)
66: *res = hte->value;
67: return n;
68: }
69:
70: -static int _ht_insert(struct ht_entry **htep, lreg_t key, lreg_t value)
71: +static int
72: +_ht_insert (struct ht_entry **htep, lreg_t key, lreg_t value)
73: {
74: struct ht_entry *hte = *htep;
75: - struct ht_entry *e = GC_malloc(sizeof(struct ht_entry));
76: + struct ht_entry *e = GC_malloc (sizeof (struct ht_entry));
77: e->key = key;
78: e->value = value;
79: e->next = hte;
80: @@ -56,11 +62,12 @@ static int _ht_insert(struct ht_entry **htep, lreg_t key, lreg_t value)
81: return 0;
82: }
83:
84: -static int ht_insert(ht_t *ht, lreg_t key, lreg_t value)
85: +static int
86: +ht_insert (ht_t * ht, lreg_t key, lreg_t value)
87: {
88: - unsigned n = ht_hashf(key);
89: - assert(n < HT_SIZE);
90: - return _ht_insert(ht->table + n, key, value);
91: + unsigned n = ht_hashf (key);
92: + assert (n < HT_SIZE);
93: + return _ht_insert (ht->table + n, key, value);
94: }
95:
96:
97: @@ -69,79 +76,86 @@ static int ht_insert(ht_t *ht, lreg_t key, lreg_t value)
98: */
99:
100: /* Ret values: < 0 => error, 0 => found, 1 not found */
101: -lreg_t env_lookup(lenv_t *env, lreg_t key)
102: +lreg_t
103: +env_lookup (lenv_t * env, lreg_t key)
104: {
105: int r;
106: lreg_t res;
107:
108: - r = ht_find(&env->htable, key, &res);
109: - if (r == 1) {
110: - raise_exception("Symbol not found", key);
111: - }
112: - if (r) {
113: - raise_exception("Internal error", key);
114: - }
115: + r = ht_find (&env->htable, key, &res);
116: + if (r == 1)
117: + {
118: + raise_exception ("Symbol not found", key);
119: + }
120: + if (r)
121: + {
122: + raise_exception ("Internal error", key);
123: + }
124: return res;
125: }
126:
127: -int env_define(lenv_t *env, lreg_t key, lreg_t value)
128: +int
129: +env_define (lenv_t * env, lreg_t key, lreg_t value)
130: {
131: - return ht_insert(&env->htable, key, value);
132: + return ht_insert (&env->htable, key, value);
133: }
134:
135: /* Ret values: < 0 => error, 0 => found, 1 not found */
136: -int env_set(lenv_t *env, lreg_t key, lreg_t value)
137: +int
138: +env_set (lenv_t * env, lreg_t key, lreg_t value)
139: {
140: int r;
141: struct ht_entry *hte;
142: - r = ht_findptr(&env->htable, key, &hte);
143: - if ( r == 0 )
144: - hte->value = value;
145: + r = ht_findptr (&env->htable, key, &hte);
146: + if (r == 0)
147: + hte->value = value;
148: return r;
149: }
150:
151: -void env_pushnew(lenv_t *env, lenv_t *new)
152: +void
153: +env_pushnew (lenv_t * env, lenv_t * new)
154: {
155: - new->htable = env->htable;
156: + new->htable = env->htable;
157: }
158:
159: #if 0
160:
161: static lenv_t le;
162: -int main ()
163: +int
164: +main ()
165: {
166: int n1, n2;
167: lreg_t res = 0;
168: lenv_t *le2;
169: - GC_INIT();
170: + GC_INIT ();
171:
172: - le.htable = GC_malloc(sizeof(ht_t));
173: -
174: - n1 = env_set(&le, LREG(0x505000, 5), LREG(0xa0a000, 0xa));
175: - printf("n1 = %d\n", n1);
176: - n1 = env_lookup(&le, LREG(0x505000, 5), &res);
177: - printf("%llx: %d\n", res, n1);
178: - n1 = env_define(&le, LREG(0x505000, 5), LREG(0xa0a000, 0xa));
179: - printf("n1 = %d\n", n1);
180: - n1 = env_lookup(&le, LREG(0x505000, 5), &res);
181: - printf("%llx: %d\n", res, n1);
182: + le.htable = GC_malloc (sizeof (ht_t));
183:
184: - printf("Creating new env\n");
185: + n1 = env_set (&le, LREG (0x505000, 5), LREG (0xa0a000, 0xa));
186: + printf ("n1 = %d\n", n1);
187: + n1 = env_lookup (&le, LREG (0x505000, 5), &res);
188: + printf ("%llx: %d\n", res, n1);
189: + n1 = env_define (&le, LREG (0x505000, 5), LREG (0xa0a000, 0xa));
190: + printf ("n1 = %d\n", n1);
191: + n1 = env_lookup (&le, LREG (0x505000, 5), &res);
192: + printf ("%llx: %d\n", res, n1);
193:
194: - le2 = env_pushnew(&le);
195: - n1 = env_lookup(le2, LREG(0x505000, 5), &res);
196: - printf("%llx: %d\n", res, n1);
197: - n1 = env_define(le2, LREG(0x505000, 5), LREG(0xb0b000, 0xa));
198: - printf("n1 = %d\n", n1);
199: - n1 = env_lookup(le2, LREG(0x505000, 5), &res);
200: - printf("%llx: %d\n", res, n1);
201: + printf ("Creating new env\n");
202:
203: - printf("Back to old env\n");
204: + le2 = env_pushnew (&le);
205: + n1 = env_lookup (le2, LREG (0x505000, 5), &res);
206: + printf ("%llx: %d\n", res, n1);
207: + n1 = env_define (le2, LREG (0x505000, 5), LREG (0xb0b000, 0xa));
208: + printf ("n1 = %d\n", n1);
209: + n1 = env_lookup (le2, LREG (0x505000, 5), &res);
210: + printf ("%llx: %d\n", res, n1);
211:
212: - n1 = env_lookup(&le, LREG(0x505000, 5), &res);
213: - printf("%llx: %d\n", res, n1);
214: + printf ("Back to old env\n");
215: +
216: + n1 = env_lookup (&le, LREG (0x505000, 5), &res);
217: + printf ("%llx: %d\n", res, n1);
218:
219:
220: }
221:
222: -#endif
223: +#endif
224: diff --git a/src/lib/ext_types.c b/src/lib/ext_types.c
225: index d78530a..46ff297 100644
226: --- a/src/lib/ext_types.c
227: +++ b/src/lib/ext_types.c
228: @@ -10,76 +10,83 @@ static lac_exttype_t *ext_types[LREG_TYPES];
229: #define EXTTY_IS_VALID(typeno) \
230: ( typeno > LREG_EXTT && typeno <= LREG_TYPES )
231:
232: -int lac_extty_register(unsigned typeno, lac_exttype_t *extty)
233: +int
234: +lac_extty_register (unsigned typeno, lac_exttype_t * extty)
235: {
236: - if ( !EXTTY_IS_VALID(typeno) )
237: + if (!EXTTY_IS_VALID (typeno))
238: return -1;
239: ext_types[typeno] = extty;
240: return 0;
241: }
242:
243: -unsigned lac_extty_get_type(lreg_t lr)
244: +unsigned
245: +lac_extty_get_type (lreg_t lr)
246: {
247: - struct treg_hdr *treg = lreg_raw_ptr(lr);
248: - return treg->type;
249: + struct treg_hdr *treg = lreg_raw_ptr (lr);
250: + return treg->type;
251: }
252:
253: -size_t lac_extty_get_size(lreg_t lr)
254: +size_t
255: +lac_extty_get_size (lreg_t lr)
256: {
257: - struct treg_hdr *treg = lreg_raw_ptr(lr);
258: - return treg->size;
259: + struct treg_hdr *treg = lreg_raw_ptr (lr);
260: + return treg->size;
261: }
262:
263: -lreg_t lac_extty_box(unsigned typeno, void *ptr, size_t sz)
264: +lreg_t
265: +lac_extty_box (unsigned typeno, void *ptr, size_t sz)
266: {
267: - struct treg_hdr *treg = lac_alloc(sizeof(struct treg_hdr) + sz);
268: - treg->type = typeno;
269: - treg->size = sz;
270: - treg->ptr = ptr;
271: + struct treg_hdr *treg = lac_alloc (sizeof (struct treg_hdr) + sz);
272: + treg->type = typeno;
273: + treg->size = sz;
274: + treg->ptr = ptr;
275:
276: - return lreg_raw(treg, LREG_EXTT);
277: + return lreg_raw (treg, LREG_EXTT);
278: }
279:
280:
281: -size_t lac_extty_unbox(lreg_t lr, void **ptr)
282: +size_t
283: +lac_extty_unbox (lreg_t lr, void **ptr)
284: {
285: - struct treg_hdr *treg = lreg_raw_ptr(lr);
286: + struct treg_hdr *treg = lreg_raw_ptr (lr);
287:
288: - if (ptr)
289: - *ptr = treg->ptr;
290: - return treg->size;
291: + if (ptr)
292: + *ptr = treg->ptr;
293: + return treg->size;
294: }
295:
296: -int lac_extty_print(FILE *fd, lreg_t lr)
297: +int
298: +lac_extty_print (FILE * fd, lreg_t lr)
299: {
300: - unsigned typeno = lac_extty_get_type(lr);
301: - if ( EXTTY_IS_VALID(typeno)
302: - && ext_types[typeno] != NULL )
303: - ext_types[typeno]->print(fd, lr);
304: - else
305: - return 0;
306: -
307: - return 1;
308: + unsigned typeno = lac_extty_get_type (lr);
309: + if (EXTTY_IS_VALID (typeno) && ext_types[typeno] != NULL)
310: + ext_types[typeno]->print (fd, lr);
311: + else
312: + return 0;
313: +
314: + return 1;
315: }
316:
317: -int lacint_extty_equal(lreg_t arg1, lreg_t arg2)
318: +int
319: +lacint_extty_equal (lreg_t arg1, lreg_t arg2)
320: {
321: - int rc = 0;
322: - unsigned typeno1 = lac_extty_get_type(arg1);
323: - unsigned typeno2 = lac_extty_get_type(arg2);
324: -
325: - if ( !EXTTY_IS_VALID(typeno1)
326: - || !EXTTY_IS_VALID(typeno2)
327: - || typeno1 != typeno2
328: - || ext_types[typeno1] == NULL )
329: - raise_exception("Internal error", NIL);
330: -
331: - if (ext_types[typeno1]->equal == NULL) {
332: - void *ptr1 = ((struct treg_hdr *)lreg_raw_ptr(arg1))->ptr;
333: - void *ptr2 = ((struct treg_hdr *)lreg_raw_ptr(arg2))->ptr;
334: - rc = ptr1 == ptr2;
335: - } else
336: - rc = ext_types[typeno1]->equal(arg1, arg2);
337: -
338: - return rc;
339: + int rc = 0;
340: + unsigned typeno1 = lac_extty_get_type (arg1);
341: + unsigned typeno2 = lac_extty_get_type (arg2);
342: +
343: + if (!EXTTY_IS_VALID (typeno1)
344: + || !EXTTY_IS_VALID (typeno2)
345: + || typeno1 != typeno2 || ext_types[typeno1] == NULL)
346: + raise_exception ("Internal error", NIL);
347: +
348: + if (ext_types[typeno1]->equal == NULL)
349: + {
350: + void *ptr1 = ((struct treg_hdr *) lreg_raw_ptr (arg1))->ptr;
351: + void *ptr2 = ((struct treg_hdr *) lreg_raw_ptr (arg2))->ptr;
352: + rc = ptr1 == ptr2;
353: + }
354: + else
355: + rc = ext_types[typeno1]->equal (arg1, arg2);
356: +
357: + return rc;
358: }
359: diff --git a/src/lib/lac.c b/src/lib/lac.c
360: index ba7875a..f0ac653 100644
361: --- a/src/lib/lac.c
362: +++ b/src/lib/lac.c
363: @@ -47,19 +47,20 @@ lreg_t sym_rest;
364: * Interface
365: */
366:
367: -lreg_t register_symbol(const char *s)
368: +lreg_t
369: +register_symbol (const char *s)
370: {
371: - unsigned len = strlen(s) + 1;
372: - char *gcs = GC_malloc(len);
373: - strncpy(gcs, s, len);
374: - return intern_symbol(gcs);
375: + unsigned len = strlen (s) + 1;
376: + char *gcs = GC_malloc (len);
377: + strncpy (gcs, s, len);
378: + return intern_symbol (gcs);
379: }
380:
381: void
382: -lac_extproc_register(lenv_t *env, const char *sym, lac_function_t f)
383: +lac_extproc_register (lenv_t * env, const char *sym, lac_function_t f)
384: {
385:
386: - env_define(env, register_symbol(sym), llproc_to_lreg(f));
387: + env_define (env, register_symbol (sym), llproc_to_lreg (f));
388: }
389:
390:
391: @@ -67,19 +68,17 @@ lac_extproc_register(lenv_t *env, const char *sym, lac_function_t f)
392: * Exception handling.
393: */
394:
395: -__thread
396: -struct _lac_xcpt *_lac_xcpt;
397: -__thread
398: -char *_lac_xcpt_msg;
399: -__thread
400: -lreg_t _lac_xcpt_reg;
401: +__thread struct _lac_xcpt *_lac_xcpt;
402: +__thread char *_lac_xcpt_msg;
403: +__thread lreg_t _lac_xcpt_reg;
404:
405: -inline void raise_exception(char *arg, lreg_t errlr)
406: +inline void
407: +raise_exception (char *arg, lreg_t errlr)
408: {
409:
410: - _lac_xcpt_msg = arg;
411: - _lac_xcpt_reg = errlr;
412: - _throw();
413: + _lac_xcpt_msg = arg;
414: + _lac_xcpt_reg = errlr;
415: + _throw ();
416: }
417:
418: /*
419: @@ -89,15 +88,17 @@ inline void raise_exception(char *arg, lreg_t errlr)
420: static sigset_t mainsigset;
421: static char extra_stack[16384];
422:
423: -static void stackovf_continuation(void *arg1, void *arg2, void *arg3)
424: +static void
425: +stackovf_continuation (void *arg1, void *arg2, void *arg3)
426: {
427: - raise_exception(arg1, NIL);
428: + raise_exception (arg1, NIL);
429: }
430:
431: -static void stackovf_handler()
432: +static void
433: +stackovf_handler ()
434: {
435: - sigprocmask(SIG_SETMASK, &mainsigset, NULL);
436: - sigsegv_leave_handler(stackovf_continuation, "STACK OVERFLOW", NULL, NULL);
437: + sigprocmask (SIG_SETMASK, &mainsigset, NULL);
438: + sigsegv_leave_handler (stackovf_continuation, "STACK OVERFLOW", NULL, NULL);
439: }
440:
441:
442: @@ -106,25 +107,27 @@ static void stackovf_handler()
443: */
444:
445: /* Get symbol from string and intern it if new. */
446: -lreg_t intern_symbol(char *s)
447: + lreg_t
448: +intern_symbol (char *s)
449: {
450: - ENTRY e = { .key = s }, *r;
451: + ENTRY e = {.key = s }, *r;
452:
453: /* Assert that the char pointer is actually aligned. If not it means
454: that we're interning a symbol from a string not allocated by the
455: GC, and this is against the code rules of this thing. */
456: - assert(((uintptr_t)s & LREG_TYPE_MASK) == 0);
457: + assert (((uintptr_t) s & LREG_TYPE_MASK) == 0);
458:
459: - r = hsearch(e, ENTER);
460: - return lreg_raw(lreg_raw_ptr((lreg_t)r->key),LREG_SYMBOL);
461: + r = hsearch (e, ENTER);
462: + return lreg_raw (lreg_raw_ptr ((lreg_t) r->key), LREG_SYMBOL);
463: }
464:
465: -lreg_t cons(lreg_t a, lreg_t d)
466: +lreg_t
467: +cons (lreg_t a, lreg_t d)
468: {
469: - struct cons *c = GC_malloc(sizeof(struct cons));
470: + struct cons *c = GC_malloc (sizeof (struct cons));
471: c->a = a;
472: c->d = d;
473: - return lreg_raw(c, LREG_CONS);
474: + return lreg_raw (c, LREG_CONS);
475: }
476:
477:
478: @@ -133,197 +136,223 @@ lreg_t cons(lreg_t a, lreg_t d)
479: */
480:
481:
482: -lreg_t evargs(lreg_t list, lenv_t *env)
483: +lreg_t
484: +evargs (lreg_t list, lenv_t * env)
485: {
486: - lreg_t tmp, head=NIL, tail=NIL;
487: + lreg_t tmp, head = NIL, tail = NIL;
488:
489: - while (is_cons(list)) {
490: - tmp = cons(eval(car(list), env), NIL);
491: - if (head != NIL) {
492: - rplacd(tail, tmp);
493: - tail = cdr(tail);
494: - } else {
495: - head = tmp;
496: - tail = head;
497: + while (is_cons (list))
498: + {
499: + tmp = cons (eval (car (list), env), NIL);
500: + if (head != NIL)
501: + {
502: + rplacd (tail, tmp);
503: + tail = cdr (tail);
504: + }
505: + else
506: + {
507: + head = tmp;
508: + tail = head;
509: + }
510: + list = cdr (list);
511: }
512: - list = cdr(list);
513: - }
514:
515: if (list != NIL)
516: {
517: - raise_exception("evargs: invalid arguments", list);
518: + raise_exception ("evargs: invalid arguments", list);
519: head = NIL;
520: }
521: return head;
522: }
523:
524: static void
525: -evbind(lreg_t binds, lreg_t args, lenv_t *argenv, lenv_t *env)
526: +evbind (lreg_t binds, lreg_t args, lenv_t * argenv, lenv_t * env)
527: {
528: lreg_t arg;
529:
530: - while (is_cons(binds) && is_cons(args)) {
531: - if (car(binds) == sym_rest)
532: - break;
533: - arg = car(args);
534: - if (argenv)
535: - arg = eval(arg, argenv);
536: - env_define(env, car(binds), arg);
537: - binds = cdr(binds);
538: - args = cdr(args);
539: - }
540: -
541: - if (car(binds) == sym_rest) {
542: - binds = cdr(binds);
543: - arg = args;
544: - if (argenv)
545: - arg = evargs(arg, argenv);
546: - env_define(env, car(binds), arg);
547: - binds = cdr(binds);
548: - args = NIL;
549: - }
550: -
551: - if (is_cons(binds))
552: - raise_exception("Undefined bindings", binds);
553: -
554: - if (is_cons(args))
555: - raise_exception("Too many arguments", args);
556: + while (is_cons (binds) && is_cons (args))
557: + {
558: + if (car (binds) == sym_rest)
559: + break;
560: + arg = car (args);
561: + if (argenv)
562: + arg = eval (arg, argenv);
563: + env_define (env, car (binds), arg);
564: + binds = cdr (binds);
565: + args = cdr (args);
566: + }
567: +
568: + if (car (binds) == sym_rest)
569: + {
570: + binds = cdr (binds);
571: + arg = args;
572: + if (argenv)
573: + arg = evargs (arg, argenv);
574: + env_define (env, car (binds), arg);
575: + binds = cdr (binds);
576: + args = NIL;
577: + }
578: +
579: + if (is_cons (binds))
580: + raise_exception ("Undefined bindings", binds);
581: +
582: + if (is_cons (args))
583: + raise_exception ("Too many arguments", args);
584: }
585:
586: lreg_t
587: -apply(lreg_t proc, lreg_t args, lenv_t *env)
588: +apply (lreg_t proc, lreg_t args, lenv_t * env)
589: {
590: - return eval(cons(sym_apply, cons(proc, cons(args, NIL))), env);
591: + return eval (cons (sym_apply, cons (proc, cons (args, NIL))), env);
592: }
593:
594: static __thread int in_tco = 0;
595:
596: -lreg_t eval(lreg_t sexp, lenv_t *env)
597: +lreg_t
598: +eval (lreg_t sexp, lenv_t * env)
599: {
600: lreg_t ans;
601: unsigned type;
602: lenv_t *cloenv;
603: lenv_t *tenvs[2] = { NULL, NULL };
604:
605: - tco:
606: - switch (lreg_raw_type(sexp))
607: +tco:
608: + switch (lreg_raw_type (sexp))
609: {
610: case LREG_SYMBOL:
611: - ans = env_lookup(env, sexp);
612: + ans = env_lookup (env, sexp);
613: break;
614: - case LREG_CONS: {
615: - lreg_t proc = car(sexp), args = cdr(sexp);
616: - lenv_t *penv, *argenv;
617: -
618: - ans = NIL;
619: - /* COND: embedded procedure */
620: - if (proc == sym_cond) {
621: - lreg_t cond = NIL;
622: - lreg_t next, test, body;
623: -
624: - body = NIL; /* Default return */
625: - while ( args != NIL ) {
626: - test = car(args);
627: - if ( !is_cons(test) )
628: - _ERROR_AND_RET("Syntax error in cond");
629: - cond = eval(car(test), env);
630: - /* Lisp-specific! Scheme (as for R5RS) checks for #t,
631: - * though guile doesn't. */
632: - if ( cond == NIL ) {
633: - args = cdr(args);
634: - continue;
635: - }
636: - body = cdr(test);
637: - break;
638: + case LREG_CONS:
639: + {
640: + lreg_t proc = car (sexp), args = cdr (sexp);
641: + lenv_t *penv, *argenv;
642: +
643: + ans = NIL;
644: + /* COND: embedded procedure */
645: + if (proc == sym_cond)
646: + {
647: + lreg_t cond = NIL;
648: + lreg_t next, test, body;
649: +
650: + body = NIL; /* Default return */
651: + while (args != NIL)
652: + {
653: + test = car (args);
654: + if (!is_cons (test))
655: + _ERROR_AND_RET ("Syntax error in cond");
656: + cond = eval (car (test), env);
657: + /* Lisp-specific! Scheme (as for R5RS) checks for #t,
658: + * though guile doesn't. */
659: + if (cond == NIL)
660: + {
661: + args = cdr (args);
662: + continue;
663: + }
664: + body = cdr (test);
665: + break;
666: }
667: - if (body == NIL)
668: - return cond;
669: - next = cdr(body);
670: - while(next != NIL) {
671: - eval(car(body), env);
672: + if (body == NIL)
673: + return cond;
674: + next = cdr (body);
675: + while (next != NIL)
676: + {
677: + eval (car (body), env);
678: body = next;
679: - next = cdr(next);
680: + next = cdr (next);
681: }
682: - if (in_tco) {
683: - sexp = car(body);
684: - /* env unchanged */
685: - goto tco;
686: + if (in_tco)
687: + {
688: + sexp = car (body);
689: + /* env unchanged */
690: + goto tco;
691: }
692: - in_tco = 1;
693: - ans = eval(car(body), env);
694: - in_tco = 0;
695: - break;
696: - } else if (proc == sym_apply) {
697: - proc = car(args);
698: - args = eval(car(cdr(args)), env);;
699: - argenv = NULL;
700: - goto _apply;
701: - } else {
702: - lreg_t lproc, binds, body, next;
703: -
704: - argenv = env;
705: - _apply:
706: - proc = eval(proc, env);
707: - type = lreg_raw_type(proc);
708: - if (type == LREG_LLPROC)
709: - return lreg_to_llproc(proc)(args, argenv, env);
710: - if (type != LREG_MACRO && type != LREG_LAMBDA) {
711: - raise_exception("not a procedure", proc);
712: - return NIL;
713: + in_tco = 1;
714: + ans = eval (car (body), env);
715: + in_tco = 0;
716: + break;
717: + }
718: + else if (proc == sym_apply)
719: + {
720: + proc = car (args);
721: + args = eval (car (cdr (args)), env);;
722: + argenv = NULL;
723: + goto _apply;
724: + }
725: + else
726: + {
727: + lreg_t lproc, binds, body, next;
728: +
729: + argenv = env;
730: + _apply:
731: + proc = eval (proc, env);
732: + type = lreg_raw_type (proc);
733: + if (type == LREG_LLPROC)
734: + return lreg_to_llproc (proc) (args, argenv, env);
735: + if (type != LREG_MACRO && type != LREG_LAMBDA)
736: + {
737: + raise_exception ("not a procedure", proc);
738: + return NIL;
739: }
740: - lproc = get_closure_proc(proc);
741: - binds = get_proc_binds(lproc);
742: - body = get_proc_body(lproc);
743: -
744: - if (tenvs[0] == NULL) {
745: - tenvs[0] = alloca(sizeof(lenv_t));
746: - cloenv = tenvs[0];
747: + lproc = get_closure_proc (proc);
748: + binds = get_proc_binds (lproc);
749: + body = get_proc_body (lproc);
750: +
751: + if (tenvs[0] == NULL)
752: + {
753: + tenvs[0] = alloca (sizeof (lenv_t));
754: + cloenv = tenvs[0];
755: }
756: - if (type == LREG_MACRO) {
757: - penv = NULL;
758: - } else
759: - penv = argenv;
760: -
761: - env_pushnew(get_closure_env(proc), cloenv);
762: - evbind(binds, args, penv, cloenv);
763: - next = cdr(body);
764: - while (body != NIL) {
765: - if (next == NIL && type == LREG_LAMBDA && in_tco) {
766: - lenv_t *t;
767: -
768: - if (tenvs[1] == NULL) {
769: - tenvs[1] = alloca(sizeof(lenv_t));
770: - env = tenvs[1];
771: - }
772: - /* Swap ENV */
773: - t = env;
774: - env = cloenv;
775: - cloenv = t;
776: - sexp = car(body);
777: - goto tco;
778: + if (type == LREG_MACRO)
779: + {
780: + penv = NULL;
781: + }
782: + else
783: + penv = argenv;
784: +
785: + env_pushnew (get_closure_env (proc), cloenv);
786: + evbind (binds, args, penv, cloenv);
787: + next = cdr (body);
788: + while (body != NIL)
789: + {
790: + if (next == NIL && type == LREG_LAMBDA && in_tco)
791: + {
792: + lenv_t *t;
793: +
794: + if (tenvs[1] == NULL)
795: + {
796: + tenvs[1] = alloca (sizeof (lenv_t));
797: + env = tenvs[1];
798: }
799: - in_tco = 1;
800: - ans = eval(car(body), cloenv);
801: - in_tco = 0;
802: + /* Swap ENV */
803: + t = env;
804: + env = cloenv;
805: + cloenv = t;
806: + sexp = car (body);
807: + goto tco;
808: + }
809: + in_tco = 1;
810: + ans = eval (car (body), cloenv);
811: + in_tco = 0;
812:
813: - body = next;
814: - next = cdr(next);
815: - }
816: - if (type == LREG_LAMBDA)
817: - break;
818: - if (in_tco) {
819: - /* Macro expand hook? */
820: - sexp = ans;
821: - /* env unchanged */
822: - goto tco;
823: + body = next;
824: + next = cdr (next);
825: }
826: - in_tco = 1;
827: - ans = eval(ans, env);
828: - in_tco = 0;
829: + if (type == LREG_LAMBDA)
830: break;
831: + if (in_tco)
832: + {
833: + /* Macro expand hook? */
834: + sexp = ans;
835: + /* env unchanged */
836: + goto tco;
837: + }
838: + in_tco = 1;
839: + ans = eval (ans, env);
840: + in_tco = 0;
841: + break;
842: + }
843: + break;
844: }
845: - break;
846: - }
847: default:
848: ans = sexp;
849: break;
850: @@ -337,86 +366,89 @@ lreg_t eval(lreg_t sexp, lenv_t *env)
851: */
852:
853: /* Special Form */
854: -LAC_API static lreg_t proc_quote(lreg_t args, lenv_t *argenv, lenv_t *env)
855: +LAC_API static lreg_t
856: +proc_quote (lreg_t args, lenv_t * argenv, lenv_t * env)
857: {
858: - _EXPECT_ARGS(args, 1);
859: - return car(args);
860: + _EXPECT_ARGS (args, 1);
861: + return car (args);
862: }
863:
864: -static void _qquote(lreg_t sexp, lenv_t *env, lreg_t *first, lreg_t *last, int nested)
865: +static void
866: +_qquote (lreg_t sexp, lenv_t * env, lreg_t * first, lreg_t * last, int nested)
867: {
868: - switch ( lreg_raw_type(sexp) )
869: + switch (lreg_raw_type (sexp))
870: {
871: case LREG_CONS:
872: - if ( car(sexp) == sym_quasiquote )
873: + if (car (sexp) == sym_quasiquote)
874: {
875: lreg_t qqd;
876: - _qquote(cdr(sexp), env, &qqd, NULL, nested+1);
877: - *first = cons(sym_quasiquote, qqd);
878: + _qquote (cdr (sexp), env, &qqd, NULL, nested + 1);
879: + *first = cons (sym_quasiquote, qqd);
880: }
881: - else if ( (car(sexp) == sym_unquote) )
882: + else if ((car (sexp) == sym_unquote))
883: {
884: - if ( nested == 0 )
885: - *first = eval(car(cdr(sexp)), env);
886: + if (nested == 0)
887: + *first = eval (car (cdr (sexp)), env);
888: else
889: {
890: lreg_t qqd;
891: - _qquote(cdr(sexp), env, &qqd, NULL, nested - 1);
892: - *first = cons(sym_unquote, qqd);
893: + _qquote (cdr (sexp), env, &qqd, NULL, nested - 1);
894: + *first = cons (sym_unquote, qqd);
895: }
896: }
897: - else if ( car(sexp) == sym_splice )
898: + else if (car (sexp) == sym_splice)
899: {
900: - if ( nested == 0 )
901: + if (nested == 0)
902: {
903: lreg_t tosplice;
904:
905: - if ( last == NULL )
906: - raise_exception("SPLICE expected on car only.", NIL);
907: -
908: - tosplice = eval(car(cdr(sexp)), env);
909: - switch( lreg_raw_type (tosplice) )
910: + if (last == NULL)
911: + raise_exception ("SPLICE expected on car only.", NIL);
912: +
913: + tosplice = eval (car (cdr (sexp)), env);
914: + switch (lreg_raw_type (tosplice))
915: {
916: lreg_t tail = NIL;
917: case LREG_CONS:
918: *first = tail = tosplice;
919: - for ( ; tosplice != NIL && is_cons(cdr(tosplice));
920: - tosplice = cdr(tosplice) );
921: + for (; tosplice != NIL && is_cons (cdr (tosplice));
922: + tosplice = cdr (tosplice));
923: *last = tosplice;
924: break;
925:
926: default:
927: *first = tosplice;
928: - *last = cons(NIL,NIL);
929: + *last = cons (NIL, NIL);
930: break;
931: }
932: }
933: else
934: {
935: lreg_t qqd;
936: - _qquote(cdr(sexp), env, &qqd, NULL, nested - 1);
937: - *first = cons(sym_splice, qqd);
938: + _qquote (cdr (sexp), env, &qqd, NULL, nested - 1);
939: + *first = cons (sym_splice, qqd);
940: }
941: }
942: else
943: {
944: lreg_t qqa, qqd, qqalast = NIL;
945:
946: - _qquote(car(sexp), env, &qqa, &qqalast, nested);
947: - _qquote(cdr(sexp), env, &qqd, NULL, nested);
948: + _qquote (car (sexp), env, &qqa, &qqalast, nested);
949: + _qquote (cdr (sexp), env, &qqd, NULL, nested);
950:
951: - if ( qqalast != NIL )
952: + if (qqalast != NIL)
953: {
954: - if ( cdr(qqalast) == NIL )
955: - rplacd(qqalast, qqd);
956: - else if ( qqd != NIL )
957: - raise_exception("Dotted pairs in spliced list can be"
958: - " present only when splicing is at end of a list.", qqd);
959: + if (cdr (qqalast) == NIL)
960: + rplacd (qqalast, qqd);
961: + else if (qqd != NIL)
962: + raise_exception ("Dotted pairs in spliced list can be"
963: + " present only when splicing is at end of a list.",
964: + qqd);
965:
966: *first = qqa;
967: }
968: else
969: - *first = cons(qqa, qqd);
970: + *first = cons (qqa, qqd);
971: }
972: break;
973: default:
974: @@ -425,261 +457,277 @@ static void _qquote(lreg_t sexp, lenv_t *env, lreg_t *first, lreg_t *last, int n
975: }
976:
977: /* Special Form */
978: -LAC_API static lreg_t proc_quasiquote(lreg_t args, lenv_t *argenv, lenv_t *env)
979: +LAC_API static lreg_t
980: +proc_quasiquote (lreg_t args, lenv_t * argenv, lenv_t * env)
981: {
982: lreg_t ret;
983: - _EXPECT_ARGS(args, 1);
984: - _qquote(car(args), env, &ret, NULL, 0);
985: + _EXPECT_ARGS (args, 1);
986: + _qquote (car (args), env, &ret, NULL, 0);
987: return ret;
988: }
989:
990: -LAC_API static lreg_t proc_car(lreg_t args, lenv_t *argenv, lenv_t *env)
991: +LAC_API static lreg_t
992: +proc_car (lreg_t args, lenv_t * argenv, lenv_t * env)
993: {
994: - _EXPECT_ARGS(args, 1);
995: - lreg_t arg1 = ARGEVAL(car(args), argenv);
996: + _EXPECT_ARGS (args, 1);
997: + lreg_t arg1 = ARGEVAL (car (args), argenv);
998:
999: /* Lisp-specific! */
1000: if (arg1 == NIL)
1001: return NIL;
1002:
1003: - if ( !is_cons(arg1) )
1004: - _ERROR_AND_RET("argument is not cons");
1005: -
1006: - return car(arg1);
1007: + if (!is_cons (arg1))
1008: + _ERROR_AND_RET ("argument is not cons");
1009: +
1010: + return car (arg1);
1011: }
1012:
1013: -LAC_API static lreg_t proc_cdr(lreg_t args, lenv_t *argenv, lenv_t *env)
1014: +LAC_API static lreg_t
1015: +proc_cdr (lreg_t args, lenv_t * argenv, lenv_t * env)
1016: {
1017: - _EXPECT_ARGS(args, 1);
1018: - lreg_t arg1 = ARGEVAL(car(args), argenv);
1019: + _EXPECT_ARGS (args, 1);
1020: + lreg_t arg1 = ARGEVAL (car (args), argenv);
1021:
1022: /* Lisp-specific!
1023: If I really want to keep this spec I should change cdr() and
1024: car() to return NIL on NIL and remove these checks. */
1025: if (arg1 == NIL)
1026: - return NIL;
1027: + return NIL;
1028:
1029: - if (!is_cons(arg1))
1030: - _ERROR_AND_RET("argument is not cons");
1031: + if (!is_cons (arg1))
1032: + _ERROR_AND_RET ("argument is not cons");
1033:
1034: - return cdr(arg1);
1035: + return cdr (arg1);
1036: }
1037:
1038: -LAC_API static lreg_t proc_cons(lreg_t args, lenv_t *argenv, lenv_t *env)
1039: +LAC_API static lreg_t
1040: +proc_cons (lreg_t args, lenv_t * argenv, lenv_t * env)
1041: {
1042: - _EXPECT_ARGS(args, 2);
1043: - lreg_t arg1 = ARGEVAL(car(args), argenv);
1044: - lreg_t arg2 = ARGEVAL(car(cdr(args)), argenv);
1045: + _EXPECT_ARGS (args, 2);
1046: + lreg_t arg1 = ARGEVAL (car (args), argenv);
1047: + lreg_t arg2 = ARGEVAL (car (cdr (args)), argenv);
1048:
1049: - return cons(arg1, arg2);
1050: + return cons (arg1, arg2);
1051: }
1052:
1053: -LAC_API static lreg_t proc_rplaca(lreg_t args, lenv_t *argenv, lenv_t *env)
1054: +LAC_API static lreg_t
1055: +proc_rplaca (lreg_t args, lenv_t * argenv, lenv_t * env)
1056: {
1057: - _EXPECT_ARGS(args, 2);
1058: - lreg_t arg1 = ARGEVAL(car(args), argenv);
1059: - lreg_t arg2 = ARGEVAL(car(cdr(args)), argenv);
1060: + _EXPECT_ARGS (args, 2);
1061: + lreg_t arg1 = ARGEVAL (car (args), argenv);
1062: + lreg_t arg2 = ARGEVAL (car (cdr (args)), argenv);
1063:
1064: - if ( !is_cons(arg1) )
1065: - _ERROR_AND_RET("argument is not cons");
1066: + if (!is_cons (arg1))
1067: + _ERROR_AND_RET ("argument is not cons");
1068:
1069: - rplaca(arg1, arg2);
1070: + rplaca (arg1, arg2);
1071: return arg1;
1072: }
1073:
1074: -LAC_API static lreg_t proc_rplacd(lreg_t args, lenv_t *argenv, lenv_t *env)
1075: +LAC_API static lreg_t
1076: +proc_rplacd (lreg_t args, lenv_t * argenv, lenv_t * env)
1077: {
1078: - _EXPECT_ARGS(args, 2);
1079: - lreg_t arg1 = ARGEVAL(car(args), argenv);
1080: - lreg_t arg2 = ARGEVAL(car(cdr(args)), argenv);
1081: + _EXPECT_ARGS (args, 2);
1082: + lreg_t arg1 = ARGEVAL (car (args), argenv);
1083: + lreg_t arg2 = ARGEVAL (car (cdr (args)), argenv);
1084:
1085: - if ( !is_cons(arg1) )
1086: - _ERROR_AND_RET("argument is not cons");
1087: + if (!is_cons (arg1))
1088: + _ERROR_AND_RET ("argument is not cons");
1089:
1090: - rplacd(arg1, arg2);
1091: + rplacd (arg1, arg2);
1092: return arg1;
1093: }
1094:
1095: -LAC_API static lreg_t proc_eq(lreg_t args, lenv_t *argenv, lenv_t *env)
1096: +LAC_API static lreg_t
1097: +proc_eq (lreg_t args, lenv_t * argenv, lenv_t * env)
1098: {
1099: - _EXPECT_ARGS(args, 2);
1100: - lreg_t arg1 = ARGEVAL(car(args), argenv);
1101: - lreg_t arg2 = ARGEVAL(car(cdr(args)), argenv);
1102: + _EXPECT_ARGS (args, 2);
1103: + lreg_t arg1 = ARGEVAL (car (args), argenv);
1104: + lreg_t arg2 = ARGEVAL (car (cdr (args)), argenv);
1105:
1106: - return (lreg_type(arg1) == lreg_type(arg2)
1107: - && lreg_ptr(arg1) == lreg_ptr(arg2)) ? sym_true : sym_false;
1108: + return (lreg_type (arg1) == lreg_type (arg2)
1109: + && lreg_ptr (arg1) == lreg_ptr (arg2)) ? sym_true : sym_false;
1110: }
1111:
1112: -LAC_API static lreg_t proc_atom_equal(lreg_t args, lenv_t *argenv, lenv_t *env)
1113: +LAC_API static lreg_t
1114: +proc_atom_equal (lreg_t args, lenv_t * argenv, lenv_t * env)
1115: {
1116: - _EXPECT_ARGS(args, 2);
1117: - lreg_t arg1 = ARGEVAL(car(args), argenv);
1118: - lreg_t arg2 = ARGEVAL(car(cdr(args)), argenv);
1119: - int rc = 0;
1120: + _EXPECT_ARGS (args, 2);
1121: + lreg_t arg1 = ARGEVAL (car (args), argenv);
1122: + lreg_t arg2 = ARGEVAL (car (cdr (args)), argenv);
1123: + int rc = 0;
1124:
1125: - if (lreg_type(arg1) != lreg_type(arg2))
1126: - raise_exception("types mismatch", cons(arg1, arg2));
1127: + if (lreg_type (arg1) != lreg_type (arg2))
1128: + raise_exception ("types mismatch", cons (arg1, arg2));
1129:
1130: - switch(lreg_raw_type(arg1)) {
1131: - case LREG_NIL:
1132: - rc = 1;
1133: - break;
1134: - case LREG_LLPROC:
1135: - case LREG_LAMBDA:
1136: - case LREG_MACRO:
1137: - case LREG_SYMBOL:
1138: - rc = lreg_raw_ptr(arg1) == lreg_raw_ptr(arg2);
1139: - break;
1140: - case LREG_STRING:
1141: - rc = !strcmp(lreg_raw_ptr(arg1), lreg_raw_ptr(arg2));
1142: - break;
1143: - case LREG_EXTT:
1144: - rc = lacint_extty_equal(arg1, arg2);
1145: - break;
1146: - default:
1147: - raise_exception("not an atom", arg1);
1148: - }
1149: + switch (lreg_raw_type (arg1))
1150: + {
1151: + case LREG_NIL:
1152: + rc = 1;
1153: + break;
1154: + case LREG_LLPROC:
1155: + case LREG_LAMBDA:
1156: + case LREG_MACRO:
1157: + case LREG_SYMBOL:
1158: + rc = lreg_raw_ptr (arg1) == lreg_raw_ptr (arg2);
1159: + break;
1160: + case LREG_STRING:
1161: + rc = !strcmp (lreg_raw_ptr (arg1), lreg_raw_ptr (arg2));
1162: + break;
1163: + case LREG_EXTT:
1164: + rc = lacint_extty_equal (arg1, arg2);
1165: + break;
1166: + default:
1167: + raise_exception ("not an atom", arg1);
1168: + }
1169:
1170: - return rc ? sym_true : sym_false;
1171: + return rc ? sym_true : sym_false;
1172: }
1173:
1174: /* Special Form */
1175: -LAC_API static lreg_t proc_labels(lreg_t args, lenv_t *argenv, lenv_t *env)
1176: +LAC_API static lreg_t
1177: +proc_labels (lreg_t args, lenv_t * argenv, lenv_t * env)
1178: {
1179: /* At least 3 arguments required. */
1180: - _EXPECT_MIN_ARGS(args, 3);
1181: + _EXPECT_MIN_ARGS (args, 3);
1182: lreg_t ret;
1183: - lreg_t lbl = car(args);
1184: - lreg_t binds = car(cdr(args));
1185: - lenv_t *penv = GC_malloc(sizeof(lenv_t));
1186: -
1187: - if ( !is_cons(binds) && binds != NIL )
1188: - _ERROR_AND_RET("Syntax error in labels");
1189: -
1190: - env_pushnew(env, penv);
1191: - ret = lreg_raw(lreg_raw_ptr(cons(cdr(args), lreg_raw(penv, LREG_NIL))), LREG_LAMBDA);
1192: - env_define(penv, lbl, ret);
1193: + lreg_t lbl = car (args);
1194: + lreg_t binds = car (cdr (args));
1195: + lenv_t *penv = GC_malloc (sizeof (lenv_t));
1196: +
1197: + if (!is_cons (binds) && binds != NIL)
1198: + _ERROR_AND_RET ("Syntax error in labels");
1199: +
1200: + env_pushnew (env, penv);
1201: + ret =
1202: + lreg_raw (lreg_raw_ptr (cons (cdr (args), lreg_raw (penv, LREG_NIL))),
1203: + LREG_LAMBDA);
1204: + env_define (penv, lbl, ret);
1205: return ret;
1206: }
1207:
1208: /* Special Form */
1209: -LAC_API static lreg_t proc_lambda(lreg_t args, lenv_t *argenv, lenv_t *env)
1210: +LAC_API static lreg_t
1211: +proc_lambda (lreg_t args, lenv_t * argenv, lenv_t * env)
1212: {
1213: /* At least 2 arguments required. */
1214: - _EXPECT_MIN_ARGS(args, 2);
1215: - lreg_t binds = car(args);
1216: - lenv_t *penv = GC_malloc(sizeof(lenv_t));
1217: + _EXPECT_MIN_ARGS (args, 2);
1218: + lreg_t binds = car (args);
1219: + lenv_t *penv = GC_malloc (sizeof (lenv_t));
1220:
1221: - if ( !is_cons(binds) && binds != NIL )
1222: - _ERROR_AND_RET("Syntax error in lambda");
1223: + if (!is_cons (binds) && binds != NIL)
1224: + _ERROR_AND_RET ("Syntax error in lambda");
1225:
1226: - env_pushnew(env, penv);
1227: - return lreg_raw(lreg_raw_ptr(cons(args, lreg_raw(penv, LREG_NIL))), LREG_LAMBDA);
1228: + env_pushnew (env, penv);
1229: + return lreg_raw (lreg_raw_ptr (cons (args, lreg_raw (penv, LREG_NIL))),
1230: + LREG_LAMBDA);
1231: }
1232:
1233: /* Special Form */
1234: -LAC_API static lreg_t proc_macro(lreg_t args, lenv_t *argenv, lenv_t *env)
1235: +LAC_API static lreg_t
1236: +proc_macro (lreg_t args, lenv_t * argenv, lenv_t * env)
1237: {
1238: /* At least 2 arguments required. */
1239: - _EXPECT_MIN_ARGS(args, 2);
1240: - lreg_t binds = car(args);
1241: - lenv_t *penv = GC_malloc(sizeof(lenv_t));
1242: + _EXPECT_MIN_ARGS (args, 2);
1243: + lreg_t binds = car (args);
1244: + lenv_t *penv = GC_malloc (sizeof (lenv_t));
1245:
1246: - if ( !is_cons(binds) && binds != NIL )
1247: - _ERROR_AND_RET("Syntax error in macro");
1248: + if (!is_cons (binds) && binds != NIL)
1249: + _ERROR_AND_RET ("Syntax error in macro");
1250:
1251: - env_pushnew(env, penv);
1252: - return lreg_raw(lreg_raw_ptr(cons(args, lreg_raw(penv, LREG_NIL))), LREG_MACRO);
1253: + env_pushnew (env, penv);
1254: + return lreg_raw (lreg_raw_ptr (cons (args, lreg_raw (penv, LREG_NIL))),
1255: + LREG_MACRO);
1256: }
1257:
1258: /* Special Form */
1259: -LAC_API static lreg_t proc_define(lreg_t args, lenv_t *argenv, lenv_t *env)
1260: +LAC_API static lreg_t
1261: +proc_define (lreg_t args, lenv_t * argenv, lenv_t * env)
1262: {
1263: lreg_t defd;
1264: - _EXPECT_ARGS(args, 2);
1265: + _EXPECT_ARGS (args, 2);
1266:
1267: - if ( !is_symbol(car(args)) )
1268: - _ERROR_AND_RET("Syntax error in define");
1269: + if (!is_symbol (car (args)))
1270: + _ERROR_AND_RET ("Syntax error in define");
1271:
1272: - defd = eval(car(cdr(args)), env);
1273: - env_define(env, car(args), defd);
1274: + defd = eval (car (cdr (args)), env);
1275: + env_define (env, car (args), defd);
1276: return defd;
1277: }
1278:
1279: -LAC_API static lreg_t proc_set(lreg_t args, lenv_t *argenv, lenv_t *env)
1280: +LAC_API static lreg_t
1281: +proc_set (lreg_t args, lenv_t * argenv, lenv_t * env)
1282: {
1283: int r;
1284: - _EXPECT_ARGS(args, 2);
1285: - lreg_t arg1 = ARGEVAL(car(args), argenv);
1286: - lreg_t arg2 = ARGEVAL(car(cdr(args)), argenv);
1287: + _EXPECT_ARGS (args, 2);
1288: + lreg_t arg1 = ARGEVAL (car (args), argenv);
1289: + lreg_t arg2 = ARGEVAL (car (cdr (args)), argenv);
1290:
1291: - if ( !is_symbol(arg1) )
1292: - _ERROR_AND_RET("Syntax error in set");
1293: + if (!is_symbol (arg1))
1294: + _ERROR_AND_RET ("Syntax error in set");
1295:
1296: - r = env_set(env, arg1, arg2);
1297: - if ( r < 0 )
1298: - raise_exception("Error while setting env.", NIL);
1299: + r = env_set (env, arg1, arg2);
1300: + if (r < 0)
1301: + raise_exception ("Error while setting env.", NIL);
1302:
1303: - if ( r == 0 )
1304: + if (r == 0)
1305: return arg2;
1306:
1307: /* Not defined */
1308: return NIL;
1309: }
1310:
1311: -LAC_DEFINE_TYPE_PFUNC(cons, LREG_CONS);
1312: -LAC_DEFINE_TYPE_PFUNC(symbol, LREG_SYMBOL);
1313: +LAC_DEFINE_TYPE_PFUNC (cons, LREG_CONS);
1314: +LAC_DEFINE_TYPE_PFUNC (symbol, LREG_SYMBOL);
1315:
1316: -LAC_API static lreg_t proc_gensym(lreg_t args, lenv_t *argenv, lenv_t *env)
1317: +LAC_API static lreg_t
1318: +proc_gensym (lreg_t args, lenv_t * argenv, lenv_t * env)
1319: {
1320: - #define GENSYM "#GSYM"
1321: +#define GENSYM "#GSYM"
1322: static int id = 0;
1323: int len;
1324: lreg_t ret;
1325: char *s, *s1;
1326: - _EXPECT_ARGS(args, 0);
1327: - asprintf(&s1, "%s-%08x", GENSYM, id);
1328: - len = strlen(s1);
1329: - s = GC_malloc(len);
1330: - memcpy(s, s1, len);
1331: - free(s1);
1332: - ret = intern_symbol(s);
1333: + _EXPECT_ARGS (args, 0);
1334: + asprintf (&s1, "%s-%08x", GENSYM, id);
1335: + len = strlen (s1);
1336: + s = GC_malloc (len);
1337: + memcpy (s, s1, len);
1338: + free (s1);
1339: + ret = intern_symbol (s);
1340: id++;
1341: return ret;
1342: }
1343:
1344: -LAC_API static lreg_t proc_load(lreg_t args, lenv_t *argenv, lenv_t *env)
1345: +LAC_API static lreg_t
1346: +proc_load (lreg_t args, lenv_t * argenv, lenv_t * env)
1347: {
1348: FILE *f;
1349: char *file;
1350: lreg_t arg1;
1351: - _EXPECT_ARGS(args, 1);
1352: -
1353: - arg1 = ARGEVAL(car(args), argenv);
1354: - if ( lreg_type(arg1) != LREG_STRING )
1355: - _ERROR_AND_RET("Syntax error in load");
1356: + _EXPECT_ARGS (args, 1);
1357:
1358: - file = (char *)lreg_raw_ptr(arg1);
1359: - f = fopen((char *)file, "r");
1360: - if ( f == NULL )
1361: - _ERROR_AND_RET("Could not open file");
1362: + arg1 = ARGEVAL (car (args), argenv);
1363: + if (lreg_type (arg1) != LREG_STRING)
1364: + _ERROR_AND_RET ("Syntax error in load");
1365:
1366: - lac_on_error({
1367: - _throw(); /* rethrow */
1368: - });
1369: + file = (char *) lreg_raw_ptr (arg1);
1370: + f = fopen ((char *) file, "r");
1371: + if (f == NULL)
1372: + _ERROR_AND_RET ("Could not open file");
1373:
1374: - sexpr_parse_file(f, (lreg_t (*)(lreg_t, void *))eval, (void *)env);
1375: + sexpr_parse_file (f, (lreg_t (*)(lreg_t, void *)) eval, (void *) env);
1376:
1377: - lac_off_error();
1378: return sym_true;
1379: }
1380:
1381:
1382: -LAC_API static lreg_t proc_collect(lreg_t args, lenv_t *argenv, lenv_t *env)
1383: +LAC_API static lreg_t
1384: +proc_collect (lreg_t args, lenv_t * argenv, lenv_t * env)
1385: {
1386: - _EXPECT_ARGS(args, 0);
1387: + _EXPECT_ARGS (args, 0);
1388:
1389: - GC_gcollect();
1390: + GC_gcollect ();
1391: return sym_true;
1392: }
1393:
1394: @@ -688,77 +736,78 @@ LAC_API static lreg_t proc_collect(lreg_t args, lenv_t *argenv, lenv_t *env)
1395: * Initialization Functions
1396: */
1397:
1398: -static void machine_init(lenv_t *env)
1399: +static void
1400: +machine_init (lenv_t * env)
1401: {
1402: /* Init symtab. */
1403: - hcreate(500);
1404: + hcreate (500);
1405:
1406: /* Init Null Env */
1407: - memset(env, 0, sizeof(struct env));
1408: + memset (env, 0, sizeof (struct env));
1409:
1410: /* Lisp-style booleans.
1411: Can be changed into Scheme-scheme. */
1412: sym_false = NIL;
1413: - sym_true = register_symbol("T");
1414: - env_define(env, sym_true, sym_true); /* Tautology. */
1415: - sym_quote = register_symbol("QUOTE");
1416: - env_define(env, sym_quote, llproc_to_lreg(proc_quote));
1417: - sym_cond = register_symbol("COND");
1418: - sym_apply = register_symbol("APPLY");
1419: -
1420: - lac_extproc_register(env, "LAMBDA", proc_lambda);
1421: - lac_extproc_register(env, "DEFINE", proc_define);
1422: - lac_extproc_register(env, "MACRO", proc_macro);
1423: - lac_extproc_register(env, "LABELS", proc_labels);
1424: -
1425: - lac_extproc_register(env,"CONS", proc_cons);
1426: - lac_extproc_register(env,"CAR", proc_car);
1427: - lac_extproc_register(env,"CDR", proc_cdr);
1428: - lac_extproc_register(env,"RPLACA", proc_rplaca);
1429: - lac_extproc_register(env,"RPLACD", proc_rplacd);
1430: - lac_extproc_register(env,"EQ", proc_eq);
1431: - lac_extproc_register(env,"ATOM-EQUAL", proc_atom_equal);
1432: - lac_extproc_register(env,"LOAD", proc_load);
1433: - lac_extproc_register(env,"SET", proc_set);
1434: - lac_extproc_register(env,"GENSYM", proc_gensym);
1435: - lac_extproc_register(env,"CONSP", LAC_TYPE_PFUNC(cons));
1436: - lac_extproc_register(env,"SYMBOLP", LAC_TYPE_PFUNC(symbol));
1437: -
1438: - sym_quasiquote = register_symbol("QUASIQUOTE");
1439: - env_define(env, sym_quasiquote, llproc_to_lreg(proc_quasiquote));
1440: - sym_unquote = register_symbol("UNQUOTE");
1441: - sym_splice = register_symbol("SPLICE");
1442: - sym_rest = register_symbol("&REST");
1443: -
1444: - lac_extproc_register(env, "GC-COLLECT", proc_collect);
1445: + sym_true = register_symbol ("T");
1446: + env_define (env, sym_true, sym_true); /* Tautology. */
1447: + sym_quote = register_symbol ("QUOTE");
1448: + env_define (env, sym_quote, llproc_to_lreg (proc_quote));
1449: + sym_cond = register_symbol ("COND");
1450: + sym_apply = register_symbol ("APPLY");
1451: +
1452: + lac_extproc_register (env, "LAMBDA", proc_lambda);
1453: + lac_extproc_register (env, "DEFINE", proc_define);
1454: + lac_extproc_register (env, "MACRO", proc_macro);
1455: + lac_extproc_register (env, "LABELS", proc_labels);
1456: +
1457: + lac_extproc_register (env, "CONS", proc_cons);
1458: + lac_extproc_register (env, "CAR", proc_car);
1459: + lac_extproc_register (env, "CDR", proc_cdr);
1460: + lac_extproc_register (env, "RPLACA", proc_rplaca);
1461: + lac_extproc_register (env, "RPLACD", proc_rplacd);
1462: + lac_extproc_register (env, "EQ", proc_eq);
1463: + lac_extproc_register (env, "ATOM-EQUAL", proc_atom_equal);
1464: + lac_extproc_register (env, "LOAD", proc_load);
1465: + lac_extproc_register (env, "SET", proc_set);
1466: + lac_extproc_register (env, "GENSYM", proc_gensym);
1467: + lac_extproc_register (env, "CONSP", LAC_TYPE_PFUNC (cons));
1468: + lac_extproc_register (env, "SYMBOLP", LAC_TYPE_PFUNC (symbol));
1469: +
1470: + sym_quasiquote = register_symbol ("QUASIQUOTE");
1471: + env_define (env, sym_quasiquote, llproc_to_lreg (proc_quasiquote));
1472: + sym_unquote = register_symbol ("UNQUOTE");
1473: + sym_splice = register_symbol ("SPLICE");
1474: + sym_rest = register_symbol ("&REST");
1475: +
1476: + lac_extproc_register (env, "GC-COLLECT", proc_collect);
1477: }
1478:
1479:
1480: static void
1481: -modules_init(lenv_t *env)
1482: +modules_init (lenv_t * env)
1483: {
1484: - void map_init(lenv_t *env);
1485: - void int_init(lenv_t *env);
1486: - void string_init(lenv_t *env);
1487: + void map_init (lenv_t * env);
1488: + void int_init (lenv_t * env);
1489: + void string_init (lenv_t * env);
1490:
1491: - int_init(env);
1492: - string_init(env);
1493: - map_init(env);
1494: + int_init (env);
1495: + string_init (env);
1496: + map_init (env);
1497: }
1498:
1499: static void
1500: -library_init(lenv_t *env)
1501: +library_init (lenv_t * env)
1502: {
1503: - FILE *f;
1504: + FILE *f;
1505:
1506: - f = fopen("sys.lac", "r");
1507: - if ( f == NULL )
1508: - f = fopen(LAC_SYSDIR"/sys.lac", "r");
1509: - if ( f == NULL )
1510: - raise_exception("SYSTEM LIBRARY NOT FOUND", NIL);
1511: + f = fopen ("sys.lac", "r");
1512: + if (f == NULL)
1513: + f = fopen (LAC_SYSDIR "/sys.lac", "r");
1514: + if (f == NULL)
1515: + raise_exception ("SYSTEM LIBRARY NOT FOUND", NIL);
1516:
1517: - sexpr_parse_file(f, (lreg_t (*)(lreg_t, void *))eval, (void *)env);
1518: - fclose(f);
1519: + sexpr_parse_file (f, (lreg_t (*)(lreg_t, void *)) eval, (void *) env);
1520: + fclose (f);
1521: }
1522:
1523:
1524: @@ -776,34 +825,31 @@ lac_error_print (FILE * f)
1525:
1526:
1527: lenv_t *
1528: -lac_init(void)
1529: +lac_init (void)
1530: {
1531: sigset_t emptyset;
1532: lenv_t *env;
1533: - GC_init();
1534: + GC_init ();
1535:
1536: - sigemptyset(&emptyset);
1537: - sigprocmask(SIG_BLOCK, &emptyset, &mainsigset);
1538: + sigemptyset (&emptyset);
1539: + sigprocmask (SIG_BLOCK, &emptyset, &mainsigset);
1540:
1541: lac_on_error ({
1542: - lac_error_print (stderr);
1543: - return NULL;
1544: + lac_error_print (stderr); return NULL;
1545: });
1546:
1547: - stackoverflow_install_handler(stackovf_handler, extra_stack, 16384);
1548: - env = lac_envalloc();
1549: - machine_init(env);
1550: - modules_init(env);
1551: - library_init(env);
1552: - lac_off_error();
1553: + stackoverflow_install_handler (stackovf_handler, extra_stack, 16384);
1554: + env = lac_envalloc ();
1555: + machine_init (env);
1556: + modules_init (env);
1557: + library_init (env);
1558: + lac_off_error ();
1559:
1560: return env;
1561: }
1562:
1563: lenv_t *
1564: -lac_envalloc(void)
1565: +lac_envalloc (void)
1566: {
1567: - return GC_malloc(sizeof(lenv_t));
1568: + return GC_malloc (sizeof (lenv_t));
1569: }
1570: -
1571: -
1572: diff --git a/src/lib/map.c b/src/lib/map.c
1573: index 72eb5b1..54b3831 100644
1574: --- a/src/lib/map.c
1575: +++ b/src/lib/map.c
1576: @@ -24,30 +24,37 @@
1577: #define ARGEVAL(_lr, _e) ((_e) == NULL ? _lr : eval((_lr), (_e)))
1578: #define is_cons(lr) (lreg_raw_type(lr) == LREG_CONS)
1579:
1580: -static lreg_t map_args(lreg_t lists)
1581: +static lreg_t
1582: +map_args (lreg_t lists)
1583: {
1584: lreg_t args = lists;
1585: lreg_t outargs = NIL, tail = NIL;
1586:
1587: - for ( ; args != NIL ; args = cdr(args) )
1588: + for (; args != NIL; args = cdr (args))
1589: {
1590: - if ( !is_cons(args) ||
1591: - !is_cons(car(args)) )
1592: + if (!is_cons (args) || !is_cons (car (args)))
1593: {
1594: - if ( is_cons(args) && car(args) == NIL )
1595: - return NIL;
1596: - raise_exception("Syntax Error in mapcar", args);
1597: + if (is_cons (args) && car (args) == NIL)
1598: + return NIL;
1599: + raise_exception ("Syntax Error in mapcar", args);
1600: }
1601:
1602: - if ( outargs == NIL ) {
1603: - outargs = tail = cons(cons(sym_quote, cons(cons(car(car(args)), NIL), NIL)), NIL);
1604: - } else {
1605: - lreg_t tmp = cons(cons(sym_quote, cons(cons(car(car(args)), NIL), NIL)), NIL);
1606: - rplacd(tail, tmp);
1607: - tail = tmp;
1608: - }
1609: + if (outargs == NIL)
1610: + {
1611: + outargs = tail =
1612: + cons (cons (sym_quote, cons (cons (car (car (args)), NIL), NIL)),
1613: + NIL);
1614: + }
1615: + else
1616: + {
1617: + lreg_t tmp =
1618: + cons (cons (sym_quote, cons (cons (car (car (args)), NIL), NIL)),
1619: + NIL);
1620: + rplacd (tail, tmp);
1621: + tail = tmp;
1622: + }
1623:
1624: - rplaca(args, cdr(car(args)));
1625: + rplaca (args, cdr (car (args)));
1626: }
1627:
1628: return outargs;
1629: @@ -55,68 +62,74 @@ static lreg_t map_args(lreg_t lists)
1630:
1631:
1632:
1633: -LAC_API static lreg_t proc_mapcar(lreg_t args, lenv_t *argenv, lenv_t *env)
1634: +LAC_API static lreg_t
1635: +proc_mapcar (lreg_t args, lenv_t * argenv, lenv_t * env)
1636: {
1637: - _EXPECT_MIN_ARGS(args, 2);
1638: + _EXPECT_MIN_ARGS (args, 2);
1639: lreg_t mapargs;
1640: lreg_t fn, lists;
1641: lreg_t outlist = NIL, tail = NIL;
1642: - lreg_t evd = argenv == NULL ? args : evargs(args, env);
1643: - fn = car(evd);
1644: - lists = cdr(evd);
1645: + lreg_t evd = argenv == NULL ? args : evargs (args, env);
1646: + fn = car (evd);
1647: + lists = cdr (evd);
1648:
1649: - switch ( lreg_type(fn) )
1650: + switch (lreg_type (fn))
1651: {
1652: case LREG_LAMBDA:
1653: case LREG_MACRO:
1654: case LREG_LLPROC:
1655: break;
1656: default:
1657: - _ERROR_AND_RET("Syntax error in mapcar");
1658: + _ERROR_AND_RET ("Syntax error in mapcar");
1659: }
1660:
1661:
1662: for (;;)
1663: {
1664: lreg_t outelm;
1665: - mapargs = map_args(lists);
1666: - if ( mapargs == NIL )
1667: - break;
1668: - outelm = apply(fn, car(mapargs), env);
1669: -
1670: - if ( outlist == NIL ) {
1671: - outlist = tail = cons(outelm, NIL);
1672: - } else {
1673: - lreg_t tmp = cons(outelm, NIL);
1674: - rplacd(tail, tmp);
1675: - tail = tmp;
1676: - }
1677: + mapargs = map_args (lists);
1678: + if (mapargs == NIL)
1679: + break;
1680: + outelm = apply (fn, car (mapargs), env);
1681: +
1682: + if (outlist == NIL)
1683: + {
1684: + outlist = tail = cons (outelm, NIL);
1685: + }
1686: + else
1687: + {
1688: + lreg_t tmp = cons (outelm, NIL);
1689: + rplacd (tail, tmp);
1690: + tail = tmp;
1691: + }
1692: }
1693: - return outlist;
1694: + return outlist;
1695: }
1696:
1697: -LAC_API static lreg_t proc_reduce(lreg_t args, lenv_t *argenv, lenv_t *env)
1698: +LAC_API static lreg_t
1699: +proc_reduce (lreg_t args, lenv_t * argenv, lenv_t * env)
1700: {
1701: - _EXPECT_ARGS(args, 2);
1702: + _EXPECT_ARGS (args, 2);
1703: lreg_t acc;
1704: - lreg_t fn = ARGEVAL(car(args), argenv);
1705: - lreg_t list = ARGEVAL(car(cdr(args)), argenv);
1706: + lreg_t fn = ARGEVAL (car (args), argenv);
1707: + lreg_t list = ARGEVAL (car (cdr (args)), argenv);
1708:
1709: - if ( !is_cons(list) )
1710: - _ERROR_AND_RET("Syntax error in reduce\n");
1711: + if (!is_cons (list))
1712: + _ERROR_AND_RET ("Syntax error in reduce\n");
1713:
1714: - acc = car(list);
1715: - list = cdr(list);
1716: + acc = car (list);
1717: + list = cdr (list);
1718:
1719: - for ( ; list != NIL; list = cdr(list) )
1720: - acc = apply(fn, cons(acc, cons(car(list), NIL)), env);
1721: + for (; list != NIL; list = cdr (list))
1722: + acc = apply (fn, cons (acc, cons (car (list), NIL)), env);
1723:
1724: return acc;
1725: }
1726:
1727: -void map_init(lenv_t *env)
1728: +void
1729: +map_init (lenv_t * env)
1730: {
1731:
1732: - lac_extproc_register(env, "MAPCAR", proc_mapcar);
1733: - lac_extproc_register(env, "REDUCE", proc_reduce);
1734: + lac_extproc_register (env, "MAPCAR", proc_mapcar);
1735: + lac_extproc_register (env, "REDUCE", proc_reduce);
1736: }
1737: diff --git a/src/lib/ty_int.c b/src/lib/ty_int.c
1738: index ed225f5..b83c46f 100644
1739: --- a/src/lib/ty_int.c
1740: +++ b/src/lib/ty_int.c
1741: @@ -29,18 +29,19 @@
1742: LAC Type Interface.
1743: */
1744:
1745: -static void int_print(FILE *fd, lreg_t lr)
1746: +static void
1747: +int_print (FILE * fd, lreg_t lr)
1748: {
1749: intptr_t n;
1750:
1751: - INT_UNBOX(lr, n);
1752: - fprintf(fd, "%ld", n);
1753: + INT_UNBOX (lr, n);
1754: + fprintf (fd, "%ld", n);
1755: }
1756:
1757: -static lac_exttype_t int_ty = {
1758: - .name = "integer",
1759: - .print = int_print,
1760: - .equal = NULL,
1761: +static lac_exttype_t int_ty = {
1762: + .name = "integer",
1763: + .print = int_print,
1764: + .equal = NULL,
1765: };
1766:
1767:
1768: @@ -61,131 +62,146 @@ static lac_exttype_t int_ty = {
1769: lac_extty_unbox(arg2, (void **)&b);
1770:
1771:
1772: -LAC_API static lreg_t proc_plus(lreg_t args, lenv_t *argenv, lenv_t *env)
1773: +LAC_API static lreg_t
1774: +proc_plus (lreg_t args, lenv_t * argenv, lenv_t * env)
1775: {
1776: intptr_t n1, n2, n;
1777: - _BINOP_CHECKS(n1, n2);
1778: + _BINOP_CHECKS (n1, n2);
1779:
1780: - if ( ((n1>0) && (n2>0) && (n1 > (LONG_MAX-n2)))
1781: - || ((n1<0) && (n2<0) && (n1 < (LONG_MIN-n2))) )
1782: - _ERROR_AND_RET("+: Integer overflow\n");
1783: + if (((n1 > 0) && (n2 > 0) && (n1 > (LONG_MAX - n2)))
1784: + || ((n1 < 0) && (n2 < 0) && (n1 < (LONG_MIN - n2))))
1785: + _ERROR_AND_RET ("+: Integer overflow\n");
1786:
1787: n = n1 + n2;
1788: - return lac_extty_box(LREG_INTEGER, (void *)n, 0);
1789: + return lac_extty_box (LREG_INTEGER, (void *) n, 0);
1790: }
1791:
1792: -LAC_API static lreg_t proc_minus(lreg_t args, lenv_t *argenv, lenv_t *env)
1793: +LAC_API static lreg_t
1794: +proc_minus (lreg_t args, lenv_t * argenv, lenv_t * env)
1795: {
1796: long n1, n2, n;
1797: - _BINOP_CHECKS(n1, n2);
1798: + _BINOP_CHECKS (n1, n2);
1799:
1800: - if ( ((n1>0) && (n2 < 0) && (n1 > (LONG_MAX+n2)))
1801: - || ((n1<0) && (n2>0) && (n1 < (LONG_MIN + n2))) )
1802: - _ERROR_AND_RET("-: Integer signed overflow\n");
1803: + if (((n1 > 0) && (n2 < 0) && (n1 > (LONG_MAX + n2)))
1804: + || ((n1 < 0) && (n2 > 0) && (n1 < (LONG_MIN + n2))))
1805: + _ERROR_AND_RET ("-: Integer signed overflow\n");
1806:
1807: n = n1 - n2;
1808: - return lac_extty_box(LREG_INTEGER, (void *)n, 0);
1809: + return lac_extty_box (LREG_INTEGER, (void *) n, 0);
1810: }
1811:
1812: -LAC_API static lreg_t proc_star(lreg_t args, lenv_t *argenv, lenv_t *env)
1813: +LAC_API static lreg_t
1814: +proc_star (lreg_t args, lenv_t * argenv, lenv_t * env)
1815: {
1816: long n1, n2, n;
1817: - _BINOP_CHECKS(n1, n2);
1818: + _BINOP_CHECKS (n1, n2);
1819:
1820: - if ( n1 == 0 || n2 == 0 )
1821: + if (n1 == 0 || n2 == 0)
1822: goto mul_res;
1823:
1824: - if ( n1 > 0 )
1825: - if ( n2 > 0 ) {
1826: - if ( n1>(LONG_MAX/(n2)) )
1827: - goto mul_of;
1828: - } else {
1829: - if ( n2<(LONG_MIN/(n1)) )
1830: + if (n1 > 0)
1831: + if (n2 > 0)
1832: + {
1833: + if (n1 > (LONG_MAX / (n2)))
1834: + goto mul_of;
1835: + }
1836: + else
1837: + {
1838: + if (n2 < (LONG_MIN / (n1)))
1839: + goto mul_of;
1840: + }
1841: + else if (n2 > 0)
1842: + {
1843: + if (n1 < (LONG_MIN / (n2)))
1844: goto mul_of;
1845: }
1846: else
1847: - if ( n2 > 0 ) {
1848: - if ( n1<(LONG_MIN/(n2)) )
1849: - goto mul_of;
1850: - } else {
1851: - if ( n2 < (LONG_MAX/(n1)) )
1852: + {
1853: + if (n2 < (LONG_MAX / (n1)))
1854: goto mul_of;
1855: }
1856:
1857: - mul_res:
1858: +mul_res:
1859: n = n1 * n2;
1860: - return lac_extty_box(LREG_INTEGER, (void *)n, 0);
1861: + return lac_extty_box (LREG_INTEGER, (void *) n, 0);
1862:
1863: - mul_of:
1864: - _ERROR_AND_RET("*: Integer sign overflow\n");
1865: +mul_of:
1866: + _ERROR_AND_RET ("*: Integer sign overflow\n");
1867: return NIL;
1868: }
1869:
1870: -LAC_API static lreg_t proc_mod(lreg_t args, lenv_t *argenv, lenv_t *env)
1871: +LAC_API static lreg_t
1872: +proc_mod (lreg_t args, lenv_t * argenv, lenv_t * env)
1873: {
1874: long n1, n2, n;
1875: - _BINOP_CHECKS(n1, n2);
1876: + _BINOP_CHECKS (n1, n2);
1877:
1878: - if ( (n2 == 0 ) || ( (n1 == LONG_MIN) && (n2 == -1) ) )
1879: - _ERROR_AND_RET("\%% would overflow or divide by zero\n");
1880: + if ((n2 == 0) || ((n1 == LONG_MIN) && (n2 == -1)))
1881: + _ERROR_AND_RET ("\%% would overflow or divide by zero\n");
1882:
1883: n = n1 % n2;
1884: - return lac_extty_box(LREG_INTEGER, (void *)n, 0);
1885: + return lac_extty_box (LREG_INTEGER, (void *) n, 0);
1886: }
1887:
1888: -LAC_API static lreg_t proc_div(lreg_t args, lenv_t *argenv, lenv_t *env)
1889: +LAC_API static lreg_t
1890: +proc_div (lreg_t args, lenv_t * argenv, lenv_t * env)
1891: {
1892: long n1, n2, n;
1893: - _BINOP_CHECKS(n1, n2);
1894: + _BINOP_CHECKS (n1, n2);
1895:
1896: - if ( (n2 == 0 ) || ( (n1 == LONG_MIN) && (n2 == -1) ) )
1897: - _ERROR_AND_RET("\%% would overflow or divide by zero\n");
1898: + if ((n2 == 0) || ((n1 == LONG_MIN) && (n2 == -1)))
1899: + _ERROR_AND_RET ("\%% would overflow or divide by zero\n");
1900:
1901: n = n1 / n2;
1902: - return lac_extty_box(LREG_INTEGER, (void *)n, 0);
1903: + return lac_extty_box (LREG_INTEGER, (void *) n, 0);
1904: }
1905:
1906: -LAC_API static lreg_t proc_greater(lreg_t args, lenv_t *argenv, lenv_t *env)
1907: +LAC_API static lreg_t
1908: +proc_greater (lreg_t args, lenv_t * argenv, lenv_t * env)
1909: {
1910: long n1, n2;
1911: - _BINOP_CHECKS(n1, n2);
1912: + _BINOP_CHECKS (n1, n2);
1913: return n1 > n2 ? sym_true : sym_false;
1914: }
1915:
1916: -LAC_API static lreg_t proc_greatereq(lreg_t args, lenv_t *argenv, lenv_t *env)
1917: +LAC_API static lreg_t
1918: +proc_greatereq (lreg_t args, lenv_t * argenv, lenv_t * env)
1919: {
1920: long n1, n2;
1921: - _BINOP_CHECKS(n1, n2);
1922: + _BINOP_CHECKS (n1, n2);
1923: return n1 >= n2 ? sym_true : sym_false;
1924: }
1925:
1926: -LAC_API static lreg_t proc_less(lreg_t args, lenv_t *argenv, lenv_t *env)
1927: +LAC_API static lreg_t
1928: +proc_less (lreg_t args, lenv_t * argenv, lenv_t * env)
1929: {
1930: long n1, n2;
1931: - _BINOP_CHECKS(n1, n2);
1932: + _BINOP_CHECKS (n1, n2);
1933: return n1 < n2 ? sym_true : sym_false;
1934: }
1935:
1936: -LAC_API static lreg_t proc_lesseq(lreg_t args, lenv_t *argenv, lenv_t *env)
1937: +LAC_API static lreg_t
1938: +proc_lesseq (lreg_t args, lenv_t * argenv, lenv_t * env)
1939: {
1940: long n1, n2;
1941: - _BINOP_CHECKS(n1, n2);
1942: + _BINOP_CHECKS (n1, n2);
1943: return n1 <= n2 ? sym_true : sym_false;
1944: }
1945:
1946: -LAC_DEFINE_TYPE_PFUNC(integer, LREG_INTEGER);
1947: +LAC_DEFINE_TYPE_PFUNC (integer, LREG_INTEGER);
1948:
1949: -void int_init(lenv_t *env)
1950: +void
1951: +int_init (lenv_t * env)
1952: {
1953: - lac_extty_register(LREG_INTEGER, &int_ty);
1954: - lac_extproc_register(env, "INTEGERP",LAC_TYPE_PFUNC(integer));
1955: - lac_extproc_register(env, "+", proc_plus);
1956: - lac_extproc_register(env, "-", proc_minus);
1957: - lac_extproc_register(env, "*", proc_star);
1958: - lac_extproc_register(env, "%", proc_mod);
1959: - lac_extproc_register(env, "/", proc_div);
1960: - lac_extproc_register(env, ">", proc_greater);
1961: - lac_extproc_register(env, ">=", proc_greatereq);
1962: - lac_extproc_register(env, "<", proc_less);
1963: - lac_extproc_register(env, "<=", proc_lesseq);
1964: + lac_extty_register (LREG_INTEGER, &int_ty);
1965: + lac_extproc_register (env, "INTEGERP", LAC_TYPE_PFUNC (integer));
1966: + lac_extproc_register (env, "+", proc_plus);
1967: + lac_extproc_register (env, "-", proc_minus);
1968: + lac_extproc_register (env, "*", proc_star);
1969: + lac_extproc_register (env, "%", proc_mod);
1970: + lac_extproc_register (env, "/", proc_div);
1971: + lac_extproc_register (env, ">", proc_greater);
1972: + lac_extproc_register (env, ">=", proc_greatereq);
1973: + lac_extproc_register (env, "<", proc_less);
1974: + lac_extproc_register (env, "<=", proc_lesseq);
1975: }
1976: diff --git a/src/lib/ty_string.c b/src/lib/ty_string.c
1977: index e164ed0..6f7aea4 100644
1978: --- a/src/lib/ty_string.c
1979: +++ b/src/lib/ty_string.c
1980: @@ -25,13 +25,14 @@
1981:
1982: #define ARGEVAL(_lr, _e) ((_e) == NULL ? _lr : eval((_lr), (_e)))
1983:
1984: -static int string_compare(lreg_t arg1, lreg_t arg2)
1985: +static int
1986: +string_compare (lreg_t arg1, lreg_t arg2)
1987: {
1988: int d;
1989: char *s1, *s2;
1990: - s1 = (char *)lreg_raw_ptr(arg1);
1991: - s2 = (char *)lreg_raw_ptr(arg2);
1992: - d = strcmp(s1, s2);
1993: + s1 = (char *) lreg_raw_ptr (arg1);
1994: + s2 = (char *) lreg_raw_ptr (arg2);
1995: + d = strcmp (s1, s2);
1996: return d;
1997: }
1998:
1999: @@ -45,30 +46,32 @@ static int string_compare(lreg_t arg1, lreg_t arg2)
2000: _ERROR_AND_RET("Function requires two strings!\n");
2001:
2002:
2003: -LAC_API lreg_t proc_string_lessp(lreg_t args, lenv_t *argenv, lenv_t *env)
2004: +LAC_API lreg_t
2005: +proc_string_lessp (lreg_t args, lenv_t * argenv, lenv_t * env)
2006: {
2007: - BINARY_STR_OP_CHECKS(args);
2008: - return (string_compare(s1, s2) >= 0 ? sym_false : sym_true);
2009: + BINARY_STR_OP_CHECKS (args);
2010: + return (string_compare (s1, s2) >= 0 ? sym_false : sym_true);
2011: }
2012:
2013: -LAC_API static lreg_t proc_string_greaterp(lreg_t args, lenv_t *argenv, lenv_t *env)
2014: +LAC_API static lreg_t
2015: +proc_string_greaterp (lreg_t args, lenv_t * argenv, lenv_t * env)
2016: {
2017: - BINARY_STR_OP_CHECKS(args);
2018: - return (string_compare(s1, s2) <= 0 ? sym_false : sym_true);
2019: + BINARY_STR_OP_CHECKS (args);
2020: + return (string_compare (s1, s2) <= 0 ? sym_false : sym_true);
2021: }
2022:
2023: -LAC_API static lreg_t proc_string_equal(lreg_t args, lenv_t *argenv, lenv_t *env)
2024: +LAC_API static lreg_t
2025: +proc_string_equal (lreg_t args, lenv_t * argenv, lenv_t * env)
2026: {
2027: - BINARY_STR_OP_CHECKS(args);
2028: - return (string_compare(s1, s2) != 0 ? sym_false : sym_true);
2029: + BINARY_STR_OP_CHECKS (args);
2030: + return (string_compare (s1, s2) != 0 ? sym_false : sym_true);
2031: }
2032:
2033: -LAC_DEFINE_TYPE_PFUNC(string, LREG_STRING)
2034: -
2035: -void string_init(lenv_t *env)
2036: +LAC_DEFINE_TYPE_PFUNC (string, LREG_STRING)
2037: + void string_init (lenv_t * env)
2038: {
2039: - lac_extproc_register(env, "STRINGP", LAC_TYPE_PFUNC(string));
2040: - lac_extproc_register(env, "STRING-LESS", proc_string_lessp);
2041: - lac_extproc_register(env, "STRING-GREATER", proc_string_greaterp);
2042: - lac_extproc_register(env, "STRING-EQUAL", proc_string_equal);
2043: + lac_extproc_register (env, "STRINGP", LAC_TYPE_PFUNC (string));
2044: + lac_extproc_register (env, "STRING-LESS", proc_string_lessp);
2045: + lac_extproc_register (env, "STRING-GREATER", proc_string_greaterp);
2046: + lac_extproc_register (env, "STRING-EQUAL", proc_string_equal);
2047: }