mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-14 05:12:38 -08:00
9b4bd625f4
+Deftype BIT-VECTOR would not expand to a vector type. +Each compiled file has an entry point whose name is either init_CODE() or another name based on the name of the source file. The algorithm for computing these names has been slightly changed so that the entry points of ECLS's own library do not conflict with user defined entry points. +A LET/LET* form in which the initializers for a variable have not the expected type produce a warning, but the code is accepted. For instance (LET (V) (DECLARE (TYPE FIXNUM V)) (SETQ V 1)) now compiles. +(SETF name), where name is a symbol, is now a valid function name in all contexts. It is accepted by DEFUN, FUNCTION, FBOUNDP, FMAKUNBOUND, etc, and it can be the on the function position in any form. +New specialized arrays for (UNSIGNED-BYTE 8) and (SIGNED-BYTE 8).
143 lines
3 KiB
D
143 lines
3 KiB
D
/*
|
|
reference.c -- Reference in Constants and Variables.
|
|
*/
|
|
/*
|
|
Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
|
|
Copyright (c) 1990, Giuseppe Attardi.
|
|
Copyright (c) 2001, Juan Jose Garcia Ripoll.
|
|
|
|
ECLS is free software; you can redistribute it and/or
|
|
modify it under the terms of the GNU Library General Public
|
|
License as published by the Free Software Foundation; either
|
|
version 2 of the License, or (at your option) any later version.
|
|
|
|
See file '../Copyright' for full details.
|
|
*/
|
|
|
|
#include "ecls.h"
|
|
#include "ecls-inl.h"
|
|
|
|
#define SBOUNDP(sym) (SYM_VAL(sym) == OBJNULL)
|
|
#define FBOUNDP(sym) (SYM_FUN(sym) == OBJNULL)
|
|
|
|
@(defun fboundp (sym)
|
|
cl_object output;
|
|
@
|
|
if (!SYMBOLP(sym)) {
|
|
cl_object sym1 = setf_namep(sym);
|
|
if (sym1 != OBJNULL)
|
|
sym = sym1;
|
|
else
|
|
FEtype_error_symbol(sym);
|
|
}
|
|
if (sym->symbol.isform)
|
|
output = Ct;
|
|
else if (FBOUNDP(sym))
|
|
output = Cnil;
|
|
else
|
|
output = Ct;
|
|
@(return output)
|
|
@)
|
|
|
|
cl_object
|
|
symbol_function(cl_object sym)
|
|
{
|
|
if (!SYMBOLP(sym)) {
|
|
cl_object sym1 = setf_namep(sym);
|
|
if (sym1 != OBJNULL)
|
|
sym = sym1;
|
|
else
|
|
FEtype_error_symbol(sym);
|
|
}
|
|
if (sym->symbol.isform || sym->symbol.mflag)
|
|
FEinvalid_function(sym);
|
|
if (FBOUNDP(sym))
|
|
FEundefined_function(sym);
|
|
return(SYM_FUN(sym));
|
|
}
|
|
|
|
/*
|
|
Symbol-function returns
|
|
function-closure for function
|
|
(macro . function-closure) for macros
|
|
(special . address) for special forms.
|
|
(if defined CLOS it returns also
|
|
generic-function for generic functions)
|
|
*/
|
|
@(defun symbol_function (sym)
|
|
cl_object output;
|
|
@
|
|
if (!SYMBOLP(sym)) {
|
|
cl_object sym1 = setf_namep(sym);
|
|
if (sym1 == OBJNULL)
|
|
FEtype_error_symbol(sym);
|
|
sym = sym1;
|
|
}
|
|
if (sym->symbol.isform)
|
|
output = @'special';
|
|
else if (FBOUNDP(sym))
|
|
FEundefined_function(sym);
|
|
else if (sym->symbol.mflag)
|
|
output = CONS(@'macro', SYM_FUN(sym));
|
|
else
|
|
output = SYM_FUN(sym);
|
|
@(return output)
|
|
@)
|
|
|
|
@(defun si::coerce_to_function (fun)
|
|
cl_type t = type_of(fun);
|
|
@
|
|
if (t == t_symbol) {
|
|
if (FBOUNDP(fun) || fun->symbol.mflag)
|
|
FEundefined_function(fun);
|
|
else
|
|
@(return SYM_FUN(fun))
|
|
} else if (t == t_cons && CAR(fun) == @'lambda') {
|
|
return @si::make-lambda(2, Cnil, CDR(fun));
|
|
} else {
|
|
cl_object setf_sym = setf_namep(fun);
|
|
if ((setf_sym != OBJNULL) && !FBOUNDP(setf_sym))
|
|
@(return SYM_FUN(setf_sym))
|
|
else
|
|
FEinvalid_function(fun);
|
|
}
|
|
@)
|
|
|
|
@(defun symbol_value (sym)
|
|
@
|
|
if (!SYMBOLP(sym))
|
|
FEtype_error_symbol(sym);
|
|
if (SBOUNDP(sym))
|
|
FEunbound_variable(sym);
|
|
@(return SYM_VAL(sym))
|
|
@)
|
|
|
|
@(defun boundp (sym)
|
|
@
|
|
if (!SYMBOLP(sym))
|
|
FEtype_error_symbol(sym);
|
|
@(return (SBOUNDP(sym)? Cnil : Ct))
|
|
@)
|
|
|
|
@(defun macro_function (sym &optional env)
|
|
cl_object fd;
|
|
@
|
|
if (!SYMBOLP(sym))
|
|
FEtype_error_symbol(sym);
|
|
if (Null(env))
|
|
fd = Cnil;
|
|
else {
|
|
fd = search_macro(sym, env);
|
|
if (!Null(fd)) @(return fd)
|
|
}
|
|
if (sym->symbol.mflag)
|
|
fd = SYM_FUN(sym);
|
|
@(return fd)
|
|
@)
|
|
|
|
@(defun special_form_p (form)
|
|
@
|
|
if (!SYMBOLP(form))
|
|
FEtype_error_symbol(form);
|
|
@(return (form->symbol.isform? Ct : Cnil))
|
|
@)
|