1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00

Fixed lambda expressions and implemented function calls using the basic list notation.

* module/language/elisp/README: Document that.
* module/language/elisp/compile-tree-il.scm: Implement function calls.
This commit is contained in:
Daniel Kraft 2009-07-13 16:51:05 +02:00
parent fad9b2dc53
commit cef997e82a
2 changed files with 44 additions and 29 deletions

View file

@ -12,7 +12,7 @@ Already implemented:
* referencing and setting (setq) variables * referencing and setting (setq) variables
* while * while
* let, let* * let, let*
* lambda expressions * lambda expressions, function calls using list notation
Especially still missing: Especially still missing:
* other progX forms, will be done in macros * other progX forms, will be done in macros
@ -25,6 +25,6 @@ Especially still missing:
* automatic creation of fluids when needed * automatic creation of fluids when needed
* macros * macros
* general primitives (+, -, *, cons, ...) * general primitives (+, -, *, cons, ...)
* function calls * funcall and apply
* fset & friends * fset & friends
* defvar, defun * defvar, defun

View file

@ -66,11 +66,19 @@
; Generate code to ensure a fluid is there for further use of a given symbol. ; Generate code to ensure a fluid is there for further use of a given symbol.
; ensure-fluids-for does the same for a list of symbols and builds a sequence
; that executes the fluid-insurances first, followed by all body commands; this
; is a routine for convenience (needed with let, let*, lambda).
(define (ensure-fluid! loc sym module) (define (ensure-fluid! loc sym module)
; FIXME: Do this! ; FIXME: Do this!
(make-void loc)) (make-void loc))
(define (ensure-fluids-for loc syms module . body)
(make-sequence loc
`(,@(map (lambda (sym) (ensure-fluid! loc sym module)) syms)
,@body)))
; Generate code to reference a fluid saved variable. ; Generate code to reference a fluid saved variable.
@ -180,29 +188,29 @@
(lambda () (lambda ()
(split-lambda-arguments loc args)) (split-lambda-arguments loc args))
(lambda (required optional rest) (lambda (required optional rest)
; FIXME: Ensure fluids there!
(let ((required-sym (map (lambda (sym) (gensym)) required)) (let ((required-sym (map (lambda (sym) (gensym)) required))
(rest-sym (if (or rest (not (null? optional))) (gensym) '()))) (rest-sym (if (or rest (not (null? optional))) (gensym) '())))
(let ((real-args (append required-sym rest-sym))) (let ((real-args (append required-sym rest-sym))
(make-lambda loc (locals `(,@required ,@optional ,@(if rest (list rest) '()))))
real-args real-args '() (make-lambda loc
(call-primitive loc 'with-fluids* real-args real-args '()
(make-application loc (make-primitive-ref loc 'list) (ensure-fluids-for loc locals value-slot
(map (lambda (sym) (make-module-ref loc value-slot sym #t)) (call-primitive loc 'with-fluids*
(append (append required optional) (make-application loc (make-primitive-ref loc 'list)
(if rest (list rest) '())))) (map (lambda (sym) (make-module-ref loc value-slot sym #t))
(make-application loc (make-primitive-ref loc 'list) locals))
(append (map (lambda (sym) (make-lexical-ref loc sym sym)) (make-application loc (make-primitive-ref loc 'list)
required-sym) (append (map (lambda (sym) (make-lexical-ref loc sym sym))
(map (lambda (sym) (nil-value loc)) required-sym)
(if (null? rest-sym) (map (lambda (sym) (nil-value loc))
optional (if rest
(append optional (list rest-sym)))))) `(,@optional ,rest-sym)
(make-lambda loc '() '() '() optional))))
(make-sequence loc (make-lambda loc '() '() '()
(cons (process-optionals loc optional rest-sym) (make-sequence loc
(cons (process-rest loc rest rest-sym) `(,(process-optionals loc optional rest-sym)
(map compile-expr body)))))))))))) ,(process-rest loc rest rest-sym)
,@(map compile-expr body))))))))))))
; Build the code to handle setting of optional arguments that are present ; Build the code to handle setting of optional arguments that are present
; and updating the rest list. ; and updating the rest list.
@ -244,13 +252,9 @@
(define (compile-symbol loc sym) (define (compile-symbol loc sym)
(case sym (case sym
((nil) (nil-value loc)) ((nil) (nil-value loc))
((t) (t-value loc)) ((t) (t-value loc))
(else (reference-with-check loc sym value-slot))))
(else
(reference-with-check loc sym value-slot))))
; Compile a pair-expression (that is, any structure-like construct). ; Compile a pair-expression (that is, any structure-like construct).
@ -386,7 +390,7 @@
(make-lexical-ref loc 'iterate itersym) (make-lexical-ref loc 'iterate itersym)
(list))) (list)))
(full-body (make-sequence loc (full-body (make-sequence loc
(append compiled-body (list iter-call)))) `(,@compiled-body ,iter-call)))
(lambda-body (make-conditional loc (lambda-body (make-conditional loc
(compile-expr condition) (compile-expr condition)
full-body full-body
@ -402,6 +406,17 @@
((function (lambda ,args . ,body)) (guard (not (null? body))) ((function (lambda ,args . ,body)) (guard (not (null? body)))
(compile-lambda loc args body)) (compile-lambda loc args body))
; Function calls using (function args) standard notation; here, we have to
; take the function value of a symbol if it is one. It seems that functions
; in form of uncompiled lists are not supported in this syntax, so we don't
; have to care for them.
((,func . ,args)
(make-application loc
(if (symbol? func)
(reference-with-check loc func function-slot)
(compile-expr func))
(map compile-expr args)))
(('quote ,val) (('quote ,val)
(make-const loc val)) (make-const loc val))