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

Implemented let and let* in elisp.

Browse source 
* module/language/elisp/README: Document it.
* module/language/elisp/compile-tree-il.scm: Implement let and let*.
This commit is contained in:
Daniel Kraft 2009-07-07 19:38:25 +02:00
parent d221c18bc0
commit 3a4b86357e
2 changed files with 56 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

4
module/language/elisp/README
View file

@ -11,6 +11,7 @@ Already implemented:
* quote
* referencing and setting (setq) variables
* while
* let, let*
Especially still missing:
* other progX forms, will be done in macros
@ -18,10 +19,11 @@ Especially still missing:
* dolist, dotimes using macros
* catch/throw, unwind-protect
* real elisp reader instead of Scheme's
* let, set based on setq
* set based on setq
* makunbound, boundp
* automatic creation of fluids when needed
* macros
* general primitives (+, -, *, cons, ...)
* functions, lambdas
* fset & friends
* defvar, defun

55
module/language/elisp/compile-tree-il.scm
View file

@ -67,7 +67,7 @@
(make-sequence loc
(list (ensure-fluid! loc sym module)
(make-application loc (make-primitive-ref loc 'fluid-ref)
(list (make-module-ref loc module sym #f))))))
(list (make-module-ref loc module sym #t))))))
; Reference a variable and error if the value is void.
@ -91,10 +91,26 @@
(make-sequence loc
(list (ensure-fluid! loc sym module)
(make-application loc (make-primitive-ref loc 'fluid-set!)
(list (make-module-ref loc module sym #f)
(list (make-module-ref loc module sym #t)
value)))))
; Process the bindings part of a let or let* expression; that is, check for
; correctness and bring it to the form ((sym1 . val1) (sym2 . val2) ...).
(define (process-let-bindings loc bindings)
(map (lambda (b)
(if (symbol? b)
(cons b 'nil)
(if (or (not (list? b))
(not (= (length b) 2)))
(report-error loc "expected symbol or list of 2 elements in let")
(if (not (symbol? (car b)))
(report-error loc "expected symbol in let")
(cons (car b) (cadr b))))))
bindings))
; Compile a symbol expression. This is a variable reference or maybe some
; special value like nil.
@ -194,6 +210,41 @@
(op (set-variable! loc sym value-slot val)))
(cons op (iterate (cdr tailtail)))))))))))
; Let is done with a single call to with-fluids* binding them locally to new
; values.
((let ,bindings . ,body) (guard (and (list? bindings)
(list? body)
(not (null? bindings))
(not (null? body))))
(let ((bind (process-let-bindings loc bindings)))
(make-application loc (make-primitive-ref loc 'with-fluids*)
(list (make-application loc (make-primitive-ref loc 'list)
(map (lambda (el)
(make-module-ref loc value-slot (car el) #t))
bind))
(make-application loc (make-primitive-ref loc 'list)
(map (lambda (el)
(compile-expr (cdr el)))
bind))
(make-lambda loc '() '() '()
(make-sequence loc (map compile-expr body)))))))
; Let* is compiled to a cascaded set of with-fluid* for each binding in turn
; so that each one already sees the preceding bindings.
((let* ,bindings . ,body) (guard (and (list? bindings)
(list? body)
(not (null? bindings))
(not (null? body))))
(let ((bind (process-let-bindings loc bindings)))
(let iterate ((tail bind))
(if (null? tail)
(make-sequence loc (map compile-expr body))
(make-application loc (make-primitive-ref loc 'with-fluid*)
(list (make-module-ref loc value-slot (caar tail) #t)
(compile-expr (cdar tail))
(make-lambda loc '() '() '()
(iterate (cdr tail)))))))))
; A while construct is transformed into a tail-recursive loop like this:
; (letrec ((iterate (lambda ()
; (if condition