Changeset 5244


Ignore:
Timestamp:
12/23/03 13:42:36 (18 years ago)
Author:
piso
Message:

Work in progress.

Location:
trunk/j/src/org/armedbear/lisp
Files:
2 edited

Legend:

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

    r5201 r5244  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.59 2003-12-19 18:30:55 piso Exp $
     4;;; $Id: jvm.lisp,v 1.60 2003-12-23 13:42:36 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    323323;;         ;; Not found in variables list.
    324324;;         (special-variable-p var))))
     325
     326(defvar *local-functions* ())
     327
     328(defstruct local-function
     329  name
     330  function)
    325331
    326332(defvar *args* nil)
     
    14611467  (unless (symbolp fun)
    14621468    (error "COMPILE-FUNCTION-CALL ~S is not a symbol" fun))
    1463   (let ((numargs (length args)))
     1469  (let ((numargs (length args))
     1470        local-function)
    14641471    (cond ((= numargs 1)
    14651472           (when (compile-function-call-1 fun args)
     
    14771484
    14781485    (cond
     1486     ((setf local-function (find fun *local-functions* :key #'local-function-name))
     1487      (format t "compiling call to local function ~S~%" local-function)
     1488      (let* ((g (declare-object (local-function-function local-function))))
     1489        (emit 'getstatic
     1490              *this-class*
     1491              g
     1492              "Lorg/armedbear/lisp/LispObject;")))
    14791493     ((eq fun *defun-name*)
    14801494      (emit 'aload 0)) ; this
     
    20532067  )
    20542068
     2069(defun compile-local-function-def (def)
     2070  (format t "*locals* = ~S~%" *locals*)
     2071  (format t "*args* = ~S~%" *args*)
     2072  (let* ((name (car def))
     2073         (arglist (cadr def))
     2074         (body (cddr def))
     2075         (form (list* 'lambda arglist body))
     2076         compiled-function)
     2077    (format t "form = ~S~%" form)
     2078    (setf function (compile-defun name form "flet.out"))
     2079    (format t "function = ~S~%" function)
     2080    (push (make-local-function :name name :function function) *local-functions*)))
     2081
     2082(defun compile-local-functions (defs)
     2083  (dolist (def defs)
     2084    (compile-local-function-def def)))
     2085
     2086(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"))
     2096
    20552097(defun compile-function (form for-effect)
    20562098   (let ((obj (second form)))
     
    22512293       #.(format nil "([~A)~A" +lisp-object+ +lisp-object+))))
    22522294
    2253 (defun compile-defun (name form)
     2295(defun compile-defun (name form &optional (classfile "out.class"))
    22542296  (unless (eq (car form) 'LAMBDA)
    22552297    (return-from compile-defun nil))
     
    23402382      (pool-name "Code") ; Must be in pool!
    23412383
    2342       ;; Write class file (out.class in current directory).
    2343       (with-open-file (*stream* "out.class"
     2384      ;; Write class file.
     2385      (with-open-file (*stream* classfile
    23442386                                :direction :output
    23452387                                :element-type 'unsigned-byte
     
    23672409        ;; attributes count
    23682410        (write-u2 0))))
    2369   (sys::load-compiled-function "out.class"))
     2411  (sys::load-compiled-function classfile))
    23702412
    23712413(defun get-lambda-to-compile (definition-designator)
     
    24582500                          cons
    24592501                          declare
     2502                          flet
    24602503                          function
    24612504                          go
  • trunk/j/src/org/armedbear/lisp/precompiler.lisp

    r5243 r5244  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: precompiler.lisp,v 1.23 2003-12-22 17:18:47 piso Exp $
     4;;; $Id: precompiler.lisp,v 1.24 2003-12-23 13:42:05 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    298298      (push (precompile-local-function-def def) result))))
    299299
    300 (defun precompile-flet (form)
    301   (let ((locals (cadr form))
    302         (body (cddr form)))
    303     (list* (car form)
    304            (precompile-local-functions locals)
    305            (mapcar #'precompile1 body))))
    306 
    307 (defun precompile-labels (form)
     300(defun precompile-flet/labels (form)
    308301  (let ((locals (cadr form))
    309302        (body (cddr form)))
     
    490483(install-handler 'do*                  'precompile-do/do*)
    491484
    492 (install-handler 'flet                 'precompile-flet)
    493 (install-handler 'labels               'precompile-labels)
     485(install-handler 'flet                 'precompile-flet/labels)
     486(install-handler 'labels               'precompile-flet/labels)
    494487
    495488(install-handler 'do-symbols           'precompile-do-symbols)
Note: See TracChangeset for help on using the changeset viewer.