This is mapfun.c in view mode; [Download] [Up]
/*
Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
This file is part of GNU Common Lisp, herein referred to as GCL
GCL 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, or (at your option)
any later version.
GCL is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
License for more details.
You should have received a copy of the GNU Library General Public License
along with GCL; see the file COPYING. If not, write to the Free Software
Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
/*
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 endp_temp;
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 endp_temp;
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 endp_temp;
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 endp_temp;
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 endp_temp;
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 endp_temp;
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.