1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

Compile Lua's ... form.

* module/language/lua/compile-tree-il.scm (compile): Add clause for
  ast-variable-arguments.
* module/language/lua/parser.scm (define-ast, make-parser): Add
  vararg-gensym field to functions, gensym field to variable-arguments.
  Propagate *vararg-gensym* from functions to variable-arguments.
* test-suite/tests/lua-eval-2.test ("lua-eval"): Check for #nil
This commit is contained in:
Ian Price 2013-03-26 05:41:32 +00:00
parent f5302e62a7
commit ddb685ee52
3 changed files with 20 additions and 8 deletions

View file

@ -156,7 +156,7 @@ dropped silently"
src (make-primitive-ref src 'return/values)
(if (list? exp) (map-compile exp #t) (list (compile exp))))))
((ast-function src name arguments argument-gensyms variable-arguments? body)
((ast-function src name arguments argument-gensyms variable-arguments? vararg-gensym body)
;; ... is always attached because lua functions must ignore
;; variable arguments; the parser will catch it if ... is used in a
;; function that doesn't have ... in the parameter list
@ -165,7 +165,7 @@ dropped silently"
src meta
(make-lambda-case src '() arguments '... #f
(map (lambda (x) (make-const src #nil)) arguments)
(append argument-gensyms (list (gensym "...")))
(append argument-gensyms (list vararg-gensym))
(compile body)
#f))))
@ -476,7 +476,12 @@ dropped silently"
(make-lexical-ref src 'and-tmp tmp)
right
(make-lexical-ref src 'and-tmp tmp)))))
(else (error #:COMPILE "unknown binary operator" operator)))))))
(else (error #:COMPILE "unknown binary operator" operator)))))
((ast-variable-arguments src gensym)
(make-application src
(make-primitive-ref src 'apply)
(list (make-primitive-ref src 'values)
(make-lexical-ref src '... gensym))))))
;; exported compiler function
(define (compile-tree-il exp env opts)

View file

@ -106,10 +106,10 @@
(numeric-for-loop named initial limit step body)
(list-for-loop names gs-names exps body)
(break)
(function name arguments argument-gensyms variable-arguments? body)
(function name arguments argument-gensyms variable-arguments? vararg-gensym body)
(function-call operator operands)
(binary-operation operator left right)
(variable-arguments))
(variable-arguments gensym))
) ; letrec-syntax
@ -219,6 +219,9 @@
;; True if inside a function and the function accepts variable arguments
(define *vararg-function* #f)
;; refers to the gensym for '...' in a function that accepts variable arguments
(define *vararg-gensym* #f)
;;;;; ENVIRONMENTS
(define (enter-environment!)
"Create a new environment, and set ENVIRONMENT to it"
@ -482,8 +485,10 @@
(enforce-next! #\()
;; parameter-list
(receive (parameters variable-arguments?) (parameter-list name)
(let* ((old-vararg-function *vararg-function*))
(let* ((old-vararg-function *vararg-function*)
(old-vararg-gensym *vararg-gensym*))
(set! *vararg-function* variable-arguments?)
(set! *vararg-gensym* (and variable-arguments? (gensym "...")))
(enforce-next! #\))
;; create function
(enter-environment!)
@ -504,11 +509,13 @@
(list (environment-lookup-gensym 'self)))
parameter-gensyms)
variable-arguments?
*vararg-gensym*
(if (null? body) *void-literal* body))))
(leave-environment!)
;; END
(enforce-next! #:end)
(set! *vararg-function* old-vararg-function)
(set! *vararg-gensym* old-vararg-gensym)
result))))
;; expression-list -> expression { ',' expression }
@ -535,7 +542,7 @@
((#:varargs)
(unless *vararg-function*
(syntax-error src "cannot use '...' outside of a variable arguments function"))
(advance! (make-ast-variable-arguments src)))
(advance! (make-ast-variable-arguments src *vararg-gensym*)))
;; FUNCTION function-body
((#:function) (advance!) (function-body src))
;; primary-expression

View file

@ -99,7 +99,7 @@
(test "print \"hello world\"; return true")
;; variable arguments
(test "function test(...) print(...) end test(1,2)")
(test "function test(...) print(...) end return test(1,2)" #nil)
;; numeric for loop
(test "for x = 1,2,1 do print(true) end return true")