Newsgroups: fj.editor.emacs
Path: galaxy.trc.rwcp.or.jp!jaist-news!cs.titech!nirvana.cs.titech!wnoc-tyo-news!sh.wide!wnoc-snd-ss2!sakunami!yagi!mori
From: Kazuyoshi Mori <mori@abe.ecei.tohoku.ac.jp>
Subject: yfunction.el (recursive lambda expression available)
Message-ID: <1994Mar20.113411.3261@ecei.tohoku.ac.jp>
Lines: 575
Sender: news@ecei.tohoku.ac.jp
Nntp-Posting-Host: bunny
Organization: Tohoku Univ.
Date: Sun, 20 Mar 1994 11:34:11 GMT
Xref: galaxy.trc.rwcp.or.jp fj.editor.emacs:4558
X-originally-archived-at: http://galaxy.rwcp.or.jp/text/cgi-bin/newsarticle2?ng=fj.editor.emacs&nb=4558&hd=a
X-reformat-date: Mon, 18 Oct 2004 15:18:22 +0900
X-reformat-comment: Tabs were expanded into 4 column tabstops by the Galaxy's archiver. See http://katsu.watanabe.name/ancientfj/galaxy-format.html for more info.

$BElKLBg3XEE5$9)3X2J0$It8&$N?9$H?=$7$^$9!%(B

yfunction, ydefun, yflet (yfunction.el) $B$J$k$b$N$r$D$/$C$F$_$^$7$?$N$G(B
$BEj9F$7$^$9!%(B

yfunction, ydefun, yflet $B$O!$:F5"$K$h$k4X?tK\BN$NCj>]@-$,<:$o$l$k$3$H(B
$B$rKI$.!$$^$?%i%`%@<0$NE,MQHO0O$r0lIt9-$2$k$?$a$N(B elisp $B$N%D!<%k$G$9!%(B

yfunction $B$O0z?t$H$7$F%i%`%@<0$r$H$j$^$9!%JV$9CM$O%i%`%@<0$HF1$80UL#$r(B
$B$b$D4X?t(B($B4X?t$rI=$9<1JL;R(B)$B$G$9!%C"$7!$%i%`%@<0Fb$N5-9f(B =@= $B$K$h$j85$N(B
$B%i%`%@<0<+?H$rI=$9$3$H$,$G$-$^$9!%$D$^$j%i%`%@<0$N:F5"$,2DG=$K$J$j$^$9!%(B
$B<B:]$K$O%i%`%@<0$r(B defun $B$K$h$k4X?t$H$7$FDj5A$r9T$J$$$=$l$r:F5"E*$K$h(B
$B$S$@$9$3$H$r9T$J$C$F$$$^$9!%(B

ydefun $B$O(B defun $B$HF1Ey$NJ8K!$r;}$A!$F1$80UL#$r;}$A$^$9!%C"$7!$5-9f(B =@=
$B$K$h$j8=:_Dj5A$7$F$$$k4X?t$rI=$9$3$H$,$G$-$^$9!%(B

yflet $B$O%m!<%+%k4X?t$r%(%_%e%l!<%H$7$^$9!%J8K!$O!$(B
    (yflet LFNS BODY...)
$B$G!$(BLFNS $B$O4X?tDj5A$+$i$J$k%j%9%H$G!$%j%9%H$NMWAG$O(B
    (SYMBOL (ARG...) BODY2...)
$B$+$i$J$j$^$9!%(BSYMBOL $B$O%m!<%+%k4X?tL>!$(BARG... $B$O2>0z?t!$(BBODY2... $B$O=g(B
$B$KI>2A$5$l$k<0$G$9!%4X?tCM$O(B BODY2... $B$N:G8e$N<0$NI>2ACM$G$9!%$J$*!$(B
BODY2... $BCf$N(B =@= $B$O8=:_Dj5A$7$F$$$k4X?t(B($B$9$J$o$A(B SYMBOL)$B$rI=$7$^$9!%(B
yflet $B$G$O$3$l$i(B LFNS $B$N%m!<%+%k4X?t$,$^$:Dj5A$5$l$^$9!%(B
 $B$=$N8e!$(Byflet $BCf$N(B BODY... $B$,=g$KI>2A$5$l$^$9!%(Byflet $B$NCM$O(B BODY...
$B$N:G8e$N<0$NI>2ACM$G$9!%$^$?!$(Byflet $B=*N;;~$K$O(B LFNS $B$K$h$jDj5A$5$l$?(B
$B4X?t$O!$85!9Dj5A$5$l$F$$$?>l9g$K$O(B yflet $B$r<B9T$9$kA0$N85$N4X?t$H$J$j!$(B
$B$^$?$ODj5A$5$l$F$$$J$$>l9g$K$OL$Dj5A$H$J$j$^$9!%(B

$B$J$*!$5-9f(B =@= $B$O!$JQ?t(B ydefun:fname-symbol:alist $B$K$h$j%+%9%?%^%$%:2D(B
$BG=$G$9!%(B

$B0J>e$N(B yfunction, ydefun, yflet $B$O<0$N0UL#$rJQ99$9$k2DG=@-$,$"$j$^$9$,!$(B
$BJQ99$rM^@)$9$k$?$a$K!$(Bynoexpand $B$rMQ0U$7$F$$$^$9!%=q<0$O(B quote $B$rF1$8(B
$B$G$9!%$^$?0UL#$b(B quote $B$HF1$8$G$9!%(B

$B!t$3$l$i(B yfunction $B$J$I$N85$N%"%$%G%"$O!$(BY $B%3%s%S%M!<%?$r;H$C$?:F5"4X(B
$B!t?t$NDj5A$K$"$j$^$9!%$^$?!$(B(1) $B8=:_$N%G%#%l%/%H%j%Q%9L>$r(B (1-1) .  
$B!t(B($B%I%C%H(B)$B$GI=$9$+!$(B(1-2) $B@dBP%Q%9$GI=$9$+$d!$(B(2) $BBeF~J8$r(B (2-1) a=a+1
$B!t$H=q$/$+!$(B(2-2) a++$B$H=q$/$+$N0c$$$r9M$($?>l9g!$(Byfunction $B$J$I$O(B (1-2)
$B!t$d(B (2-2) $B$K6a$$$b$N$H9M$($F$$$^$9!%(B

$B!t$=$&$$$($P!$@N$N(B lisp $B$K$O(B label $B$H$+$$$&$N$G:F5"$rDj5A$7$?$H$+$$$&$N(B
$B!t$r$I$3$+$G8+$?$h$&$J3P$($,$"$k$N$G$9$,!$;w$?$h$&$J$b$N$J$N$+$J!%(B

$B!v(B $B!v(B $B!v(B

ydefun $B$rMxMQ$9$k$H!$(B

(defun a (u v)
  (cond
    ((zerop u) (1+ v))
    ((zerop v) (a (1- u) 1))
    (t (a (1- u) (a u (1- v))))))

$B$,(B

(ydefun a (u v)
  (cond
    ((zerop u) (1+ v))
    ((zerop v) (=@= (1- u) 1))
    (t (=@= (1- u) (=@= u (1- v))))))

$B$N$h$&$KJQ$($k$3$H$,$G$-$^$9!%$=$l$@$1$G$9(B :) $BC"$7!$4X?tDj5A$,JQ2=$9$k(B
$B>l9g!$JV$9CM$,0[$J$k>l9g$,$"$j$^$9!%Nc$($P!$(B

$B%1!<%9(B 1:
(ydefun a (u v) 
  (cond
    ((zerop u) (1+ v))
    ((zerop v) (a (1- u) 1))
    (t (a (1- u) (a u (1- v))))))
(setq b (symbol-function 'a))
(apply b '(3 4))                     <--- 1-A
(ydefun a (u v) (+ u v))
(apply b '(3 4))                     <--- 1-B

$B%1!<%9(B 2:
(ydefun a (u v)
  (cond
    ((zerop u) (1+ v))
    ((zerop v) (=@= (1- u) 1))
    (t (=@= (1- u) (=@= u (1- v))))))
(setq b (symbol-function 'a))
(apply b '(3 4))                     <--- 2-A
(ydefun a (u v) (+ u v))
(apply b '(3 4))                     <--- 2-B

$B>e$N%1!<%9(B 1 $B$G$O!$(B1-A $B$G(B 125 $B$rJV$7!$(B1-B $B$G(B 8 $B$rJV$7$^$9!%0lJ}!$%1!<(B
$B%9(B 2 $B$G$O!$(B2-A, 2-B $B$H$b(B 125 $B$rJV$7$^$9!%(B

$B$^$?!$(Byfunction $B$r;H$&$H(B

(setq a (yfunction (lambda (u v)
  (cond
    ((zerop u) (1+ v))
    ((zerop v) (=@= (1- u) 1))
    (t (=@= (1- u) (=@= u (1- v))))))))

$B$N$h$&$K%i%`%@<0$N:F5"$,2DG=$K$J$j$^$9!%(B

$B!v(B $B!v(B $B!v(B

yfunction, ydefun, yflet $B$O%M%9%H$b2DG=$G$9!%?F$N(B yfunction $B$N0z?t$H$J$C(B
$B$F$$$k%i%`%@<0!$?F$N(Byflet $B$N4X?t$r;H$$$?$$$H$-$K$O!$(B=@@= $B$^$?$O(B=2= $B$,(B
=@= $B$NBe$o$j$K;H$($^$9!%F1MM$K!$?F$N?F$K$O(B =@@@= $B$^$?$O(B =3=$B!$$=$N?F$K(B
$B$O(B =@@@@= $B$^$?$O(B=4=$B!$(B.... $B$,;H$($^$9!%(B16 $B8D$^$G$N%M%9%H$KBQ$($i$l$k$h(B
$B$&$K$J$C$F$$$^$9!%(B($B%M%9%H$N5!G=$O$"$^$jJXMx$H$O;W$C$F$$$J$$$N$G$9$,!$(B
$B:n$k$3$H$N6=L#$+$i:n$C$F$_$^$7$?!%(B)

$B$J$*!$5-9f(B =@@=, =2=, =@@@=, =3=, ... $B$b!$JQ?t(B
yfunction:fname-symbol:alist $B$K$h$j%+%9%?%^%$%:2DG=$G$9!%(B

$B0J2<$K!$(B=@= $B$H(B =@@= $B$H$rMQ$$$?<BNc$r$"$2$^$9(B($B7h$7$FH~$7$$;H$$J}$H$O$$(B
$B$($J$$$N$G$9$,(B)$B!%Dj5A$7$F$$$k4X?t$O!$M?$($i$l$?(B S $B<0Cf$K(B
       (include "$B%U%!%$%kL>(B") 
$B$,8=$o$l$?>l9g$K!$(B"$B%U%!%$%kL>(B" $BCf$N$O$8$a$N(B 1 $B$D$N(B S $B<0$rFI$_9~$_!$$"(B
$B$?$+$b(B (include "$B%U%!%$%kL>(B") $B$N2U=j$K(B "$B%U%!%$%kL>(B" $BCf$N(B 1 $B$D$N(B S $B<0$,(B
$B$"$k$h$&$K8+$;$k$b$N$G$9!%(B
| (ydefun include-expand (u)
|   "S $B<0Cf$N(B include $BJ8$rE83+$9$k!%(B"
| 
|   (yflet ((rest (u)
|           (if (consp u) (cons (=@@= (car u)) (=@= (cdr u))) u))
|               
|           (include (u)
|             (setq u (expand-file-name u))
|             (if (not (file-exists-p u)) (error "File %s not found." u))
|             (save-excursion
|               (let ((bf (generate-new-buffer "xxx")))
|                 (set-buffer bf)
|                 (insert-file u)
|                 (goto-char (point-min))
|                 (prog1 (read (current-buffer)) (kill-buffer bf))))))
| 
|     (if (and (consp u) (eq (car u) 'include) (stringp (car (cdr u))))
|      ;then
|       (include (car (cdr u)))
|      ;else
|       (rest u))))

$B!v(B $B!v(B $B!v(B

$B%3%s%Q%$%i$KBP1~$5$;$k$?$a$K$O!$F1Iu$N%Q%C%A(B (bytecomp.el.diff) $B$r(B
bytecomp.el $B$KEv$F$F2<$5$$!%C"$7!$%Q%9$,#1$DA}$($^$9$N$G%3%s%Q%$%k;~4V(B
$B$,D9$/$J$j$^$9!%EvJ}$N4D6-$O(B

GNU Emacs 18.59.6 of Thu Mar  3 1994 on oyakata (berkeley-unix)
  Nemacs version 3.3.2 of 1990.6.6

$B$G$9$,!$4JC1$J%Q%C%A$J$N$GB>$N(B emacs $B$G$b$3$N%Q%C%A$O;H$($k$H;W$$$^$9!%(B

$B$J$*!$%P%/$,$"$j$^$7$?$i;d$^$G65$($FD:$1$l$P9,$$$G$9!%$?$@$7!$5^$.$N>l(B
$B9g$O!$(Bfj.editor.emacs $B$^$?$O(B mule $B$rMxMQ$7$?J}$,3N<B$G$7$g$&(B :)

$B?9(B $BOB9%(B ($BElKLBg3X(B $B9)3XIt(B $BEE5$9)3X2J(B)

#!/bin/sh

# This is a shell archive.  Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# Wrapped by  on Sun Mar 20 20:35:36 JST 1994
# Contents:  yfunction.el bytecomp.el.diff
 
echo x - yfunction.el
sed 's/^@//' > "yfunction.el" <<'@//E*O*F yfunction.el//'
;;; -*- Mode: Emacs-Lisp -*-
;;; File:yfunction.el
;;; Author:Kazuyoshi Mori <mori@abe.ecei.tohoku.ac.jp>
;;; First created:March 20, 1994
;;; Version:0.1J

;; Copyright (C) 1994 Kazuyoshi Mori

;;   This program is free software; you can redistribute it and/or modify
;;   it under the terms of the GNU General Public License as published by
;;   the Free Software Foundation; either version 1, or (at your option)
;;   any later version.

;;   This program 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 General Public License for more details.

;;   You should have received a copy of the GNU General Public License
;;   along with this program; if not, write to the Free Software
;;   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

(defvar yfunction:creat:id:number 0 "yfunction:creat:id $B$K=>B0$9$kJQ?t!%(B")
(defun yfunction:creat:id ()
  "\
 $B?7$7$$%f%K!<%/$J<1JL;R$r:n$j$^$9!%(B
 ($BC"$7!$40A4$K%f%K!<%/$H$$$&J]>Z$O$J$$(B)"
  (setq yfunction:creat:id:number (1+ yfunction:creat:id:number))
  (intern (format "yfunction:creat:id:%s:%s:%s:%d" 
              (current-time-string) 
              (system-name)
              (make-temp-name "")
              yfunction:creat:id:number)))

(defvar yfunction:pointer-symbol (yfunction:creat:id) "$BFbItJQ?t(B")
(defvar yfunction:stack nil "$BFbItJQ?t(B")
(defvar yfunction:stack:length 0 "$BFbItJQ?t(B")

(defmacro yfunction (lam)
  "\
 LAM $B$O%i%`%@<0!%(B
 $B:F5"E*$J%i%`%@<0$r2DG=$K$7$^$9!%$D$^$j%i%`%@<0Fb$G!$%i%`%@<0(B
 $B<+J,<+?H$r(B =@= $B$K$h$jI=$9$3$H$,2DG=$K$J$j$^$9!%$J$*!$(B=@= $B$OJQ(B
 $B?t(B yfunction:fname-symbol $B$K$h$j%+%9%?%^%$%:$G$-$^$9!%(B

 $B%M%9%H$b2DG=$G$9!%?F$O(B =@@= $B$^$?$O(B =2= $B$K$h$j!$?F$N?F$O(B =@@@= $B$^$?$O(B
 =3=, ....$B$K$h$j;2>H$G$-$^$9!%(B

 $BCm0U(B:$B85$N%i%`%@<0$O%j%9%H$K$h$jI=8=$5$l$F$$$^$9$,!$$=$l$OJ]B8(B
 $B$5$l$^$;$s!%(B"

  (let* (newlam newfns (yfunction:stack nil) (yfunction:stack:length 0))
    (setq newlam (yfunction:sexp-expand (list 'yfunction lam)))
    (setq newfns (cdr newlam))
    (setq newlam (car newlam))
    (yfunction:foreach fn newfns (eval fn))
    newlam
  );let
);defmacro

(defmacro ydefun (&rest u)
  "\
 $BJ8K!$O(B defun $B$HF1Ey!%(B
 $BC"$7!$Dj5AFb$G4X?t<+J,<+?H$r(B =@= $B$K$h$jI=$9$3$H$,2DG=$K$J$j$^$9!%(B
 $B$J$*!$(B=@= $B$OJQ?t(B yfunction:fname-symbol $B$K$h$j%+%9%?%^%$%:$G$-$^$9!%(B"

  (let* (newbodyfns (yfunction:stack nil) (yfunction:stack:length 0))
    (setq newbodyfns (yfunction:sexp-expand (cons 'ydefun u)))
    (yfunction:foreach fn (cdr newbodyfns) (eval fn))    
    (car newbodyfns)))

(defmacro yflet (lfns &rest body)
  "\
 yflet $B$O%m!<%+%k4X?t$r%(%_%e%l!<%H$7$^$9!%J8K!$O!$(B
     (yflet LFNS BODY...)
 $B$G!$(BLFNS $B$O4X?tDj5A$+$i$J$k%j%9%H$G!$%j%9%H$NMWAG$O(B
     (SYMBOL (ARG...) BODY2...)
 $B$+$i$J$j$^$9!%(BSYMBOL $B$O%m!<%+%k4X?tL>!$(BARG... $B$O2>0z?t!$(BBODY2... $B$O=g(B
 $B$KI>2A$5$l$k<0$G$9!%4X?tCM$O(B BODY2... $B$N:G8e$N<0$NI>2ACM$G$9!%$J$*!$(B
 BODY2... $BCf$N(B =@= $B$O8=:_Dj5A$7$F$$$k4X?t(B($B$9$J$o$A(B SYMBOL)$B$rI=$7$^$9!%(B
 yflet $B$G$O$3$l$i(B LFNS $B$N%m!<%+%k4X?t$,$^$:Dj5A$5$l$^$9!%(B
  $B$=$N8e!$(Byflet $BCf$N(B BODY... $B$,=g$KI>2A$5$l$^$9!%(Byflet $B$NCM$O(B BODY...
 $B$N:G8e$N<0$NI>2ACM$G$9!%$^$?!$(Byflet $B=*N;;~$K$O(B LFNS $B$K$h$jDj5A$5$l$?(B
 $B4X?t$O!$85!9Dj5A$5$l$F$$$?>l9g$K$O(B yflet $B$r<B9T$9$kA0$N85$N4X?t$H$J$j!$(B
 $B$^$?$ODj5A$5$l$F$$$J$$>l9g$K$OL$Dj5A$H$J$j$^$9!%(B"

  (let* (newfns newbody (yfunction:stack nil) (yfunction:stack:length 0))
    (setq newbody (yfunction:sexp-expand (cons 'yflet (cons lfns body))))
    (setq newfns  (cdr newbody))
    (setq newbody (car newbody))
    (yfunction:foreach fn newfns (eval fn))
    newbody
  );let
);defmacro

(defmacro ynoexpand (u) (list 'quote u))

(defun yfunction:sexp-expand (u)
  (yfunction:sexp-expand:subst 
     (yfunction:sexp-expand:subst:init u)))

(defun yfunction:sexp-expand:subst:init (u)
  (if (yfunction:ynoexpandp u) (cons 'quote (cdr u))
      (yfunction:sexp-expand:subst:init:rest u)))

(defun yfunction:sexp-expand:subst:init:rest (u)
  (if (consp u)
    ;then
     (cons (yfunction:sexp-expand:subst:init (car u))
           (yfunction:sexp-expand:subst:init:rest (cdr u)))
    ;else
      (let ((v (assoc u yfunction:fname-symbol:alist)))
        (if v (cons yfunction:pointer-symbol (cdr v))
              u))))

(defun yfunction:sexp-expand:subst (u)
  (if (consp u) 
   ;then
    (cond
     ;((yfunction:ynoexpandp u) (yfunction:sexp-expand:subst:ynoexpand u))
      ((yfunction:ydefunp    u) (yfunction:sexp-expand:subst:ydefun    u))
      ((yfunction:yfunctionp u) (yfunction:sexp-expand:subst:yfunction u))
      ((yfunction:yfletp     u) (yfunction:sexp-expand:subst:yflet     u))
      ((yfunction:pointerp   u) (yfunction:sexp-expand:subst:pointer   u))
      (t                        (yfunction:sexp-expand:subst:rest      u)))
   ;else
    (cons u nil)))

(defun yfunction:sexp-expand:subst:rest (u)
  (if (consp u) 
   ;then
     (let* ((newu1  (yfunction:sexp-expand:subst      (car u)))
            (newu2  (yfunction:sexp-expand:subst:rest (cdr u)))
            (newu   (cons (car newu1) (car newu2)))
            (newfns (append (cdr newu1) (cdr newu2))))

       (cons newu newfns))
   ;else
    (cons u nil)))

(defun yfunction:yfunctionp (u)
 "\
 U $B$,(B yfunction $B$N<0$+%A%'%C%/$9$k!%(B"
  (and (consp u) (eq (car u) 'yfunction)
       (consp (cdr u)) (consp (car (cdr u))) 
       (eq (car (car (cdr u))) 'lambda)
       (consp (cdr (car (cdr u))))
       (or (null (car (cdr (car (cdr u)))))
           (consp (car (cdr (car (cdr u))))))))

(defun yfunction:ynoexpandp (u)
  (and (consp u) (eq 'ynoexpand (car u))))

(defun yfunction:pointerp (u)
 "\
 U $B$,(B pointer $B$+%A%'%C%/$9$k!%(B"
  (and (consp u) (eq (car u) yfunction:pointer-symbol)
       (numberp (cdr u))))

(defun yfunction:ydefunp (u)
 "\
 U $B$,(B ydefun $B$N<0$+%A%'%C%/$9$k!%(B"
  (and (consp u) (eq (car u) 'ydefun)
       (consp (cdr u)) (consp (cdr (cdr u)))))

(defun yfunction:yfletp (u)
 "\
 U $B$,(B yflet $B$N<0$+%A%'%C%/$9$k!%(B"
  (and (consp u) (eq (car u) 'yflet)
       (consp (cdr u)) (consp (car (cdr u))) 
       (consp (cdr (cdr u)))))

(defun yfunction:sexp-expand:subst:yfunction (u)
  (let* ((id    (yfunction:creat:id))
         (vlist (car (cdr (car (cdr u)))))
         (body  (cdr (cdr (car (cdr u)))))
         (yfunction:stack (cons id yfunction:stack))
         (yfunction:stack:length (1+ yfunction:stack:length))
         (newfns)
         (newbody))

    (setq newbody (yfunction:sexp-expand:subst:rest body))
    (setq newfns  (cdr newbody))
    (setq newbody (car newbody))

    (cons (list 'function id)
          (cons (cons 'defun (cons id (cons vlist newbody))) newfns))
))

(defun yfunction:sexp-expand:subst:ydefun (u)
  (let* ((id (car (cdr u)))
         (newid)
         (newfns))
   
    (setq newid (yfunction:sexp-expand:subst (list 'yfunction
            (cons 'lambda (cdr (cdr u))))))
    (setq newfns (cdr newid))
    (setq newid  (car newid))

    (cons (list 'quote id) (append newfns
            (list (list 'fset (list 'quote id) 
                               (list 'symbol-function newid)))))
))

(defvar yfunction:sexp-expand:subst:yflet:undef (yfunction:creat:id))
(defun yfunction:sexp-expand:subst:yflet (u)
  (let* ((tmpv (yfunction:creat:id))
         (lfns (car (cdr u)))
         (body (cdr (cdr u)))
         (undef yfunction:sexp-expand:subst:yflet:undef)
         (newfns)
         (s1) (s2) (s3))
   
    (setq lfns (mapcar (function (lambda (f)
      (let* ((name (car f))
             (args (car (cdr f)))
             (body (cdr (cdr f)))
             (newname (yfunction:creat:id)))

        (setq newfns (append (yfunction:sexp-expand 
                      (cons 'ydefun (cons newname (cons args body)))) newfns))
        (cons name newname))))
      lfns))

    (setq s1 nil)
    (yfunction:foreach f lfns
      (let ((name    (car f))
            (newname (cdr f)))

         (setq s1 (cons
           (` (if (fboundp '(, name))
                (setq (, tmpv) (cons (cons '(, name)
                                        (symbol-function '(, name))) (, tmpv)))
                (setq (, tmpv) (cons (cons '(, name) '(, undef)) (, tmpv)))))
          (cons
           (` (fset '(, name) (symbol-function '(, newname))))
            s1)))))
 
    (setq s2  (` (while (, tmpv)
                          (if (eq (cdr (car (, tmpv))) '(, undef))
                            (fmakunbound (car (car (, tmpv))))
                            (fset (car (car (, tmpv))) (cdr (car (, tmpv)))))
                          (setq (, tmpv) (cdr (, tmpv))))))

    (setq s3 (` (let ((, tmpv))
                  (,@ s1)
                  (unwind-protect 
                    (,@ (if (null (cdr body)) body (list (cons 'progn body))))
                    (, s2)))))
    (cons s3 newfns)
  );let*
);defun

(defun yfunction:sexp-expand:subst:ynoexpand (u)
  (cons (car (cdr u)) nil))

(defun yfunction:sexp-expand:subst:pointer (u)
  (if (> (cdr u) yfunction:stack:length)
     (error "yfunction: yfunction:sexp-expand:subst:pointer error"))

  (cons (nth (1- (cdr u)) yfunction:stack) nil))

(defun yfunction:buffer-expand ()
  "\
 $B%P%C%U%!Fb$N(B yfunction, ydefun, yflet (ynoexpand $B$N=hM}4^$`(B) $B$rE83+$9$k!%(B"
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (let (p1 p2 u newform genfns 
          (expandp t))
      (while (save-excursion
       (while (progn (skip-chars-forward " \t\n\^l")
     (looking-at ";"))
 (forward-line 1))
       (not (eobp)))

        (setq p1 (point))
        (setq u (read (current-buffer)))
        (setq p2 (point))
        (goto-char p1)
        (if (re-search-forward yfunction:buffer-expand:keyword:reg p2 t) (progn
         ;then
          (delete-region p1 p2)
          (setq newform (yfunction:sexp-expand u))
          (setq genfns  (cdr newform))
          (setq newform (car newform))
  
          (print newform (current-buffer))
          (yfunction:foreach fn genfns
            (insert "\n")
            (print fn (current-buffer))))
         ;else
          (goto-char p2)
        )
      );while
    );let
  );save-excursion
);defun

(defvar yfunction:foreach:tempvar (yfunction:creat:id) "$BFbItJQ?t(B")
(defmacro yfunction:foreach (var vlist &rest forms)
  (list 'let (list var yfunction:foreach:tempvar)
    (list 'setq yfunction:foreach:tempvar vlist)
    (list 'while yfunction:foreach:tempvar
          (list 'setq var (list 'car yfunction:foreach:tempvar))
          (cond  
            ((null forms) nil)
            ((null (cdr forms)) (car forms))
            (t (cons 'progn forms)))
          (list 'setq yfunction:foreach:tempvar 
                                        (list 'cdr yfunction:foreach:tempvar)))
    nil)
);defmacro

(defun yfunction:reg:concat (&rest l)
  (if (null (cdr l)) 
    (car l)
    (apply (function concat) (cons "\\(" (yfunction:reg:concat:slave l)))))

(ydefun yfunction:reg:concat:slave (l)
  (if (null (cdr l))
    (cons (car l) (cons "\\)" nil))
    (cons (car l) (cons "\\|" (yfunction:reg:concat:slave (cdr l))))))

(defvar yfunction:buffer-expand:keyword:reg
  (concat "\\<" (yfunction:reg:concat "yfunction"
                                      "ydefun"
                                      "yflet"
                                      "ynoexpand") "\\>")
  "\
 yfunction:buffer-expanbd $B<B9T;~$K%P%C%U%!$rE83+$9$kI,MW$N$"$k(B S $B<0$N(B
 $B@55,I=8=(B"
)

(defvar yfunction:fname-symbol:alist (ynoexpand
   ((=@=                .  1) (=1=  .  1)
    (=@@=               .  2) (=2=  .  2)
    (=@@@=              .  3) (=3=  .  3)
    (=@@@@=             .  4) (=4=  .  4)
    (=@@@@@=            .  5) (=5=  .  5)
    (=@@@@@@=           .  6) (=6=  .  6)
    (=@@@@@@@=          .  7) (=7=  .  7)
    (=@@@@@@@@=         .  8) (=8=  .  8)
    (=@@@@@@@@@=        .  9) (=9=  .  9)
    (=@@@@@@@@@@=       . 10) (=10= . 10)
    (=@@@@@@@@@@@=      . 11) (=11= . 11)
    (=@@@@@@@@@@@@=     . 12) (=12= . 12)
    (=@@@@@@@@@@@@@=    . 13) (=13= . 13)
    (=@@@@@@@@@@@@@@=   . 14) (=14= . 14)
    (=@@@@@@@@@@@@@@@=  . 15) (=15= . 15)
    (=@@@@@@@@@@@@@@@@= . 16) (=16= . 16)))
 "\
 yfunction:fname-symbol:alist $B$O!$O"A[%j%9%H$rCM$H$7$F;}$A$^$9!%(B

 $B3FMWAG$O!$(B(SYMBOL . NUMBER) $B$+$i$J$k%Z%"$G$9!%<+A3?t(B NUMBER $B$,(B
 SYMBOL $B$NI=$o$94X?t$rDj$a$^$9!%$9$J$o$A!$(BNUMBER $B$NCM$,(B 
  1 : $B8=:_Dj5A$7$F$$$k4X?t<+?H(B(yfunction $B$J$i%i%`%@<0!$(Bydefun, yflet $B$J$i(B
      $BDj5A$7$F$$$k4X?t(B)
  2 : $B?F(B
  3 : $B?F$N?F(B
  4 : $B?F$N?F$N?F(B
  ... 

 $B$H$J$j$^$9!%(B"
)

;(defun yfunction:creat:id ()
;  "$B?7$7$$%f%K!<%/$J<1JL;R$r:n$k4X?t!%%G%P%C%0MQ!%(B"
;  (setq yfunction:creat:id:number (1+ yfunction:creat:id:number))
;  (intern (format "id%d" yfunction:creat:id:number)))

(provide 'yfunction)

;Local Variables:                                                  %
;eval: (message "yfunction.el: Copyright (C) 1994 Kazuyoshi Mori") %
;End:                                                              %
@//E*O*F yfunction.el//
chmod u=rw,g=r,o=r yfunction.el
 
echo x - bytecomp.el.diff
sed 's/^@//' > "bytecomp.el.diff" <<'@//E*O*F bytecomp.el.diff//'
*** bytecomp.el.orgSat Mar  5 18:45:59 1994
--- bytecomp.elMon Mar  7 12:20:13 1994
***************
*** 20,25 ****
--- 20,26 ----
  ;; along with GNU Emacs; see the file COPYING.  If not, write to
  ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  
+ (require 'yfunction)
  (provide 'byte-compile)
  
  (defvar byte-compile-constnum -1
***************
*** 219,224 ****
--- 220,226 ----
        (set-buffer inbuffer)
        (erase-buffer)
        (insert-file-contents filename)
+       (yfunction:buffer-expand)
        (goto-char 1)
        (set-buffer outbuffer)
        ;; Avoid running hooks; all we really want is the syntax table.
@//E*O*F bytecomp.el.diff//
chmod u=rw,g=r,o=r bytecomp.el.diff
 
exit 0
