coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 7 Packages Projects Releases Wiki Activity
Files
1dc96c814efaf3ba5ad53e9b4d76acfa40d2d095
rose-ash/lib/lua/transpile.sx
giles 99753580b4 Recover agent-loop progress: lua/prolog/forth/erlang/haskell phases 1-2 
Salvaged from worktree-agent-* branches killed during sx-tree MCP outage:
- lua: tokenizer + parser + phase-2 transpile (~157 tests)
- prolog: tokenizer + parser + unification (72 tests, plan update lost to WIP)
- forth: phase-1 reader/interpreter + phase-2 colon/VARIABLE (134 tests)
- erlang: tokenizer + parser (114 tests)
- haskell: tokenizer + parse tests (43 tests)

Cherry-picked file contents only, not branch history, to avoid pulling in
unrelated ocaml-vm merge commits that were in those branches' bases.
2026-04-24 16:03:00 +00:00

437 lines
12 KiB
Plaintext
Raw Blame History

(define
lua-tx
(fn
(node)
(cond
((= node nil) nil)
((not (= (type-of node) "list")) node)
(else (lua-tx-dispatch (first node) node)))))
(define
lua-tx-dispatch
(fn
(tag node)
(cond
((= tag (quote lua-num)) (nth node 1))
((= tag (quote lua-str)) (nth node 1))
((= tag (quote lua-nil)) nil)
((= tag (quote lua-true)) true)
((= tag (quote lua-false)) false)
((= tag (quote lua-name)) (make-symbol (nth node 1)))
((= tag (quote lua-vararg))
(error "lua-transpile: ... not yet supported"))
((= tag (quote lua-binop)) (lua-tx-binop node))
((= tag (quote lua-unop)) (lua-tx-unop node))
((= tag (quote lua-call)) (lua-tx-call node))
((= tag (quote lua-method-call)) (lua-tx-method-call node))
((= tag (quote lua-field)) (lua-tx-field node))
((= tag (quote lua-index)) (lua-tx-index node))
((= tag (quote lua-table)) (lua-tx-table node))
((= tag (quote lua-function)) (lua-tx-function node))
((= tag (quote lua-block)) (lua-tx-block node))
((= tag (quote lua-local)) (lua-tx-local node))
((= tag (quote lua-assign)) (lua-tx-assign node))
((= tag (quote lua-if)) (lua-tx-if node))
((= tag (quote lua-while)) (lua-tx-while node))
((= tag (quote lua-repeat)) (lua-tx-repeat node))
((= tag (quote lua-for-num)) (lua-tx-for-num node))
((= tag (quote lua-do)) (lua-tx-do node))
((= tag (quote lua-break)) (quote lua-break-marker))
((= tag (quote lua-return)) (lua-tx-return node))
((= tag (quote lua-call-stmt)) (lua-tx (nth node 1)))
((= tag (quote lua-local-function)) (lua-tx-local-function node))
((= tag (quote lua-function-decl)) (lua-tx-function-decl node))
(else (error (str "lua-transpile: unknown node " tag))))))
(define
lua-tx-binop
(fn
(node)
(let
((op (nth node 1))
(a (lua-tx (nth node 2)))
(b (lua-tx (nth node 3))))
(cond
((= op "+") (list (make-symbol "lua-add") a b))
((= op "-") (list (make-symbol "lua-sub") a b))
((= op "*") (list (make-symbol "lua-mul") a b))
((= op "/") (list (make-symbol "lua-div") a b))
((= op "%") (list (make-symbol "lua-mod") a b))
((= op "^") (list (make-symbol "lua-pow") a b))
((= op "..") (list (make-symbol "lua-concat") a b))
((= op "==") (list (make-symbol "lua-eq") a b))
((= op "~=") (list (make-symbol "lua-neq") a b))
((= op "<") (list (make-symbol "lua-lt") a b))
((= op "<=") (list (make-symbol "lua-le") a b))
((= op ">") (list (make-symbol "lua-gt") a b))
((= op ">=") (list (make-symbol "lua-ge") a b))
((= op "and")
(list
(make-symbol "let")
(list (list (make-symbol "_la") a))
(list
(make-symbol "if")
(list (make-symbol "lua-truthy?") (make-symbol "_la"))
b
(make-symbol "_la"))))
((= op "or")
(list
(make-symbol "let")
(list (list (make-symbol "_la") a))
(list
(make-symbol "if")
(list (make-symbol "lua-truthy?") (make-symbol "_la"))
(make-symbol "_la")
b)))
(else (error (str "lua-transpile: unknown binop " op)))))))
(define
lua-tx-unop
(fn
(node)
(let
((op (nth node 1)) (e (lua-tx (nth node 2))))
(cond
((= op "-") (list (make-symbol "lua-neg") e))
((= op "not")
(list (make-symbol "not") (list (make-symbol "lua-truthy?") e)))
((= op "#") (list (make-symbol "lua-len") e))
(else (error (str "lua-transpile: unknown unop " op)))))))
(define
lua-tx-call
(fn
(node)
(let
((fn-ast (nth node 1)) (args (nth node 2)))
(cons (lua-tx fn-ast) (map lua-tx args)))))
(define
lua-tx-method-call
(fn
(node)
(let
((obj (lua-tx (nth node 1)))
(name (nth node 2))
(args (nth node 3)))
(cons
(list (make-symbol "lua-get") obj name)
(cons obj (map lua-tx args))))))
(define
lua-tx-field
(fn
(node)
(list (make-symbol "lua-get") (lua-tx (nth node 1)) (nth node 2))))
(define
lua-tx-index
(fn
(node)
(list
(make-symbol "lua-get")
(lua-tx (nth node 1))
(lua-tx (nth node 2)))))
(define
lua-tx-table
(fn
(node)
(let
((fields (rest node)))
(cons (make-symbol "lua-make-table") (map lua-tx-table-field fields)))))
(define
lua-tx-table-field
(fn
(f)
(cond
((= (first f) (quote lua-pos))
(list (make-symbol "list") "pos" (lua-tx (nth f 1))))
((= (first f) (quote lua-kv))
(list
(make-symbol "list")
"kv"
(lua-tx (nth f 1))
(lua-tx (nth f 2))))
(else (error "lua-transpile: unknown table field")))))
(define
lua-tx-function
(fn
(node)
(let
((params (nth node 1))
(is-vararg (nth node 2))
(body (nth node 3)))
(let
((sym-params (map make-symbol params)))
(list (make-symbol "fn") sym-params (lua-tx body))))))
(define
lua-tx-block
(fn
(node)
(let
((stmts (rest node)))
(cond
((= (len stmts) 0) nil)
((= (len stmts) 1) (lua-tx (first stmts)))
(else (cons (make-symbol "begin") (map lua-tx stmts)))))))
(define
lua-tx-local
(fn
(node)
(let
((names (nth node 1)) (exps (nth node 2)))
(cond
((= (len names) 1)
(list
(make-symbol "define")
(make-symbol (first names))
(if (> (len exps) 0) (lua-tx (first exps)) nil)))
(else
(cons (make-symbol "begin") (lua-tx-local-pairs names exps 0)))))))
(define
lua-tx-local-pairs
(fn
(names exps i)
(if
(>= i (len names))
(list)
(cons
(list
(make-symbol "define")
(make-symbol (nth names i))
(if (< i (len exps)) (lua-tx (nth exps i)) nil))
(lua-tx-local-pairs names exps (+ i 1))))))
(define
lua-tx-assign
(fn
(node)
(let
((lhss (nth node 1)) (rhss (nth node 2)))
(cond
((= (len lhss) 1)
(lua-tx-single-assign (first lhss) (lua-tx (first rhss))))
(else
(cons (make-symbol "begin") (lua-tx-assign-pairs lhss rhss 0)))))))
(define
lua-tx-assign-pairs
(fn
(lhss rhss i)
(if
(>= i (len lhss))
(list)
(cons
(lua-tx-single-assign
(nth lhss i)
(if (< i (len rhss)) (lua-tx (nth rhss i)) nil))
(lua-tx-assign-pairs lhss rhss (+ i 1))))))
(define
lua-tx-single-assign
(fn
(lhs rhs)
(cond
((= (first lhs) (quote lua-name))
(list (make-symbol "set!") (make-symbol (nth lhs 1)) rhs))
((= (first lhs) (quote lua-field))
(list
(make-symbol "lua-set!")
(lua-tx (nth lhs 1))
(nth lhs 2)
rhs))
((= (first lhs) (quote lua-index))
(list
(make-symbol "lua-set!")
(lua-tx (nth lhs 1))
(lua-tx (nth lhs 2))
rhs))
(else (error "lua-transpile: bad assignment target")))))
(define
lua-tx-if
(fn
(node)
(let
((cnd (lua-tx (nth node 1)))
(then-body (lua-tx (nth node 2)))
(elseifs (nth node 3))
(else-body (nth node 4)))
(if
(and (= (len elseifs) 0) (= else-body nil))
(list
(make-symbol "when")
(list (make-symbol "lua-truthy?") cnd)
then-body)
(lua-tx-if-cond cnd then-body elseifs else-body)))))
(define
lua-tx-if-cond
(fn
(cnd then-body elseifs else-body)
(let
((clauses (cons (list (list (make-symbol "lua-truthy?") cnd) then-body) (map lua-tx-elseif elseifs))))
(cons
(make-symbol "cond")
(if
(= else-body nil)
clauses
(append
clauses
(list (list (make-symbol "else") (lua-tx else-body)))))))))
(define
lua-tx-elseif
(fn
(pair)
(list
(list (make-symbol "lua-truthy?") (lua-tx (first pair)))
(lua-tx (nth pair 1)))))
(define
lua-tx-while
(fn
(node)
(let
((cnd (lua-tx (nth node 1))) (body (lua-tx (nth node 2))))
(list
(make-symbol "let")
(list)
(list
(make-symbol "define")
(make-symbol "_while_loop")
(list
(make-symbol "fn")
(list)
(list
(make-symbol "when")
(list (make-symbol "lua-truthy?") cnd)
(list
(make-symbol "begin")
body
(list (make-symbol "_while_loop"))))))
(list (make-symbol "_while_loop"))))))
(define
lua-tx-repeat
(fn
(node)
(let
((body (lua-tx (nth node 1))) (cnd (lua-tx (nth node 2))))
(list
(make-symbol "let")
(list)
(list
(make-symbol "define")
(make-symbol "_repeat_loop")
(list
(make-symbol "fn")
(list)
(list
(make-symbol "begin")
body
(list
(make-symbol "when")
(list
(make-symbol "not")
(list (make-symbol "lua-truthy?") cnd))
(list (make-symbol "_repeat_loop"))))))
(list (make-symbol "_repeat_loop"))))))
(define
lua-tx-for-num
(fn
(node)
(let
((name (nth node 1))
(start (lua-tx (nth node 2)))
(stop (lua-tx (nth node 3)))
(step-ast (nth node 4))
(body (lua-tx (nth node 5))))
(let
((step (if (= step-ast nil) 1 (lua-tx step-ast))))
(list
(make-symbol "let")
(list
(list (make-symbol "_for_stop") stop)
(list (make-symbol "_for_step") step))
(list (make-symbol "define") (make-symbol name) start)
(list
(make-symbol "define")
(make-symbol "_for_loop")
(list
(make-symbol "fn")
(list)
(list
(make-symbol "when")
(list
(make-symbol "lua-for-continue?")
(make-symbol name)
(make-symbol "_for_stop")
(make-symbol "_for_step"))
(list
(make-symbol "begin")
body
(list
(make-symbol "set!")
(make-symbol name)
(list
(make-symbol "+")
(make-symbol name)
(make-symbol "_for_step")))
(list (make-symbol "_for_loop"))))))
(list (make-symbol "_for_loop")))))))
(define lua-tx-do (fn (node) (lua-tx (nth node 1))))
(define
lua-tx-return
(fn
(node)
(let
((exps (nth node 1)))
(cond
((= (len exps) 0) nil)
((= (len exps) 1) (lua-tx (first exps)))
(else (cons (make-symbol "list") (map lua-tx exps)))))))
(define
lua-tx-local-function
(fn
(node)
(let
((name (nth node 1)) (func (nth node 2)))
(list (make-symbol "define") (make-symbol name) (lua-tx func)))))
(define
lua-tx-function-decl
(fn
(node)
(let
((target (nth node 1)) (func (nth node 2)))
(cond
((= (first target) (quote lua-name))
(list
(make-symbol "define")
(make-symbol (nth target 1))
(lua-tx func)))
((= (first target) (quote lua-field))
(list
(make-symbol "lua-set!")
(lua-tx (nth target 1))
(nth target 2)
(lua-tx func)))
(else (error "lua-transpile: bad function decl target"))))))
(define lua-transpile (fn (src) (lua-tx (lua-parse src))))
(define
lua-eval-ast
(fn (src) (let ((sx (lua-transpile src))) (eval-expr sx))))
Reference in New Issue View Git Blame Copy Permalink