Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-24 20:45:06 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Staging changes to use a rename tbl instead of glo

Browse source
This commit is contained in:
Justin Ethier 2016-09-20 18:55:12 -04:00
parent 796d5f9e0a
commit 6ca3b7fca7
2 changed files with 16 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
scheme/cyclone/macros.sld
View file

@ -11,6 +11,7 @@
(scheme write) ;; Debug only (scheme write) ;; Debug only
(scheme eval) (scheme eval)
(scheme cyclone util) (scheme cyclone util)
(srfi 69)
) )
(export (export
define-syntax? define-syntax?
@ -29,8 +30,6 @@
;; A list of all macros defined by the program/library being compiled ;; A list of all macros defined by the program/library being compiled
(define *macro:defined-macros* '()) (define *macro:defined-macros* '())
(define *macro:renamed-variables* (env:extend-environment '() '() '()))
(define (macro:add! name body) (define (macro:add! name body)
(set! *macro:defined-macros* (set! *macro:defined-macros*
(cons (cons name body) *macro:defined-macros*)) (cons (cons name body) *macro:defined-macros*))
@ -54,7 +53,7 @@
(define (macro:macro? exp defined-macros) (assoc (car exp) defined-macros)) (define (macro:macro? exp defined-macros) (assoc (car exp) defined-macros))
(define (macro:expand exp macro mac-env) (define (macro:expand exp macro mac-env rename-tbl)
(let* ((use-env (env:extend-environment '() '() '())) (let* ((use-env (env:extend-environment '() '() '()))
(compiled-macro? (or (Cyc-macro? (Cyc-get-cvar (cadr macro))) (compiled-macro? (or (Cyc-macro? (Cyc-get-cvar (cadr macro)))
(procedure? (cadr macro)))) (procedure? (cadr macro))))
@ -73,14 +72,14 @@
((Cyc-get-cvar (cadr macro)) ((Cyc-get-cvar (cadr macro))
exp exp
(Cyc-er-rename use-env mac-env) (Cyc-er-rename use-env mac-env)
(Cyc-er-compare? use-env *macro:renamed-variables*))) (Cyc-er-compare? use-env rename-tbl)))
(else (else
(eval (eval
(list (list
(Cyc-get-cvar (cadr macro)) (Cyc-get-cvar (cadr macro))
(list 'quote exp) (list 'quote exp)
(Cyc-er-rename use-env mac-env) (Cyc-er-rename use-env mac-env)
(Cyc-er-compare? use-env *macro:renamed-variables*)) (Cyc-er-compare? use-env rename-tbl))
mac-env)))) mac-env))))
; (newline) ; (newline)
; (display "/* ") ; (display "/* ")
@ -88,18 +87,19 @@
; (newline) ; (newline)
; (display (list result)) ; (display (list result))
; (display "*/ ") ; (display "*/ ")
(macro:add-renamed-vars! use-env) (macro:add-renamed-vars! use-env rename-tbl)
result)) result))
(define (macro:add-renamed-vars! env) (define (macro:add-renamed-vars! env rename-tbl)
;; TODO: change this to use a hash table ;; TODO: change this to use a hash table
(set! *macro:renamed-variables* ;(set! *macro:renamed-variables*
(env:extend-environment ; (env:extend-environment
(env:all-variables env) ; (env:all-variables env)
(env:all-values env) ; (env:all-values env)
*macro:renamed-variables*))) ; *macro:renamed-variables*))
)
(define (macro:cleanup expr) (define (macro:cleanup expr rename-tbl)
(define (clean expr bv) ;; Bound variables (define (clean expr bv) ;; Bound variables
;(newline) ;(newline)
;(display "/* macro:cleanup->clean, bv =") ;(display "/* macro:cleanup->clean, bv =")
@ -117,6 +117,7 @@
((ref? expr) ((ref? expr)
;; if symbol has been renamed and is not a bound variable, ;; if symbol has been renamed and is not a bound variable,
;; undo the rename ;; undo the rename
TODO: no good, change to use rename-tbl (a hashtable)
(let ((val (env:lookup expr *macro:renamed-variables* #f))) (let ((val (env:lookup expr *macro:renamed-variables* #f)))
(if (and val (not (member expr bv))) (if (and val (not (member expr bv)))
(clean val bv) (clean val bv)

3
scheme/cyclone/util.sld
View file

@ -8,7 +8,8 @@
;;;; ;;;;
(define-library (scheme cyclone util) (define-library (scheme cyclone util)
(import (scheme base) (import (scheme base)
(scheme char)) (scheme char)
(srfi 69))
(export (export
;; Code analysis ;; Code analysis
tagged-list? tagged-list?