home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / c / mapfun.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-05-07  |  5.3 KB  |  320 lines
  1. /*
  2.  Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
  3.  
  4. This file is part of GNU Common Lisp, herein referred to as GCL
  5.  
  6. GCL is free software; you can redistribute it and/or modify it under
  7. the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GCL is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
  14. License for more details.
  15.  
  16. You should have received a copy of the GNU Library General Public License 
  17. along with GCL; see the file COPYING.  If not, write to the Free Software
  18. Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. */
  21.  
  22. /*
  23.  
  24.     mapfun.c
  25.  
  26.     Mapping
  27. */
  28.  
  29. #include "include.h"
  30.  
  31. /*
  32.  
  33. Use of VS in mapfunctions:
  34.  
  35.         |    |
  36.         |-------|
  37.     base ->    |  fun    |
  38.         | list1    |
  39.         |   :    |
  40.         |   :    |
  41.         | listn    |
  42.     top ->    | value    | -----    the list which should be returned
  43.         | arg1    | --|
  44.         |   :    |   |--    arguments to FUN.
  45.         |   :    |   |    On call to FUN, vs_base = top+1
  46.         | argn    | --|            vs_top  = top+n+1
  47.         |-------|
  48.         |    |
  49.            VS
  50. */
  51.  
  52. Lmapcar()
  53. {
  54.     object *top = vs_top;
  55.     object *base = vs_base;
  56.     object x, handy;
  57.     int n = vs_top-vs_base-1;
  58.     int i;
  59.  
  60.     if (n <= 0)
  61.         too_few_arguments();
  62.     vs_push(Cnil);
  63.     for (i = 1;  i <= n;  i++) {
  64.         x = base[i];
  65.         if (endp(x)) {
  66.             base[0] = Cnil;
  67.             vs_top = base+1;
  68.             vs_base = base;
  69.             return;
  70.         }
  71.         vs_push(MMcar(x));
  72.         base[i] = MMcdr(x);
  73.     }
  74.     handy = top[0] = MMcons(Cnil,Cnil);
  75. LOOP:
  76.     vs_base = top+1;
  77.     super_funcall(base[0]);
  78.     MMcar(handy) = vs_base[0];
  79.     for (i = 1;  i <= n;  i++) {
  80.         x = base[i];
  81.         if (endp(x)) {
  82.             vs_base = top;
  83.             vs_top = top+1;
  84.             return;
  85.         }
  86.         top[i] = MMcar(x);
  87.         base[i] = MMcdr(x);
  88.     }
  89.     vs_top = top+n+1;
  90.     handy = MMcdr(handy) = MMcons(Cnil,Cnil);
  91.     goto LOOP;
  92. }
  93.  
  94. Lmaplist()
  95. {
  96.     object *top = vs_top;
  97.     object *base = vs_base;
  98.     object x, handy;
  99.     int n = vs_top-vs_base-1;
  100.     int i;
  101.  
  102.     if (n <= 0)
  103.         too_few_arguments();
  104.     vs_push(Cnil);
  105.     for (i = 1;  i <= n;  i++) {
  106.         x = base[i];
  107.         if (endp(x)) {
  108.             base[0] = Cnil;
  109.             vs_top = base+1;
  110.             vs_base = base;
  111.             return;
  112.         }
  113.         vs_push(x);
  114.         base[i] = MMcdr(x);
  115.     }
  116.     handy = top[0] = MMcons(Cnil,Cnil);
  117. LOOP:
  118.     vs_base = top+1;
  119.     super_funcall(base[0]);
  120.     MMcar(handy) = vs_base[0];
  121.     for (i = 1;  i <= n;  i++) {
  122.         x = base[i];
  123.         if (endp(x)) {
  124.             vs_base = top;
  125.             vs_top = top+1;
  126.             return;
  127.         }
  128.         top[i] = x;
  129.         base[i] = MMcdr(x);
  130.     }
  131.     vs_top = top+n+1;
  132.     handy = MMcdr(handy) = MMcons(Cnil,Cnil);
  133.     goto LOOP;
  134. }
  135.  
  136. Lmapc()
  137. {
  138.     object *top = vs_top;
  139.     object *base = vs_base;
  140.     object x;
  141.     int n = vs_top-vs_base-1;
  142.     int i;
  143.  
  144.     if (n <= 0)
  145.         too_few_arguments();
  146.     vs_push(base[1]);
  147.     for (i = 1;  i <= n;  i++) {
  148.         x = base[i];
  149.         if (endp(x)) {
  150.             vs_top = top+1;
  151.             vs_base = top;
  152.             return;
  153.         }
  154.         vs_push(MMcar(x));
  155.         base[i] = MMcdr(x);
  156.     }
  157. LOOP:
  158.     vs_base = top+1;
  159.     super_funcall(base[0]);
  160.     for (i = 1;  i <= n;  i++) {
  161.         x = base[i];
  162.         if (endp(x)) {
  163.             vs_base = top;
  164.             vs_top = top+1;
  165.             return;
  166.         }
  167.         top[i] = MMcar(x);
  168.         base[i] = MMcdr(x);
  169.     }
  170.     vs_top = top+n+1;
  171.     goto LOOP;
  172. }
  173.  
  174. Lmapl()
  175. {
  176.     object *top = vs_top;
  177.     object *base = vs_base;
  178.     object x;
  179.     int n = vs_top-vs_base-1;
  180.     int i;
  181.  
  182.     if (n <= 0)
  183.         too_few_arguments();
  184.     vs_push(base[1]);
  185.     for (i = 1;  i <= n;  i++) {
  186.         x = base[i];
  187.         if (endp(x)) {
  188.             vs_top = top+1;
  189.             vs_base = top;
  190.             return;
  191.         }
  192.         vs_push(x);
  193.         base[i] = MMcdr(x);
  194.     }
  195. LOOP:
  196.     vs_base = top+1;
  197.     super_funcall(base[0]);
  198.     for (i = 1;  i <= n;  i++) {
  199.         x = base[i];
  200.         if (endp(x)) {
  201.             vs_base = top;
  202.             vs_top = top+1;
  203.             return;
  204.         }
  205.         top[i] = x;
  206.         base[i] = MMcdr(x);
  207.     }
  208.     vs_top = top+n+1;
  209.     goto LOOP;
  210. }
  211.  
  212. Lmapcan()
  213. {
  214.     object *top = vs_top;
  215.     object *base = vs_base;
  216.     object x, handy;
  217.     int n = vs_top-vs_base-1;
  218.     int i;
  219.  
  220.     if (n <= 0)
  221.         too_few_arguments();
  222.     vs_push(Cnil);
  223.     for (i = 1;  i <= n;  i++) {
  224.         x = base[i];
  225.         if (endp(x)) {
  226.             base[0] = Cnil;
  227.             vs_top = base+1;
  228.             vs_base = base;
  229.             return;
  230.         }
  231.         vs_push(MMcar(x));
  232.         base[i] = MMcdr(x);
  233.     }
  234.     handy = Cnil;
  235. LOOP:
  236.     vs_base = top+1;
  237.     super_funcall(base[0]);
  238.     if (endp(handy)) handy = top[0] = vs_base[0];
  239.     else {
  240.         x = MMcdr(handy);
  241.         while(!endp(x)) {
  242.             handy = x;
  243.             x = MMcdr(x);
  244.         }
  245.         MMcdr(handy) = vs_base[0];
  246.         }
  247.     for (i = 1;  i <= n;  i++) {
  248.         x = base[i];
  249.         if (endp(x)) {
  250.             vs_base = top;
  251.             vs_top = top+1;
  252.             return;
  253.         }
  254.         top[i] = MMcar(x);
  255.         base[i] = MMcdr(x);
  256.     }
  257.     vs_top = top+n+1;
  258.     goto LOOP;
  259. }
  260.  
  261. Lmapcon()
  262. {
  263.     object *top = vs_top;
  264.     object *base = vs_base;
  265.     object x, handy;
  266.     int n = vs_top-vs_base-1;
  267.     int i;
  268.  
  269.     if (n <= 0)
  270.         too_few_arguments();
  271.     vs_push(Cnil);
  272.     for (i = 1;  i <= n;  i++) {
  273.         x = base[i];
  274.         if (endp(x)) {
  275.             base[0] = Cnil;
  276.             vs_top = base+1;
  277.             vs_base = base;
  278.             return;
  279.         }
  280.         vs_push(x);
  281.         base[i] = MMcdr(x);
  282.     }
  283.     handy = Cnil;
  284. LOOP:
  285.     vs_base = top+1;
  286.     super_funcall(base[0]);
  287.     if (endp(handy))
  288.         handy = top[0] = vs_base[0];
  289.     else {
  290.         x = MMcdr(handy);
  291.         while(!endp(x)) {
  292.             handy = x;
  293.             x = MMcdr(x);
  294.         }
  295.         MMcdr(handy) = vs_base[0];
  296.     }
  297.     for (i = 1;  i <= n;  i++) {
  298.         x = base[i];
  299.         if (endp(x)) {
  300.             vs_base = top;
  301.             vs_top = top+1;
  302.             return;
  303.         }
  304.         top[i] = x;
  305.         base[i] = MMcdr(x);
  306.     }
  307.     vs_top = top+n+1;
  308.     goto LOOP;
  309. }
  310.  
  311. init_mapfun()
  312. {
  313.     make_function("MAPCAR", Lmapcar);
  314.     make_function("MAPLIST", Lmaplist);
  315.     make_function("MAPC", Lmapc);
  316.     make_function("MAPL", Lmapl);
  317.     make_function("MAPCAN", Lmapcan);
  318.     make_function("MAPCON", Lmapcon);
  319. }
  320.