unify: remove obsolete interface
This commit is contained in:
Daniel Kochmański
parent
61500316b7
commit
6ff5d20417
7 changed files with 2 additions and 345 deletions
|
|
@ -66,7 +66,7 @@ HDIR = $(top_srcdir)\h
|
|||
HFILES = ..\ecl\config.h ..\ecl\atomic_ops.h $(HDIR)\ecl.h $(HDIR)\ecl-cmp.h\
|
||||
$(HDIR)\object.h $(HDIR)\cs.h $(HDIR)\stacks.h\
|
||||
$(HDIR)\external.h $(HDIR)\cons.h $(HDIR)\legacy.h\
|
||||
$(HDIR)\number.h $(HDIR)\page.h $(HDIR)\unify.h\
|
||||
$(HDIR)\number.h $(HDIR)\page.h
|
||||
$(HDIR)\internal.h $(HDIR)\ecl-inl.h $(HDIR)\bytecodes.h \
|
||||
$(HDIR)\impl\math_dispatch.h
|
||||
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@ HDIR = ../ecl
|
|||
HFILES = $(HDIR)/config.h $(HDIR)/ecl.h $(HDIR)/ecl-cmp.h\
|
||||
$(HDIR)/object.h $(HDIR)/cs.h $(HDIR)/stacks.h\
|
||||
$(HDIR)/external.h $(HDIR)/cons.h $(HDIR)/legacy.h\
|
||||
$(HDIR)/number.h $(HDIR)/page.h $(HDIR)/unify.h
|
||||
$(HDIR)/number.h $(HDIR)/page.h
|
||||
OBJS = main.o symbol.o package.o cons.o list.o\
|
||||
apply.o eval.o interpreter.o compiler.o disassembler.o \
|
||||
instance.o gfun.o clos/cache.o clos/accessor.o \
|
||||
|
|
|
|||
301
src/c/unify.d
301
src/c/unify.d
|
|
@ -1,301 +0,0 @@
|
|||
/* -*- Mode: C; c-basic-offset: 8; indent-tabs-mode: nil -*- */
|
||||
/* vim: set filetype=c tabstop=8 shiftwidth=4 expandtab: */
|
||||
|
||||
/*
|
||||
unify.d -- Support for unification.
|
||||
*/
|
||||
/*
|
||||
Copyright (c) 1990, Giuseppe Attardi.
|
||||
Copyright (c) 2001, Juan Jose Garcia Ripoll.
|
||||
|
||||
ECL 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 "ecl.h"
|
||||
#include "unify.h"
|
||||
|
||||
object *slot; /* scanning pointer within object */
|
||||
int (*slotf)(); /* read/write mode accessor */
|
||||
|
||||
/* -------------------- Trail Instructions -------------------- */
|
||||
|
||||
object *trail[VSSIZE];
|
||||
object **trail_top = trail;
|
||||
|
||||
#define BIND(loc, val) {loc = val; trail_push(&loc);}
|
||||
|
||||
@(defun trail_mark ()
|
||||
@
|
||||
trail_mark;
|
||||
@)
|
||||
|
||||
@(defun trail_restore ()
|
||||
@
|
||||
trail_restore;
|
||||
@(return ECL_NIL)
|
||||
@)
|
||||
|
||||
@(defun trail_unmark ()
|
||||
@
|
||||
trail_unmark;
|
||||
@(return ECL_NIL)
|
||||
@)
|
||||
|
||||
/* -------------------- Mode Operators -------------------- */
|
||||
|
||||
bool get_slot(object x) /* read mode */
|
||||
{
|
||||
if (x == *slot || unify(x, *slot))
|
||||
if (*slot == OBJNULL)
|
||||
return((bool)MAKE_LOCATIVE(slot++));
|
||||
else
|
||||
return((bool)*slot++); /* dereference */
|
||||
else
|
||||
return(FALSE);
|
||||
}
|
||||
|
||||
bool set_slot(object x) /* write mode */
|
||||
{
|
||||
/* NOTE: slot contains OBJNULL */
|
||||
*slot = x;
|
||||
return((bool)MAKE_LOCATIVE(slot++));
|
||||
}
|
||||
|
||||
|
||||
/* -------------------- Get Instructions -------------------- */
|
||||
|
||||
/* get_variable is just setq */
|
||||
|
||||
@(defun get_value (v x)
|
||||
@
|
||||
@(return (get_value(v, x)?ECL_T:ECL_NIL))
|
||||
@)
|
||||
|
||||
@(defun get_constant (c x)
|
||||
@
|
||||
@(return (get_constant(c, x)?ECL_T:ECL_NIL))
|
||||
@)
|
||||
|
||||
@(defun get_nil (arg)
|
||||
@
|
||||
@(return (get_nil(arg)?ECL_T:ECL_NIL))
|
||||
@)
|
||||
|
||||
bool
|
||||
get_cons(object x)
|
||||
{
|
||||
|
||||
RETRY: switch (ecl_t_of(x)) {
|
||||
case t_cons:
|
||||
slot = &CDR(x); /* cdr slot is first in struct cons */
|
||||
slotf = get_slot;
|
||||
return(TRUE);
|
||||
|
||||
case t_locative:
|
||||
if (UNBOUNDP(x)) {
|
||||
object new = CONS(OBJNULL, OBJNULL);
|
||||
BIND(DEREF(x), new);
|
||||
slot = &CDR(new);
|
||||
slotf = set_slot;
|
||||
return(TRUE);
|
||||
}
|
||||
else {
|
||||
x = DEREF(x);
|
||||
goto RETRY;
|
||||
}
|
||||
|
||||
default: return(FALSE);
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
@(defun get_cons (arg)
|
||||
@
|
||||
@(return (get_cons(arg)?ECL_T:ECL_NIL))
|
||||
@)
|
||||
|
||||
bool
|
||||
get_instance(object x, object class, int arity)
|
||||
{
|
||||
RETRY: switch (ecl_t_of(x)) {
|
||||
case t_instance:
|
||||
if (ECL_CLASS_OF(x) == class) {
|
||||
slot = x->instance.slots;
|
||||
slotf = get_slot;
|
||||
return(TRUE);
|
||||
} else
|
||||
return(FALSE);
|
||||
|
||||
case t_locative:
|
||||
if (UNBOUNDP(x)) {
|
||||
object new = allocate_instance(class, arity);
|
||||
BIND(DEREF(x), new);
|
||||
slot = new->instance.slots;
|
||||
slotf = set_slot;
|
||||
return(TRUE);
|
||||
}
|
||||
else {
|
||||
x = DEREF(x);
|
||||
goto RETRY;
|
||||
}
|
||||
default: return(FALSE);
|
||||
}
|
||||
}
|
||||
|
||||
@(defun get_instance (x class arity)
|
||||
@
|
||||
@(return (get_instance(x, class, ecl_fixnum(arity))?ECL_T:ECL_NIL))
|
||||
@)
|
||||
|
||||
|
||||
/* -------------------- Unify Instructions -------------------- */
|
||||
|
||||
#define UNIFY_LOCATIVE(x, y, L) {object *p = &DEREF(x); \
|
||||
if (*p == OBJNULL) { \
|
||||
BIND(*p, y); return(TRUE); } \
|
||||
else { x = *p; goto L;}}
|
||||
/*
|
||||
#define UNIFY_LOCATIVE(x, y, L) {if (UNBOUNDP(x)) { \
|
||||
BIND(DEREF(x), y); return(TRUE); } \
|
||||
else { x = DEREF(x); goto L;}}
|
||||
*/
|
||||
|
||||
bool
|
||||
unify(object x, object y)
|
||||
{
|
||||
/* NOTE: x <- y */
|
||||
|
||||
L: switch (ecl_t_of(x)) {
|
||||
|
||||
case t_locative: UNIFY_LOCATIVE(x, y, L);
|
||||
|
||||
case t_cons:
|
||||
L1: switch (ecl_t_of(y)) {
|
||||
|
||||
case t_cons: return(unify(CAR(x), CAR(y)) &&
|
||||
unify(CDR(x), CDR(y)));
|
||||
|
||||
case t_locative: UNIFY_LOCATIVE(y, x, L1);
|
||||
|
||||
default: return(FALSE);
|
||||
}
|
||||
|
||||
case t_instance:
|
||||
L2: switch (ecl_t_of(y)) {
|
||||
|
||||
case t_instance:
|
||||
if (ECL_CLASS_OF(x) == ECL_CLASS_OF(y)) {
|
||||
int l = x->instance.length; int i;
|
||||
object *slotx = x->instance.slots;
|
||||
object *sloty = y->instance.slots;
|
||||
for (i = 0; i < l; i++) {
|
||||
if (!unify(*slotx++, *sloty++))
|
||||
return(FALSE);
|
||||
}
|
||||
return(TRUE);
|
||||
} else
|
||||
return(FALSE);
|
||||
|
||||
case t_locative: UNIFY_LOCATIVE(y, x, L2);
|
||||
|
||||
default: return(FALSE);
|
||||
}
|
||||
|
||||
default:
|
||||
L3: if (LOCATIVEP(y))
|
||||
UNIFY_LOCATIVE(y, x, L3)
|
||||
else if (equal(x,y))
|
||||
return(TRUE);
|
||||
else
|
||||
return(FALSE);
|
||||
}
|
||||
}
|
||||
|
||||
/* Internal function. One should use unify_variable, which always returns T */
|
||||
|
||||
@(defun unify_slot ()
|
||||
@
|
||||
@(return ((object)unify_slot))
|
||||
@)
|
||||
|
||||
|
||||
@(defun unify_value (loc)
|
||||
object x;
|
||||
@
|
||||
x = (object)unify_value(loc);
|
||||
@(return ((x == ECL_NIL || x)?ECL_T:ECL_NIL))
|
||||
@)
|
||||
|
||||
@(defun unify_constant (c)
|
||||
object x;
|
||||
@
|
||||
x = (object)unify_constant(c);
|
||||
@(return ((x == ECL_NIL || x)?ECL_T:ECL_NIL))
|
||||
@)
|
||||
|
||||
@(defun unify_nil ()
|
||||
object x;
|
||||
@
|
||||
x = (object)unify_nil;
|
||||
@(return ((x == ECL_NIL || x)?ECL_T:ECL_NIL))
|
||||
@)
|
||||
|
||||
/* -------------------- Test Functions -------------------- */
|
||||
|
||||
@(defun make_locative (&optional (n 0))
|
||||
@
|
||||
@(return (MAKE_LOCATIVE(ecl_fixnum(n))))
|
||||
@)
|
||||
|
||||
@(defun locativep (obje)
|
||||
@
|
||||
@(return (LOCATIVEP(obje)?ECL_T:ECL_NIL))
|
||||
@)
|
||||
|
||||
@(defun unboundp (loc)
|
||||
@
|
||||
@(return (UNBOUNDP(loc)?ECL_T:ECL_NIL))
|
||||
@)
|
||||
|
||||
@(defun dereference (x)
|
||||
extern object Slocative;
|
||||
@
|
||||
while (ecl_t_of(x) != t_locative)
|
||||
x = wrong_type_argument(Slocative, x);
|
||||
@(return (DEREF(x)))
|
||||
@)
|
||||
|
||||
@(defun make_variable (name)
|
||||
@
|
||||
@(return (CONS(name, OBJNULL)))
|
||||
@)
|
||||
|
||||
/* (defmacro unify-variable (v) `(progn (setq ,v (si:unify-slot)) t) */
|
||||
|
||||
object Ssetq, Sunify_slot;
|
||||
|
||||
@(defun unify_variable (object var)
|
||||
@
|
||||
@(return list(3, Sprogn,
|
||||
list(3, Ssetq, CADR(var),
|
||||
CONS(Sunify_slot, ECL_NIL)),
|
||||
ECL_T))
|
||||
@)
|
||||
|
||||
#define make_si_macro(name, cfun) \
|
||||
{object x = make_si_ordinary(name); \
|
||||
ECL_SYM_FUN(x) = make_cfun(cfun, ECL_NIL, NULL); \
|
||||
x->symbol.mflag = TRUE; \
|
||||
}
|
||||
|
||||
void
|
||||
init_unify(void)
|
||||
{
|
||||
make_si_macro("UNIFY-VARIABLE", Lunify_variable);
|
||||
}
|
||||
|
|
@ -269,8 +269,6 @@ typedef unsigned char ecl_base_char;
|
|||
|
||||
/* CLX */
|
||||
#undef CLX
|
||||
/* Locatives */
|
||||
#undef LOCATIVE
|
||||
|
||||
/* Define this if you want a runtime version only without compiler */
|
||||
#undef RUNTIME
|
||||
|
|
|
|||
|
|
@ -84,9 +84,6 @@
|
|||
#include <ecl/cons.h>
|
||||
#include <ecl/stacks.h>
|
||||
#include <ecl/number.h>
|
||||
#ifdef LOCATIVE
|
||||
#include <ecl/unify.h>
|
||||
#endif
|
||||
#include <ecl/legacy.h>
|
||||
|
||||
typedef void (*ecl_init_function_t)(cl_object block);
|
||||
|
|
|
|||
|
|
@ -1,35 +0,0 @@
|
|||
/* -*- Mode: C; c-basic-offset: 8; indent-tabs-mode: nil -*- */
|
||||
/* vim: set filetype=c tabstop=8 shiftwidth=4 expandtab: */
|
||||
|
||||
/*
|
||||
unify.h -- Unification macros
|
||||
*/
|
||||
/*
|
||||
Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
|
||||
Copyright (c) 1990, Giuseppe Attardi.
|
||||
|
||||
ECoLisp 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.
|
||||
*/
|
||||
|
||||
|
||||
#define trail_push(loc) (*trail_top++ = (loc))
|
||||
#define trail_pop (**--trail_top = OBJNULL)
|
||||
#define trail_mark trail_push((object *)NULL)
|
||||
#define trail_restore {while (trail_top[-1] != (object *)NULL) \
|
||||
trail_pop;}
|
||||
#define trail_unmark {trail_restore; trail_top--;}
|
||||
#define BIND(loc, val) {loc = val; trail_push(&loc);}
|
||||
|
||||
#define get_value(v, x) unify(x, v)
|
||||
#define get_constant(c, x) (c == x || unify(x, c))
|
||||
#define get_nil(x) (ECL_NIL == x || unify(x, ECL_NIL))
|
||||
|
||||
#define unify_slot (*slotf)(*slot)
|
||||
#define unify_value(loc) (*slotf)(loc)
|
||||
#define unify_constant(c) (*slotf)(c)
|
||||
#define unify_nil (*slotf)(ECL_NIL)
|
||||
|
|
@ -215,7 +215,6 @@
|
|||
"c/threads/semaphore.d"
|
||||
"c/time.d"
|
||||
"c/typespec.d"
|
||||
"c/unify.d"
|
||||
"c/unixfsys.d"
|
||||
"c/unixint.d"
|
||||
"c/unixsys.d"
|
||||
|
|
@ -239,7 +238,6 @@
|
|||
"h/object.h"
|
||||
"h/page.h"
|
||||
"h/stacks.h"
|
||||
"h/unify.h"
|
||||
"lsp/arraylib.lsp"
|
||||
"lsp/assert.lsp"
|
||||
"lsp/autoload.lsp"
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue