← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/c/macros.d

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2006-05-17 02:46:26 UTC
  • Revision ID: james.westby@ubuntu.com-20060517024626-lljr08ftv9g9vefl
Tags: upstream-0.9h-20060510
Import upstream version 0.9h-20060510

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/c/macros.d
 
1
/*
 
2
    macros.c -- Macros.
 
3
*/
 
4
/*
 
5
    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
 
6
    Copyright (c) 1990, Giuseppe Attardi.
 
7
    Copyright (c) 2001, Juan Jose Garcia Ripoll.
 
8
 
 
9
    ECL is free software; you can redistribute it and/or
 
10
    modify it under the terms of the GNU Library General Public
 
11
    License as published by the Free Software Foundation; either
 
12
    version 2 of the License, or (at your option) any later version.
 
13
 
 
14
    See file '../Copyright' for full details.
 
15
*/
 
16
 
 
17
#include <ecl/ecl.h>
 
18
#include <ecl/internal.h>
 
19
 
 
20
/******************************* REQUIRES ******************************/
 
21
 
 
22
/* Requires expand-defmacro, from lsp/defmacro.lsp */
 
23
 
 
24
/******************************* ------- ******************************/
 
25
 
 
26
/*
 
27
        MACRO_DEF is an internal function which, given a form, returns
 
28
        the expansion function if the form is a macro form.  Otherwise,
 
29
        MACRO_DEF returns NIL.
 
30
*/
 
31
static cl_object
 
32
search_symbol_macro(cl_object name, cl_object env)
 
33
{
 
34
        cl_object record = assq(name, CAR(env));
 
35
        if (Null(record))
 
36
                return si_get_sysprop(name, @'si::symbol-macro');
 
37
        else if (CADR(record) == @'si::symbol-macro')
 
38
                return CADDR(record);
 
39
        else
 
40
                return Cnil;
 
41
}
 
42
 
 
43
cl_object
 
44
search_macro(cl_object name, cl_object env)
 
45
{
 
46
        cl_object record = assq(name, CDR(env));
 
47
        if (CONSP(record) && CADR(record) == @'si::macro')
 
48
                return CADDR(record);
 
49
        return Cnil;
 
50
}
 
51
 
 
52
static cl_object
 
53
macro_def(cl_object form, cl_object env)
 
54
{
 
55
        cl_object head, fd;
 
56
 
 
57
        if (ATOM(form)) {
 
58
                if (!SYMBOLP(form))
 
59
                        return Cnil;
 
60
                /* First look for SYMBOL-MACROLET definitions */
 
61
                fd = search_symbol_macro(form, env);
 
62
                return fd;
 
63
        }
 
64
        head = CAR(form);
 
65
        if (!SYMBOLP(head))
 
66
                return(Cnil);
 
67
        fd = search_macro(head, env);
 
68
        if (!Null(fd))
 
69
                return fd;
 
70
        else if (head->symbol.mflag)
 
71
                return(SYM_FUN(head));
 
72
        else
 
73
                return(Cnil);
 
74
}
 
75
 
 
76
@(defun macroexpand (form &optional (env Cnil))
 
77
        cl_object new_form = OBJNULL;
 
78
        cl_object done = Cnil;
 
79
@
 
80
        new_form = macro_expand1(form, env);
 
81
        while (new_form != form) {
 
82
                done = Ct;
 
83
                form = new_form;
 
84
                new_form = macro_expand(form, env);
 
85
        }
 
86
        @(return new_form done)
 
87
@)
 
88
 
 
89
@(defun macroexpand_1 (form &optional (env Cnil))
 
90
        cl_object new_form;
 
91
@
 
92
        new_form = macro_expand1(form, env);
 
93
        @(return new_form (new_form == form? Cnil : Ct))
 
94
@)
 
95
 
 
96
/*
 
97
        MACRO_EXPAND1 is an internal function which simply applies the
 
98
        function EXP_FUN to FORM.  On return, the expanded form is stored
 
99
        in VALUES(0).
 
100
*/
 
101
cl_object
 
102
macro_expand1(cl_object form, cl_object env)
 
103
{
 
104
        cl_object hook, exp_fun;
 
105
 
 
106
        exp_fun = macro_def(form, env);
 
107
        if (Null(exp_fun))
 
108
                return form;
 
109
        hook = symbol_value(@'*macroexpand-hook*');
 
110
        if (hook == @'funcall')
 
111
                return funcall(3, exp_fun, form, env);
 
112
        else
 
113
                return funcall(4, hook, exp_fun, form, env);
 
114
}
 
115
 
 
116
/*
 
117
        MACRO_EXPAND expands a form as many times as possible and returns
 
118
        the finally expanded form.
 
119
*/
 
120
cl_object
 
121
macro_expand(cl_object form, cl_object env)
 
122
{
 
123
        cl_object new_form;
 
124
 
 
125
        for (new_form = OBJNULL; new_form != form; form = new_form) {
 
126
                new_form = macro_expand1(form, env);
 
127
        }
 
128
        return new_form;
 
129
}
 
130
 
 
131
static cl_object
 
132
or_macro(cl_object whole, cl_object env)
 
133
{
 
134
        cl_object output = Cnil;
 
135
        whole = CDR(whole);
 
136
        if (Null(whole))        /* (OR) => NIL */
 
137
                @(return Cnil);
 
138
        while (!Null(CDR(whole))) {
 
139
                output = CONS(CONS(CAR(whole), Cnil), output);
 
140
                whole = CDR(whole);
 
141
        }
 
142
        if (Null(output))       /* (OR form1) => form1 */
 
143
                @(return CAR(whole));
 
144
        /* (OR form1 ... formn forml) => (COND (form1) ... (formn) (t forml)) */
 
145
        output = CONS(cl_list(2, Ct, CAR(whole)), output);
 
146
        @(return CONS(@'cond', cl_nreverse(output)))
 
147
}
 
148
 
 
149
static cl_object
 
150
expand_and(cl_object whole)
 
151
{
 
152
        if (Null(whole))
 
153
                return Ct;
 
154
        if (Null(CDR(whole)))
 
155
                return CAR(whole);
 
156
        return cl_list(3, @'if', CAR(whole), expand_and(CDR(whole)));
 
157
}
 
158
 
 
159
static cl_object
 
160
and_macro(cl_object whole, cl_object env)
 
161
{
 
162
        @(return expand_and(CDR(whole)))
 
163
}
 
164
 
 
165
static cl_object
 
166
when_macro(cl_object whole, cl_object env)
 
167
{
 
168
        cl_object args = CDR(whole);
 
169
        if (endp(args))
 
170
                FEprogram_error("Syntax error: ~S.", 1, whole);
 
171
        return cl_list(3, @'if', CAR(args), CONS(@'progn', CDR(args)));
 
172
}
 
173
 
 
174
void
 
175
init_macros(void)
 
176
{
 
177
        ECL_SET(@'*macroexpand-hook*', @'funcall');
 
178
        cl_def_c_macro(@'or', or_macro, 2);
 
179
        cl_def_c_macro(@'and', and_macro, 2);
 
180
        cl_def_c_macro(@'when', when_macro, 2);
 
181
}