lua: add lua-unwrap-final-return helper (for future use); keep top-level guard
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

This commit is contained in:
2026-04-24 23:34:07 +00:00
parent f89e50aa4d
commit 2a4a4531b9
2 changed files with 39 additions and 1 deletions

View File

@@ -532,11 +532,48 @@
(define lua-transpile (fn (src) (lua-tx (lua-parse src))))
(define
lua-ret-raise?
(fn (x)
(and (= (type-of x) "list")
(= (len x) 2)
(= (first x) (make-symbol "raise"))
(= (type-of (nth x 1)) "list")
(= (len (nth x 1)) 3)
(= (first (nth x 1)) (make-symbol "list"))
(= (type-of (nth (nth x 1) 1)) "list")
(= (first (nth (nth x 1) 1)) (make-symbol "quote"))
(= (nth (nth (nth x 1) 1) 1) (make-symbol "lua-ret")))))
(define
lua-ret-value
(fn (raise-form) (nth (nth raise-form 1) 2)))
(define
lua-unwrap-final-return
(fn (sx)
(cond
((lua-ret-raise? sx) (lua-ret-value sx))
((and (= (type-of sx) "list") (> (len sx) 0) (= (first sx) (make-symbol "begin")))
(let ((items (rest sx)))
(cond
((= (len items) 0) sx)
(else
(let ((last-item (nth items (- (len items) 1))))
(cond
((lua-ret-raise? last-item)
(let ((val (lua-ret-value last-item))
(prefix (lua-init-before items 0 (- (len items) 1))))
(cons (make-symbol "begin") (append prefix (list val)))))
(else sx)))))))
(else sx))))
(define
lua-eval-ast
(fn (src)
(let ((sx (lua-transpile src)))
(eval-expr (lua-tx-function-guard sx)))))
(let ((sx2 (lua-unwrap-final-return sx)))
(eval-expr (lua-tx-function-guard sx2))))))
(define
lua-tx-multi-args