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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
@(bind ad @(append-each* ((i (range 2 5))) (rperm "ad" i)))
@(do
(defun compile-ad (string arg)
(casequal string
("" arg)
(t `c@[string 0]r(@(compile-ad [string 1..:] arg))`))))
@(next "lib.c")
@(collect)
@{c-copyright}
@(until)
@(end)
@(next "stdlib/place.tl")
@(collect)
@{tl-copyright}
@(until)
@(end)
@(output "cadr.c")
/* This file is generated by gencadr.txr */
@{c-copyright "\n"}
#include <stdio.h>
#include <stdarg.h>
#include <stdlib.h>
#include <limits.h>
#include "config.h"
#include "lib.h"
#include "eval.h"
#include "stream.h"
#include "autoload.h"
#include "txr.h"
#include "cadr.h"
@ (repeat)
val c@{ad}r(val cons)
{
return @(compile-ad ad 'cons);
}
@ (end)
static val cadr_register(void)
{
@ (repeat)
reg_fun(intern(lit("c@{ad}r"), user_package), func_n1(c@{ad}r));
@ (end)
load(scat2(stdlib_path, lit("cadr")));
return nil;
}
static val cadr_set_entries(val fun)
{
val name[] = {
@ (repeat)
lit("c@{ad}r"),
@ (end)
nil
};
autoload_set(al_fun, name, fun);
return nil;
}
void cadr_init(void)
{
autoload_reg(cadr_register, cadr_set_entries);
}
@(end)
@(output "cadr.h")
/* This file is generated by gencadr.txr */
@{c-copyright "\n"}
@ (repeat)
val c@{ad}r(val);
@ (end)
void cadr_init(void);
@(end)
@(output "stdlib/cadr.tl")
;; This file is generated by gencadr.txr
@{tl-copyright "\n"}
@ (repeat)
(defplace (c@{ad}r cell) body
(getter setter
(with-gensyms (cell-sym)
^(let ((,cell-sym (c@{ad [1..:]}r ,cell)))
(macrolet ((,getter () ^(c@{ad [0]}r ,',cell-sym))
(,setter (val) ^(sys:rplac@{ad [0]} ,',cell-sym ,val)))
,body))))
(ssetter
^(macrolet ((,ssetter (val) ^(sys:rplac@{ad [0]} (c@{ad [1..:]}r ,',cell) ,val)))
,body))
(deleter
^(macrolet ((,deleter ()
(with-gensyms (tmp)
(with-update-expander (cgetter csetter) '(c@{ad [1..:]}r ,cell) nil
^(let ((,tmp (,cgetter)))
@(if (equal [ad 0] #\a)
`(prog1 (car ,tmp) (,csetter (cdr ,tmp)))`
`(prog1 (cdr ,tmp) (,csetter (car ,tmp)))`))))))
,body)))
@ (end)
@(end)
|
