mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 12:20:20 +02:00
Code Activity

Replace ice-9 match's structures with guile's records

Browse source 
* module/system/base/syntax.scm (define-record): Rebase to implement on
  top of Guile's records, which are the substrate of srfi-9's records.
  (%compute-initargs): Rename from %make-struct, just return the list of
  values.
  (get-slot, set-slot!, slot): Removed, no longer used.
  (record-case): Allow slots of the form (MYNAME SLOTNAME), which binds
  SLOTNAME to MYNAME (instead of SLOTNAME to SLOTNAME).
  (record-case, record?): No more ice-9 match!

* module/system/il/compile.scm (codegen): Tweaks so that the new record
  code works.

* module/system/il/ghil.scm: Fix some slot references.

* module/system/vm/assemble.scm (preprocess, codegen): Remove calls to
  `slot'.
  (codegen): Fix some slot references.
This commit is contained in:
Andy Wingo 2008-05-04 17:25:13 +02:00
parent a27bf0b7f6
commit f540e3271b
4 changed files with 54 additions and 83 deletions
Download patch file Download diff file Expand all files Collapse all files

20
module/system/il/compile.scm
View file

@ -276,10 +276,10 @@
((<ghil-lambda> env loc vars rest body)
(return-code! (codegen tree)))
((<ghil-inline> env loc inst args)
((<ghil-inline> env loc inline args)
;; ARGS...
;; (INST NARGS)
(push-call! loc inst args)
(push-call! loc inline args)
(maybe-drop)
(maybe-return))
@ -293,19 +293,19 @@
;;
;; main
(record-case ghil
((<ghil-lambda> env loc args rest body)
(let* ((vars (ghil-env-variables env))
(locs (pick (lambda (v) (eq? (ghil-var-kind v) 'local)) vars))
(exts (pick (lambda (v) (eq? (ghil-var-kind v) 'external)) vars)))
((<ghil-lambda> env loc vars rest body)
(let* ((evars (ghil-env-variables env))
(locs (pick (lambda (v) (eq? (ghil-var-kind v) 'local)) evars))
(exts (pick (lambda (v) (eq? (ghil-var-kind v) 'external)) evars)))
;; initialize variable indexes
(finalize-index! args)
(finalize-index! vars)
(finalize-index! locs)
(finalize-index! exts)
;; meta bindings
(push-bindings! args)
(push-bindings! vars)
;; export arguments
(do ((n 0 (1+ n))
(l args (cdr l)))
(l vars (cdr l)))
((null? l))
(let ((v (car l)))
(case (ghil-var-kind v)
@ -315,7 +315,7 @@
;; compile body
(comp body #t #f)
;; create GLIL
(let ((vars (make-glil-vars :nargs (length args)
(let ((vars (make-glil-vars :nargs (length vars)
:nrest (if rest 1 0)
:nlocs (length locs)
:nexts (length exts))))

2
module/system/il/ghil.scm
View file

@ -155,7 +155,7 @@
(define-public (make-ghil-env e)
(record-case e
((<ghil-mod>) (%make-ghil-env :mod e :parent e))
((<ghil-env> m) (%make-ghil-env :mod m :parent e))))
((<ghil-env> mod) (%make-ghil-env :mod mod :parent e))))
(define (ghil-env-toplevel? e)
(eq? (ghil-env-mod e) (gil-env-parent e)))