mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 20:30:28 +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:
parent
f5302e62a7
commit
ddb685ee52
3 changed files with 20 additions and 8 deletions
|
@ -156,7 +156,7 @@ dropped silently"
|
||||||
src (make-primitive-ref src 'return/values)
|
src (make-primitive-ref src 'return/values)
|
||||||
(if (list? exp) (map-compile exp #t) (list (compile exp))))))
|
(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
|
;; ... is always attached because lua functions must ignore
|
||||||
;; variable arguments; the parser will catch it if ... is used in a
|
;; variable arguments; the parser will catch it if ... is used in a
|
||||||
;; function that doesn't have ... in the parameter list
|
;; function that doesn't have ... in the parameter list
|
||||||
|
@ -165,7 +165,7 @@ dropped silently"
|
||||||
src meta
|
src meta
|
||||||
(make-lambda-case src '() arguments '... #f
|
(make-lambda-case src '() arguments '... #f
|
||||||
(map (lambda (x) (make-const src #nil)) arguments)
|
(map (lambda (x) (make-const src #nil)) arguments)
|
||||||
(append argument-gensyms (list (gensym "...")))
|
(append argument-gensyms (list vararg-gensym))
|
||||||
(compile body)
|
(compile body)
|
||||||
#f))))
|
#f))))
|
||||||
|
|
||||||
|
@ -476,7 +476,12 @@ dropped silently"
|
||||||
(make-lexical-ref src 'and-tmp tmp)
|
(make-lexical-ref src 'and-tmp tmp)
|
||||||
right
|
right
|
||||||
(make-lexical-ref src 'and-tmp tmp)))))
|
(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
|
;; exported compiler function
|
||||||
(define (compile-tree-il exp env opts)
|
(define (compile-tree-il exp env opts)
|
||||||
|
|
|
@ -106,10 +106,10 @@
|
||||||
(numeric-for-loop named initial limit step body)
|
(numeric-for-loop named initial limit step body)
|
||||||
(list-for-loop names gs-names exps body)
|
(list-for-loop names gs-names exps body)
|
||||||
(break)
|
(break)
|
||||||
(function name arguments argument-gensyms variable-arguments? body)
|
(function name arguments argument-gensyms variable-arguments? vararg-gensym body)
|
||||||
(function-call operator operands)
|
(function-call operator operands)
|
||||||
(binary-operation operator left right)
|
(binary-operation operator left right)
|
||||||
(variable-arguments))
|
(variable-arguments gensym))
|
||||||
|
|
||||||
) ; letrec-syntax
|
) ; letrec-syntax
|
||||||
|
|
||||||
|
@ -219,6 +219,9 @@
|
||||||
;; True if inside a function and the function accepts variable arguments
|
;; True if inside a function and the function accepts variable arguments
|
||||||
(define *vararg-function* #f)
|
(define *vararg-function* #f)
|
||||||
|
|
||||||
|
;; refers to the gensym for '...' in a function that accepts variable arguments
|
||||||
|
(define *vararg-gensym* #f)
|
||||||
|
|
||||||
;;;;; ENVIRONMENTS
|
;;;;; ENVIRONMENTS
|
||||||
(define (enter-environment!)
|
(define (enter-environment!)
|
||||||
"Create a new environment, and set ENVIRONMENT to it"
|
"Create a new environment, and set ENVIRONMENT to it"
|
||||||
|
@ -482,8 +485,10 @@
|
||||||
(enforce-next! #\()
|
(enforce-next! #\()
|
||||||
;; parameter-list
|
;; parameter-list
|
||||||
(receive (parameters variable-arguments?) (parameter-list name)
|
(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-function* variable-arguments?)
|
||||||
|
(set! *vararg-gensym* (and variable-arguments? (gensym "...")))
|
||||||
(enforce-next! #\))
|
(enforce-next! #\))
|
||||||
;; create function
|
;; create function
|
||||||
(enter-environment!)
|
(enter-environment!)
|
||||||
|
@ -504,11 +509,13 @@
|
||||||
(list (environment-lookup-gensym 'self)))
|
(list (environment-lookup-gensym 'self)))
|
||||||
parameter-gensyms)
|
parameter-gensyms)
|
||||||
variable-arguments?
|
variable-arguments?
|
||||||
|
*vararg-gensym*
|
||||||
(if (null? body) *void-literal* body))))
|
(if (null? body) *void-literal* body))))
|
||||||
(leave-environment!)
|
(leave-environment!)
|
||||||
;; END
|
;; END
|
||||||
(enforce-next! #:end)
|
(enforce-next! #:end)
|
||||||
(set! *vararg-function* old-vararg-function)
|
(set! *vararg-function* old-vararg-function)
|
||||||
|
(set! *vararg-gensym* old-vararg-gensym)
|
||||||
result))))
|
result))))
|
||||||
|
|
||||||
;; expression-list -> expression { ',' expression }
|
;; expression-list -> expression { ',' expression }
|
||||||
|
@ -535,7 +542,7 @@
|
||||||
((#:varargs)
|
((#:varargs)
|
||||||
(unless *vararg-function*
|
(unless *vararg-function*
|
||||||
(syntax-error src "cannot use '...' outside of a variable arguments 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 function-body
|
||||||
((#:function) (advance!) (function-body src))
|
((#:function) (advance!) (function-body src))
|
||||||
;; primary-expression
|
;; primary-expression
|
||||||
|
|
|
@ -99,7 +99,7 @@
|
||||||
(test "print \"hello world\"; return true")
|
(test "print \"hello world\"; return true")
|
||||||
|
|
||||||
;; variable arguments
|
;; variable arguments
|
||||||
(test "function test(...) print(...) end test(1,2)")
|
(test "function test(...) print(...) end return test(1,2)" #nil)
|
||||||
|
|
||||||
;; numeric for loop
|
;; numeric for loop
|
||||||
(test "for x = 1,2,1 do print(true) end return true")
|
(test "for x = 1,2,1 do print(true) end return true")
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue