This is mapfun.c in view mode; [Download] [Up]
/*
(c) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved.
Copying of this file is authorized to users who have executed the true and
proper "License Agreement for Kyoto Common LISP" with SIGLISP.
*/
/*
mapfun.c
Mapping
*/
#include "include.h"
/*
Use of VS in mapfunctions:
| |
|-------|
base -> | fun |
| list1 |
| : |
| : |
| listn |
top -> | value | ----- the list which should be returned
| arg1 | --|
| : | |-- arguments to FUN.
| : | | On call to FUN, vs_base = top+1
| argn | --| vs_top = top+n+1
|-------|
| |
VS
*/
Lmapcar()
{
object *top = vs_top;
object *base = vs_base;
object x, handy;
int n = vs_top-vs_base-1;
int i;
if (n <= 0)
too_few_arguments();
vs_push(Cnil);
for (i = 1; i <= n; i++) {
x = base[i];
if (endp(x)) {
base[0] = Cnil;
vs_top = base+1;
vs_base = base;
return;
}
vs_push(MMcar(x));
base[i] = MMcdr(x);
}
handy = top[0] = MMcons(Cnil,Cnil);
LOOP:
vs_base = top+1;
super_funcall(base[0]);
MMcar(handy) = vs_base[0];
for (i = 1; i <= n; i++) {
x = base[i];
if (endp(x)) {
vs_base = top;
vs_top = top+1;
return;
}
top[i] = MMcar(x);
base[i] = MMcdr(x);
}
vs_top = top+n+1;
handy = MMcdr(handy) = MMcons(Cnil,Cnil);
goto LOOP;
}
Lmaplist()
{
object *top = vs_top;
object *base = vs_base;
object x, handy;
int n = vs_top-vs_base-1;
int i;
if (n <= 0)
too_few_arguments();
vs_push(Cnil);
for (i = 1; i <= n; i++) {
x = base[i];
if (endp(x)) {
base[0] = Cnil;
vs_top = base+1;
vs_base = base;
return;
}
vs_push(x);
base[i] = MMcdr(x);
}
handy = top[0] = MMcons(Cnil,Cnil);
LOOP:
vs_base = top+1;
super_funcall(base[0]);
MMcar(handy) = vs_base[0];
for (i = 1; i <= n; i++) {
x = base[i];
if (endp(x)) {
vs_base = top;
vs_top = top+1;
return;
}
top[i] = x;
base[i] = MMcdr(x);
}
vs_top = top+n+1;
handy = MMcdr(handy) = MMcons(Cnil,Cnil);
goto LOOP;
}
Lmapc()
{
object *top = vs_top;
object *base = vs_base;
object x;
int n = vs_top-vs_base-1;
int i;
if (n <= 0)
too_few_arguments();
vs_push(base[1]);
for (i = 1; i <= n; i++) {
x = base[i];
if (endp(x)) {
vs_top = top+1;
vs_base = top;
return;
}
vs_push(MMcar(x));
base[i] = MMcdr(x);
}
LOOP:
vs_base = top+1;
super_funcall(base[0]);
for (i = 1; i <= n; i++) {
x = base[i];
if (endp(x)) {
vs_base = top;
vs_top = top+1;
return;
}
top[i] = MMcar(x);
base[i] = MMcdr(x);
}
vs_top = top+n+1;
goto LOOP;
}
Lmapl()
{
object *top = vs_top;
object *base = vs_base;
object x;
int n = vs_top-vs_base-1;
int i;
if (n <= 0)
too_few_arguments();
vs_push(base[1]);
for (i = 1; i <= n; i++) {
x = base[i];
if (endp(x)) {
vs_top = top+1;
vs_base = top;
return;
}
vs_push(x);
base[i] = MMcdr(x);
}
LOOP:
vs_base = top+1;
super_funcall(base[0]);
for (i = 1; i <= n; i++) {
x = base[i];
if (endp(x)) {
vs_base = top;
vs_top = top+1;
return;
}
top[i] = x;
base[i] = MMcdr(x);
}
vs_top = top+n+1;
goto LOOP;
}
Lmapcan()
{
object *top = vs_top;
object *base = vs_base;
object x, handy;
int n = vs_top-vs_base-1;
int i;
if (n <= 0)
too_few_arguments();
vs_push(Cnil);
for (i = 1; i <= n; i++) {
x = base[i];
if (endp(x)) {
base[0] = Cnil;
vs_top = base+1;
vs_base = base;
return;
}
vs_push(MMcar(x));
base[i] = MMcdr(x);
}
handy = Cnil;
LOOP:
vs_base = top+1;
super_funcall(base[0]);
if (endp(handy)) handy = top[0] = vs_base[0];
else {
x = MMcdr(handy);
while(!endp(x)) {
handy = x;
x = MMcdr(x);
}
MMcdr(handy) = vs_base[0];
}
for (i = 1; i <= n; i++) {
x = base[i];
if (endp(x)) {
vs_base = top;
vs_top = top+1;
return;
}
top[i] = MMcar(x);
base[i] = MMcdr(x);
}
vs_top = top+n+1;
goto LOOP;
}
Lmapcon()
{
object *top = vs_top;
object *base = vs_base;
object x, handy;
int n = vs_top-vs_base-1;
int i;
if (n <= 0)
too_few_arguments();
vs_push(Cnil);
for (i = 1; i <= n; i++) {
x = base[i];
if (endp(x)) {
base[0] = Cnil;
vs_top = base+1;
vs_base = base;
return;
}
vs_push(x);
base[i] = MMcdr(x);
}
handy = Cnil;
LOOP:
vs_base = top+1;
super_funcall(base[0]);
if (endp(handy))
handy = top[0] = vs_base[0];
else {
x = MMcdr(handy);
while(!endp(x)) {
handy = x;
x = MMcdr(x);
}
MMcdr(handy) = vs_base[0];
}
for (i = 1; i <= n; i++) {
x = base[i];
if (endp(x)) {
vs_base = top;
vs_top = top+1;
return;
}
top[i] = x;
base[i] = MMcdr(x);
}
vs_top = top+n+1;
goto LOOP;
}
init_mapfun()
{
make_function("MAPCAR", Lmapcar);
make_function("MAPLIST", Lmaplist);
make_function("MAPC", Lmapc);
make_function("MAPL", Lmapl);
make_function("MAPCAN", Lmapcan);
make_function("MAPCON", Lmapcon);
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.