Changeset 5245


Ignore:
Timestamp:
12/23/03 15:24:04 (18 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/jvm.lisp

    r5244 r5245  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.60 2003-12-23 13:42:36 piso Exp $
     4;;; $Id: jvm.lisp,v 1.61 2003-12-23 15:24:04 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    328328(defstruct local-function
    329329  name
     330  args-to-add
    330331  function)
    331332
     
    337338
    338339(defun clear ()
    339   (setq *pool* nil
     340  (setf *pool* nil
    340341        *pool-count* 1
    341342        *code* nil)
     
    14841485
    14851486    (cond
    1486      ((setf local-function (find fun *local-functions* :key #'local-function-name))
     1487     ((setf local-function
     1488            (find fun *local-functions* :key #'local-function-name))
    14871489      (format t "compiling call to local function ~S~%" local-function)
     1490      (when (local-function-args-to-add local-function)
     1491        (format t "args-to-add = ~S~%" (local-function-args-to-add local-function))
     1492        (setf args (append (local-function-args-to-add local-function) args))
     1493        (setf numargs (length args))
     1494        (format t "args = ~S~%" args))
    14881495      (let* ((g (declare-object (local-function-function local-function))))
    14891496        (emit 'getstatic
     
    20742081         (body (cddr def))
    20752082         (form (list* 'lambda arglist body))
    2076          compiled-function)
     2083         (args-to-add (remove-duplicates (union (remove nil (coerce *locals* 'list))
     2084                                                (remove nil (coerce *args* 'list))))))
     2085    (format t "form = ~S~%" form)
     2086    (format t "args-to-add = ~S~%" args-to-add)
     2087    (format t "new arglist = ~S~%" (append args-to-add arglist))
     2088    (when args-to-add
     2089      (setf arglist (append args-to-add arglist))
     2090      (setf form (list* 'lambda arglist body)))
    20772091    (format t "form = ~S~%" form)
    20782092    (setf function (compile-defun name form "flet.out"))
    20792093    (format t "function = ~S~%" function)
    2080     (push (make-local-function :name name :function function) *local-functions*)))
     2094    (push (make-local-function :name name
     2095                               :args-to-add args-to-add
     2096                               :function function)
     2097          *local-functions*)))
    20812098
    20822099(defun compile-local-functions (defs)
     
    20852102
    20862103(defun compile-flet (form for-effect)
    2087   #+nil
    2088   (let ((*local-functions* *local-functions*)
    2089         (locals (cadr form))
    2090         (body (cddr form)))
    2091     (compile-local-functions locals)
    2092     (do ((forms body (cdr forms)))
    2093         ((null forms))
    2094       (compile-form (car forms) (cdr forms))))
    2095   (error "COMPILE-FLET: unsupported case"))
     2104  (if nil
     2105      (let ((*local-functions* *local-functions*)
     2106            (locals (cadr form))
     2107            (body (cddr form)))
     2108        (compile-local-functions locals)
     2109        (do ((forms body (cdr forms)))
     2110            ((null forms))
     2111          (compile-form (car forms) (cdr forms))))
     2112      (error "COMPILE-FLET: unsupported case")))
    20962113
    20972114(defun compile-function (form for-effect)
Note: See TracChangeset for help on using the changeset viewer.