Changeset 13473
 Timestamp:
 08/12/11 22:31:54 (10 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/abcl/src/org/armedbear/lisp/compilerpass1.lisp
r13472 r13473 876 876 (defun validatefunctionname (name) 877 877 (unless (or (symbolp name) (setffunctionnamep name)) 878 (compilererror "~S is not a valid function name." name))) 879 880 (defmacro withlocalfunctionsforflet/labels 881 (form localfunctionsvar lambdalistvar namevar bodyvar body1 body2) 882 `(let ((*visiblevariables* *visiblevariables*) 878 (compilererror "~S is not a valid function name." name)) 879 name) 880 881 (defun constructflet/labelsfunction (definition variablename) 882 (let* ((name (car definition)) 883 (blockname (fdefinitionblockname (validatefunctionname name))) 884 (lambdalist (cadr definition)) 885 (compiland (makecompiland :name name :parent *currentcompiland*)) 886 (localfunction (makelocalfunction :name name :compiland compiland))) 887 (push compiland (compilandchildren *currentcompiland*)) 888 (when variablename 889 (setf (localfunctionvariable localfunction) 890 (makevariable :name variablename))) 891 (multiplevaluebind 892 (body decls) 893 (parsebody (cddr definition)) 894 (setf (localfunctiondefinition localfunction) 895 (copytree (cdr definition))) 896 (setf (compilandlambdaexpression compiland) 897 (rewritelambda `(lambda ,lambdalist 898 ,@decls 899 (block ,blockname 900 ,@body))))) 901 localfunction)) 902 903 (defun p1flet (form) 904 (let* ((localfunctions 905 (mapcar #'(lambda (definition) 906 (constructflet/labelsfunction definition nil)) 907 (cadr form))) 908 (*localfunctions* *localfunctions*)) 909 (dolist (localfunction localfunctions) 910 (p1compiland (localfunctioncompiland localfunction))) 911 (dolist (localfunction localfunctions) 912 (push localfunction *localfunctions*)) 913 (withsavedcompilerpolicy 914 (processoptimizationdeclarations (cddr form)) 915 (let* ((block (makefletnode)) 916 (*block* block) 917 (*blocks* (cons block *blocks*)) 918 (body (cddr form)) 919 (*visiblevariables* *visiblevariables*)) 920 (setf (fletfreespecials block) 921 (processdeclarationsforvars body nil block)) 922 (dolist (special (fletfreespecials block)) 923 (push special *visiblevariables*)) 924 (setf body (p1body body) ;; affects the outcome of referencesneededp 925 (fletform block) 926 (list* (car form) 927 (removeif #'(lambda (fn) 928 (and (inlinep (localfunctionname fn)) 929 (not (localfunctionreferencesneededp fn)))) 930 localfunctions) 931 body)) 932 block)))) 933 934 935 (defun p1labels (form) 936 (let* ((localfunctions 937 (mapcar #'(lambda (definition) 938 (constructflet/labelsfunction definition (gensym))) 939 (cadr form))) 883 940 (*localfunctions* *localfunctions*) 884 (parentcompiland *currentcompiland*) 885 (,localfunctionsvar '())) 886 (dolist (definition (cadr ,form)) 887 (let ((,namevar (car definition)) 888 (,lambdalistvar (cadr definition))) 889 (validatefunctionname ,namevar) 890 (let* ((,bodyvar (cddr definition)) 891 (compiland (makecompiland :name ,namevar 892 :parent parentcompiland))) 893 (push compiland (compilandchildren parentcompiland)) 894 ,@body1))) 895 (setf ,localfunctionsvar (nreverse ,localfunctionsvar)) 896 ;; Make the local functions visible. 897 (dolist (localfunction ,localfunctionsvar) 898 (push localfunction *localfunctions*) 899 (let ((variable (localfunctionvariable localfunction))) 900 (when variable 901 (push variable *visiblevariables*)))) 902 ,@body2)) 903 904 (defun p1flet (form) 905 (withlocalfunctionsforflet/labels 906 form localfunctions lambdalist name body 907 ((let ((localfunction (makelocalfunction :name name 908 :compiland compiland)) 909 (definition (cons lambdalist body))) 910 (multiplevaluebind (body decls) (parsebody body) 911 (let* ((blockname (fdefinitionblockname name)) 912 (lambdaexpression 913 (rewritelambda `(lambda ,lambdalist 914 ,@decls 915 (block ,blockname ,@body))))) 916 (setf (compilandlambdaexpression compiland) lambdaexpression) 917 (setf (localfunctiondefinition localfunction) 918 (copytree definition)) 919 (p1compiland compiland))) 920 (push localfunction localfunctions))) 921 ((withsavedcompilerpolicy 922 (processoptimizationdeclarations (cddr form)) 923 (let* ((block (makefletnode)) 924 (*block* block) 925 (*blocks* (cons block *blocks*)) 926 (body (cddr form)) 927 (*visiblevariables* *visiblevariables*)) 928 (setf (fletfreespecials block) 929 (processdeclarationsforvars body nil block)) 930 (dolist (special (fletfreespecials block)) 931 (push special *visiblevariables*)) 932 (let ((body (p1body (cddr form)))) 933 (setf (fletform block) 934 (list* (car form) 935 (removeif (lambda (fn) 936 (and (inlinep (localfunctionname fn)) 937 (not (localfunctionreferencesneededp fn)))) 938 localfunctions) 939 body))) 940 block))))) 941 942 943 (defun p1labels (form) 944 (withlocalfunctionsforflet/labels 945 form localfunctions lambdalist name body 946 ((let* ((variable (makevariable :name (gensym))) 947 (localfunction (makelocalfunction :name name 948 :compiland compiland 949 :variable variable)) 950 (blockname (fdefinitionblockname name))) 951 (setf (localfunctiondefinition localfunction) 952 (copytree (cons lambdalist body))) 953 (multiplevaluebind (body decls) (parsebody body) 954 (setf (compilandlambdaexpression compiland) 955 (rewritelambda 956 `(lambda ,lambdalist ,@decls (block ,blockname ,@body))))) 957 (push variable *allvariables*) 958 (push localfunction localfunctions))) 959 ((dolist (localfunction localfunctions) 960 (let ((*visiblevariables* *visiblevariables*)) 961 (p1compiland (localfunctioncompiland localfunction)))) 962 (let* ((block (makelabelsnode)) 963 (*block* block) 964 (*blocks* (cons block *blocks*)) 965 (body (cddr form)) 966 (*visiblevariables* *visiblevariables*)) 967 (setf (labelsfreespecials block) 968 (processdeclarationsforvars body nil block)) 969 (dolist (special (labelsfreespecials block)) 970 (push special *visiblevariables*)) 971 (setf (labelsform block) 972 (list* (car form) localfunctions (p1body (cddr form)))) 973 block)))) 941 (*visiblevariables* *visiblevariables*)) 942 (dolist (localfunction localfunctions) 943 (push localfunction *localfunctions*) 944 (let ((variable (localfunctionvariable localfunction))) 945 (push variable *allvariables*) 946 (push variable *visiblevariables*))) 947 (dolist (localfunction localfunctions) 948 (p1compiland (localfunctioncompiland localfunction))) 949 (let* ((block (makelabelsnode)) 950 (*block* block) 951 (*blocks* (cons block *blocks*)) 952 (body (cddr form)) 953 (*visiblevariables* *visiblevariables*)) 954 (setf (labelsfreespecials block) 955 (processdeclarationsforvars body nil block)) 956 (dolist (special (labelsfreespecials block)) 957 (push special *visiblevariables*)) 958 (setf (labelsform block) 959 (list* (car form) localfunctions (p1body (cddr form)))) 960 block))) 974 961 975 962 (defknown p1funcall (t) t)
Note: See TracChangeset
for help on using the changeset viewer.