← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/c/reference.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/reference.d
 
1
/*
 
2
    reference.c -- Reference in Constants and Variables.
 
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/ecl-inl.h>
 
19
 
 
20
/*
 
21
        Symbol-function returns
 
22
                function-closure                for function
 
23
                (macro . function-closure)      for macros
 
24
                special                         for special forms.
 
25
*/
 
26
cl_object
 
27
cl_symbol_function(cl_object sym)
 
28
{
 
29
        cl_object output;
 
30
 
 
31
        assert_type_symbol(sym);
 
32
        if (sym->symbol.isform)
 
33
                output = @'special';
 
34
        else if (SYM_FUN(sym) == Cnil)
 
35
                FEundefined_function(sym);
 
36
        else if (sym->symbol.mflag)
 
37
                output = CONS(@'si::macro', SYM_FUN(sym));
 
38
        else
 
39
                output = SYM_FUN(sym);
 
40
        @(return output)
 
41
}
 
42
 
 
43
cl_object
 
44
cl_fdefinition(cl_object fname)
 
45
{
 
46
        @(return ((SYMBOLP(fname))? cl_symbol_function(fname) : ecl_fdefinition(fname)))
 
47
}
 
48
 
 
49
cl_object
 
50
cl_fboundp(cl_object fname)
 
51
{
 
52
        if (SYMBOLP(fname)) {
 
53
                @(return ((fname->symbol.isform || SYM_FUN(fname) != Cnil)? Ct : Cnil))
 
54
        } else if (CONSP(fname)) {
 
55
                if (CAR(fname) == @'setf') {
 
56
                        cl_object sym = CDR(fname);
 
57
                        if (CONSP(sym) && CDR(sym) == Cnil) {
 
58
                                sym = CAR(sym);
 
59
                                if (SYMBOLP(sym))
 
60
                                        @(return si_get_sysprop(sym, @'si::setf-symbol'))
 
61
                        }
 
62
                }
 
63
        }
 
64
        FEinvalid_function_name(fname);
 
65
}
 
66
 
 
67
cl_object
 
68
ecl_fdefinition(cl_object fun)
 
69
{
 
70
        cl_type t = type_of(fun);
 
71
        cl_object output;
 
72
 
 
73
        if (t == t_symbol) {
 
74
                output = SYM_FUN(fun);
 
75
                if (output == Cnil)
 
76
                        FEundefined_function(fun);
 
77
                if (fun->symbol.isform || fun->symbol.mflag)
 
78
                        FEundefined_function(fun);
 
79
        } else if (t == t_cons) {
 
80
                cl_object sym = CDR(fun);
 
81
                if (!CONSP(sym))
 
82
                        FEinvalid_function_name(fun);
 
83
                if (CAR(fun) == @'setf') {
 
84
                        if (CDR(sym) != Cnil)
 
85
                                FEinvalid_function_name(fun);
 
86
                        sym = CAR(sym);
 
87
                        if (type_of(sym) != t_symbol)
 
88
                                FEinvalid_function_name(fun);
 
89
                        output = si_get_sysprop(sym, @'si::setf-symbol');
 
90
                        if (Null(output))
 
91
                                FEundefined_function(fun);
 
92
                } else if (CAR(fun) == @'lambda') {
 
93
                        return si_make_lambda(Cnil, sym);
 
94
                } else if (CAR(fun) == @'ext::lambda-block') {
 
95
                        return si_make_lambda(CAR(sym), CDR(sym));
 
96
                } else {
 
97
                        FEinvalid_function_name(fun);
 
98
                }
 
99
        } else {
 
100
                FEinvalid_function_name(fun);
 
101
        }
 
102
        return output;
 
103
}
 
104
 
 
105
cl_object
 
106
si_coerce_to_function(cl_object fun)
 
107
{
 
108
        cl_type t = type_of(fun);
 
109
        if (!(t == t_cfun || t == t_cclosure || t == t_bytecodes
 
110
#ifdef CLOS
 
111
              || (t == t_instance && fun->instance.isgf)
 
112
#endif
 
113
                )) {
 
114
            fun = ecl_fdefinition(fun);
 
115
        }
 
116
        @(return fun)
 
117
}
 
118
 
 
119
cl_object
 
120
cl_symbol_value(cl_object sym)
 
121
{
 
122
        if (!SYMBOLP(sym))
 
123
                FEtype_error_symbol(sym);
 
124
        if (SYM_VAL(sym) == OBJNULL)
 
125
                FEunbound_variable(sym);
 
126
        @(return SYM_VAL(sym))
 
127
}
 
128
 
 
129
cl_object
 
130
cl_boundp(cl_object sym)
 
131
{
 
132
        if (!SYMBOLP(sym))
 
133
                FEtype_error_symbol(sym);
 
134
        @(return ((SYM_VAL(sym) == OBJNULL)? Cnil : Ct))
 
135
}
 
136
 
 
137
@(defun macro_function (sym &optional env)
 
138
        cl_object fd;
 
139
@
 
140
        if (!SYMBOLP(sym))
 
141
                FEtype_error_symbol(sym);
 
142
        if (Null(env))
 
143
                fd = Cnil;
 
144
        else {
 
145
                fd = search_macro(sym, env);
 
146
                if (!Null(fd)) @(return fd)
 
147
        }
 
148
        if (sym->symbol.mflag)
 
149
                fd = SYM_FUN(sym);
 
150
        @(return fd)
 
151
@)
 
152
 
 
153
cl_object
 
154
cl_special_operator_p(cl_object form)
 
155
{
 
156
        if (!SYMBOLP(form))
 
157
                FEtype_error_symbol(form);
 
158
        @(return (form->symbol.isform? Ct : Cnil))
 
159
}