2 Commits

Author SHA1 Message Date
15eb133311 ruby: Phase 1 parser (+83 tests, 190 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 11s
2026-04-25 18:50:49 +00:00
96019e9fe8 ruby: Phase 1 tokenizer (+107 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
lib/ruby/tokenizer.sx — rb-tokenize: keywords, identifiers (@/@~/$/const),
numbers (dec/hex/oct/bin/float), strings (dq with raw interpolation, sq),
symbols, %w/%i, operators (all compound forms), punctuation, comments,
line/col tracking. Plus test runner test.sh and 107 passing tests.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-25 18:13:05 +00:00
13 changed files with 2132 additions and 1393 deletions

831
lib/ruby/parser.sx Normal file
View File

@@ -0,0 +1,831 @@
;; Ruby parser: token list → AST.
;; Entry: (rb-parse tokens) or (rb-parse-str src)
;; AST nodes: dicts with :type plus type-specific fields.
(define rb-parse
(fn (tokens)
(let ((pos 0) (tok-count (len tokens)))
(define rb-p-cur
(fn () (nth tokens pos)))
(define rb-p-peek
(fn (n)
(if (< (+ pos n) tok-count)
(nth tokens (+ pos n))
{:type "eof" :value nil :line 0 :col 0})))
(define rb-p-advance!
(fn () (set! pos (+ pos 1))))
(define rb-p-type
(fn () (get (rb-p-cur) :type)))
(define rb-p-val
(fn () (get (rb-p-cur) :value)))
(define rb-p-sep?
(fn () (or (= (rb-p-type) "newline") (= (rb-p-type) "semi"))))
(define rb-p-skip-seps!
(fn ()
(when (rb-p-sep?)
(do (rb-p-advance!) (rb-p-skip-seps!)))))
(define rb-p-skip-newlines!
(fn ()
(when (= (rb-p-type) "newline")
(do (rb-p-advance!) (rb-p-skip-newlines!)))))
(define rb-p-expect!
(fn (type)
(if (= (rb-p-type) type)
(let ((tok (rb-p-cur)))
(rb-p-advance!)
tok)
{:type "error"
:msg (join "" (list "expected " type " got " (rb-p-type)))})))
(define rb-p-expect-kw!
(fn (kw)
(when (and (= (rb-p-type) "keyword") (= (rb-p-val) kw))
(rb-p-advance!))))
;; Block: do |params| body end or { |params| body }
(define rb-p-parse-block-params
(fn ()
(if (= (rb-p-type) "pipe")
(do
(rb-p-advance!)
(let ((params (list)))
(define rb-p-bp-loop
(fn ()
(when (not (or (= (rb-p-type) "pipe") (= (rb-p-type) "eof")))
(do
(cond
((and (= (rb-p-type) "op") (= (rb-p-val) "**"))
(do
(rb-p-advance!)
(append! params {:type "param-kwrest" :name (rb-p-val)})
(rb-p-advance!)))
((and (= (rb-p-type) "op") (= (rb-p-val) "*"))
(do
(rb-p-advance!)
(if (= (rb-p-type) "ident")
(do
(append! params {:type "param-rest" :name (rb-p-val)})
(rb-p-advance!))
(append! params {:type "param-rest" :name nil}))))
(:else
(do
(append! params {:type "param-req" :name (rb-p-val)})
(rb-p-advance!))))
(when (= (rb-p-type) "comma") (rb-p-advance!))
(rb-p-bp-loop)))))
(rb-p-bp-loop)
(rb-p-expect! "pipe")
params))
(list))))
(define rb-p-parse-block
(fn ()
(cond
((and (= (rb-p-type) "keyword") (= (rb-p-val) "do"))
(do
(rb-p-advance!)
(let ((params (rb-p-parse-block-params)))
(rb-p-skip-seps!)
(let ((body (rb-p-parse-stmts (list "end"))))
(rb-p-expect-kw! "end")
{:type "block" :params params :body body}))))
((= (rb-p-type) "lbrace")
(do
(rb-p-advance!)
(let ((params (rb-p-parse-block-params)))
(rb-p-skip-seps!)
(let ((body (rb-p-parse-stmts (list "rbrace"))))
(rb-p-expect! "rbrace")
{:type "block" :params params :body body}))))
(:else nil))))
;; Method def params
(define rb-p-parse-def-params
(fn ()
(let ((params (list)))
(define rb-p-dp-one
(fn ()
(cond
((and (= (rb-p-type) "op") (= (rb-p-val) "&"))
(do
(rb-p-advance!)
(append! params {:type "param-block" :name (rb-p-val)})
(rb-p-advance!)))
((and (= (rb-p-type) "op") (= (rb-p-val) "**"))
(do
(rb-p-advance!)
(append! params {:type "param-kwrest" :name (rb-p-val)})
(rb-p-advance!)))
((and (= (rb-p-type) "op") (= (rb-p-val) "*"))
(do
(rb-p-advance!)
(if (= (rb-p-type) "ident")
(do
(append! params {:type "param-rest" :name (rb-p-val)})
(rb-p-advance!))
(append! params {:type "param-rest" :name nil}))))
((and (= (rb-p-type) "ident")
(= (get (rb-p-peek 1) :type) "colon"))
(do
(let ((name (rb-p-val)))
(rb-p-advance!)
(rb-p-advance!)
(if (or (rb-p-sep?) (= (rb-p-type) "comma")
(= (rb-p-type) "rparen") (= (rb-p-type) "eof"))
(append! params {:type "param-kw" :name name :default nil})
(append! params {:type "param-kw" :name name
:default (rb-p-parse-assign)})))))
(:else
(let ((name (rb-p-val)))
(rb-p-advance!)
(if (and (= (rb-p-type) "op") (= (rb-p-val) "="))
(do
(rb-p-advance!)
(append! params {:type "param-opt" :name name
:default (rb-p-parse-assign)}))
(append! params {:type "param-req" :name name})))))))
(define rb-p-dp-loop
(fn ()
(when (not (or (= (rb-p-type) "rparen") (rb-p-sep?)
(= (rb-p-type) "eof")))
(do
(rb-p-dp-one)
(when (= (rb-p-type) "comma")
(do (rb-p-advance!) (rb-p-skip-newlines!)))
(rb-p-dp-loop)))))
(rb-p-dp-loop)
params)))
;; def [recv.] name [(params)] body end
(define rb-p-parse-def
(fn ()
(rb-p-advance!)
(let ((recv nil) (name nil))
(cond
((and (= (rb-p-type) "keyword") (= (rb-p-val) "self")
(= (get (rb-p-peek 1) :type) "dot"))
(do
(set! recv {:type "self"})
(rb-p-advance!)
(rb-p-advance!)
(set! name (rb-p-val))
(rb-p-advance!)))
((and (= (rb-p-type) "ident")
(= (get (rb-p-peek 1) :type) "dot"))
(do
(set! recv {:type "lvar" :name (rb-p-val)})
(rb-p-advance!)
(rb-p-advance!)
(set! name (rb-p-val))
(rb-p-advance!)))
(:else
(do
(set! name (rb-p-val))
(rb-p-advance!))))
(let ((params (list)))
(cond
((= (rb-p-type) "lparen")
(do
(rb-p-advance!)
(rb-p-skip-newlines!)
(set! params (rb-p-parse-def-params))
(rb-p-expect! "rparen")))
((not (or (rb-p-sep?) (= (rb-p-type) "eof")))
(set! params (rb-p-parse-def-params)))
(:else nil))
(rb-p-skip-seps!)
(let ((body (rb-p-parse-stmts (list "end"))))
(rb-p-expect-kw! "end")
{:type "method-def" :recv recv :name name
:params params :body body})))))
;; class [<<obj | Name [<Super]] body end
(define rb-p-parse-class
(fn ()
(rb-p-advance!)
(if (and (= (rb-p-type) "op") (= (rb-p-val) "<<"))
(do
(rb-p-advance!)
(let ((obj (rb-p-parse-primary)))
(rb-p-skip-seps!)
(let ((body (rb-p-parse-stmts (list "end"))))
(rb-p-expect-kw! "end")
{:type "sclass" :obj obj :body body})))
(let ((name (rb-p-parse-const-path)))
(let ((super nil))
(when (and (= (rb-p-type) "op") (= (rb-p-val) "<"))
(do
(rb-p-advance!)
(set! super (rb-p-parse-const-path))))
(rb-p-skip-seps!)
(let ((body (rb-p-parse-stmts (list "end"))))
(rb-p-expect-kw! "end")
{:type "class-def" :name name :super super :body body}))))))
;; module Name body end
(define rb-p-parse-module
(fn ()
(rb-p-advance!)
(let ((name (rb-p-parse-const-path)))
(rb-p-skip-seps!)
(let ((body (rb-p-parse-stmts (list "end"))))
(rb-p-expect-kw! "end")
{:type "module-def" :name name :body body}))))
;; Const or Const::Const::...
(define rb-p-parse-const-path
(fn ()
(let ((node {:type "const" :name (rb-p-val)}))
(rb-p-advance!)
(define rb-p-cp-loop
(fn ()
(when (= (rb-p-type) "dcolon")
(do
(rb-p-advance!)
(let ((name (rb-p-val)))
(rb-p-advance!)
(set! node {:type "const-path" :left node :name name})
(rb-p-cp-loop))))))
(rb-p-cp-loop)
node)))
;; [e, *e, ...]
(define rb-p-parse-array
(fn ()
(rb-p-advance!)
(rb-p-skip-newlines!)
(let ((elems (list)))
(define rb-p-arr-loop
(fn ()
(when (not (or (= (rb-p-type) "rbracket") (= (rb-p-type) "eof")))
(do
(if (and (= (rb-p-type) "op") (= (rb-p-val) "*"))
(do
(rb-p-advance!)
(append! elems {:type "splat" :value (rb-p-parse-assign)}))
(append! elems (rb-p-parse-assign)))
(rb-p-skip-newlines!)
(when (= (rb-p-type) "comma")
(do (rb-p-advance!) (rb-p-skip-newlines!)))
(rb-p-arr-loop)))))
(rb-p-arr-loop)
(rb-p-expect! "rbracket")
{:type "array" :elems elems})))
;; {k: v, k => v, ...}
(define rb-p-parse-hash
(fn ()
(rb-p-advance!)
(rb-p-skip-newlines!)
(let ((pairs (list)))
(define rb-p-hash-loop
(fn ()
(when (not (or (= (rb-p-type) "rbrace") (= (rb-p-type) "eof")))
(do
(let ((key nil) (val nil) (style nil))
(cond
((and (or (= (rb-p-type) "ident") (= (rb-p-type) "const"))
(= (get (rb-p-peek 1) :type) "colon"))
(do
(set! key {:type "lit-sym" :value (rb-p-val)})
(set! style "colon")
(rb-p-advance!)
(rb-p-advance!)))
(:else
(do
(set! key (rb-p-parse-assign))
(set! style "rocket")
(when (and (= (rb-p-type) "op") (= (rb-p-val) "=>"))
(rb-p-advance!)))))
(rb-p-skip-newlines!)
(set! val (rb-p-parse-assign))
(append! pairs {:key key :val val :style style}))
(rb-p-skip-newlines!)
(when (= (rb-p-type) "comma")
(do (rb-p-advance!) (rb-p-skip-newlines!)))
(rb-p-hash-loop)))))
(rb-p-hash-loop)
(rb-p-expect! "rbrace")
{:type "hash" :pairs pairs})))
;; (a, *b, **c, &d)
(define rb-p-parse-args-parens
(fn ()
(rb-p-advance!)
(rb-p-skip-newlines!)
(let ((args (list)))
(define rb-p-ap-loop
(fn ()
(when (not (or (= (rb-p-type) "rparen") (= (rb-p-type) "eof")))
(do
(cond
((and (= (rb-p-type) "op") (= (rb-p-val) "**"))
(do (rb-p-advance!)
(append! args {:type "dsplat" :value (rb-p-parse-assign)})))
((and (= (rb-p-type) "op") (= (rb-p-val) "*"))
(do (rb-p-advance!)
(append! args {:type "splat" :value (rb-p-parse-assign)})))
((and (= (rb-p-type) "op") (= (rb-p-val) "&"))
(do (rb-p-advance!)
(append! args {:type "block-pass" :value (rb-p-parse-assign)})))
(:else (append! args (rb-p-parse-assign))))
(rb-p-skip-newlines!)
(when (= (rb-p-type) "comma")
(do (rb-p-advance!) (rb-p-skip-newlines!)))
(rb-p-ap-loop)))))
(rb-p-ap-loop)
(rb-p-expect! "rparen")
args)))
;; No-paren arg list up to sep/end-keyword
(define rb-p-parse-args-bare
(fn ()
(let ((args (list)) (going true))
(define rb-p-ab-loop
(fn ()
(when (and going
(not (rb-p-sep?))
(not (= (rb-p-type) "eof"))
(not (= (rb-p-type) "rparen"))
(not (= (rb-p-type) "rbracket"))
(not (= (rb-p-type) "rbrace"))
(not (and (= (rb-p-type) "keyword")
(contains? (list "end" "else" "elsif" "when"
"rescue" "ensure" "then" "do")
(rb-p-val)))))
(do
(cond
((and (= (rb-p-type) "op") (= (rb-p-val) "*"))
(do (rb-p-advance!)
(append! args {:type "splat" :value (rb-p-parse-assign)})))
((and (= (rb-p-type) "op") (= (rb-p-val) "**"))
(do (rb-p-advance!)
(append! args {:type "dsplat" :value (rb-p-parse-assign)})))
((and (= (rb-p-type) "op") (= (rb-p-val) "&"))
(do (rb-p-advance!)
(append! args {:type "block-pass" :value (rb-p-parse-assign)})))
(:else (append! args (rb-p-parse-assign))))
(if (= (rb-p-type) "comma")
(do (rb-p-advance!) (rb-p-skip-newlines!) (rb-p-ab-loop))
(set! going false))))))
(rb-p-ab-loop)
args)))
;; Primary expression
(define rb-p-parse-primary
(fn ()
(cond
((= (rb-p-type) "int")
(let ((v (rb-p-val))) (rb-p-advance!) {:type "lit-int" :value v}))
((= (rb-p-type) "float")
(let ((v (rb-p-val))) (rb-p-advance!) {:type "lit-float" :value v}))
((= (rb-p-type) "string")
(let ((v (rb-p-val))) (rb-p-advance!) {:type "lit-str" :value v}))
((= (rb-p-type) "symbol")
(let ((v (rb-p-val))) (rb-p-advance!) {:type "lit-sym" :value v}))
((= (rb-p-type) "words")
(let ((v (rb-p-val))) (rb-p-advance!) {:type "lit-words" :elems v}))
((= (rb-p-type) "isymbols")
(let ((v (rb-p-val))) (rb-p-advance!) {:type "lit-isyms" :elems v}))
((= (rb-p-type) "ivar")
(let ((v (rb-p-val))) (rb-p-advance!) {:type "ivar" :name v}))
((= (rb-p-type) "cvar")
(let ((v (rb-p-val))) (rb-p-advance!) {:type "cvar" :name v}))
((= (rb-p-type) "gvar")
(let ((v (rb-p-val))) (rb-p-advance!) {:type "gvar" :name v}))
((= (rb-p-type) "const")
(rb-p-parse-const-path))
((= (rb-p-type) "ident")
(let ((name (rb-p-val)))
(rb-p-advance!)
(if (= (rb-p-type) "lparen")
(let ((args (rb-p-parse-args-parens))
(blk (rb-p-parse-block)))
{:type "send" :name name :args args :block blk})
{:type "send" :name name :args (list) :block nil})))
((= (rb-p-type) "keyword")
(cond
((= (rb-p-val) "nil")
(do (rb-p-advance!) {:type "lit-nil"}))
((= (rb-p-val) "true")
(do (rb-p-advance!) {:type "lit-bool" :value true}))
((= (rb-p-val) "false")
(do (rb-p-advance!) {:type "lit-bool" :value false}))
((= (rb-p-val) "self")
(do (rb-p-advance!) {:type "self"}))
((= (rb-p-val) "super")
(do
(rb-p-advance!)
(let ((args (if (= (rb-p-type) "lparen")
(rb-p-parse-args-parens) (list)))
(blk (rb-p-parse-block)))
{:type "send" :name "super" :args args :block blk})))
(:else
{:type "error"
:msg (join "" (list "unexpected kw " (rb-p-val)))})))
((= (rb-p-type) "lbracket")
(rb-p-parse-array))
((= (rb-p-type) "lbrace")
(rb-p-parse-hash))
((= (rb-p-type) "lparen")
(do
(rb-p-advance!)
(rb-p-skip-seps!)
(let ((node (rb-p-parse-expr)))
(rb-p-skip-seps!)
(rb-p-expect! "rparen")
node)))
(:else
(do
(rb-p-advance!)
{:type "error"
:msg (join "" (list "unexpected " (rb-p-type)
" '" (or (rb-p-val) "") "'"))})))))
;; .method ::Const [index] chains
(define rb-p-parse-postfix
(fn ()
(let ((node (rb-p-parse-primary)))
(define rb-p-pf-loop
(fn ()
(cond
((= (rb-p-type) "dot")
(do
(rb-p-advance!)
(let ((method (rb-p-val)))
(rb-p-advance!)
(let ((args (if (= (rb-p-type) "lparen")
(rb-p-parse-args-parens) (list)))
(blk (rb-p-parse-block)))
(set! node {:type "call" :recv node :method method
:args args :block blk})
(rb-p-pf-loop)))))
((= (rb-p-type) "dcolon")
(do
(rb-p-advance!)
(let ((name (rb-p-val)))
(rb-p-advance!)
(if (= (rb-p-type) "lparen")
(let ((args (rb-p-parse-args-parens))
(blk (rb-p-parse-block)))
(set! node {:type "call" :recv node :method name
:args args :block blk}))
(set! node {:type "const-path" :left node :name name}))
(rb-p-pf-loop))))
((= (rb-p-type) "lbracket")
(do
(rb-p-advance!)
(rb-p-skip-newlines!)
(let ((idxargs (list)))
(define rb-p-idx-loop
(fn ()
(when (not (or (= (rb-p-type) "rbracket") (= (rb-p-type) "eof")))
(do
(append! idxargs (rb-p-parse-assign))
(when (= (rb-p-type) "comma")
(do (rb-p-advance!) (rb-p-skip-newlines!)))
(rb-p-idx-loop)))))
(rb-p-idx-loop)
(rb-p-expect! "rbracket")
(set! node {:type "index" :recv node :args idxargs})
(rb-p-pf-loop))))
(:else nil))))
(rb-p-pf-loop)
node)))
(define rb-p-parse-unary
(fn ()
(cond
((and (= (rb-p-type) "op") (= (rb-p-val) "!"))
(do (rb-p-advance!)
{:type "unop" :op "!" :value (rb-p-parse-unary)}))
((and (= (rb-p-type) "op") (= (rb-p-val) "~"))
(do (rb-p-advance!)
{:type "unop" :op "~" :value (rb-p-parse-unary)}))
((and (= (rb-p-type) "op") (= (rb-p-val) "-"))
(do (rb-p-advance!)
{:type "unop" :op "-" :value (rb-p-parse-unary)}))
((and (= (rb-p-type) "op") (= (rb-p-val) "+"))
(do (rb-p-advance!) (rb-p-parse-unary)))
(:else (rb-p-parse-postfix)))))
(define rb-p-parse-power
(fn ()
(let ((node (rb-p-parse-unary)))
(if (and (= (rb-p-type) "op") (= (rb-p-val) "**"))
(do (rb-p-advance!)
{:type "binop" :op "**" :left node :right (rb-p-parse-power)})
node))))
(define rb-p-parse-mul
(fn ()
(let ((node (rb-p-parse-power)))
(define rb-p-mul-loop
(fn ()
(if (and (= (rb-p-type) "op")
(or (= (rb-p-val) "*") (= (rb-p-val) "/") (= (rb-p-val) "%")))
(let ((op (rb-p-val)))
(rb-p-advance!)
(set! node {:type "binop" :op op :left node :right (rb-p-parse-power)})
(rb-p-mul-loop))
node)))
(rb-p-mul-loop))))
(define rb-p-parse-add
(fn ()
(let ((node (rb-p-parse-mul)))
(define rb-p-add-loop
(fn ()
(if (and (= (rb-p-type) "op")
(or (= (rb-p-val) "+") (= (rb-p-val) "-")))
(let ((op (rb-p-val)))
(rb-p-advance!)
(set! node {:type "binop" :op op :left node :right (rb-p-parse-mul)})
(rb-p-add-loop))
node)))
(rb-p-add-loop))))
(define rb-p-parse-shift
(fn ()
(let ((node (rb-p-parse-add)))
(define rb-p-sh-loop
(fn ()
(if (and (= (rb-p-type) "op")
(or (= (rb-p-val) "<<") (= (rb-p-val) ">>")))
(let ((op (rb-p-val)))
(rb-p-advance!)
(set! node {:type "binop" :op op :left node :right (rb-p-parse-add)})
(rb-p-sh-loop))
node)))
(rb-p-sh-loop))))
(define rb-p-parse-bitand
(fn ()
(let ((node (rb-p-parse-shift)))
(define rb-p-ba-loop
(fn ()
(if (and (= (rb-p-type) "op") (= (rb-p-val) "&"))
(do
(rb-p-advance!)
(set! node {:type "binop" :op "&" :left node :right (rb-p-parse-shift)})
(rb-p-ba-loop))
node)))
(rb-p-ba-loop))))
;; | is "pipe" token (not "op")
(define rb-p-parse-bitor
(fn ()
(let ((node (rb-p-parse-bitand)))
(define rb-p-bo-loop
(fn ()
(cond
((= (rb-p-type) "pipe")
(do
(rb-p-advance!)
(set! node {:type "binop" :op "|" :left node :right (rb-p-parse-bitand)})
(rb-p-bo-loop)))
((and (= (rb-p-type) "op") (= (rb-p-val) "^"))
(do
(rb-p-advance!)
(set! node {:type "binop" :op "^" :left node :right (rb-p-parse-bitand)})
(rb-p-bo-loop)))
(:else node))))
(rb-p-bo-loop))))
(define rb-p-parse-comparison
(fn ()
(let ((node (rb-p-parse-bitor)))
(if (and (= (rb-p-type) "op")
(contains? (list "==" "!=" "<" ">" "<=" ">="
"<=>" "===" "=~" "!~") (rb-p-val)))
(let ((op (rb-p-val)))
(rb-p-advance!)
{:type "binop" :op op :left node :right (rb-p-parse-bitor)})
node))))
(define rb-p-parse-not
(fn ()
(if (and (= (rb-p-type) "keyword") (= (rb-p-val) "not"))
(do (rb-p-advance!)
{:type "not" :value (rb-p-parse-not)})
(rb-p-parse-comparison))))
(define rb-p-parse-and
(fn ()
(let ((node (rb-p-parse-not)))
(define rb-p-and-loop
(fn ()
(cond
((and (= (rb-p-type) "op") (= (rb-p-val) "&&"))
(do
(rb-p-advance!)
(set! node {:type "binop" :op "&&" :left node :right (rb-p-parse-not)})
(rb-p-and-loop)))
((and (= (rb-p-type) "keyword") (= (rb-p-val) "and"))
(do
(rb-p-advance!)
(set! node {:type "binop" :op "and" :left node :right (rb-p-parse-not)})
(rb-p-and-loop)))
(:else node))))
(rb-p-and-loop))))
(define rb-p-parse-or
(fn ()
(let ((node (rb-p-parse-and)))
(define rb-p-or-loop
(fn ()
(cond
((and (= (rb-p-type) "op") (= (rb-p-val) "||"))
(do
(rb-p-advance!)
(set! node {:type "binop" :op "||" :left node :right (rb-p-parse-and)})
(rb-p-or-loop)))
((and (= (rb-p-type) "keyword") (= (rb-p-val) "or"))
(do
(rb-p-advance!)
(set! node {:type "binop" :op "or" :left node :right (rb-p-parse-and)})
(rb-p-or-loop)))
(:else node))))
(rb-p-or-loop))))
(define rb-p-parse-range
(fn ()
(let ((node (rb-p-parse-or)))
(cond
((= (rb-p-type) "dotdot")
(do (rb-p-advance!)
{:type "range" :from node :to (rb-p-parse-or) :exclusive false}))
((= (rb-p-type) "dotdotdot")
(do (rb-p-advance!)
{:type "range" :from node :to (rb-p-parse-or) :exclusive true}))
(:else node)))))
(define rb-p-parse-assign
(fn ()
(let ((node (rb-p-parse-range)))
(cond
((and (= (rb-p-type) "op") (= (rb-p-val) "="))
(do (rb-p-advance!)
{:type "assign" :target node :value (rb-p-parse-assign)}))
((and (= (rb-p-type) "op")
(contains? (list "+=" "-=" "*=" "/=" "%=" "**="
"<<=" ">>=" "&=" "|=" "^=" "&&=" "||=")
(rb-p-val)))
(let ((op (substring (rb-p-val) 0 (- (len (rb-p-val)) 1))))
(rb-p-advance!)
{:type "op-assign" :target node :op op :value (rb-p-parse-assign)}))
(:else node)))))
(define rb-p-parse-expr
(fn () (rb-p-parse-assign)))
;; e, e, ... → single node or array
(define rb-p-parse-multi-val
(fn ()
(let ((vals (list)))
(define rb-p-mv-loop
(fn ()
(append! vals (rb-p-parse-assign))
(when (= (rb-p-type) "comma")
(do (rb-p-advance!) (rb-p-skip-newlines!) (rb-p-mv-loop)))))
(rb-p-mv-loop)
(if (= (len vals) 1)
(nth vals 0)
{:type "array" :elems vals}))))
;; a, b, *c = rhs
(define rb-p-parse-massign
(fn ()
(let ((targets (list)))
(define rb-p-ma-loop
(fn ()
(cond
((and (= (rb-p-type) "op") (= (rb-p-val) "*"))
(do
(rb-p-advance!)
(if (= (rb-p-type) "ident")
(do
(append! targets {:type "splat-target" :name (rb-p-val)})
(rb-p-advance!))
(append! targets {:type "splat-target" :name nil}))))
((= (rb-p-type) "ident")
(do (append! targets {:type "lvar" :name (rb-p-val)}) (rb-p-advance!)))
((= (rb-p-type) "ivar")
(do (append! targets {:type "ivar" :name (rb-p-val)}) (rb-p-advance!)))
((= (rb-p-type) "cvar")
(do (append! targets {:type "cvar" :name (rb-p-val)}) (rb-p-advance!)))
((= (rb-p-type) "gvar")
(do (append! targets {:type "gvar" :name (rb-p-val)}) (rb-p-advance!)))
((= (rb-p-type) "const")
(do (append! targets {:type "const" :name (rb-p-val)}) (rb-p-advance!)))
(:else nil))
(when (= (rb-p-type) "comma")
(do (rb-p-advance!) (rb-p-skip-newlines!) (rb-p-ma-loop)))))
(rb-p-ma-loop)
(rb-p-advance!)
{:type "massign" :targets targets :value (rb-p-parse-multi-val)})))
(define rb-p-parse-stmt
(fn ()
(cond
((and (= (rb-p-type) "keyword") (= (rb-p-val) "def"))
(rb-p-parse-def))
((and (= (rb-p-type) "keyword") (= (rb-p-val) "class"))
(rb-p-parse-class))
((and (= (rb-p-type) "keyword") (= (rb-p-val) "module"))
(rb-p-parse-module))
((and (= (rb-p-type) "keyword") (= (rb-p-val) "return"))
(do (rb-p-advance!)
{:type "return"
:value (if (or (rb-p-sep?) (= (rb-p-type) "eof"))
nil (rb-p-parse-multi-val))}))
((and (= (rb-p-type) "keyword") (= (rb-p-val) "yield"))
(do (rb-p-advance!)
{:type "yield"
:args (cond
((= (rb-p-type) "lparen") (rb-p-parse-args-parens))
((or (rb-p-sep?) (= (rb-p-type) "eof")) (list))
(:else (rb-p-parse-args-bare)))}))
((and (= (rb-p-type) "keyword") (= (rb-p-val) "break"))
(do (rb-p-advance!)
{:type "break"
:value (if (or (rb-p-sep?) (= (rb-p-type) "eof"))
nil (rb-p-parse-expr))}))
((and (= (rb-p-type) "keyword") (= (rb-p-val) "next"))
(do (rb-p-advance!)
{:type "next"
:value (if (or (rb-p-sep?) (= (rb-p-type) "eof"))
nil (rb-p-parse-expr))}))
((and (= (rb-p-type) "keyword") (= (rb-p-val) "redo"))
(do (rb-p-advance!) {:type "redo"}))
((and (= (rb-p-type) "keyword") (= (rb-p-val) "raise"))
(do (rb-p-advance!)
{:type "raise"
:value (if (or (rb-p-sep?) (= (rb-p-type) "eof"))
nil (rb-p-parse-expr))}))
;; Massign: token followed by comma
((and (or (= (rb-p-type) "ident") (= (rb-p-type) "ivar")
(= (rb-p-type) "cvar") (= (rb-p-type) "gvar")
(= (rb-p-type) "const"))
(= (get (rb-p-peek 1) :type) "comma"))
(rb-p-parse-massign))
(:else
(let ((node (rb-p-parse-assign)))
(if (and (= (get node :type) "send")
(= (len (get node :args)) 0)
(nil? (get node :block)))
;; Bare send: check for block or no-paren args
(cond
;; Block immediately follows (do or {)
((or (and (= (rb-p-type) "keyword") (= (rb-p-val) "do"))
(= (rb-p-type) "lbrace"))
(let ((blk (rb-p-parse-block)))
{:type "send" :name (get node :name) :args (list) :block blk}))
;; No-paren args (stop before block/sep/end keywords)
((and (not (rb-p-sep?))
(not (= (rb-p-type) "eof"))
(not (= (rb-p-type) "op"))
(not (= (rb-p-type) "dot"))
(not (= (rb-p-type) "dcolon"))
(not (= (rb-p-type) "rparen"))
(not (= (rb-p-type) "rbracket"))
(not (= (rb-p-type) "rbrace"))
(not (= (rb-p-type) "lbrace"))
(not (and (= (rb-p-type) "keyword")
(contains? (list "end" "else" "elsif" "when"
"rescue" "ensure" "then" "do"
"and" "or" "not")
(rb-p-val)))))
(let ((args (rb-p-parse-args-bare))
(blk (rb-p-parse-block)))
(if (> (len args) 0)
{:type "send" :name (get node :name) :args args :block blk}
node)))
(:else node))
node))))))
(define rb-p-parse-stmts
(fn (terminators)
(let ((stmts (list)))
(define rb-p-at-term?
(fn ()
(or (= (rb-p-type) "eof")
(and (= (rb-p-type) "keyword")
(contains? terminators (rb-p-val)))
(and (= (rb-p-type) "rbrace")
(contains? terminators "rbrace")))))
(define rb-p-ps-loop
(fn ()
(rb-p-skip-seps!)
(when (not (rb-p-at-term?))
(do
(append! stmts (rb-p-parse-stmt))
(rb-p-skip-seps!)
(rb-p-ps-loop)))))
(rb-p-ps-loop)
stmts)))
{:type "program" :stmts (rb-p-parse-stmts (list))})))
(define rb-parse-str
(fn (src) (rb-parse (rb-tokenize src))))

92
lib/ruby/test.sh Executable file
View File

@@ -0,0 +1,92 @@
#!/usr/bin/env bash
# Ruby-on-SX test runner.
# Usage:
# bash lib/ruby/test.sh # run all tests
# bash lib/ruby/test.sh -v # verbose
# bash lib/ruby/test.sh tests/parse.sx # single file
set -euo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
if [ ! -x "$SX_SERVER" ]; then
MAIN_ROOT=$(git worktree list | head -1 | awk '{print $1}')
if [ -x "$MAIN_ROOT/$SX_SERVER" ]; then
SX_SERVER="$MAIN_ROOT/$SX_SERVER"
else
echo "ERROR: sx_server.exe not found."
exit 1
fi
fi
VERBOSE=""
FILES=()
for arg in "$@"; do
case "$arg" in
-v|--verbose) VERBOSE=1 ;;
*) FILES+=("$arg") ;;
esac
done
if [ ${#FILES[@]} -eq 0 ]; then
mapfile -t FILES < <(find lib/ruby/tests -maxdepth 2 -name '*.sx' | sort)
fi
TOTAL_PASS=0
TOTAL_FAIL=0
FAILED_FILES=()
for FILE in "${FILES[@]}"; do
[ -f "$FILE" ] || { echo "skip $FILE (not found)"; continue; }
TMPFILE=$(mktemp)
# Build epoch sequence: load runtime files, then test file, then eval summary.
{
echo "(epoch 1)"
echo "(load \"lib/ruby/tokenizer.sx\")"
if [ -f "lib/ruby/parser.sx" ]; then
echo "(epoch 2)"
echo "(load \"lib/ruby/parser.sx\")"
fi
echo "(epoch 3)"
echo "(load \"$FILE\")"
echo "(epoch 4)"
echo "(eval \"(list rb-test-pass rb-test-fail)\")"
} > "$TMPFILE"
OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
rm -f "$TMPFILE"
# Extract epoch 4 result: (ok-len 4 N)\n<val> or (ok 4 <val>)
LINE=$(printf '%s\n' "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}')
if [ -z "$LINE" ]; then
LINE=$(printf '%s\n' "$OUTPUT" \
| grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \
| sed -E 's/^\(ok 4 //; s/\)$//')
fi
if [ -z "$LINE" ]; then
echo "$FILE: could not extract summary"
printf '%s\n' "$OUTPUT" | grep -v '^(ok ' | tail -10
TOTAL_FAIL=$((TOTAL_FAIL + 1))
FAILED_FILES+=("$FILE")
continue
fi
P=$(printf '%s\n' "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
F=$(printf '%s\n' "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
TOTAL_PASS=$((TOTAL_PASS + P))
TOTAL_FAIL=$((TOTAL_FAIL + F))
if [ "$F" -gt 0 ]; then
FAILED_FILES+=("$FILE")
printf '✗ %-40s %d/%d\n' "$FILE" "$P" "$((P+F))"
elif [ "$VERBOSE" = "1" ]; then
printf '✓ %-40s %d passed\n' "$FILE" "$P"
fi
done
TOTAL=$((TOTAL_PASS + TOTAL_FAIL))
if [ $TOTAL_FAIL -eq 0 ]; then
echo "$TOTAL_PASS/$TOTAL ruby-on-sx tests passed"
else
echo "$TOTAL_PASS/$TOTAL passed, $TOTAL_FAIL failed in: ${FAILED_FILES[*]}"
fi
[ $TOTAL_FAIL -eq 0 ]

439
lib/ruby/tests/parse.sx Normal file
View File

@@ -0,0 +1,439 @@
;; Parser tests for Ruby 2.7 subset.
(define rb-deep=?
(fn (a b)
(cond
((= a b) true)
((and (dict? a) (dict? b))
(let ((ak (keys a)) (bk (keys b)))
(if (not (= (len ak) (len bk)))
false
(every?
(fn (k)
(and (has-key? b k) (rb-deep=? (get a k) (get b k))))
ak))))
((and (list? a) (list? b))
(if (not (= (len a) (len b)))
false
(let ((i 0) (ok true))
(define rb-de-loop
(fn ()
(when (and ok (< i (len a)))
(do
(when (not (rb-deep=? (nth a i) (nth b i)))
(set! ok false))
(set! i (+ i 1))
(rb-de-loop)))))
(rb-de-loop)
ok)))
(:else false))))
(define rb-test-pass 0)
(define rb-test-fail 0)
(define rb-test-fails (list))
(define rb-test
(fn (name actual expected)
(if (rb-deep=? actual expected)
(set! rb-test-pass (+ rb-test-pass 1))
(do
(set! rb-test-fail (+ rb-test-fail 1))
(append! rb-test-fails {:name name :actual actual :expected expected})))))
;; Shorthand: parse src and extract :stmts list
(define rb-p-stmts
(fn (src)
(get (rb-parse-str src) :stmts)))
;; Shorthand: parse and get first statement
(define rb-p-first
(fn (src)
(nth (rb-p-stmts src) 0)))
;; ── Literals ─────────────────────────────────────────────────────────────────
(rb-test "int literal"
(rb-p-first "42")
{:type "lit-int" :value 42})
(rb-test "negative int"
(rb-p-first "-7")
{:type "unop" :op "-" :value {:type "lit-int" :value 7}})
(rb-test "float literal"
(rb-p-first "3.14")
{:type "lit-float" :value "3.14"})
(rb-test "string literal"
(rb-p-first "\"hello\"")
{:type "lit-str" :value "hello"})
(rb-test "symbol literal"
(rb-p-first ":foo")
{:type "lit-sym" :value "foo"})
(rb-test "nil literal"
(rb-p-first "nil")
{:type "lit-nil"})
(rb-test "true literal"
(rb-p-first "true")
{:type "lit-bool" :value true})
(rb-test "false literal"
(rb-p-first "false")
{:type "lit-bool" :value false})
(rb-test "self"
(rb-p-first "self")
{:type "self"})
(rb-test "%w[] words"
(rb-p-first "%w[a b c]")
{:type "lit-words" :elems (list "a" "b" "c")})
(rb-test "%i[] isymbols"
(rb-p-first "%i[x y]")
{:type "lit-isyms" :elems (list "x" "y")})
;; ── Variables ─────────────────────────────────────────────────────────────────
(rb-test "local var / send"
(rb-p-first "x")
{:type "send" :name "x" :args (list) :block nil})
(rb-test "ivar"
(rb-p-first "@foo")
{:type "ivar" :name "@foo"})
(rb-test "cvar"
(rb-p-first "@@count")
{:type "cvar" :name "@@count"})
(rb-test "gvar"
(rb-p-first "$stdout")
{:type "gvar" :name "$stdout"})
(rb-test "constant"
(rb-p-first "Foo")
{:type "const" :name "Foo"})
(rb-test "const path"
(rb-p-first "Foo::Bar")
{:type "const-path"
:left {:type "const" :name "Foo"}
:name "Bar"})
(rb-test "triple const path"
(rb-p-first "A::B::C")
{:type "const-path"
:left {:type "const-path"
:left {:type "const" :name "A"}
:name "B"}
:name "C"})
;; ── Arrays and Hashes ─────────────────────────────────────────────────────────
(rb-test "empty array"
(rb-p-first "[]")
{:type "array" :elems (list)})
(rb-test "array literal"
(rb-p-first "[1, 2, 3]")
{:type "array" :elems (list {:type "lit-int" :value 1}
{:type "lit-int" :value 2}
{:type "lit-int" :value 3})})
(rb-test "hash colon style"
(get (rb-p-first "{a: 1}") :type)
"hash")
(rb-test "hash pair style"
(get (nth (get (rb-p-first "{a: 1}") :pairs) 0) :style)
"colon")
(rb-test "hash symbol key"
(get (get (nth (get (rb-p-first "{a: 1}") :pairs) 0) :key) :value)
"a")
;; ── Binary operators ──────────────────────────────────────────────────────────
(rb-test "addition"
(rb-p-first "1 + 2")
{:type "binop" :op "+"
:left {:type "lit-int" :value 1}
:right {:type "lit-int" :value 2}})
(rb-test "subtraction"
(get (rb-p-first "a - b") :op)
"-")
(rb-test "multiplication"
(get (rb-p-first "x * y") :op)
"*")
(rb-test "precedence: * before +"
(rb-p-first "1 + 2 * 3")
{:type "binop" :op "+"
:left {:type "lit-int" :value 1}
:right {:type "binop" :op "*"
:left {:type "lit-int" :value 2}
:right {:type "lit-int" :value 3}}})
(rb-test "power right-assoc"
(rb-p-first "2 ** 3 ** 4")
{:type "binop" :op "**"
:left {:type "lit-int" :value 2}
:right {:type "binop" :op "**"
:left {:type "lit-int" :value 3}
:right {:type "lit-int" :value 4}}})
(rb-test "equality"
(get (rb-p-first "a == b") :op)
"==")
(rb-test "logical and"
(get (rb-p-first "a && b") :op)
"&&")
(rb-test "logical or"
(get (rb-p-first "a || b") :op)
"||")
(rb-test "range inclusive"
(rb-p-first "1..5")
{:type "range"
:from {:type "lit-int" :value 1}
:to {:type "lit-int" :value 5}
:exclusive false})
(rb-test "range exclusive"
(get (rb-p-first "1...5") :exclusive)
true)
;; ── Assignment ────────────────────────────────────────────────────────────────
(rb-test "assign"
(rb-p-first "x = 1")
{:type "assign"
:target {:type "send" :name "x" :args (list) :block nil}
:value {:type "lit-int" :value 1}})
(rb-test "op-assign +="
(get (rb-p-first "x += 1") :type)
"op-assign")
(rb-test "op-assign op"
(get (rb-p-first "x += 1") :op)
"+")
(rb-test "massign"
(get (rb-p-first "a, b = 1, 2") :type)
"massign")
(rb-test "massign targets"
(len (get (rb-p-first "a, b = 1, 2") :targets))
2)
(rb-test "massign value array"
(get (get (rb-p-first "a, b = 1, 2") :value) :type)
"array")
;; ── Method calls ──────────────────────────────────────────────────────────────
(rb-test "call with parens"
(rb-p-first "foo(1, 2)")
{:type "send" :name "foo"
:args (list {:type "lit-int" :value 1}
{:type "lit-int" :value 2})
:block nil})
(rb-test "chained call"
(get (rb-p-first "obj.foo") :type)
"call")
(rb-test "chained call method"
(get (rb-p-first "obj.foo") :method)
"foo")
(rb-test "chained call with args"
(len (get (rb-p-first "obj.foo(1, 2)") :args))
2)
(rb-test "no-paren call"
(get (rb-p-first "puts \"hello\"") :type)
"send")
(rb-test "no-paren call name"
(get (rb-p-first "puts \"hello\"") :name)
"puts")
(rb-test "no-paren call args"
(len (get (rb-p-first "puts \"hello\"") :args))
1)
(rb-test "indexing"
(get (rb-p-first "a[0]") :type)
"index")
;; ── Unary operators ───────────────────────────────────────────────────────────
(rb-test "unary not"
(rb-p-first "!x")
{:type "unop" :op "!"
:value {:type "send" :name "x" :args (list) :block nil}})
(rb-test "unary minus"
(get (rb-p-first "-x") :op)
"-")
;; ── Method def ────────────────────────────────────────────────────────────────
(rb-test "empty method def"
(get (rb-p-first "def foo; end") :type)
"method-def")
(rb-test "method def name"
(get (rb-p-first "def foo; end") :name)
"foo")
(rb-test "method def no params"
(len (get (rb-p-first "def foo; end") :params))
0)
(rb-test "method def with params"
(len (get (rb-p-first "def foo(a, b); end") :params))
2)
(rb-test "method def param-req"
(get (nth (get (rb-p-first "def foo(a); end") :params) 0) :type)
"param-req")
(rb-test "method def param name"
(get (nth (get (rb-p-first "def foo(a); end") :params) 0) :name)
"a")
(rb-test "method def optional param"
(get (nth (get (rb-p-first "def foo(a, b=1); end") :params) 1) :type)
"param-opt")
(rb-test "method def splat"
(get (nth (get (rb-p-first "def foo(*args); end") :params) 0) :type)
"param-rest")
(rb-test "method def double splat"
(get (nth (get (rb-p-first "def foo(**opts); end") :params) 0) :type)
"param-kwrest")
(rb-test "method def block param"
(get (nth (get (rb-p-first "def foo(&blk); end") :params) 0) :type)
"param-block")
(rb-test "method def all param types"
(len (get (rb-p-first "def foo(a, b=1, *c, **d, &e); end") :params))
5)
(rb-test "method def singleton recv"
(get (get (rb-p-first "def self.bar; end") :recv) :type)
"self")
(rb-test "method def body"
(len (get (rb-p-first "def foo; 1; 2; end") :body))
2)
;; ── Class def ────────────────────────────────────────────────────────────────
(rb-test "class def type"
(get (rb-p-first "class Foo; end") :type)
"class-def")
(rb-test "class def name"
(get (get (rb-p-first "class Foo; end") :name) :name)
"Foo")
(rb-test "class def no super"
(nil? (get (rb-p-first "class Foo; end") :super))
true)
(rb-test "class def with super"
(get (get (rb-p-first "class Foo < Bar; end") :super) :name)
"Bar")
(rb-test "singleton class"
(get (rb-p-first "class << self; end") :type)
"sclass")
;; ── Module def ────────────────────────────────────────────────────────────────
(rb-test "module def type"
(get (rb-p-first "module M; end") :type)
"module-def")
(rb-test "module def name"
(get (get (rb-p-first "module M; end") :name) :name)
"M")
;; ── Blocks ────────────────────────────────────────────────────────────────────
(rb-test "block do...end"
(get (get (rb-p-first "foo do |x| x end") :block) :type)
"block")
(rb-test "block brace"
(get (get (rb-p-first "foo { |x| x }") :block) :type)
"block")
(rb-test "block params"
(len (get (get (rb-p-first "foo { |a, b| a }") :block) :params))
2)
(rb-test "block no params"
(len (get (get (rb-p-first "foo { 42 }") :block) :params))
0)
;; ── Control flow ──────────────────────────────────────────────────────────────
(rb-test "return type"
(get (rb-p-first "return 1") :type)
"return")
(rb-test "return value"
(get (get (rb-p-first "return 1") :value) :value)
1)
(rb-test "return nil"
(nil? (get (rb-p-first "return") :value))
true)
(rb-test "yield type"
(get (rb-p-first "yield 1") :type)
"yield")
(rb-test "break type"
(get (rb-p-first "break") :type)
"break")
(rb-test "next type"
(get (rb-p-first "next") :type)
"next")
(rb-test "redo type"
(get (rb-p-first "redo") :type)
"redo")
;; ── Multi-statement program ───────────────────────────────────────────────────
(rb-test "two statements"
(len (rb-p-stmts "1\n2"))
2)
(rb-test "semi-separated"
(len (rb-p-stmts "1; 2; 3"))
3)
(rb-test "class with method"
(let ((cls (rb-p-first "class Foo\n def bar\n 1\n end\nend")))
(len (get cls :body)))
1)
(list rb-test-pass rb-test-fail)

210
lib/ruby/tests/tokenizer.sx Normal file
View File

@@ -0,0 +1,210 @@
;; Ruby tokenizer tests.
;; Final value: {:pass N :fail N :fails (list)}
(define rb-deep=?
(fn (a b)
(cond
((= a b) true)
((and (dict? a) (dict? b))
(let ((ak (keys a)) (bk (keys b)))
(if (not (= (len ak) (len bk)))
false
(every?
(fn (k) (and (has-key? b k) (rb-deep=? (get a k) (get b k))))
ak))))
((and (list? a) (list? b))
(if (not (= (len a) (len b)))
false
(let ((i 0) (ok true))
(define rb-de-loop
(fn ()
(when (and ok (< i (len a)))
(do
(when (not (rb-deep=? (nth a i) (nth b i)))
(set! ok false))
(set! i (+ i 1))
(rb-de-loop)))))
(rb-de-loop)
ok)))
(:else false))))
(define rb-test-pass 0)
(define rb-test-fail 0)
(define rb-test-fails (list))
(define rb-test
(fn (name actual expected)
(if (rb-deep=? actual expected)
(set! rb-test-pass (+ rb-test-pass 1))
(do
(set! rb-test-fail (+ rb-test-fail 1))
(append! rb-test-fails {:name name :actual actual :expected expected})))))
;; Helper: tokenize, drop newline+eof, return {:type :value} pairs
(define rb-toks
(fn (src)
(map
(fn (tok) {:value (get tok "value") :type (get tok "type")})
(filter
(fn (tok)
(let ((ty (get tok "type")))
(not (or (= ty "newline") (= ty "eof")))))
(rb-tokenize src)))))
;; Helper: get just types
(define rb-types
(fn (src) (map (fn (t) (get t "type")) (rb-toks src))))
;; Helper: get first token type
(define rb-first-type
(fn (src) (get (get (rb-tokenize src) 0) "type")))
(define rb-first-value
(fn (src) (get (get (rb-tokenize src) 0) "value")))
;; ── 1. Keywords ────────────────────────<E29480><E29480><EFBFBD>─────────────────────────
(rb-test "keyword def" (rb-toks "def") (list {:value "def" :type "keyword"}))
(rb-test "keyword end" (rb-toks "end") (list {:value "end" :type "keyword"}))
(rb-test "keyword class" (rb-toks "class") (list {:value "class" :type "keyword"}))
(rb-test "keyword if" (rb-toks "if") (list {:value "if" :type "keyword"}))
(rb-test "keyword while" (rb-toks "while") (list {:value "while" :type "keyword"}))
(rb-test "keyword nil" (rb-toks "nil") (list {:value "nil" :type "keyword"}))
(rb-test "keyword true" (rb-toks "true") (list {:value "true" :type "keyword"}))
(rb-test "keyword false" (rb-toks "false") (list {:value "false" :type "keyword"}))
(rb-test "keyword return" (rb-toks "return") (list {:value "return" :type "keyword"}))
(rb-test "keyword yield" (rb-toks "yield") (list {:value "yield" :type "keyword"}))
(rb-test "keyword begin" (rb-toks "begin") (list {:value "begin" :type "keyword"}))
(rb-test "keyword rescue" (rb-toks "rescue") (list {:value "rescue" :type "keyword"}))
(rb-test "keyword self" (rb-toks "self") (list {:value "self" :type "keyword"}))
(rb-test "keyword super" (rb-toks "super") (list {:value "super" :type "keyword"}))
;; ── 2. Identifiers ────────────────────────────────────────────────
(rb-test "ident simple" (rb-toks "foo") (list {:value "foo" :type "ident"}))
(rb-test "ident underscore" (rb-toks "_foo") (list {:value "_foo" :type "ident"}))
(rb-test "ident with digit" (rb-toks "foo2") (list {:value "foo2" :type "ident"}))
(rb-test "ident predicate" (rb-toks "empty?") (list {:value "empty?" :type "ident"}))
(rb-test "ident bang" (rb-toks "save!") (list {:value "save!" :type "ident"}))
(rb-test "defined?" (rb-toks "defined?") (list {:value "defined?" :type "keyword"}))
;; ── 3. Constants ──────────────────────────────────────────────────
(rb-test "const simple" (rb-toks "Foo") (list {:value "Foo" :type "const"}))
(rb-test "const upcase" (rb-toks "MY_CONST") (list {:value "MY_CONST" :type "const"}))
(rb-test "const class" (rb-toks "String") (list {:value "String" :type "const"}))
;; ── 4. Sigil variables ───────────────────────────────────────────
(rb-test "ivar" (rb-toks "@name") (list {:value "@name" :type "ivar"}))
(rb-test "cvar" (rb-toks "@@count") (list {:value "@@count" :type "cvar"}))
(rb-test "gvar" (rb-toks "$global") (list {:value "$global" :type "gvar"}))
;; ── 5. Integers ───────────────────────────────────────────────────
(rb-test "int decimal" (rb-first-value "42") 42)
(rb-test "int zero" (rb-first-value "0") 0)
(rb-test "int underscore" (rb-first-value "1_000") 1000)
(rb-test "int hex" (rb-first-value "0xFF") 255)
(rb-test "int hex lower" (rb-first-value "0xff") 255)
(rb-test "int octal" (rb-first-value "0o17") 15)
(rb-test "int binary" (rb-first-value "0b1010") 10)
(rb-test "int type" (rb-first-type "42") "int")
;; ── 6. Floats ─────────────────────────────────────────────────────
(rb-test "float simple" (rb-first-type "3.14") "float")
(rb-test "float value" (rb-first-value "3.14") "3.14")
(rb-test "float exp" (rb-first-type "1.5e10") "float")
(rb-test "float exp value" (rb-first-value "1.5e10") "1.5e10")
;; ── 7. Strings ────────────────────────────────────────────────────
(rb-test "dq string" (rb-first-value "\"hello\"") "hello")
(rb-test "dq string type" (rb-first-type "\"hello\"") "string")
(rb-test "sq string" (rb-first-value "'world'") "world")
(rb-test "dq escape nl" (rb-first-value "\"a\\nb\"") "a\nb")
(rb-test "dq escape tab" (rb-first-value "\"a\\tb\"") "a\tb")
(rb-test "dq escape quote" (rb-first-value "\"a\\\"b\"") "a\"b")
(rb-test "sq no escape" (rb-first-value "'a\\nb'") "a\\nb")
(rb-test "sq escape backslash" (rb-first-value "'a\\\\'") "a\\")
(rb-test "dq interp kept" (rb-first-value "\"#{x}\"") "#{x}")
;; ── 8. Symbols ────────────────────────────────────────────────────
(rb-test "symbol simple" (rb-first-type ":foo") "symbol")
(rb-test "symbol value" (rb-first-value ":foo") "foo")
(rb-test "symbol predicate" (rb-first-value ":empty?") "empty?")
(rb-test "symbol dq" (rb-first-value ":\"hello world\"") "hello world")
(rb-test "symbol sq" (rb-first-value ":'hello'") "hello")
;; ── 9. %w and %i literals ────────────────────────────────────────
(rb-test "%w bracket" (rb-first-type "%w[a b c]") "words")
(rb-test "%w value" (rb-first-value "%w[a b c]") (list "a" "b" "c"))
(rb-test "%w paren" (rb-first-value "%w(x y)") (list "x" "y"))
(rb-test "%i bracket" (rb-first-type "%i[a b]") "isymbols")
(rb-test "%i value" (rb-first-value "%i[foo bar]") (list "foo" "bar"))
;; ── 10. Punctuation ───────────────────────────────────────────────
(rb-test "dot" (rb-first-type ".") "dot")
(rb-test "dotdot" (rb-first-type "..") "dotdot")
(rb-test "dotdotdot" (rb-first-type "...") "dotdotdot")
(rb-test "dcolon" (rb-first-type "::") "dcolon")
(rb-test "comma" (rb-first-type ",") "comma")
(rb-test "semi" (rb-first-type ";") "semi")
(rb-test "lparen" (rb-first-type "(") "lparen")
(rb-test "rparen" (rb-first-type ")") "rparen")
(rb-test "lbracket" (rb-first-type "[") "lbracket")
(rb-test "rbracket" (rb-first-type "]") "rbracket")
(rb-test "lbrace" (rb-first-type "{") "lbrace")
(rb-test "rbrace" (rb-first-type "}") "rbrace")
(rb-test "pipe" (rb-first-type "|") "pipe")
;; ── 11. Operators ─────────────────────────────────────────────────
(rb-test "op plus" (rb-first-value "+") "+")
(rb-test "op minus" (rb-first-value "-") "-")
(rb-test "op star" (rb-first-value "*") "*")
(rb-test "op slash" (rb-first-value "/") "/")
(rb-test "op eq" (rb-first-value "=") "=")
(rb-test "op eqeq" (rb-first-value "==") "==")
(rb-test "op neq" (rb-first-value "!=") "!=")
(rb-test "op lt" (rb-first-value "<") "<")
(rb-test "op gt" (rb-first-value ">") ">")
(rb-test "op lte" (rb-first-value "<=") "<=")
(rb-test "op gte" (rb-first-value ">=") ">=")
(rb-test "op spaceship" (rb-first-value "<=>") "<=>")
(rb-test "op tripleq" (rb-first-value "===") "===")
(rb-test "op match" (rb-first-value "=~") "=~")
(rb-test "op nomatch" (rb-first-value "!~") "!~")
(rb-test "op lshift" (rb-first-value "<<") "<<")
(rb-test "op rshift" (rb-first-value ">>") ">>")
(rb-test "op and" (rb-first-value "&&") "&&")
(rb-test "op or" (rb-first-value "||") "||")
(rb-test "op power" (rb-first-value "**") "**")
(rb-test "op plus-eq" (rb-first-value "+=") "+=")
(rb-test "op minus-eq" (rb-first-value "-=") "-=")
(rb-test "op arrow" (rb-first-value "->") "->")
(rb-test "op hash-rocket" (rb-first-value "=>") "=>")
;; ── 12. Comments ──────────────────────────────────────────────────
(rb-test "comment skipped" (len (rb-toks "# this is a comment")) 0)
(rb-test "comment mid-line" (rb-types "x = 1 # comment") (list "ident" "op" "int"))
;; ── 13. Multi-token sequences ─────────────────────────────────────
(rb-test "method call" (rb-types "foo.bar")
(list "ident" "dot" "ident"))
(rb-test "class def" (rb-types "class Foo")
(list "keyword" "const"))
(rb-test "method def" (rb-types "def greet(name)")
(list "keyword" "ident" "lparen" "ident" "rparen"))
(rb-test "assignment" (rb-types "x = 42")
(list "ident" "op" "int"))
(rb-test "block params" (rb-types "|x, y|")
(list "pipe" "ident" "comma" "ident" "pipe"))
(rb-test "scope resolution" (rb-types "Foo::Bar")
(list "const" "dcolon" "const"))
(rb-test "range" (rb-types "1..10")
(list "int" "dotdot" "int"))
(rb-test "exclusive range" (rb-types "1...10")
(list "int" "dotdotdot" "int"))
;; ── 14. Line/col tracking ────────────────────────────────────────
(define rb-tok1 (get (rb-tokenize "hello\nworld") 0))
(define rb-tok2 (get (rb-tokenize "hello\nworld") 2))
(rb-test "line track start" (get rb-tok1 "line") 1)
(rb-test "line track second" (get rb-tok2 "line") 2)
(rb-test "col track start" (get rb-tok1 "col") 1)
(list rb-test-pass rb-test-fail)

549
lib/ruby/tokenizer.sx Normal file
View File

@@ -0,0 +1,549 @@
;; Ruby tokenizer for Ruby 2.7 subset.
;; Token: {:type T :value V :line L :col C}
;;
;; Types: keyword ident ivar cvar gvar const
;; int float string symbol
;; op dot dotdot dotdotdot dcolon colon
;; lparen rparen lbracket rbracket lbrace rbrace
;; comma semi pipe newline words isymbols eof
;; ── Character code table ──────────────────────────────────────────
(define rb-ord-table
(let ((t (dict)) (i 0))
(define rb-build-table
(fn ()
(when (< i 128)
(do
(dict-set! t (char-from-code i) i)
(set! i (+ i 1))
(rb-build-table)))))
(rb-build-table)
t))
(define rb-ord (fn (c) (or (get rb-ord-table c) 0)))
;; ── Character predicates ──────────────────────────────────────────
(define rb-digit?
(fn (c) (and (string? c) (>= (rb-ord c) 48) (<= (rb-ord c) 57))))
(define rb-hex-digit?
(fn (c)
(and (string? c)
(or (and (>= (rb-ord c) 48) (<= (rb-ord c) 57))
(and (>= (rb-ord c) 97) (<= (rb-ord c) 102))
(and (>= (rb-ord c) 65) (<= (rb-ord c) 70))))))
(define rb-octal-digit?
(fn (c) (and (string? c) (>= (rb-ord c) 48) (<= (rb-ord c) 55))))
(define rb-binary-digit? (fn (c) (or (= c "0") (= c "1"))))
(define rb-lower?
(fn (c) (and (string? c) (>= (rb-ord c) 97) (<= (rb-ord c) 122))))
(define rb-upper?
(fn (c) (and (string? c) (>= (rb-ord c) 65) (<= (rb-ord c) 90))))
(define rb-ident-start?
(fn (c) (or (rb-lower? c) (rb-upper? c) (= c "_"))))
(define rb-ident-cont?
(fn (c) (or (rb-lower? c) (rb-upper? c) (rb-digit? c) (= c "_"))))
(define rb-space? (fn (c) (or (= c " ") (= c "\t") (= c "\r"))))
;; ── Reserved words ────────────────────────────────────────────────
(define rb-keywords
(list "__ENCODING__" "__LINE__" "__FILE__"
"BEGIN" "END"
"alias" "and"
"begin" "break"
"case" "class"
"def" "defined?" "do"
"else" "elsif" "end" "ensure"
"false" "for"
"if" "in"
"module"
"next" "nil" "not"
"or"
"redo" "rescue" "retry" "return"
"self" "super"
"then" "true"
"undef" "unless" "until"
"when" "while"
"yield"))
(define rb-keyword? (fn (w) (contains? rb-keywords w)))
;; ── Token constructor ─────────────────────────────────────────────
(define rb-make-token
(fn (type value line col) {:type type :value value :line line :col col}))
;; ── Radix number parser ───────────────────────────────────────────
(define rb-parse-radix
(fn (s radix)
(let ((n (len s)) (i 0) (acc 0))
(define rb-rad-loop
(fn ()
(when (< i n)
(do
(let ((c (substring s i (+ i 1))))
(cond
((and (>= (rb-ord c) 48) (<= (rb-ord c) 57))
(set! acc (+ (* acc radix) (- (rb-ord c) 48))))
((and (>= (rb-ord c) 97) (<= (rb-ord c) 102))
(set! acc (+ (* acc radix) (+ 10 (- (rb-ord c) 97)))))
((and (>= (rb-ord c) 65) (<= (rb-ord c) 70))
(set! acc (+ (* acc radix) (+ 10 (- (rb-ord c) 65)))))))
(set! i (+ i 1))
(rb-rad-loop)))))
(rb-rad-loop)
acc)))
;; ── Strip underscores from numeric literals ───────────────────────
(define rb-strip-underscores
(fn (s)
(let ((n (len s)) (i 0) (parts (list)))
(define rb-su-loop
(fn ()
(when (< i n)
(do
(let ((c (substring s i (+ i 1))))
(when (not (= c "_"))
(append! parts c)))
(set! i (+ i 1))
(rb-su-loop)))))
(rb-su-loop)
(join "" parts))))
;; ── Main tokenizer ────────────────────────────────────────────────
(define rb-tokenize
(fn (src)
(let ((tokens (list))
(pos 0)
(line 1)
(col 1)
(src-len (len src)))
(define rb-peek
(fn (offset)
(if (< (+ pos offset) src-len)
(substring src (+ pos offset) (+ pos offset 1))
nil)))
(define rb-cur (fn () (rb-peek 0)))
(define rb-advance!
(fn ()
(let ((c (rb-cur)))
(set! pos (+ pos 1))
(if (= c "\n")
(do (set! line (+ line 1)) (set! col 1))
(set! col (+ col 1))))))
(define rb-advance-n!
(fn (n)
(when (> n 0)
(do (rb-advance!) (rb-advance-n! (- n 1))))))
(define rb-push!
(fn (type value tok-line tok-col)
(append! tokens (rb-make-token type value tok-line tok-col))))
(define rb-read-while
(fn (pred)
(let ((start pos))
(define rb-rw-loop
(fn ()
(when (and (< pos src-len) (pred (rb-cur)))
(do (rb-advance!) (rb-rw-loop)))))
(rb-rw-loop)
(substring src start pos))))
(define rb-skip-line-comment!
(fn ()
(define rb-slc-loop
(fn ()
(when (and (< pos src-len) (not (= (rb-cur) "\n")))
(do (rb-advance!) (rb-slc-loop)))))
(rb-slc-loop)))
(define rb-read-escape
(fn ()
(rb-advance!)
(let ((c (rb-cur)))
(cond
((= c "n") (do (rb-advance!) "\n"))
((= c "t") (do (rb-advance!) "\t"))
((= c "r") (do (rb-advance!) "\r"))
((= c "\\") (do (rb-advance!) "\\"))
((= c "'") (do (rb-advance!) "'"))
((= c "\"") (do (rb-advance!) "\""))
((= c "a") (do (rb-advance!) (char-from-code 7)))
((= c "b") (do (rb-advance!) (char-from-code 8)))
((= c "f") (do (rb-advance!) (char-from-code 12)))
((= c "v") (do (rb-advance!) (char-from-code 11)))
((= c "e") (do (rb-advance!) (char-from-code 27)))
((= c "s") (do (rb-advance!) " "))
((= c "0") (do (rb-advance!) (char-from-code 0)))
(:else (do (rb-advance!) (str "\\" c)))))))
(define rb-read-sq-string
(fn ()
(let ((parts (list)))
(rb-advance!)
(define rb-sq-loop
(fn ()
(cond
((>= pos src-len) nil)
((= (rb-cur) "'") (rb-advance!))
((and (= (rb-cur) "\\")
(let ((n (rb-peek 1)))
(or (= n "\\") (= n "'"))))
(do
(rb-advance!)
(append! parts (rb-cur))
(rb-advance!)
(rb-sq-loop)))
(:else
(do
(append! parts (rb-cur))
(rb-advance!)
(rb-sq-loop))))))
(rb-sq-loop)
(join "" parts))))
(define rb-read-dq-string
(fn ()
(let ((parts (list)))
(rb-advance!)
(define rb-dq-loop
(fn ()
(cond
((>= pos src-len) nil)
((= (rb-cur) "\"") (rb-advance!))
((= (rb-cur) "\\")
(do
(append! parts (rb-read-escape))
(rb-dq-loop)))
((and (= (rb-cur) "#") (= (rb-peek 1) "{"))
(do
(append! parts "#{")
(rb-advance-n! 2)
(let ((depth 1))
(define rb-interp-inner
(fn ()
(when (and (< pos src-len) (> depth 0))
(do
(let ((c (rb-cur)))
(cond
((= c "{")
(do
(set! depth (+ depth 1))
(append! parts c)
(rb-advance!)))
((= c "}")
(do
(set! depth (- depth 1))
(when (> depth 0)
(do (append! parts c) (rb-advance!)))))
(:else
(do (append! parts c) (rb-advance!)))))
(rb-interp-inner)))))
(rb-interp-inner))
(when (= (rb-cur) "}")
(do (append! parts "}") (rb-advance!)))
(rb-dq-loop)))
(:else
(do
(append! parts (rb-cur))
(rb-advance!)
(rb-dq-loop))))))
(rb-dq-loop)
(join "" parts))))
(define rb-read-percent-words
(fn ()
(rb-advance-n! 2)
(let ((open-ch (rb-cur)))
(let ((close-ch
(cond
((= open-ch "[") "]")
((= open-ch "(") ")")
((= open-ch "{") "}")
((= open-ch "<") ">")
(:else open-ch))))
(rb-advance!)
(let ((items (list)))
(define rb-pw-skip
(fn ()
(when (and (< pos src-len) (or (rb-space? (rb-cur)) (= (rb-cur) "\n")))
(do (rb-advance!) (rb-pw-skip)))))
(define rb-pw-word
(fn (wparts)
(if (or (>= pos src-len)
(rb-space? (rb-cur))
(= (rb-cur) "\n")
(= (rb-cur) close-ch))
(append! items (join "" wparts))
(do
(append! wparts (rb-cur))
(rb-advance!)
(rb-pw-word wparts)))))
(define rb-pw-loop
(fn ()
(rb-pw-skip)
(when (and (< pos src-len) (not (= (rb-cur) close-ch)))
(do
(rb-pw-word (list))
(rb-pw-loop)))))
(rb-pw-loop)
(when (= (rb-cur) close-ch) (rb-advance!))
items)))))
(define rb-read-ident-word
(fn ()
(let ((start pos))
(rb-read-while rb-ident-cont?)
(when (and (= (rb-cur) "?") (not (= (rb-peek 1) "=")))
(rb-advance!))
(when (and (= (rb-cur) "!") (not (or (= (rb-peek 1) "=") (= (rb-peek 1) "~"))))
(rb-advance!))
(substring src start pos))))
(define rb-read-number!
(fn (tok-line tok-col)
(let ((start pos))
(cond
((and (= (rb-cur) "0") (let ((p (rb-peek 1))) (or (= p "b") (= p "B"))))
(do
(rb-advance-n! 2)
(let ((bin-str (rb-read-while rb-binary-digit?)))
(rb-push! "int" (rb-parse-radix bin-str 2) tok-line tok-col))))
((and (= (rb-cur) "0") (let ((p (rb-peek 1))) (or (= p "o") (= p "O"))))
(do
(rb-advance-n! 2)
(let ((oct-str (rb-read-while rb-octal-digit?)))
(rb-push! "int" (rb-parse-radix oct-str 8) tok-line tok-col))))
((and (= (rb-cur) "0") (let ((p (rb-peek 1))) (or (= p "x") (= p "X"))))
(do
(rb-advance-n! 2)
(let ((hex-str (rb-read-while rb-hex-digit?)))
(rb-push! "int" (rb-parse-radix hex-str 16) tok-line tok-col))))
(:else
(do
(rb-read-while (fn (c) (or (rb-digit? c) (= c "_"))))
(let ((is-float false))
(when (and (= (rb-cur) ".") (rb-digit? (rb-peek 1)))
(do
(set! is-float true)
(rb-advance!)
(rb-read-while (fn (c) (or (rb-digit? c) (= c "_"))))))
(when (or (= (rb-cur) "e") (= (rb-cur) "E"))
(do
(set! is-float true)
(rb-advance!)
(when (or (= (rb-cur) "+") (= (rb-cur) "-"))
(rb-advance!))
(rb-read-while rb-digit?)))
(let ((num-str (rb-strip-underscores (substring src start pos))))
(if is-float
(rb-push! "float" num-str tok-line tok-col)
(rb-push! "int" (parse-int num-str) tok-line tok-col))))))))))
(define rb-read-op!
(fn (tok-line tok-col)
(let ((c0 (rb-cur)) (c1 (rb-peek 1)) (c2 (rb-peek 2)))
(cond
((and (= c0 "<") (= c1 "=") (= c2 ">"))
(do (rb-advance-n! 3) (rb-push! "op" "<=>" tok-line tok-col)))
((and (= c0 "=") (= c1 "=") (= c2 "="))
(do (rb-advance-n! 3) (rb-push! "op" "===" tok-line tok-col)))
((and (= c0 "*") (= c1 "*") (= c2 "="))
(do (rb-advance-n! 3) (rb-push! "op" "**=" tok-line tok-col)))
((and (= c0 "<") (= c1 "<") (= c2 "="))
(do (rb-advance-n! 3) (rb-push! "op" "<<=" tok-line tok-col)))
((and (= c0 ">") (= c1 ">") (= c2 "="))
(do (rb-advance-n! 3) (rb-push! "op" ">>=" tok-line tok-col)))
((and (= c0 "&") (= c1 "&") (= c2 "="))
(do (rb-advance-n! 3) (rb-push! "op" "&&=" tok-line tok-col)))
((and (= c0 "|") (= c1 "|") (= c2 "="))
(do (rb-advance-n! 3) (rb-push! "op" "||=" tok-line tok-col)))
((and (= c0 "*") (= c1 "*"))
(do (rb-advance-n! 2) (rb-push! "op" "**" tok-line tok-col)))
((and (= c0 "=") (= c1 "="))
(do (rb-advance-n! 2) (rb-push! "op" "==" tok-line tok-col)))
((and (= c0 "!") (= c1 "="))
(do (rb-advance-n! 2) (rb-push! "op" "!=" tok-line tok-col)))
((and (= c0 "<") (= c1 "="))
(do (rb-advance-n! 2) (rb-push! "op" "<=" tok-line tok-col)))
((and (= c0 ">") (= c1 "="))
(do (rb-advance-n! 2) (rb-push! "op" ">=" tok-line tok-col)))
((and (= c0 "=") (= c1 "~"))
(do (rb-advance-n! 2) (rb-push! "op" "=~" tok-line tok-col)))
((and (= c0 "!") (= c1 "~"))
(do (rb-advance-n! 2) (rb-push! "op" "!~" tok-line tok-col)))
((and (= c0 "<") (= c1 "<"))
(do (rb-advance-n! 2) (rb-push! "op" "<<" tok-line tok-col)))
((and (= c0 ">") (= c1 ">"))
(do (rb-advance-n! 2) (rb-push! "op" ">>" tok-line tok-col)))
((and (= c0 "&") (= c1 "&"))
(do (rb-advance-n! 2) (rb-push! "op" "&&" tok-line tok-col)))
((and (= c0 "|") (= c1 "|"))
(do (rb-advance-n! 2) (rb-push! "op" "||" tok-line tok-col)))
((and (= c0 "+") (= c1 "="))
(do (rb-advance-n! 2) (rb-push! "op" "+=" tok-line tok-col)))
((and (= c0 "-") (= c1 "="))
(do (rb-advance-n! 2) (rb-push! "op" "-=" tok-line tok-col)))
((and (= c0 "*") (= c1 "="))
(do (rb-advance-n! 2) (rb-push! "op" "*=" tok-line tok-col)))
((and (= c0 "/") (= c1 "="))
(do (rb-advance-n! 2) (rb-push! "op" "/=" tok-line tok-col)))
((and (= c0 "%") (= c1 "="))
(do (rb-advance-n! 2) (rb-push! "op" "%=" tok-line tok-col)))
((and (= c0 "&") (= c1 "="))
(do (rb-advance-n! 2) (rb-push! "op" "&=" tok-line tok-col)))
((and (= c0 "|") (= c1 "="))
(do (rb-advance-n! 2) (rb-push! "op" "|=" tok-line tok-col)))
((and (= c0 "^") (= c1 "="))
(do (rb-advance-n! 2) (rb-push! "op" "^=" tok-line tok-col)))
((and (= c0 "-") (= c1 ">"))
(do (rb-advance-n! 2) (rb-push! "op" "->" tok-line tok-col)))
((and (= c0 "=") (= c1 ">"))
(do (rb-advance-n! 2) (rb-push! "op" "=>" tok-line tok-col)))
((and (= c0 "|") (nil? c1))
(do (rb-advance!) (rb-push! "pipe" "|" tok-line tok-col)))
((= c0 "|")
(do (rb-advance!) (rb-push! "pipe" "|" tok-line tok-col)))
(:else
(do (rb-advance!) (rb-push! "op" c0 tok-line tok-col)))))))
(define rb-scan!
(fn ()
(cond
((>= pos src-len) nil)
((rb-space? (rb-cur)) (do (rb-advance!) (rb-scan!)))
((= (rb-cur) "#") (do (rb-skip-line-comment!) (rb-scan!)))
((= (rb-cur) "\n")
(do
(let ((l line) (c col))
(rb-advance!)
(rb-push! "newline" nil l c))
(rb-scan!)))
((rb-digit? (rb-cur))
(do
(let ((l line) (c col))
(rb-read-number! l c))
(rb-scan!)))
((rb-ident-start? (rb-cur))
(do
(let ((l line) (c col))
(let ((w (rb-read-ident-word)))
(if (rb-keyword? w)
(rb-push! "keyword" w l c)
(if (rb-upper? (substring w 0 1))
(rb-push! "const" w l c)
(rb-push! "ident" w l c)))))
(rb-scan!)))
((= (rb-cur) "@")
(do
(let ((l line) (c col))
(if (= (rb-peek 1) "@")
(do
(rb-advance-n! 2)
(let ((name (rb-read-while rb-ident-cont?)))
(rb-push! "cvar" (str "@@" name) l c)))
(do
(rb-advance!)
(let ((name (rb-read-while rb-ident-cont?)))
(rb-push! "ivar" (str "@" name) l c)))))
(rb-scan!)))
((= (rb-cur) "$")
(do
(let ((l line) (c col))
(rb-advance!)
(let ((name (rb-read-while rb-ident-cont?)))
(rb-push! "gvar" (str "$" name) l c)))
(rb-scan!)))
((= (rb-cur) "\"")
(do
(let ((l line) (c col))
(rb-push! "string" (rb-read-dq-string) l c))
(rb-scan!)))
((= (rb-cur) "'")
(do
(let ((l line) (c col))
(rb-push! "string" (rb-read-sq-string) l c))
(rb-scan!)))
((and (= (rb-cur) ":") (= (rb-peek 1) ":"))
(do
(let ((l line) (c col))
(rb-advance-n! 2)
(rb-push! "dcolon" "::" l c))
(rb-scan!)))
((= (rb-cur) ":")
(do
(let ((l line) (c col))
(rb-advance!)
(cond
((= (rb-cur) "\"")
(rb-push! "symbol" (rb-read-dq-string) l c))
((= (rb-cur) "'")
(rb-push! "symbol" (rb-read-sq-string) l c))
((rb-ident-start? (rb-cur))
(let ((name (rb-read-ident-word)))
(rb-push! "symbol" name l c)))
(:else
(rb-push! "colon" ":" l c))))
(rb-scan!)))
((and (= (rb-cur) "%")
(let ((p (rb-peek 1)))
(or (= p "w") (= p "W") (= p "i") (= p "I"))))
(do
(let ((l line) (c col))
(let ((kind (rb-peek 1)))
(let ((items (rb-read-percent-words)))
(if (or (= kind "i") (= kind "I"))
(rb-push! "isymbols" items l c)
(rb-push! "words" items l c)))))
(rb-scan!)))
((= (rb-cur) ".")
(do
(let ((l line) (c col))
(cond
((and (= (rb-peek 1) ".") (= (rb-peek 2) "."))
(do (rb-advance-n! 3) (rb-push! "dotdotdot" "..." l c)))
((= (rb-peek 1) ".")
(do (rb-advance-n! 2) (rb-push! "dotdot" ".." l c)))
(:else
(do (rb-advance!) (rb-push! "dot" "." l c)))))
(rb-scan!)))
((= (rb-cur) ",")
(do
(let ((l line) (c col)) (rb-push! "comma" "," l c) (rb-advance!))
(rb-scan!)))
((= (rb-cur) ";")
(do
(let ((l line) (c col)) (rb-push! "semi" ";" l c) (rb-advance!))
(rb-scan!)))
((= (rb-cur) "(")
(do
(let ((l line) (c col)) (rb-push! "lparen" "(" l c) (rb-advance!))
(rb-scan!)))
((= (rb-cur) ")")
(do
(let ((l line) (c col)) (rb-push! "rparen" ")" l c) (rb-advance!))
(rb-scan!)))
((= (rb-cur) "[")
(do
(let ((l line) (c col)) (rb-push! "lbracket" "[" l c) (rb-advance!))
(rb-scan!)))
((= (rb-cur) "]")
(do
(let ((l line) (c col)) (rb-push! "rbracket" "]" l c) (rb-advance!))
(rb-scan!)))
((= (rb-cur) "{")
(do
(let ((l line) (c col)) (rb-push! "lbrace" "{" l c) (rb-advance!))
(rb-scan!)))
((= (rb-cur) "}")
(do
(let ((l line) (c col)) (rb-push! "rbrace" "}" l c) (rb-advance!))
(rb-scan!)))
((or (= (rb-cur) "+") (= (rb-cur) "-") (= (rb-cur) "*")
(= (rb-cur) "/") (= (rb-cur) "%") (= (rb-cur) "=")
(= (rb-cur) "!") (= (rb-cur) "<") (= (rb-cur) ">")
(= (rb-cur) "&") (= (rb-cur) "^") (= (rb-cur) "~")
(= (rb-cur) "|"))
(do
(let ((l line) (c col)) (rb-read-op! l c))
(rb-scan!)))
(:else (do (rb-advance!) (rb-scan!))))))
(rb-scan!)
(rb-push! "eof" nil line col)
tokens)))

View File

@@ -1,41 +0,0 @@
; Tcl parser — thin layer over tcl-tokenize
; Adds tcl-parse entry point and word utility fns
; Entry point: parse Tcl source to a list of commands.
; Returns same structure as tcl-tokenize.
(define tcl-parse (fn (src) (tcl-tokenize src)))
; True if word has no substitutions — value can be read statically.
; braced words are always simple. compound words are simple when all
; parts are plain text with no var/cmd parts.
(define tcl-word-simple?
(fn (word)
(cond
((= (get word :type) "braced") true)
((= (get word :type) "compound")
(let ((parts (get word :parts)))
(every? (fn (p) (= (get p :type) "text")) parts)))
(else false))))
; Concatenate text parts of a simple word into a single string.
; For braced words returns :value directly.
; For compound words with only text parts, joins them.
; Returns nil for words with substitutions.
(define tcl-word-literal
(fn (word)
(cond
((= (get word :type) "braced") (get word :value))
((= (get word :type) "compound")
(if (tcl-word-simple? word)
(join "" (map (fn (p) (get p :value)) (get word :parts)))
nil))
(else nil))))
; Number of words in a parsed command.
(define tcl-cmd-len
(fn (cmd) (len (get cmd :words))))
; Nth word literal from a command (index 0 = command name).
; Returns nil if word has substitutions.
(define tcl-nth-literal
(fn (cmd n) (tcl-word-literal (nth (get cmd :words) n))))

View File

@@ -1,570 +0,0 @@
; Tcl-on-SX runtime evaluator
; State: {:frame frame :commands cmd-table :result last-result :output accumulated-output}
(define make-frame (fn (level parent) {:level level :locals {} :parent parent}))
(define
frame-lookup
(fn
(frame name)
(if
(nil? frame)
nil
(let
((val (get (get frame :locals) name)))
(if (nil? val) (frame-lookup (get frame :parent) name) val)))))
(define
frame-set-top
(fn
(frame name val)
(assoc frame :locals (assoc (get frame :locals) name val))))
(define make-tcl-interp (fn () {:result "" :output "" :code 0 :frame (make-frame 0 nil) :commands {}}))
(define
tcl-register
(fn
(interp name f)
(assoc interp :commands (assoc (get interp :commands) name f))))
(define
tcl-var-get
(fn
(interp name)
(let
((val (frame-lookup (get interp :frame) name)))
(if
(nil? val)
(error (str "can't read \"" name "\": no such variable"))
val))))
(define
tcl-var-set
(fn
(interp name val)
(assoc interp :frame (frame-set-top (get interp :frame) name val))))
(define
tcl-eval-parts
(fn
(parts interp)
(reduce
(fn
(acc part)
(let
((type (get part :type)) (cur-interp (get acc :interp)))
(cond
((equal? type "text") {:values (append (get acc :values) (list (get part :value))) :interp cur-interp})
((equal? type "var") {:values (append (get acc :values) (list (tcl-var-get cur-interp (get part :name)))) :interp cur-interp})
((equal? type "var-arr")
(let
((key-acc (tcl-eval-parts (get part :key) cur-interp)))
(let
((key (join "" (get key-acc :values)))
(next-interp (get key-acc :interp)))
{:values (append (get acc :values) (list (tcl-var-get next-interp (str (get part :name) "(" key ")")))) :interp next-interp})))
((equal? type "cmd")
(let
((new-interp (tcl-eval-string cur-interp (get part :src))))
{:values (append (get acc :values) (list (get new-interp :result))) :interp new-interp}))
(else (error (str "tcl: unknown part type: " type))))))
{:values (quote ()) :interp interp}
parts)))
(define
tcl-eval-word
(fn
(word interp)
(let
((type (get word :type)))
(cond
((equal? type "braced") {:interp interp :value (get word :value)})
((equal? type "compound")
(let
((result (tcl-eval-parts (get word :parts) interp)))
{:interp (get result :interp) :value (join "" (get result :values))}))
((equal? type "expand") (tcl-eval-word (get word :word) interp))
(else (error (str "tcl: unknown word type: " type)))))))
(define
tcl-list-split
(fn
(s)
(define chars (split s ""))
(define len-s (len chars))
(define
go
(fn
(i acc cur-item depth)
(if
(>= i len-s)
(if (> (len cur-item) 0) (append acc (list cur-item)) acc)
(let
((c (nth chars i)))
(cond
((equal? c "{")
(if
(= depth 0)
(go (+ i 1) acc "" (+ depth 1))
(go (+ i 1) acc (str cur-item c) (+ depth 1))))
((equal? c "}")
(if
(= depth 1)
(go (+ i 1) (append acc (list cur-item)) "" 0)
(go (+ i 1) acc (str cur-item c) (- depth 1))))
((equal? c " ")
(if
(and (= depth 0) (> (len cur-item) 0))
(go (+ i 1) (append acc (list cur-item)) "" 0)
(go
(+ i 1)
acc
(if (> depth 0) (str cur-item c) cur-item)
depth)))
(else (go (+ i 1) acc (str cur-item c) depth)))))))
(go 0 (list) "" 0)))
(define
tcl-eval-words
(fn
(words interp)
(reduce
(fn
(acc w)
(let
((cur-interp (get acc :interp)))
(if
(equal? (get w :type) "expand")
(let
((wr (tcl-eval-word (get w :word) cur-interp)))
{:values (append (get acc :values) (tcl-list-split (get wr :value))) :interp (get wr :interp)})
(let ((wr (tcl-eval-word w cur-interp))) {:values (append (get acc :values) (list (get wr :value))) :interp (get wr :interp)}))))
{:values (quote ()) :interp interp}
words)))
(define
tcl-eval-cmd
(fn
(interp cmd)
(let
((wr (tcl-eval-words (get cmd :words) interp)))
(let
((words (get wr :values)) (cur-interp (get wr :interp)))
(if
(= 0 (len words))
cur-interp
(let
((cmd-name (first words)) (cmd-args (rest words)))
(let
((cmd-fn (get (get cur-interp :commands) cmd-name)))
(if
(nil? cmd-fn)
(error (str "unknown command: \"" cmd-name "\""))
(cmd-fn cur-interp cmd-args)))))))))
(define
tcl-eval-script
(fn
(interp cmds)
(if
(or (= 0 (len cmds)) (not (= 0 (get interp :code))))
interp
(tcl-eval-script (tcl-eval-cmd interp (first cmds)) (rest cmds)))))
(define
tcl-eval-string
(fn (interp src) (tcl-eval-script interp (tcl-parse src))))
(define
tcl-cmd-set
(fn
(interp args)
(if
(= (len args) 1)
(assoc interp :result (tcl-var-get interp (first args)))
(let
((val (nth args 1)))
(assoc (tcl-var-set interp (first args) val) :result val)))))
(define
tcl-cmd-puts
(fn
(interp args)
(let
((text (last args))
(no-nl
(and
(> (len args) 1)
(equal? (first args) "-nonewline"))))
(let
((line (if no-nl text (str text "\n"))))
(assoc interp :output (str (get interp :output) line))))))
(define
tcl-cmd-incr
(fn
(interp args)
(let
((name (first args))
(delta
(if
(> (len args) 1)
(parse-int (nth args 1))
1)))
(let
((new-val (str (+ (parse-int (tcl-var-get interp name)) delta))))
(assoc (tcl-var-set interp name new-val) :result new-val)))))
(define
tcl-cmd-append
(fn
(interp args)
(let
((name (first args)) (suffix (join "" (rest args))))
(let
((cur (let ((v (frame-lookup (get interp :frame) name))) (if (nil? v) "" v))))
(let
((new-val (str cur suffix)))
(assoc (tcl-var-set interp name new-val) :result new-val))))))
(define
tcl-true?
(fn
(s)
(not
(or (equal? s "0") (equal? s "") (equal? s "false") (equal? s "no")))))
(define tcl-false? (fn (s) (not (tcl-true? s))))
(define
tcl-expr-compute
(fn
(tokens)
(let
((n (len tokens)))
(cond
((= n 1) (first tokens))
((= n 2)
(let
((op (first tokens)) (x (nth tokens 1)))
(if
(equal? op "!")
(if (tcl-false? x) "1" "0")
(error (str "expr: unknown unary op: " op)))))
((= n 3)
(let
((l (first tokens)) (op (nth tokens 1)) (r (nth tokens 2)))
(cond
((equal? op "+") (str (+ (parse-int l) (parse-int r))))
((equal? op "-") (str (- (parse-int l) (parse-int r))))
((equal? op "*") (str (* (parse-int l) (parse-int r))))
((equal? op "/") (str (/ (parse-int l) (parse-int r))))
((equal? op "%") (str (mod (parse-int l) (parse-int r))))
((equal? op "==") (if (equal? l r) "1" "0"))
((equal? op "!=") (if (equal? l r) "0" "1"))
((equal? op "<")
(if (< (parse-int l) (parse-int r)) "1" "0"))
((equal? op ">")
(if (> (parse-int l) (parse-int r)) "1" "0"))
((equal? op "<=")
(if (<= (parse-int l) (parse-int r)) "1" "0"))
((equal? op ">=")
(if (>= (parse-int l) (parse-int r)) "1" "0"))
((equal? op "&&")
(if (and (tcl-true? l) (tcl-true? r)) "1" "0"))
((equal? op "||")
(if (or (tcl-true? l) (tcl-true? r)) "1" "0"))
(else (error (str "expr: unknown op: " op))))))
(else (error (str "expr: complex expr not yet supported")))))))
(define
tcl-expr-eval
(fn
(interp s)
(let
((cmds (tcl-parse s)))
(if
(= 0 (len cmds))
{:result "0" :interp interp}
(let
((wr (tcl-eval-words (get (first cmds) :words) interp)))
{:result (tcl-expr-compute (get wr :values)) :interp (get wr :interp)})))))
(define tcl-cmd-break (fn (interp args) (assoc interp :code 3)))
(define tcl-cmd-continue (fn (interp args) (assoc interp :code 4)))
(define
tcl-cmd-return
(fn
(interp args)
(let
((val (if (> (len args) 0) (last args) "")))
(assoc (assoc interp :result val) :code 2))))
(define
tcl-cmd-error
(fn
(interp args)
(let
((msg (if (> (len args) 0) (first args) "error")))
(assoc (assoc interp :result msg) :code 1))))
(define
tcl-cmd-unset
(fn
(interp args)
(reduce
(fn
(i name)
(let
((frame (get i :frame)))
(let
((new-locals (reduce (fn (acc k) (if (equal? k name) acc (assoc acc k (get (get frame :locals) k)))) {} (keys (get frame :locals)))))
(assoc i :frame (assoc frame :locals new-locals)))))
interp
args)))
(define
tcl-cmd-lappend
(fn
(interp args)
(let
((name (first args)) (items (rest args)))
(let
((cur (let ((v (frame-lookup (get interp :frame) name))) (if (nil? v) "" v))))
(let
((new-val (if (equal? cur "") (join " " items) (str cur " " (join " " items)))))
(assoc (tcl-var-set interp name new-val) :result new-val))))))
(define
tcl-cmd-eval
(fn (interp args) (tcl-eval-string interp (join " " args))))
(define
tcl-while-loop
(fn
(interp cond-str body)
(let
((er (tcl-expr-eval interp cond-str)))
(if
(tcl-false? (get er :result))
(get er :interp)
(let
((body-result (tcl-eval-string (get er :interp) body)))
(let
((code (get body-result :code)))
(cond
((= code 3) (assoc body-result :code 0))
((= code 2) body-result)
((= code 1) body-result)
(else
(tcl-while-loop
(assoc body-result :code 0)
cond-str
body)))))))))
(define
tcl-cmd-while
(fn
(interp args)
(tcl-while-loop interp (first args) (nth args 1))))
(define
tcl-cmd-if
(fn
(interp args)
(let
((er (tcl-expr-eval interp (first args))))
(let
((cond-true (tcl-true? (get er :result)))
(new-interp (get er :interp))
(rest-args (rest args)))
(let
((adj (if (and (> (len rest-args) 0) (equal? (first rest-args) "then")) (rest rest-args) rest-args)))
(let
((then-body (first adj)) (rest2 (rest adj)))
(if
cond-true
(tcl-eval-string new-interp then-body)
(cond
((= 0 (len rest2)) new-interp)
((equal? (first rest2) "else")
(if
(> (len rest2) 1)
(tcl-eval-string new-interp (nth rest2 1))
new-interp))
((equal? (first rest2) "elseif")
(tcl-cmd-if new-interp (rest rest2)))
(else new-interp)))))))))
(define
tcl-for-loop
(fn
(interp cond-str step body)
(let
((er (tcl-expr-eval interp cond-str)))
(if
(tcl-false? (get er :result))
(get er :interp)
(let
((body-result (tcl-eval-string (get er :interp) body)))
(let
((code (get body-result :code)))
(cond
((= code 3) (assoc body-result :code 0))
((= code 2) body-result)
((= code 1) body-result)
(else
(let
((step-result (tcl-eval-string (assoc body-result :code 0) step)))
(tcl-for-loop
(assoc step-result :code 0)
cond-str
step
body))))))))))
(define
tcl-cmd-for
(fn
(interp args)
(let
((init-body (first args))
(cond-str (nth args 1))
(step (nth args 2))
(body (nth args 3)))
(let
((init-result (tcl-eval-string interp init-body)))
(tcl-for-loop init-result cond-str step body)))))
(define
tcl-foreach-loop
(fn
(interp var-name items body)
(if
(= 0 (len items))
interp
(let
((body-result (tcl-eval-string (tcl-var-set interp var-name (first items)) body)))
(let
((code (get body-result :code)))
(cond
((= code 3) (assoc body-result :code 0))
((= code 2) body-result)
((= code 1) body-result)
(else
(tcl-foreach-loop
(assoc body-result :code 0)
var-name
(rest items)
body))))))))
(define
tcl-cmd-foreach
(fn
(interp args)
(let
((var-name (first args))
(list-str (nth args 1))
(body (nth args 2)))
(tcl-foreach-loop interp var-name (tcl-list-split list-str) body))))
(define
tcl-cmd-switch
(fn
(interp args)
(let
((str-val (first args)) (body (nth args 1)))
(let
((pairs (tcl-list-split body)))
(define
try-pairs
(fn
(ps)
(if
(= 0 (len ps))
interp
(let
((pat (first ps)) (bdy (nth ps 1)))
(if
(or (equal? pat str-val) (equal? pat "default"))
(if
(equal? bdy "-")
(try-pairs (rest (rest ps)))
(tcl-eval-string interp bdy))
(try-pairs (rest (rest ps))))))))
(try-pairs pairs)))))
(define
tcl-cmd-expr
(fn
(interp args)
(let
((s (join " " args)))
(let
((er (tcl-expr-eval interp s)))
(assoc (get er :interp) :result (get er :result))))))
(define tcl-cmd-gets (fn (interp args) (assoc interp :result "")))
(define
tcl-cmd-subst
(fn (interp args) (assoc interp :result (last args))))
(define
tcl-cmd-format
(fn (interp args) (assoc interp :result (join "" args))))
(define tcl-cmd-scan (fn (interp args) (assoc interp :result "0")))
(define
make-default-tcl-interp
(fn
()
(let
((i (make-tcl-interp)))
(let
((i (tcl-register i "set" tcl-cmd-set)))
(let
((i (tcl-register i "puts" tcl-cmd-puts)))
(let
((i (tcl-register i "incr" tcl-cmd-incr)))
(let
((i (tcl-register i "append" tcl-cmd-append)))
(let
((i (tcl-register i "unset" tcl-cmd-unset)))
(let
((i (tcl-register i "lappend" tcl-cmd-lappend)))
(let
((i (tcl-register i "eval" tcl-cmd-eval)))
(let
((i (tcl-register i "if" tcl-cmd-if)))
(let
((i (tcl-register i "while" tcl-cmd-while)))
(let
((i (tcl-register i "for" tcl-cmd-for)))
(let
((i (tcl-register i "foreach" tcl-cmd-foreach)))
(let
((i (tcl-register i "switch" tcl-cmd-switch)))
(let
((i (tcl-register i "break" tcl-cmd-break)))
(let
((i (tcl-register i "continue" tcl-cmd-continue)))
(let
((i (tcl-register i "return" tcl-cmd-return)))
(let
((i (tcl-register i "error" tcl-cmd-error)))
(let
((i (tcl-register i "expr" tcl-cmd-expr)))
(let
((i (tcl-register i "gets" tcl-cmd-gets)))
(let
((i (tcl-register i "subst" tcl-cmd-subst)))
(let
((i (tcl-register i "format" tcl-cmd-format)))
(tcl-register
i
"scan"
tcl-cmd-scan))))))))))))))))))))))))

View File

@@ -1,81 +0,0 @@
#!/usr/bin/env bash
# Tcl-on-SX test runner — epoch protocol to sx_server.exe
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then echo "ERROR: sx_server.exe not found"; exit 1; fi
VERBOSE="${1:-}"
TMPFILE=$(mktemp)
HELPER=$(mktemp --suffix=.sx)
trap "rm -f $TMPFILE $HELPER" EXIT
# Helper file: run both test suites and format a parseable summary string
cat > "$HELPER" << 'HELPER_EOF'
(define __pr (tcl-run-parse-tests))
(define __er (tcl-run-eval-tests))
(define tcl-test-summary
(str "PARSE:" (get __pr "passed") ":" (get __pr "failed")
" EVAL:" (get __er "passed") ":" (get __er "failed")))
HELPER_EOF
cat > "$TMPFILE" << EPOCHS
(epoch 1)
(load "lib/tcl/tokenizer.sx")
(epoch 2)
(load "lib/tcl/parser.sx")
(epoch 3)
(load "lib/tcl/tests/parse.sx")
(epoch 4)
(load "lib/tcl/runtime.sx")
(epoch 5)
(load "lib/tcl/tests/eval.sx")
(epoch 6)
(load "$HELPER")
(epoch 7)
(eval "tcl-test-summary")
EPOCHS
OUTPUT=$(timeout 30 "$SX_SERVER" < "$TMPFILE" 2>&1)
[ "$VERBOSE" = "-v" ] && echo "$OUTPUT"
# Extract summary line from epoch 7 output
SUMMARY=$(echo "$OUTPUT" | grep -A1 "^(ok-len 7 " | tail -1 | tr -d '"')
if [ -z "$SUMMARY" ]; then
echo "ERROR: no summary from test run"
echo "$OUTPUT" | tail -20
exit 1
fi
# Parse PARSE:N:M EVAL:N:M
PARSE_PART=$(echo "$SUMMARY" | grep -o 'PARSE:[0-9]*:[0-9]*')
EVAL_PART=$(echo "$SUMMARY" | grep -o 'EVAL:[0-9]*:[0-9]*')
PARSE_PASSED=$(echo "$PARSE_PART" | cut -d: -f2)
PARSE_FAILED=$(echo "$PARSE_PART" | cut -d: -f3)
EVAL_PASSED=$(echo "$EVAL_PART" | cut -d: -f2)
EVAL_FAILED=$(echo "$EVAL_PART" | cut -d: -f3)
PARSE_PASSED=${PARSE_PASSED:-0}; PARSE_FAILED=${PARSE_FAILED:-1}
EVAL_PASSED=${EVAL_PASSED:-0}; EVAL_FAILED=${EVAL_FAILED:-1}
TOTAL_PASSED=$((PARSE_PASSED + EVAL_PASSED))
TOTAL_FAILED=$((PARSE_FAILED + EVAL_FAILED))
TOTAL=$((TOTAL_PASSED + TOTAL_FAILED))
if [ "$TOTAL_FAILED" = "0" ]; then
echo "ok $TOTAL_PASSED/$TOTAL tcl tests passed (parse: $PARSE_PASSED, eval: $EVAL_PASSED)"
exit 0
else
echo "FAIL $TOTAL_PASSED/$TOTAL passed, $TOTAL_FAILED failed (parse: $PARSE_PASSED/$((PARSE_PASSED+PARSE_FAILED)), eval: $EVAL_PASSED/$((EVAL_PASSED+EVAL_FAILED)))"
if [ -z "$VERBOSE" ]; then
echo "--- output ---"
echo "$OUTPUT" | tail -20
fi
exit 1
fi

View File

@@ -1,194 +0,0 @@
; Tcl-on-SX eval tests
(define tcl-eval-pass 0)
(define tcl-eval-fail 0)
(define tcl-eval-failures (list))
(define
tcl-eval-assert
(fn
(label expected actual)
(if
(equal? expected actual)
(set! tcl-eval-pass (+ tcl-eval-pass 1))
(begin
(set! tcl-eval-fail (+ tcl-eval-fail 1))
(append!
tcl-eval-failures
(str label ": expected=" (str expected) " got=" (str actual)))))))
(define
tcl-run-eval-tests
(fn
()
(set! tcl-eval-pass 0)
(set! tcl-eval-fail 0)
(set! tcl-eval-failures (list))
(define interp (fn () (make-default-tcl-interp)))
(define run (fn (src) (tcl-eval-string (interp) src)))
(define
ok
(fn (label actual expected) (tcl-eval-assert label expected actual)))
(define
ok?
(fn (label condition) (tcl-eval-assert label true condition)))
(tcl-eval-assert "set-result" "hello" (get (run "set x hello") :result))
(tcl-eval-assert
"set-stored"
"hello"
(tcl-var-get (run "set x hello") "x"))
(tcl-eval-assert
"var-sub"
"hello"
(tcl-var-get (run "set x hello\nset y $x") "y"))
(tcl-eval-assert
"puts"
"world\n"
(get (run "set x world\nputs $x") :output))
(tcl-eval-assert
"puts-nonewline"
"hi"
(get (run "puts -nonewline hi") :output))
(tcl-eval-assert "incr" "6" (tcl-var-get (run "set x 5\nincr x") "x"))
(tcl-eval-assert
"incr-delta"
"8"
(tcl-var-get (run "set x 5\nincr x 3") "x"))
(tcl-eval-assert
"incr-neg"
"7"
(tcl-var-get (run "set x 10\nincr x -3") "x"))
(tcl-eval-assert
"append"
"foobar"
(tcl-var-get (run "set x foo\nappend x bar") "x"))
(tcl-eval-assert
"append-new"
"hello"
(tcl-var-get (run "append x hello") "x"))
(tcl-eval-assert
"cmdsub-result"
"6"
(get (run "set x 5\nset y [incr x]") :result))
(tcl-eval-assert
"cmdsub-y"
"6"
(tcl-var-get (run "set x 5\nset y [incr x]") "y"))
(tcl-eval-assert
"cmdsub-x"
"6"
(tcl-var-get (run "set x 5\nset y [incr x]") "x"))
(tcl-eval-assert
"multi-cmd"
"second"
(get (run "set x first\nset x second") :result))
(tcl-eval-assert "semi-x" "1" (tcl-var-get (run "set x 1; set y 2") "x"))
(tcl-eval-assert "semi-y" "2" (tcl-var-get (run "set x 1; set y 2") "y"))
(tcl-eval-assert
"braced-nosub"
"$x"
(tcl-var-get (run "set x 42\nset y {$x}") "y"))
(tcl-eval-assert
"concat-word"
"foobar"
(tcl-var-get (run "set x foo\nset y ${x}bar") "y"))
(tcl-eval-assert
"set-get"
"world"
(get (run "set x world\nset x") :result))
(tcl-eval-assert
"puts-channel"
"hello\n"
(get (run "puts stdout hello") :output))
(ok "if-true" (get (run "set x 0\nif {1} {set x 1}") :result) "1")
(ok "if-false" (get (run "set x 0\nif {0} {set x 1}") :result) "0")
(ok
"if-else-t"
(tcl-var-get (run "if {1} {set x yes} else {set x no}") "x")
"yes")
(ok
"if-else-f"
(tcl-var-get (run "if {0} {set x yes} else {set x no}") "x")
"no")
(ok
"if-cmp"
(tcl-var-get
(run "set x 5\nif {$x > 3} {set r big} else {set r small}")
"r")
"big")
(ok
"while"
(tcl-var-get
(run "set i 0\nset s 0\nwhile {$i < 5} {incr i\nincr s $i}")
"s")
"15")
(ok
"while-break"
(tcl-var-get
(run "set i 0\nwhile {1} {incr i\nif {$i == 3} {break}}")
"i")
"3")
(ok
"for"
(tcl-var-get
(run "set s 0\nfor {set i 1} {$i <= 5} {incr i} {incr s $i}")
"s")
"15")
(ok
"foreach"
(tcl-var-get (run "set s 0\nforeach x {1 2 3 4 5} {incr s $x}") "s")
"15")
(ok
"foreach-list"
(get (run "set acc \"\"\nforeach w {hello world} {append acc $w}") :result)
"helloworld")
(ok
"lappend"
(tcl-var-get (run "lappend lst a\nlappend lst b\nlappend lst c") "lst")
"a b c")
(ok?
"unset-gone"
(let
((i (run "set x 42\nunset x")))
(let
((frame (get i :frame)))
(nil? (get (get frame :locals) "x")))))
(ok "eval" (tcl-var-get (run "eval {set x hello}") "x") "hello")
(ok "expr-add" (get (run "expr {3 + 4}") :result) "7")
(ok "expr-cmp" (get (run "expr {5 > 3}") :result) "1")
(ok
"break-stops"
(tcl-var-get (run "set x 0\nwhile {1} {set x 1\nbreak\nset x 99}") "x")
"1")
(ok
"continue"
(tcl-var-get
(run
"set s 0\nfor {set i 1} {$i <= 5} {incr i} {if {$i == 3} {continue}\nincr s $i}")
"s")
"12")
(ok
"switch"
(tcl-var-get
(run "set x foo\nswitch $x {{foo} {set r yes} {bar} {set r no}}")
"r")
"yes")
(ok
"switch-default"
(tcl-var-get
(run "set x baz\nswitch $x {{foo} {set r yes} default {set r other}}")
"r")
"other")
(ok
"nested-if"
(tcl-var-get
(run
"set x 5\nif {$x > 10} {set r big} elseif {$x > 3} {set r mid} else {set r small}")
"r")
"mid")
(dict
"passed"
tcl-eval-pass
"failed"
tcl-eval-fail
"failures"
tcl-eval-failures)))

View File

@@ -1,186 +0,0 @@
(define tcl-parse-pass 0)
(define tcl-parse-fail 0)
(define tcl-parse-failures (list))
(define tcl-assert
(fn (label expected actual)
(if (= expected actual)
(set! tcl-parse-pass (+ tcl-parse-pass 1))
(begin
(set! tcl-parse-fail (+ tcl-parse-fail 1))
(append! tcl-parse-failures
(str label ": expected=" (str expected) " got=" (str actual)))))))
(define tcl-first-cmd
(fn (src) (nth (tcl-tokenize src) 0)))
(define tcl-cmd-words
(fn (src) (get (tcl-first-cmd src) :words)))
(define tcl-word
(fn (src wi) (nth (tcl-cmd-words src) wi)))
(define tcl-parts
(fn (src wi) (get (tcl-word src wi) :parts)))
(define tcl-part
(fn (src wi pi) (nth (tcl-parts src wi) pi)))
(define tcl-run-parse-tests
(fn ()
(set! tcl-parse-pass 0)
(set! tcl-parse-fail 0)
(set! tcl-parse-failures (list))
; empty / whitespace-only
(tcl-assert "empty" 0 (len (tcl-tokenize "")))
(tcl-assert "ws-only" 0 (len (tcl-tokenize " ")))
(tcl-assert "nl-only" 0 (len (tcl-tokenize "\n\n")))
; single command word count
(tcl-assert "1word" 1 (len (tcl-cmd-words "set")))
(tcl-assert "3words" 3 (len (tcl-cmd-words "set x 1")))
(tcl-assert "4words" 4 (len (tcl-cmd-words "set a b c")))
; word type — bare word is compound
(tcl-assert "bare-type" "compound" (get (tcl-word "set x 1" 0) :type))
(tcl-assert "bare-quoted" false (get (tcl-word "set x 1" 0) :quoted))
(tcl-assert "bare-part-type" "text" (get (tcl-part "set x 1" 0 0) :type))
(tcl-assert "bare-part-val" "set" (get (tcl-part "set x 1" 0 0) :value))
(tcl-assert "bare-part2-val" "x" (get (tcl-part "set x 1" 1 0) :value))
(tcl-assert "bare-part3-val" "1" (get (tcl-part "set x 1" 2 0) :value))
; multiple commands
(tcl-assert "semi-sep" 2 (len (tcl-tokenize "set x 1; set y 2")))
(tcl-assert "nl-sep" 2 (len (tcl-tokenize "set x 1\nset y 2")))
(tcl-assert "multi-nl" 3 (len (tcl-tokenize "a\nb\nc")))
; comments
(tcl-assert "comment-only" 0 (len (tcl-tokenize "# comment")))
(tcl-assert "comment-nl" 0 (len (tcl-tokenize "# comment\n")))
(tcl-assert "comment-then-cmd" 1 (len (tcl-tokenize "# comment\nset x 1")))
(tcl-assert "semi-then-comment" 1 (len (tcl-tokenize "set x 1; # comment")))
; brace-quoted words
(tcl-assert "brace-type" "braced" (get (tcl-word "{hello}" 0) :type))
(tcl-assert "brace-value" "hello" (get (tcl-word "{hello}" 0) :value))
(tcl-assert "brace-spaces" "hello world" (get (tcl-word "{hello world}" 0) :value))
(tcl-assert "brace-nested" "a {b} c" (get (tcl-word "{a {b} c}" 0) :value))
(tcl-assert "brace-no-var-sub" "hello $x" (get (tcl-word "{hello $x}" 0) :value))
(tcl-assert "brace-no-cmd-sub" "[expr 1]" (get (tcl-word "{[expr 1]}" 0) :value))
; double-quoted words
(tcl-assert "dq-type" "compound" (get (tcl-word "\"hello\"" 0) :type))
(tcl-assert "dq-quoted" true (get (tcl-word "\"hello\"" 0) :quoted))
(tcl-assert "dq-literal" "hello" (get (tcl-part "\"hello\"" 0 0) :value))
; variable substitution in bare word
(tcl-assert "var-type" "var" (get (tcl-part "$x" 0 0) :type))
(tcl-assert "var-name" "x" (get (tcl-part "$x" 0 0) :name))
(tcl-assert "var-long" "long_name" (get (tcl-part "$long_name" 0 0) :name))
; ${name} form
(tcl-assert "var-brace-type" "var" (get (tcl-part "${x}" 0 0) :type))
(tcl-assert "var-brace-name" "x" (get (tcl-part "${x}" 0 0) :name))
; array variable substitution
(tcl-assert "arr-type" "var-arr" (get (tcl-part "$arr(key)" 0 0) :type))
(tcl-assert "arr-name" "arr" (get (tcl-part "$arr(key)" 0 0) :name))
(tcl-assert "arr-key-len" 1 (len (get (tcl-part "$arr(key)" 0 0) :key)))
(tcl-assert "arr-key-text" "key"
(get (nth (get (tcl-part "$arr(key)" 0 0) :key) 0) :value))
; command substitution
(tcl-assert "cmd-type" "cmd" (get (tcl-part "[expr 1+1]" 0 0) :type))
(tcl-assert "cmd-src" "expr 1+1" (get (tcl-part "[expr 1+1]" 0 0) :src))
; nested command substitution
(tcl-assert "cmd-nested-src" "expr [string length x]"
(get (tcl-part "[expr [string length x]]" 0 0) :src))
; backslash substitution in double-quoted word
(let ((ps (tcl-parts "\"a\\nb\"" 0)))
(begin
(tcl-assert "bs-n-part0" "a" (get (nth ps 0) :value))
(tcl-assert "bs-n-part1" "\n" (get (nth ps 1) :value))
(tcl-assert "bs-n-part2" "b" (get (nth ps 2) :value))))
(let ((ps (tcl-parts "\"a\\tb\"" 0)))
(tcl-assert "bs-t-part1" "\t" (get (nth ps 1) :value)))
(let ((ps (tcl-parts "\"a\\\\b\"" 0)))
(tcl-assert "bs-bs-part1" "\\" (get (nth ps 1) :value)))
; mixed word: text + var + text in double-quoted
(let ((ps (tcl-parts "\"hello $name!\"" 0)))
(begin
(tcl-assert "mixed-text0" "hello " (get (nth ps 0) :value))
(tcl-assert "mixed-var1-type" "var" (get (nth ps 1) :type))
(tcl-assert "mixed-var1-name" "name" (get (nth ps 1) :name))
(tcl-assert "mixed-text2" "!" (get (nth ps 2) :value))))
; {*} expansion
(tcl-assert "expand-type" "expand" (get (tcl-word "{*}$list" 0) :type))
; line continuation between words
(tcl-assert "cont-words" 3 (len (tcl-cmd-words "set x \\\n 1")))
; continuation — third command word is correct
(tcl-assert "cont-word2-val" "1"
(get (tcl-part "set x \\\n 1" 2 0) :value))
; --- parser helpers ---
; tcl-parse is an alias for tcl-tokenize
(tcl-assert "parse-cmd-count" 1 (len (tcl-parse "set x 1")))
(tcl-assert "parse-2cmds" 2 (len (tcl-parse "set x 1; set y 2")))
; tcl-cmd-len
(tcl-assert "cmd-len-3" 3 (tcl-cmd-len (nth (tcl-parse "set x 1") 0)))
(tcl-assert "cmd-len-1" 1 (tcl-cmd-len (nth (tcl-parse "puts") 0)))
; tcl-word-simple? on braced word
(tcl-assert "simple-braced" true
(tcl-word-simple? (nth (get (nth (tcl-parse "{hello}") 0) :words) 0)))
; tcl-word-simple? on bare word with no subs
(tcl-assert "simple-bare" true
(tcl-word-simple? (nth (get (nth (tcl-parse "hello") 0) :words) 0)))
; tcl-word-simple? on word containing a var sub — false
(tcl-assert "simple-var-false" false
(tcl-word-simple? (nth (get (nth (tcl-parse "$x") 0) :words) 0)))
; tcl-word-simple? on word containing a cmd sub — false
(tcl-assert "simple-cmd-false" false
(tcl-word-simple? (nth (get (nth (tcl-parse "[expr 1]") 0) :words) 0)))
; tcl-word-literal on braced word
(tcl-assert "lit-braced" "hello world"
(tcl-word-literal (nth (get (nth (tcl-parse "{hello world}") 0) :words) 0)))
; tcl-word-literal on bare word
(tcl-assert "lit-bare" "hello"
(tcl-word-literal (nth (get (nth (tcl-parse "hello") 0) :words) 0)))
; tcl-word-literal on word with var sub returns nil
(tcl-assert "lit-var-nil" nil
(tcl-word-literal (nth (get (nth (tcl-parse "$x") 0) :words) 0)))
; tcl-nth-literal
(tcl-assert "nth-lit-0" "set"
(tcl-nth-literal (nth (tcl-parse "set x 1") 0) 0))
(tcl-assert "nth-lit-1" "x"
(tcl-nth-literal (nth (tcl-parse "set x 1") 0) 1))
(tcl-assert "nth-lit-2" "1"
(tcl-nth-literal (nth (tcl-parse "set x 1") 0) 2))
; tcl-nth-literal returns nil when word has subs
(tcl-assert "nth-lit-nil" nil
(tcl-nth-literal (nth (tcl-parse "set x $y") 0) 2))
(dict
"passed" tcl-parse-pass
"failed" tcl-parse-fail
"failures" tcl-parse-failures)))

View File

@@ -1,308 +0,0 @@
(define tcl-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\r"))))
(define tcl-alpha?
(fn (c)
(and
(not (= c nil))
(or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z"))))))
(define tcl-digit?
(fn (c) (and (not (= c nil)) (>= c "0") (<= c "9"))))
(define tcl-ident-start?
(fn (c) (or (tcl-alpha? c) (= c "_"))))
(define tcl-ident-char?
(fn (c) (or (tcl-ident-start? c) (tcl-digit? c))))
(define tcl-tokenize
(fn (src)
(let ((pos 0) (src-len (len src)) (commands (list)))
(define char-at
(fn (off)
(if (< (+ pos off) src-len) (nth src (+ pos off)) nil)))
(define cur (fn () (char-at 0)))
(define advance! (fn (n) (set! pos (+ pos n))))
(define skip-ws!
(fn ()
(when (tcl-ws? (cur))
(begin (advance! 1) (skip-ws!)))))
(define skip-to-eol!
(fn ()
(when (and (< pos src-len) (not (= (cur) "\n")))
(begin (advance! 1) (skip-to-eol!)))))
(define skip-brace-content!
(fn (d)
(when (and (< pos src-len) (> d 0))
(cond
((= (cur) "{") (begin (advance! 1) (skip-brace-content! (+ d 1))))
((= (cur) "}") (begin (advance! 1) (skip-brace-content! (- d 1))))
(else (begin (advance! 1) (skip-brace-content! d)))))))
(define skip-dquote-content!
(fn ()
(when (and (< pos src-len) (not (= (cur) "\"")))
(begin
(when (= (cur) "\\") (advance! 1))
(when (< pos src-len) (advance! 1))
(skip-dquote-content!)))))
(define parse-bs
(fn ()
(advance! 1)
(let ((c (cur)))
(cond
((= c nil) "\\")
((= c "n") (begin (advance! 1) "\n"))
((= c "t") (begin (advance! 1) "\t"))
((= c "r") (begin (advance! 1) "\r"))
((= c "\\") (begin (advance! 1) "\\"))
((= c "[") (begin (advance! 1) "["))
((= c "]") (begin (advance! 1) "]"))
((= c "{") (begin (advance! 1) "{"))
((= c "}") (begin (advance! 1) "}"))
((= c "$") (begin (advance! 1) "$"))
((= c ";") (begin (advance! 1) ";"))
((= c "\"") (begin (advance! 1) "\""))
((= c "'") (begin (advance! 1) "'"))
((= c " ") (begin (advance! 1) " "))
((= c "\n")
(begin
(advance! 1)
(skip-ws!)
" "))
(else (begin (advance! 1) (str "\\" c)))))))
(define parse-cmd-sub
(fn ()
(advance! 1)
(let ((start pos) (depth 1))
(define scan!
(fn ()
(when (and (< pos src-len) (> depth 0))
(cond
((= (cur) "[")
(begin (set! depth (+ depth 1)) (advance! 1) (scan!)))
((= (cur) "]")
(begin
(set! depth (- depth 1))
(when (> depth 0) (advance! 1))
(scan!)))
((= (cur) "{")
(begin (advance! 1) (skip-brace-content! 1) (scan!)))
((= (cur) "\"")
(begin
(advance! 1)
(skip-dquote-content!)
(when (= (cur) "\"") (advance! 1))
(scan!)))
((= (cur) "\\")
(begin (advance! 1) (when (< pos src-len) (advance! 1)) (scan!)))
(else (begin (advance! 1) (scan!)))))))
(scan!)
(let ((src-text (slice src start pos)))
(begin
(when (= (cur) "]") (advance! 1))
{:type "cmd" :src src-text})))))
(define scan-name!
(fn ()
(when (and (< pos src-len) (not (= (cur) "}")))
(begin (advance! 1) (scan-name!)))))
(define scan-ns-name!
(fn ()
(cond
((tcl-ident-char? (cur))
(begin (advance! 1) (scan-ns-name!)))
((and (= (cur) ":") (= (char-at 1) ":"))
(begin (advance! 2) (scan-ns-name!)))
(else nil))))
(define scan-klit!
(fn ()
(when (and (< pos src-len)
(not (= (cur) ")"))
(not (= (cur) "$"))
(not (= (cur) "["))
(not (= (cur) "\\")))
(begin (advance! 1) (scan-klit!)))))
(define scan-key!
(fn (kp)
(when (and (< pos src-len) (not (= (cur) ")")))
(cond
((= (cur) "$")
(begin (append! kp (parse-var-sub)) (scan-key! kp)))
((= (cur) "[")
(begin (append! kp (parse-cmd-sub)) (scan-key! kp)))
((= (cur) "\\")
(begin
(append! kp {:type "text" :value (parse-bs)})
(scan-key! kp)))
(else
(let ((kstart pos))
(begin
(scan-klit!)
(append! kp {:type "text" :value (slice src kstart pos)})
(scan-key! kp))))))))
(define parse-var-sub
(fn ()
(advance! 1)
(cond
((= (cur) "{")
(begin
(advance! 1)
(let ((start pos))
(begin
(scan-name!)
(let ((name (slice src start pos)))
(begin
(when (= (cur) "}") (advance! 1))
{:type "var" :name name}))))))
((tcl-ident-start? (cur))
(let ((start pos))
(begin
(scan-ns-name!)
(let ((name (slice src start pos)))
(if (= (cur) "(")
(begin
(advance! 1)
(let ((key-parts (list)))
(begin
(scan-key! key-parts)
(when (= (cur) ")") (advance! 1))
{:type "var-arr" :name name :key key-parts})))
{:type "var" :name name})))))
(else {:type "text" :value "$"}))))
(define scan-lit!
(fn (stop?)
(when (and (< pos src-len)
(not (stop? (cur)))
(not (= (cur) "$"))
(not (= (cur) "["))
(not (= (cur) "\\")))
(begin (advance! 1) (scan-lit! stop?)))))
(define parse-word-parts!
(fn (parts stop?)
(when (and (< pos src-len) (not (stop? (cur))))
(cond
((= (cur) "$")
(begin (append! parts (parse-var-sub)) (parse-word-parts! parts stop?)))
((= (cur) "[")
(begin (append! parts (parse-cmd-sub)) (parse-word-parts! parts stop?)))
((= (cur) "\\")
(begin
(append! parts {:type "text" :value (parse-bs)})
(parse-word-parts! parts stop?)))
(else
(let ((start pos))
(begin
(scan-lit! stop?)
(when (> pos start)
(append! parts {:type "text" :value (slice src start pos)}))
(parse-word-parts! parts stop?))))))))
(define parse-brace-word
(fn ()
(advance! 1)
(let ((depth 1) (start pos))
(define scan!
(fn ()
(when (and (< pos src-len) (> depth 0))
(cond
((= (cur) "{")
(begin (set! depth (+ depth 1)) (advance! 1) (scan!)))
((= (cur) "}")
(begin (set! depth (- depth 1)) (when (> depth 0) (advance! 1)) (scan!)))
(else (begin (advance! 1) (scan!)))))))
(scan!)
(let ((value (slice src start pos)))
(begin
(when (= (cur) "}") (advance! 1))
{:type "braced" :value value})))))
(define parse-dquote-word
(fn ()
(advance! 1)
(let ((parts (list)))
(begin
(parse-word-parts! parts (fn (c) (or (= c "\"") (= c nil))))
(when (= (cur) "\"") (advance! 1))
{:type "compound" :parts parts :quoted true}))))
(define parse-bare-word
(fn ()
(let ((parts (list)))
(begin
(parse-word-parts!
parts
(fn (c) (or (tcl-ws? c) (= c "\n") (= c ";") (= c nil))))
{:type "compound" :parts parts :quoted false}))))
(define parse-word-no-expand
(fn ()
(cond
((= (cur) "{") (parse-brace-word))
((= (cur) "\"") (parse-dquote-word))
(else (parse-bare-word)))))
(define parse-word
(fn ()
(cond
((and (= (cur) "{") (= (char-at 1) "*") (= (char-at 2) "}"))
(begin
(advance! 3)
{:type "expand" :word (parse-word-no-expand)}))
((= (cur) "{") (parse-brace-word))
((= (cur) "\"") (parse-dquote-word))
(else (parse-bare-word)))))
(define parse-words!
(fn (words)
(skip-ws!)
(cond
((or (= (cur) nil) (= (cur) "\n") (= (cur) ";")) nil)
((and (= (cur) "\\") (= (char-at 1) "\n"))
(begin (advance! 2) (skip-ws!) (parse-words! words)))
(else
(begin
(append! words (parse-word))
(parse-words! words))))))
(define skip-seps!
(fn ()
(when (< pos src-len)
(cond
((or (tcl-ws? (cur)) (= (cur) "\n") (= (cur) ";"))
(begin (advance! 1) (skip-seps!)))
((and (= (cur) "\\") (= (char-at 1) "\n"))
(begin (advance! 2) (skip-seps!)))
(else nil)))))
(define parse-all!
(fn ()
(skip-seps!)
(when (< pos src-len)
(cond
((= (cur) "#")
(begin (skip-to-eol!) (parse-all!)))
(else
(let ((words (list)))
(begin
(parse-words! words)
(when (> (len words) 0)
(append! commands {:type "command" :words words}))
(parse-all!))))))))
(parse-all!)
commands)))

View File

@@ -51,11 +51,11 @@ Core mapping:
## Roadmap ## Roadmap
### Phase 1 — tokenizer + parser ### Phase 1 — tokenizer + parser
- [ ] Tokenizer: keywords (`def end class module if unless while until do return yield begin rescue ensure case when then else elsif`), identifiers (lowercase = local/method, `@` = ivar, `@@` = cvar, `$` = global, uppercase = constant), numbers (int, float, `0x` `0o` `0b`, `_` separators), strings (`"…"` interpolation, `'…'` literal, `%w[a b c]`, `%i[a b c]`), symbols `:foo` `:"…"`, operators (`+ - * / % ** == != < > <= >= <=> === =~ !~ << >> & | ^ ~ ! && || and or not`), `:: . , ; ( ) [ ] { } -> => |`, comments `#` - [x] Tokenizer: keywords (`def end class module if unless while until do return yield begin rescue ensure case when then else elsif`), identifiers (lowercase = local/method, `@` = ivar, `@@` = cvar, `$` = global, uppercase = constant), numbers (int, float, `0x` `0o` `0b`, `_` separators), strings (`"…"` interpolation, `'…'` literal, `%w[a b c]`, `%i[a b c]`), symbols `:foo` `:"…"`, operators (`+ - * / % ** == != < > <= >= <=> === =~ !~ << >> & | ^ ~ ! && || and or not`), `:: . , ; ( ) [ ] { } -> => |`, comments `#`
- [ ] Parser: program is sequence of statements separated by newlines or `;`; method def `def name(args) … end`; class `class Foo < Bar … end`; module `module M … end`; block `do |a, b| … end` and `{ |a, b| … }`; call sugar (no parens), `obj.method`, `Mod::Const`; arg shapes (positional, default, splat `*args`, double-splat `**opts`, block `&blk`) - [x] Parser: program is sequence of statements separated by newlines or `;`; method def `def name(args) … end`; class `class Foo < Bar … end`; module `module M … end`; block `do |a, b| … end` and `{ |a, b| … }`; call sugar (no parens), `obj.method`, `Mod::Const`; arg shapes (positional, default, splat `*args`, double-splat `**opts`, block `&blk`)
- [ ] If/while/case expressions (return values), `unless`/`until`, postfix modifiers - [ ] If/while/case expressions (return values), `unless`/`until`, postfix modifiers
- [ ] Begin/rescue/ensure/retry, raise, raise with class+message - [ ] Begin/rescue/ensure/retry, raise, raise with class+message
- [ ] Unit tests in `lib/ruby/tests/parse.sx` - [x] Unit tests in `lib/ruby/tests/parse.sx`
### Phase 2 — object model + sequential eval ### Phase 2 — object model + sequential eval
- [ ] Class table bootstrap: `BasicObject`, `Object`, `Kernel`, `Module`, `Class`, `Numeric`, `Integer`, `Float`, `String`, `Symbol`, `Array`, `Hash`, `Range`, `NilClass`, `TrueClass`, `FalseClass`, `Proc`, `Method` - [ ] Class table bootstrap: `BasicObject`, `Object`, `Kernel`, `Module`, `Class`, `Numeric`, `Integer`, `Float`, `String`, `Symbol`, `Array`, `Hash`, `Range`, `NilClass`, `TrueClass`, `FalseClass`, `Proc`, `Method`
@@ -117,7 +117,8 @@ Core mapping:
_Newest first._ _Newest first._
- _(none yet)_ - 2026-04-25: Phase 1 parser complete — `lib/ruby/parser.sx` (rb-parse/rb-parse-str) + `lib/ruby/tests/parse.sx` (83/83 tests). Program, method-def (all param shapes), class/module/sclass, blocks (do/brace), method calls (parens + no-parens + chains), const-path, assignment (=, op=, massign), binary/unary ops with precedence, array/hash literals, return/yield/break/next/redo/raise, indexing.
- 2026-04-25: Phase 1 tokenizer complete — `lib/ruby/tokenizer.sx` + `lib/ruby/tests/tokenizer.sx` (107/107 tests). Keywords, identifiers (@ivar @@cvar $gvar), numbers (dec/hex/octal/binary/float), strings (dq with interpolation kept raw, sq), symbols, %w/%i literals, operators (all compound forms), punctuation, comments, line/col tracking.
## Blockers ## Blockers

View File

@@ -50,7 +50,7 @@ Core mapping:
## Roadmap ## Roadmap
### Phase 1 — tokenizer + parser (the Dodekalogue) ### Phase 1 — tokenizer + parser (the Dodekalogue)
- [x] Tokenizer applying the 12 rules: - [ ] Tokenizer applying the 12 rules:
1. Commands separated by `;` or newlines 1. Commands separated by `;` or newlines
2. Words separated by whitespace within a command 2. Words separated by whitespace within a command
3. Double-quoted words: `\` escapes + `[…]` + `${…}` + `$var` substitution 3. Double-quoted words: `\` escapes + `[…]` + `${…}` + `$var` substitution
@@ -63,12 +63,12 @@ Core mapping:
10. Order of substitution is left-to-right, single-pass 10. Order of substitution is left-to-right, single-pass
11. Substitutions don't recurse — substituted text is not re-parsed 11. Substitutions don't recurse — substituted text is not re-parsed
12. The result of any substitution is the value, not a new script 12. The result of any substitution is the value, not a new script
- [x] Parser: script = list of commands; command = list of words; word = literal string + list of substitutions - [ ] Parser: script = list of commands; command = list of words; word = literal string + list of substitutions
- [x] Unit tests in `lib/tcl/tests/parse.sx` - [ ] Unit tests in `lib/tcl/tests/parse.sx`
### Phase 2 — sequential eval + core commands ### Phase 2 — sequential eval + core commands
- [x] `tcl-eval-script`: walk command list, dispatch each first-word into command table - [ ] `tcl-eval-script`: walk command list, dispatch each first-word into command table
- [x] Core commands: `set`, `unset`, `incr`, `append`, `lappend`, `puts`, `gets`, `expr`, `if`, `while`, `for`, `foreach`, `switch`, `break`, `continue`, `return`, `error`, `eval`, `subst`, `format`, `scan` - [ ] Core commands: `set`, `unset`, `incr`, `append`, `lappend`, `puts`, `gets`, `expr`, `if`, `while`, `for`, `foreach`, `switch`, `break`, `continue`, `return`, `error`, `eval`, `subst`, `format`, `scan`
- [ ] `expr` is its own mini-language — operator precedence, function calls (`sin`, `sqrt`, `pow`, `abs`, `int`, `double`), variable substitution, command substitution - [ ] `expr` is its own mini-language — operator precedence, function calls (`sin`, `sqrt`, `pow`, `abs`, `int`, `double`), variable substitution, command substitution
- [ ] String commands: `string length`, `string index`, `string range`, `string compare`, `string match`, `string toupper`, `string tolower`, `string trim`, `string map`, `string repeat`, `string first`, `string last`, `string is`, `string cat` - [ ] String commands: `string length`, `string index`, `string range`, `string compare`, `string match`, `string toupper`, `string tolower`, `string trim`, `string map`, `string repeat`, `string first`, `string last`, `string is`, `string cat`
- [ ] List commands: `list`, `lindex`, `lrange`, `llength`, `lreverse`, `lsearch`, `lsort`, `lsort -integer/-real/-dictionary`, `lreplace`, `linsert`, `concat`, `split`, `join` - [ ] List commands: `list`, `lindex`, `lrange`, `llength`, `lreverse`, `lsearch`, `lsort`, `lsort -integer/-real/-dictionary`, `lreplace`, `linsert`, `concat`, `split`, `join`
@@ -120,10 +120,7 @@ Core mapping:
_Newest first._ _Newest first._
- 2026-04-26: Phase 2 core commands — if/while/for/foreach/switch/break/continue/return/error/unset/lappend/eval/expr + :code control flow, 107 tests green (67 parse + 40 eval) - _(none yet)_
- 2026-04-26: Phase 2 eval engine — `lib/tcl/runtime.sx`, tcl-eval-script + set/puts/incr/append, 87 tests green (67 parse + 20 eval)
- 2026-04-25: Phase 1 parser — `lib/tcl/parser.sx`, word-simple?/word-literal helpers, 67 tests green, commit 6ee05259
- 2026-04-25: Phase 1 tokenizer (Dodekalogue) — `lib/tcl/tokenizer.sx`, 52 tests green, commit 666e29d5
## Blockers ## Blockers