Compare commits
2 Commits
loops/apl
...
loops/ruby
| Author | SHA1 | Date | |
|---|---|---|---|
| 15eb133311 | |||
| 96019e9fe8 |
@@ -1,436 +0,0 @@
|
|||||||
; APL Parser — right-to-left expression parser
|
|
||||||
;
|
|
||||||
; Takes a token list (output of apl-tokenize) and produces an AST.
|
|
||||||
; APL evaluates right-to-left with no precedence among functions.
|
|
||||||
; Operators bind to the function immediately to their left in the source.
|
|
||||||
;
|
|
||||||
; AST node types:
|
|
||||||
; (:num n) number literal
|
|
||||||
; (:str s) string literal
|
|
||||||
; (:vec n1 n2 ...) strand (juxtaposed literals)
|
|
||||||
; (:name "x") name reference / alpha / omega
|
|
||||||
; (:assign "x" expr) assignment x←expr
|
|
||||||
; (:monad fn arg) monadic function call
|
|
||||||
; (:dyad fn left right) dyadic function call
|
|
||||||
; (:derived-fn op fn) derived function: f/ f¨ f⍨
|
|
||||||
; (:derived-fn2 "." f g) inner product: f.g
|
|
||||||
; (:outer "∘." fn) outer product: ∘.f
|
|
||||||
; (:fn-glyph "⍳") function reference
|
|
||||||
; (:fn-name "foo") named-function reference (dfn variable)
|
|
||||||
; (:dfn stmt...) {⍺+⍵} anonymous function
|
|
||||||
; (:guard cond expr) cond:expr guard inside dfn
|
|
||||||
; (:program stmt...) multi-statement sequence
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Glyph classification sets
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define apl-parse-op-glyphs
|
|
||||||
(list "/" "\\" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@"))
|
|
||||||
|
|
||||||
(define apl-parse-fn-glyphs
|
|
||||||
(list "+" "-" "×" "÷" "*" "⍟" "⌈" "⌊" "|" "!" "?" "○" "~"
|
|
||||||
"<" "≤" "=" "≥" ">" "≠" "∊" "∧" "∨" "⍱" "⍲"
|
|
||||||
"," "⍪" "⍴" "⌽" "⊖" "⍉" "↑" "↓" "⊂" "⊃" "⊆"
|
|
||||||
"∪" "∩" "⍳" "⍸" "⌷" "⍋" "⍒" "⊥" "⊤" "⊣" "⊢" "⍎" "⍕"))
|
|
||||||
|
|
||||||
(define apl-parse-op-glyph?
|
|
||||||
(fn (v)
|
|
||||||
(some (fn (g) (= g v)) apl-parse-op-glyphs)))
|
|
||||||
|
|
||||||
(define apl-parse-fn-glyph?
|
|
||||||
(fn (v)
|
|
||||||
(some (fn (g) (= g v)) apl-parse-fn-glyphs)))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Token accessors
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define tok-type
|
|
||||||
(fn (tok)
|
|
||||||
(get tok :type)))
|
|
||||||
|
|
||||||
(define tok-val
|
|
||||||
(fn (tok)
|
|
||||||
(get tok :value)))
|
|
||||||
|
|
||||||
(define is-op-tok?
|
|
||||||
(fn (tok)
|
|
||||||
(and (= (tok-type tok) :glyph)
|
|
||||||
(apl-parse-op-glyph? (tok-val tok)))))
|
|
||||||
|
|
||||||
(define is-fn-tok?
|
|
||||||
(fn (tok)
|
|
||||||
(and (= (tok-type tok) :glyph)
|
|
||||||
(apl-parse-fn-glyph? (tok-val tok)))))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Collect trailing operators starting at index i
|
|
||||||
; Returns {:ops (op ...) :end new-i}
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define collect-ops
|
|
||||||
(fn (tokens i)
|
|
||||||
(collect-ops-loop tokens i (list))))
|
|
||||||
|
|
||||||
(define collect-ops-loop
|
|
||||||
(fn (tokens i acc)
|
|
||||||
(if (>= i (len tokens))
|
|
||||||
{:ops acc :end i}
|
|
||||||
(let ((tok (nth tokens i)))
|
|
||||||
(if (is-op-tok? tok)
|
|
||||||
(collect-ops-loop tokens (+ i 1) (append acc (tok-val tok)))
|
|
||||||
{:ops acc :end i})))))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Build a derived-fn node by chaining operators left-to-right
|
|
||||||
; (+/¨ → (:derived-fn "¨" (:derived-fn "/" (:fn-glyph "+"))))
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define build-derived-fn
|
|
||||||
(fn (fn-node ops)
|
|
||||||
(if (= (len ops) 0)
|
|
||||||
fn-node
|
|
||||||
(build-derived-fn
|
|
||||||
(list :derived-fn (first ops) fn-node)
|
|
||||||
(rest ops)))))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Find matching close bracket/paren/brace
|
|
||||||
; Returns the index of the matching close token
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define find-matching-close
|
|
||||||
(fn (tokens start open-type close-type)
|
|
||||||
(find-matching-close-loop tokens start open-type close-type 1)))
|
|
||||||
|
|
||||||
(define find-matching-close-loop
|
|
||||||
(fn (tokens i open-type close-type depth)
|
|
||||||
(if (>= i (len tokens))
|
|
||||||
(len tokens)
|
|
||||||
(let ((tt (tok-type (nth tokens i))))
|
|
||||||
(cond
|
|
||||||
((= tt open-type)
|
|
||||||
(find-matching-close-loop tokens (+ i 1) open-type close-type (+ depth 1)))
|
|
||||||
((= tt close-type)
|
|
||||||
(if (= depth 1)
|
|
||||||
i
|
|
||||||
(find-matching-close-loop tokens (+ i 1) open-type close-type (- depth 1))))
|
|
||||||
(true
|
|
||||||
(find-matching-close-loop tokens (+ i 1) open-type close-type depth)))))))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Segment collection: scan tokens left-to-right, building
|
|
||||||
; a list of {:kind "val"/"fn" :node ast} segments.
|
|
||||||
; Operators following function glyphs are merged into
|
|
||||||
; derived-fn nodes during this pass.
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define collect-segments
|
|
||||||
(fn (tokens)
|
|
||||||
(collect-segments-loop tokens 0 (list))))
|
|
||||||
|
|
||||||
(define collect-segments-loop
|
|
||||||
(fn (tokens i acc)
|
|
||||||
(if (>= i (len tokens))
|
|
||||||
acc
|
|
||||||
(let ((tok (nth tokens i))
|
|
||||||
(n (len tokens)))
|
|
||||||
(let ((tt (tok-type tok))
|
|
||||||
(tv (tok-val tok)))
|
|
||||||
(cond
|
|
||||||
; Skip separators
|
|
||||||
((or (= tt :diamond) (= tt :newline) (= tt :semi))
|
|
||||||
(collect-segments-loop tokens (+ i 1) acc))
|
|
||||||
|
|
||||||
; Number → value segment
|
|
||||||
((= tt :num)
|
|
||||||
(collect-segments-loop tokens (+ i 1)
|
|
||||||
(append acc {:kind "val" :node (list :num tv)})))
|
|
||||||
|
|
||||||
; String → value segment
|
|
||||||
((= tt :str)
|
|
||||||
(collect-segments-loop tokens (+ i 1)
|
|
||||||
(append acc {:kind "val" :node (list :str tv)})))
|
|
||||||
|
|
||||||
; Name → always a value segment in Phase 1
|
|
||||||
; (Named functions with operators like f/ are Phase 5)
|
|
||||||
((= tt :name)
|
|
||||||
(collect-segments-loop tokens (+ i 1)
|
|
||||||
(append acc {:kind "val" :node (list :name tv)})))
|
|
||||||
|
|
||||||
|
|
||||||
; Left paren → parse subexpression recursively
|
|
||||||
((= tt :lparen)
|
|
||||||
(let ((end (find-matching-close tokens (+ i 1) :lparen :rparen)))
|
|
||||||
(let ((inner-tokens (slice tokens (+ i 1) end))
|
|
||||||
(after (+ end 1)))
|
|
||||||
(collect-segments-loop tokens after
|
|
||||||
(append acc {:kind "val" :node (parse-apl-expr inner-tokens)})))))
|
|
||||||
|
|
||||||
; Left brace → dfn
|
|
||||||
((= tt :lbrace)
|
|
||||||
(let ((end (find-matching-close tokens (+ i 1) :lbrace :rbrace)))
|
|
||||||
(let ((inner-tokens (slice tokens (+ i 1) end))
|
|
||||||
(after (+ end 1)))
|
|
||||||
(collect-segments-loop tokens after
|
|
||||||
(append acc {:kind "fn" :node (parse-dfn inner-tokens)})))))
|
|
||||||
|
|
||||||
; Glyph token — need to classify
|
|
||||||
((= tt :glyph)
|
|
||||||
(cond
|
|
||||||
; Alpha (⍺) and Omega (⍵) → values inside dfn context
|
|
||||||
((or (= tv "⍺") (= tv "⍵"))
|
|
||||||
(collect-segments-loop tokens (+ i 1)
|
|
||||||
(append acc {:kind "val" :node (list :name tv)})))
|
|
||||||
|
|
||||||
; Nabla (∇) → self-reference function in dfn context
|
|
||||||
((= tv "∇")
|
|
||||||
(collect-segments-loop tokens (+ i 1)
|
|
||||||
(append acc {:kind "fn" :node (list :fn-glyph "∇")})))
|
|
||||||
|
|
||||||
; ∘. → outer product (special case: ∘ followed by .)
|
|
||||||
((and (= tv "∘")
|
|
||||||
(< (+ i 1) n)
|
|
||||||
(= (tok-val (nth tokens (+ i 1))) "."))
|
|
||||||
(if (and (< (+ i 2) n) (is-fn-tok? (nth tokens (+ i 2))))
|
|
||||||
(let ((fn-tv (tok-val (nth tokens (+ i 2)))))
|
|
||||||
(let ((op-result (collect-ops tokens (+ i 3))))
|
|
||||||
(let ((ops (get op-result :ops))
|
|
||||||
(ni (get op-result :end)))
|
|
||||||
(let ((fn-node (build-derived-fn (list :fn-glyph fn-tv) ops)))
|
|
||||||
(collect-segments-loop tokens ni
|
|
||||||
(append acc {:kind "fn" :node (list :outer "∘." fn-node)}))))))
|
|
||||||
; ∘. without function — treat ∘ as plain compose operator
|
|
||||||
; skip the . and continue
|
|
||||||
(collect-segments-loop tokens (+ i 1)
|
|
||||||
acc)))
|
|
||||||
|
|
||||||
; Function glyph — collect following operators
|
|
||||||
((apl-parse-fn-glyph? tv)
|
|
||||||
(let ((op-result (collect-ops tokens (+ i 1))))
|
|
||||||
(let ((ops (get op-result :ops))
|
|
||||||
(ni (get op-result :end)))
|
|
||||||
; Check for inner product: fn . fn
|
|
||||||
; (ops = ("." ) and next token is also a function glyph)
|
|
||||||
(if (and (= (len ops) 1)
|
|
||||||
(= (first ops) ".")
|
|
||||||
(< ni n)
|
|
||||||
(is-fn-tok? (nth tokens ni)))
|
|
||||||
; f.g inner product
|
|
||||||
(let ((g-tv (tok-val (nth tokens ni))))
|
|
||||||
(let ((op-result2 (collect-ops tokens (+ ni 1))))
|
|
||||||
(let ((ops2 (get op-result2 :ops))
|
|
||||||
(ni2 (get op-result2 :end)))
|
|
||||||
(let ((g-node (build-derived-fn (list :fn-glyph g-tv) ops2)))
|
|
||||||
(collect-segments-loop tokens ni2
|
|
||||||
(append acc {:kind "fn"
|
|
||||||
:node (list :derived-fn2 "." (list :fn-glyph tv) g-node)}))))))
|
|
||||||
; Regular function with zero or more operator modifiers
|
|
||||||
(let ((fn-node (build-derived-fn (list :fn-glyph tv) ops)))
|
|
||||||
(collect-segments-loop tokens ni
|
|
||||||
(append acc {:kind "fn" :node fn-node})))))))
|
|
||||||
|
|
||||||
; Stray operator glyph — skip (shouldn't appear outside function context)
|
|
||||||
((apl-parse-op-glyph? tv)
|
|
||||||
(collect-segments-loop tokens (+ i 1) acc))
|
|
||||||
|
|
||||||
; Unknown glyph — skip
|
|
||||||
(true
|
|
||||||
(collect-segments-loop tokens (+ i 1) acc))))
|
|
||||||
|
|
||||||
; Skip unknown token types
|
|
||||||
(true
|
|
||||||
(collect-segments-loop tokens (+ i 1) acc))))))))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Build tree from segment list
|
|
||||||
;
|
|
||||||
; The segments are in left-to-right order.
|
|
||||||
; APL evaluates right-to-left, so the LEFTMOST function is
|
|
||||||
; the outermost (last-evaluated) node.
|
|
||||||
;
|
|
||||||
; Patterns:
|
|
||||||
; [val] → val node
|
|
||||||
; [fn val ...] → (:monad fn (build-tree rest))
|
|
||||||
; [val fn val ...] → (:dyad fn val (build-tree rest))
|
|
||||||
; [val val ...] → (:vec val1 val2 ...) — strand
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
; Find the index of the first function segment (returns -1 if none)
|
|
||||||
(define find-first-fn
|
|
||||||
(fn (segs)
|
|
||||||
(find-first-fn-loop segs 0)))
|
|
||||||
|
|
||||||
(define find-first-fn-loop
|
|
||||||
(fn (segs i)
|
|
||||||
(if (>= i (len segs))
|
|
||||||
-1
|
|
||||||
(if (= (get (nth segs i) :kind) "fn")
|
|
||||||
i
|
|
||||||
(find-first-fn-loop segs (+ i 1))))))
|
|
||||||
|
|
||||||
; Build an array node from 0..n value segments
|
|
||||||
; If n=1 → return that segment's node
|
|
||||||
; If n>1 → return (:vec node1 node2 ...)
|
|
||||||
(define segs-to-array
|
|
||||||
(fn (segs)
|
|
||||||
(if (= (len segs) 1)
|
|
||||||
(get (first segs) :node)
|
|
||||||
(cons :vec (map (fn (s) (get s :node)) segs)))))
|
|
||||||
|
|
||||||
(define build-tree
|
|
||||||
(fn (segs)
|
|
||||||
(cond
|
|
||||||
; Empty → nil
|
|
||||||
((= (len segs) 0) nil)
|
|
||||||
; Single segment → return its node directly
|
|
||||||
((= (len segs) 1) (get (first segs) :node))
|
|
||||||
; All values → strand
|
|
||||||
((every? (fn (s) (= (get s :kind) "val")) segs)
|
|
||||||
(segs-to-array segs))
|
|
||||||
; Find the first function segment
|
|
||||||
(true
|
|
||||||
(let ((fn-idx (find-first-fn segs)))
|
|
||||||
(cond
|
|
||||||
; No function found (shouldn't happen given above checks) → strand
|
|
||||||
((= fn-idx -1) (segs-to-array segs))
|
|
||||||
; Function is first → monadic call
|
|
||||||
((= fn-idx 0)
|
|
||||||
(list :monad
|
|
||||||
(get (first segs) :node)
|
|
||||||
(build-tree (rest segs))))
|
|
||||||
; Function at position fn-idx: left args are segs[0..fn-idx-1]
|
|
||||||
(true
|
|
||||||
(let ((left-segs (slice segs 0 fn-idx))
|
|
||||||
(fn-seg (nth segs fn-idx))
|
|
||||||
(right-segs (slice segs (+ fn-idx 1))))
|
|
||||||
(list :dyad
|
|
||||||
(get fn-seg :node)
|
|
||||||
(segs-to-array left-segs)
|
|
||||||
(build-tree right-segs))))))))))
|
|
||||||
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Split token list on statement separators (diamond / newline)
|
|
||||||
; Only splits at depth 0 (ignores separators inside { } or ( ) )
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define split-statements
|
|
||||||
(fn (tokens)
|
|
||||||
(split-statements-loop tokens (list) (list) 0)))
|
|
||||||
|
|
||||||
(define split-statements-loop
|
|
||||||
(fn (tokens current-stmt acc depth)
|
|
||||||
(if (= (len tokens) 0)
|
|
||||||
(if (> (len current-stmt) 0)
|
|
||||||
(append acc (list current-stmt))
|
|
||||||
acc)
|
|
||||||
(let ((tok (first tokens))
|
|
||||||
(rest-toks (rest tokens))
|
|
||||||
(tt (tok-type (first tokens))))
|
|
||||||
(cond
|
|
||||||
; Open brackets increase depth
|
|
||||||
((or (= tt :lparen) (= tt :lbrace) (= tt :lbracket))
|
|
||||||
(split-statements-loop rest-toks (append current-stmt tok) acc (+ depth 1)))
|
|
||||||
; Close brackets decrease depth
|
|
||||||
((or (= tt :rparen) (= tt :rbrace) (= tt :rbracket))
|
|
||||||
(split-statements-loop rest-toks (append current-stmt tok) acc (- depth 1)))
|
|
||||||
; Separators only split at top level (depth = 0)
|
|
||||||
((and (> depth 0) (or (= tt :diamond) (= tt :newline)))
|
|
||||||
(split-statements-loop rest-toks (append current-stmt tok) acc depth))
|
|
||||||
((and (= depth 0) (or (= tt :diamond) (= tt :newline)))
|
|
||||||
(if (> (len current-stmt) 0)
|
|
||||||
(split-statements-loop rest-toks (list) (append acc (list current-stmt)) depth)
|
|
||||||
(split-statements-loop rest-toks (list) acc depth)))
|
|
||||||
; All other tokens go into current statement
|
|
||||||
(true
|
|
||||||
(split-statements-loop rest-toks (append current-stmt tok) acc depth)))))))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Parse a dfn body (tokens between { and })
|
|
||||||
; Handles guard expressions: cond : expr
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define parse-dfn
|
|
||||||
(fn (tokens)
|
|
||||||
(let ((stmt-groups (split-statements tokens)))
|
|
||||||
(let ((stmts (map parse-dfn-stmt stmt-groups)))
|
|
||||||
(cons :dfn stmts)))))
|
|
||||||
|
|
||||||
(define parse-dfn-stmt
|
|
||||||
(fn (tokens)
|
|
||||||
; Check for guard: expr : expr
|
|
||||||
; A guard has a :colon token not inside parens/braces
|
|
||||||
(let ((colon-idx (find-top-level-colon tokens 0)))
|
|
||||||
(if (>= colon-idx 0)
|
|
||||||
; Guard: cond : expr
|
|
||||||
(let ((cond-tokens (slice tokens 0 colon-idx))
|
|
||||||
(body-tokens (slice tokens (+ colon-idx 1))))
|
|
||||||
(list :guard
|
|
||||||
(parse-apl-expr cond-tokens)
|
|
||||||
(parse-apl-expr body-tokens)))
|
|
||||||
; Regular statement
|
|
||||||
(parse-stmt tokens)))))
|
|
||||||
|
|
||||||
(define find-top-level-colon
|
|
||||||
(fn (tokens i)
|
|
||||||
(find-top-level-colon-loop tokens i 0)))
|
|
||||||
|
|
||||||
(define find-top-level-colon-loop
|
|
||||||
(fn (tokens i depth)
|
|
||||||
(if (>= i (len tokens))
|
|
||||||
-1
|
|
||||||
(let ((tok (nth tokens i))
|
|
||||||
(tt (tok-type (nth tokens i))))
|
|
||||||
(cond
|
|
||||||
((or (= tt :lparen) (= tt :lbrace) (= tt :lbracket))
|
|
||||||
(find-top-level-colon-loop tokens (+ i 1) (+ depth 1)))
|
|
||||||
((or (= tt :rparen) (= tt :rbrace) (= tt :rbracket))
|
|
||||||
(find-top-level-colon-loop tokens (+ i 1) (- depth 1)))
|
|
||||||
((and (= tt :colon) (= depth 0))
|
|
||||||
i)
|
|
||||||
(true
|
|
||||||
(find-top-level-colon-loop tokens (+ i 1) depth)))))))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Parse a single statement (assignment or expression)
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define parse-stmt
|
|
||||||
(fn (tokens)
|
|
||||||
(if (and (>= (len tokens) 2)
|
|
||||||
(= (tok-type (nth tokens 0)) :name)
|
|
||||||
(= (tok-type (nth tokens 1)) :assign))
|
|
||||||
; Assignment: name ← expr
|
|
||||||
(list :assign
|
|
||||||
(tok-val (nth tokens 0))
|
|
||||||
(parse-apl-expr (slice tokens 2)))
|
|
||||||
; Expression
|
|
||||||
(parse-apl-expr tokens))))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Parse an expression from a flat token list
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define parse-apl-expr
|
|
||||||
(fn (tokens)
|
|
||||||
(let ((segs (collect-segments tokens)))
|
|
||||||
(if (= (len segs) 0)
|
|
||||||
nil
|
|
||||||
(build-tree segs)))))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Main entry point
|
|
||||||
; parse-apl: string → AST
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define parse-apl
|
|
||||||
(fn (src)
|
|
||||||
(let ((tokens (apl-tokenize src)))
|
|
||||||
(let ((stmt-groups (split-statements tokens)))
|
|
||||||
(if (= (len stmt-groups) 0)
|
|
||||||
nil
|
|
||||||
(if (= (len stmt-groups) 1)
|
|
||||||
(parse-stmt (first stmt-groups))
|
|
||||||
(cons :program (map parse-stmt stmt-groups))))))))
|
|
||||||
@@ -1,349 +0,0 @@
|
|||||||
; APL Runtime — array model + scalar primitives
|
|
||||||
;
|
|
||||||
; Array = SX dict {:shape (d1 d2 ...) :ravel (v1 v2 ...)}
|
|
||||||
; Scalar: rank 0, shape (), one element in ravel
|
|
||||||
; Vector: rank 1, shape (n), n elements in ravel
|
|
||||||
; Matrix: rank 2, shape (r c), r*c elements in ravel
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Array constructors
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define make-array (fn (shape ravel) {:ravel ravel :shape shape}))
|
|
||||||
|
|
||||||
(define apl-scalar (fn (v) {:ravel (list v) :shape (list)}))
|
|
||||||
|
|
||||||
(define apl-vector (fn (elems) {:ravel elems :shape (list (len elems))}))
|
|
||||||
|
|
||||||
; enclose — wrap any value in a rank-0 box
|
|
||||||
(define enclose (fn (v) (apl-scalar v)))
|
|
||||||
|
|
||||||
; disclose — unwrap rank-0 box, returning the first element
|
|
||||||
(define disclose (fn (arr) (first (get arr :ravel))))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Array accessors
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define array-rank (fn (arr) (len (get arr :shape))))
|
|
||||||
|
|
||||||
(define scalar? (fn (arr) (= (len (get arr :shape)) 0)))
|
|
||||||
|
|
||||||
(define array-ref (fn (arr i) (nth (get arr :ravel) i)))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; System variables
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define apl-io 1)
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Broadcast engine
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define
|
|
||||||
broadcast-monadic
|
|
||||||
(fn (f arr) (make-array (get arr :shape) (map f (get arr :ravel)))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
broadcast-dyadic
|
|
||||||
(fn
|
|
||||||
(f a b)
|
|
||||||
(cond
|
|
||||||
((and (scalar? a) (scalar? b))
|
|
||||||
(apl-scalar (f (first (get a :ravel)) (first (get b :ravel)))))
|
|
||||||
((scalar? a)
|
|
||||||
(let
|
|
||||||
((sv (first (get a :ravel))))
|
|
||||||
(make-array
|
|
||||||
(get b :shape)
|
|
||||||
(map (fn (x) (f sv x)) (get b :ravel)))))
|
|
||||||
((scalar? b)
|
|
||||||
(let
|
|
||||||
((sv (first (get b :ravel))))
|
|
||||||
(make-array
|
|
||||||
(get a :shape)
|
|
||||||
(map (fn (x) (f x sv)) (get a :ravel)))))
|
|
||||||
(else
|
|
||||||
(if
|
|
||||||
(equal? (get a :shape) (get b :shape))
|
|
||||||
(make-array (get a :shape) (map f (get a :ravel) (get b :ravel)))
|
|
||||||
(error "length error: shape mismatch"))))))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Arithmetic primitives
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
; Monadic + : identity
|
|
||||||
(define apl-plus-m (fn (a) (broadcast-monadic (fn (x) x) a)))
|
|
||||||
|
|
||||||
; Dyadic +
|
|
||||||
(define apl-add (fn (a b) (broadcast-dyadic (fn (x y) (+ x y)) a b)))
|
|
||||||
|
|
||||||
; Monadic - : negate
|
|
||||||
(define apl-neg-m (fn (a) (broadcast-monadic (fn (x) (- 0 x)) a)))
|
|
||||||
|
|
||||||
; Dyadic -
|
|
||||||
(define apl-sub (fn (a b) (broadcast-dyadic (fn (x y) (- x y)) a b)))
|
|
||||||
|
|
||||||
; Monadic × : signum
|
|
||||||
(define
|
|
||||||
apl-signum
|
|
||||||
(fn
|
|
||||||
(a)
|
|
||||||
(broadcast-monadic
|
|
||||||
(fn (x) (cond ((> x 0) 1) ((< x 0) -1) (else 0)))
|
|
||||||
a)))
|
|
||||||
|
|
||||||
; Dyadic ×
|
|
||||||
(define apl-mul (fn (a b) (broadcast-dyadic (fn (x y) (* x y)) a b)))
|
|
||||||
|
|
||||||
; Monadic ÷ : reciprocal
|
|
||||||
(define apl-recip (fn (a) (broadcast-monadic (fn (x) (/ 1 x)) a)))
|
|
||||||
|
|
||||||
; Dyadic ÷
|
|
||||||
(define apl-div (fn (a b) (broadcast-dyadic (fn (x y) (/ x y)) a b)))
|
|
||||||
|
|
||||||
; Monadic ⌈ : ceiling
|
|
||||||
(define apl-ceil (fn (a) (broadcast-monadic (fn (x) (ceil x)) a)))
|
|
||||||
|
|
||||||
; Dyadic ⌈ : max
|
|
||||||
(define
|
|
||||||
apl-max
|
|
||||||
(fn (a b) (broadcast-dyadic (fn (x y) (if (>= x y) x y)) a b)))
|
|
||||||
|
|
||||||
; Monadic ⌊ : floor
|
|
||||||
(define apl-floor (fn (a) (broadcast-monadic (fn (x) (floor x)) a)))
|
|
||||||
|
|
||||||
; Dyadic ⌊ : min
|
|
||||||
(define
|
|
||||||
apl-min
|
|
||||||
(fn (a b) (broadcast-dyadic (fn (x y) (if (<= x y) x y)) a b)))
|
|
||||||
|
|
||||||
; Monadic * : e^x
|
|
||||||
(define apl-exp (fn (a) (broadcast-monadic (fn (x) (exp x)) a)))
|
|
||||||
|
|
||||||
; Dyadic * : power
|
|
||||||
(define apl-pow (fn (a b) (broadcast-dyadic (fn (x y) (pow x y)) a b)))
|
|
||||||
|
|
||||||
; Monadic ⍟ : natural log
|
|
||||||
(define apl-ln (fn (a) (broadcast-monadic (fn (x) (log x)) a)))
|
|
||||||
|
|
||||||
; Dyadic ⍟ : log base (a⍟b = log base a of b)
|
|
||||||
(define
|
|
||||||
apl-log
|
|
||||||
(fn (a b) (broadcast-dyadic (fn (x y) (/ (log y) (log x))) a b)))
|
|
||||||
|
|
||||||
; Monadic | : absolute value
|
|
||||||
(define
|
|
||||||
apl-abs
|
|
||||||
(fn (a) (broadcast-monadic (fn (x) (if (< x 0) (- 0 x) x)) a)))
|
|
||||||
|
|
||||||
; Dyadic | : modulo (a|b = b mod a)
|
|
||||||
(define
|
|
||||||
apl-mod
|
|
||||||
(fn
|
|
||||||
(a b)
|
|
||||||
(broadcast-dyadic
|
|
||||||
(fn (x y) (if (= x 0) y (- y (* x (floor (/ y x))))))
|
|
||||||
a
|
|
||||||
b)))
|
|
||||||
|
|
||||||
; Monadic ! : factorial
|
|
||||||
(define
|
|
||||||
apl-fact
|
|
||||||
(fn
|
|
||||||
(a)
|
|
||||||
(broadcast-monadic
|
|
||||||
(fn
|
|
||||||
(n)
|
|
||||||
(let
|
|
||||||
((loop nil))
|
|
||||||
(begin
|
|
||||||
(set!
|
|
||||||
loop
|
|
||||||
(fn (i acc) (if (> i n) acc (loop (+ i 1) (* acc i)))))
|
|
||||||
(loop 1 1))))
|
|
||||||
a)))
|
|
||||||
|
|
||||||
; Dyadic ! : binomial coefficient n!k (a=n, b=k => a choose b)
|
|
||||||
(define
|
|
||||||
apl-binomial
|
|
||||||
(fn
|
|
||||||
(a b)
|
|
||||||
(broadcast-dyadic
|
|
||||||
(fn
|
|
||||||
(n k)
|
|
||||||
(let
|
|
||||||
((loop nil))
|
|
||||||
(begin
|
|
||||||
(set!
|
|
||||||
loop
|
|
||||||
(fn
|
|
||||||
(i num den)
|
|
||||||
(if
|
|
||||||
(> i k)
|
|
||||||
(/ num den)
|
|
||||||
(loop (+ i 1) (* num (- (+ n 1) i)) (* den i)))))
|
|
||||||
(loop 1 1 1))))
|
|
||||||
a
|
|
||||||
b)))
|
|
||||||
|
|
||||||
; Monadic ○ : pi times x
|
|
||||||
(define
|
|
||||||
apl-pi-times
|
|
||||||
(fn (a) (broadcast-monadic (fn (x) (* 3.14159 x)) a)))
|
|
||||||
|
|
||||||
; Dyadic ○ : trig functions (a○b, a=code, b=value)
|
|
||||||
(define
|
|
||||||
apl-trig
|
|
||||||
(fn
|
|
||||||
(a b)
|
|
||||||
(broadcast-dyadic
|
|
||||||
(fn
|
|
||||||
(n x)
|
|
||||||
(cond
|
|
||||||
((= n 0) (pow (- 1 (* x x)) 0.5))
|
|
||||||
((= n 1) (sin x))
|
|
||||||
((= n 2) (cos x))
|
|
||||||
((= n 3) (tan x))
|
|
||||||
((= n -1) (asin x))
|
|
||||||
((= n -2) (acos x))
|
|
||||||
((= n -3) (atan x))
|
|
||||||
(else (error "circle: unsupported trig code"))))
|
|
||||||
a
|
|
||||||
b)))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Comparison primitives (return 0 or 1)
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define
|
|
||||||
apl-lt
|
|
||||||
(fn (a b) (broadcast-dyadic (fn (x y) (if (< x y) 1 0)) a b)))
|
|
||||||
|
|
||||||
(define
|
|
||||||
apl-le
|
|
||||||
(fn (a b) (broadcast-dyadic (fn (x y) (if (<= x y) 1 0)) a b)))
|
|
||||||
|
|
||||||
(define
|
|
||||||
apl-eq
|
|
||||||
(fn (a b) (broadcast-dyadic (fn (x y) (if (= x y) 1 0)) a b)))
|
|
||||||
|
|
||||||
(define
|
|
||||||
apl-ge
|
|
||||||
(fn (a b) (broadcast-dyadic (fn (x y) (if (>= x y) 1 0)) a b)))
|
|
||||||
|
|
||||||
(define
|
|
||||||
apl-gt
|
|
||||||
(fn (a b) (broadcast-dyadic (fn (x y) (if (> x y) 1 0)) a b)))
|
|
||||||
|
|
||||||
(define
|
|
||||||
apl-ne
|
|
||||||
(fn (a b) (broadcast-dyadic (fn (x y) (if (= x y) 0 1)) a b)))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Logical primitives
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
; Monadic ~ : logical not
|
|
||||||
(define
|
|
||||||
apl-not
|
|
||||||
(fn (a) (broadcast-monadic (fn (x) (if (= x 0) 1 0)) a)))
|
|
||||||
|
|
||||||
; Dyadic ∧ : logical and
|
|
||||||
(define
|
|
||||||
apl-and
|
|
||||||
(fn
|
|
||||||
(a b)
|
|
||||||
(broadcast-dyadic
|
|
||||||
(fn (x y) (if (and (not (= x 0)) (not (= y 0))) 1 0))
|
|
||||||
a
|
|
||||||
b)))
|
|
||||||
|
|
||||||
; Dyadic ∨ : logical or
|
|
||||||
(define
|
|
||||||
apl-or
|
|
||||||
(fn
|
|
||||||
(a b)
|
|
||||||
(broadcast-dyadic
|
|
||||||
(fn (x y) (if (or (not (= x 0)) (not (= y 0))) 1 0))
|
|
||||||
a
|
|
||||||
b)))
|
|
||||||
|
|
||||||
; Dyadic ⍱ : logical nor
|
|
||||||
(define
|
|
||||||
apl-nor
|
|
||||||
(fn
|
|
||||||
(a b)
|
|
||||||
(broadcast-dyadic
|
|
||||||
(fn (x y) (if (or (not (= x 0)) (not (= y 0))) 0 1))
|
|
||||||
a
|
|
||||||
b)))
|
|
||||||
|
|
||||||
; Dyadic ⍲ : logical nand
|
|
||||||
(define
|
|
||||||
apl-nand
|
|
||||||
(fn
|
|
||||||
(a b)
|
|
||||||
(broadcast-dyadic
|
|
||||||
(fn (x y) (if (and (not (= x 0)) (not (= y 0))) 0 1))
|
|
||||||
a
|
|
||||||
b)))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Shape primitives
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
; Monadic ⍴ : shape — returns shape as a vector array
|
|
||||||
(define apl-shape (fn (arr) (apl-vector (get arr :shape))))
|
|
||||||
|
|
||||||
; Monadic , : ravel — returns a rank-1 vector of all elements
|
|
||||||
(define apl-ravel (fn (arr) (apl-vector (get arr :ravel))))
|
|
||||||
|
|
||||||
; Monadic ≢ : tally — first dimension (1 for scalar)
|
|
||||||
(define
|
|
||||||
apl-tally
|
|
||||||
(fn
|
|
||||||
(arr)
|
|
||||||
(if
|
|
||||||
(scalar? arr)
|
|
||||||
(apl-scalar 1)
|
|
||||||
(apl-scalar (first (get arr :shape))))))
|
|
||||||
|
|
||||||
; Monadic ≡ : depth
|
|
||||||
; simple number/string value → 0
|
|
||||||
; array containing only non-arrays → 0
|
|
||||||
; array containing arrays → 1 + max depth of elements
|
|
||||||
(define
|
|
||||||
apl-depth
|
|
||||||
(fn
|
|
||||||
(arr)
|
|
||||||
(define item-depth nil)
|
|
||||||
(set!
|
|
||||||
item-depth
|
|
||||||
(fn
|
|
||||||
(v)
|
|
||||||
(if
|
|
||||||
(and
|
|
||||||
(dict? v)
|
|
||||||
(not (= nil (get v :shape nil)))
|
|
||||||
(not (= nil (get v :ravel nil))))
|
|
||||||
(+ 1 (first (get (apl-depth v) :ravel)))
|
|
||||||
0)))
|
|
||||||
(let
|
|
||||||
((depths (map item-depth (get arr :ravel))))
|
|
||||||
(apl-scalar (reduce (fn (a b) (if (> a b) a b)) 0 depths)))))
|
|
||||||
|
|
||||||
; Monadic ⍳ : iota — vector 1..n (with ⎕IO=1)
|
|
||||||
(define
|
|
||||||
apl-iota
|
|
||||||
(fn
|
|
||||||
(n-arr)
|
|
||||||
(let
|
|
||||||
((n (first (get n-arr :ravel))) (build nil))
|
|
||||||
(begin
|
|
||||||
(set!
|
|
||||||
build
|
|
||||||
(fn (i acc) (if (< i 1) acc (build (- i 1) (cons i acc)))))
|
|
||||||
(apl-vector (build n (list)))))))
|
|
||||||
@@ -1,340 +0,0 @@
|
|||||||
(define apl-test-count 0)
|
|
||||||
(define apl-test-pass 0)
|
|
||||||
(define apl-test-fails (list))
|
|
||||||
|
|
||||||
(define apl-test
|
|
||||||
(fn (name actual expected)
|
|
||||||
(begin
|
|
||||||
(set! apl-test-count (+ apl-test-count 1))
|
|
||||||
(if (= actual expected)
|
|
||||||
(set! apl-test-pass (+ apl-test-pass 1))
|
|
||||||
(append! apl-test-fails {:name name :actual actual :expected expected})))))
|
|
||||||
|
|
||||||
(define tok-types
|
|
||||||
(fn (src)
|
|
||||||
(map (fn (t) (get t :type)) (apl-tokenize src))))
|
|
||||||
|
|
||||||
(define tok-values
|
|
||||||
(fn (src)
|
|
||||||
(map (fn (t) (get t :value)) (apl-tokenize src))))
|
|
||||||
|
|
||||||
(define tok-count
|
|
||||||
(fn (src)
|
|
||||||
(len (apl-tokenize src))))
|
|
||||||
|
|
||||||
(define tok-type-at
|
|
||||||
(fn (src i)
|
|
||||||
(get (nth (apl-tokenize src) i) :type)))
|
|
||||||
|
|
||||||
(define tok-value-at
|
|
||||||
(fn (src i)
|
|
||||||
(get (nth (apl-tokenize src) i) :value)))
|
|
||||||
|
|
||||||
(apl-test "empty: no tokens" (tok-count "") 0)
|
|
||||||
(apl-test "empty: whitespace only" (tok-count " ") 0)
|
|
||||||
(apl-test "num: zero" (tok-values "0") (list 0))
|
|
||||||
(apl-test "num: positive" (tok-values "42") (list 42))
|
|
||||||
(apl-test "num: large" (tok-values "12345") (list 12345))
|
|
||||||
(apl-test "num: negative" (tok-values "¯5") (list -5))
|
|
||||||
(apl-test "num: negative zero" (tok-values "¯0") (list 0))
|
|
||||||
(apl-test "num: strand count" (tok-count "1 2 3") 3)
|
|
||||||
(apl-test "num: strand types" (tok-types "1 2 3") (list :num :num :num))
|
|
||||||
(apl-test "num: strand values" (tok-values "1 2 3") (list 1 2 3))
|
|
||||||
(apl-test "num: neg in strand" (tok-values "1 ¯2 3") (list 1 -2 3))
|
|
||||||
(apl-test "str: empty" (tok-values "''") (list ""))
|
|
||||||
(apl-test "str: single char" (tok-values "'a'") (list "a"))
|
|
||||||
(apl-test "str: word" (tok-values "'hello'") (list "hello"))
|
|
||||||
(apl-test "str: escaped quote" (tok-values "''''") (list "'"))
|
|
||||||
(apl-test "str: type" (tok-types "'abc'") (list :str))
|
|
||||||
(apl-test "name: simple" (tok-values "foo") (list "foo"))
|
|
||||||
(apl-test "name: type" (tok-types "foo") (list :name))
|
|
||||||
(apl-test "name: mixed case" (tok-values "MyVar") (list "MyVar"))
|
|
||||||
(apl-test "name: with digits" (tok-values "x1") (list "x1"))
|
|
||||||
(apl-test "name: system var" (tok-values "⎕IO") (list "⎕IO"))
|
|
||||||
(apl-test "name: system var type" (tok-types "⎕IO") (list :name))
|
|
||||||
(apl-test "glyph: plus" (tok-types "+") (list :glyph))
|
|
||||||
(apl-test "glyph: plus value" (tok-values "+") (list "+"))
|
|
||||||
(apl-test "glyph: iota" (tok-values "⍳") (list "⍳"))
|
|
||||||
(apl-test "glyph: reduce" (tok-values "+/") (list "+" "/"))
|
|
||||||
(apl-test "glyph: floor" (tok-values "⌊") (list "⌊"))
|
|
||||||
(apl-test "glyph: rho" (tok-values "⍴") (list "⍴"))
|
|
||||||
(apl-test "glyph: alpha omega" (tok-types "⍺ ⍵") (list :glyph :glyph))
|
|
||||||
(apl-test "punct: lparen" (tok-types "(") (list :lparen))
|
|
||||||
(apl-test "punct: rparen" (tok-types ")") (list :rparen))
|
|
||||||
(apl-test "punct: brackets" (tok-types "[42]") (list :lbracket :num :rbracket))
|
|
||||||
(apl-test "punct: braces" (tok-types "{}") (list :lbrace :rbrace))
|
|
||||||
(apl-test "punct: semi" (tok-types ";") (list :semi))
|
|
||||||
(apl-test "assign: arrow" (tok-types "x←1") (list :name :assign :num))
|
|
||||||
(apl-test "diamond: separator" (tok-types "1⋄2") (list :num :diamond :num))
|
|
||||||
(apl-test "newline: emitted" (tok-types "1\n2") (list :num :newline :num))
|
|
||||||
(apl-test "comment: skipped" (tok-count "⍝ ignore me") 0)
|
|
||||||
(apl-test "comment: rest ignored" (tok-count "1 ⍝ note") 1)
|
|
||||||
(apl-test "colon: bare" (tok-types ":") (list :colon))
|
|
||||||
(apl-test "keyword: If" (tok-values ":If") (list ":If"))
|
|
||||||
(apl-test "keyword: type" (tok-types ":While") (list :keyword))
|
|
||||||
(apl-test "keyword: EndFor" (tok-values ":EndFor") (list ":EndFor"))
|
|
||||||
(apl-test "expr: +/ ⍳ 5" (tok-types "+/ ⍳ 5") (list :glyph :glyph :glyph :num))
|
|
||||||
(apl-test "expr: x←42" (tok-count "x←42") 3)
|
|
||||||
(apl-test "expr: dfn body" (tok-types "{⍺+⍵}")
|
|
||||||
(list :lbrace :glyph :glyph :glyph :rbrace))
|
|
||||||
|
|
||||||
(define apl-tokenize-test-summary
|
|
||||||
(str "tokenizer " apl-test-pass "/" apl-test-count
|
|
||||||
(if (= (len apl-test-fails) 0) "" (str " FAILS: " apl-test-fails))))
|
|
||||||
|
|
||||||
; ===========================================================================
|
|
||||||
; Parser tests
|
|
||||||
; ===========================================================================
|
|
||||||
|
|
||||||
; Helper: parse an APL source string and return the AST
|
|
||||||
(define parse
|
|
||||||
(fn (src) (parse-apl src)))
|
|
||||||
|
|
||||||
; Helper: build an expected AST node using keyword-tagged lists
|
|
||||||
(define num-node (fn (n) (list :num n)))
|
|
||||||
(define str-node (fn (s) (list :str s)))
|
|
||||||
(define name-node (fn (n) (list :name n)))
|
|
||||||
(define fn-node (fn (g) (list :fn-glyph g)))
|
|
||||||
(define fn-nm (fn (n) (list :fn-name n)))
|
|
||||||
(define assign-node (fn (nm expr) (list :assign nm expr)))
|
|
||||||
(define monad-node (fn (f a) (list :monad f a)))
|
|
||||||
(define dyad-node (fn (f l r) (list :dyad f l r)))
|
|
||||||
(define derived-fn (fn (op f) (list :derived-fn op f)))
|
|
||||||
(define derived-fn2 (fn (op f g) (list :derived-fn2 op f g)))
|
|
||||||
(define outer-node (fn (f) (list :outer "∘." f)))
|
|
||||||
(define guard-node (fn (c e) (list :guard c e)))
|
|
||||||
|
|
||||||
; ---- numeric literals ----
|
|
||||||
|
|
||||||
(apl-test "parse: num literal"
|
|
||||||
(parse "42")
|
|
||||||
(num-node 42))
|
|
||||||
|
|
||||||
(apl-test "parse: negative num"
|
|
||||||
(parse "¯3")
|
|
||||||
(num-node -3))
|
|
||||||
|
|
||||||
(apl-test "parse: zero"
|
|
||||||
(parse "0")
|
|
||||||
(num-node 0))
|
|
||||||
|
|
||||||
; ---- string literals ----
|
|
||||||
|
|
||||||
(apl-test "parse: str literal"
|
|
||||||
(parse "'hello'")
|
|
||||||
(str-node "hello"))
|
|
||||||
|
|
||||||
(apl-test "parse: empty str"
|
|
||||||
(parse "''")
|
|
||||||
(str-node ""))
|
|
||||||
|
|
||||||
; ---- name reference ----
|
|
||||||
|
|
||||||
(apl-test "parse: name"
|
|
||||||
(parse "x")
|
|
||||||
(name-node "x"))
|
|
||||||
|
|
||||||
(apl-test "parse: system name"
|
|
||||||
(parse "⎕IO")
|
|
||||||
(name-node "⎕IO"))
|
|
||||||
|
|
||||||
; ---- strands (vec nodes) ----
|
|
||||||
|
|
||||||
(apl-test "parse: strand 3 nums"
|
|
||||||
(parse "1 2 3")
|
|
||||||
(list :vec (num-node 1) (num-node 2) (num-node 3)))
|
|
||||||
|
|
||||||
(apl-test "parse: strand 2 nums"
|
|
||||||
(parse "1 2")
|
|
||||||
(list :vec (num-node 1) (num-node 2)))
|
|
||||||
|
|
||||||
(apl-test "parse: strand with negatives"
|
|
||||||
(parse "1 ¯2 3")
|
|
||||||
(list :vec (num-node 1) (num-node -2) (num-node 3)))
|
|
||||||
|
|
||||||
; ---- assignment ----
|
|
||||||
|
|
||||||
(apl-test "parse: assignment"
|
|
||||||
(parse "x←42")
|
|
||||||
(assign-node "x" (num-node 42)))
|
|
||||||
|
|
||||||
(apl-test "parse: assignment with spaces"
|
|
||||||
(parse "x ← 42")
|
|
||||||
(assign-node "x" (num-node 42)))
|
|
||||||
|
|
||||||
(apl-test "parse: assignment of expr"
|
|
||||||
(parse "r←2+3")
|
|
||||||
(assign-node "r" (dyad-node (fn-node "+") (num-node 2) (num-node 3))))
|
|
||||||
|
|
||||||
; ---- monadic functions ----
|
|
||||||
|
|
||||||
(apl-test "parse: monadic iota"
|
|
||||||
(parse "⍳5")
|
|
||||||
(monad-node (fn-node "⍳") (num-node 5)))
|
|
||||||
|
|
||||||
(apl-test "parse: monadic iota with space"
|
|
||||||
(parse "⍳ 5")
|
|
||||||
(monad-node (fn-node "⍳") (num-node 5)))
|
|
||||||
|
|
||||||
(apl-test "parse: monadic negate"
|
|
||||||
(parse "-3")
|
|
||||||
(monad-node (fn-node "-") (num-node 3)))
|
|
||||||
|
|
||||||
(apl-test "parse: monadic floor"
|
|
||||||
(parse "⌊2")
|
|
||||||
(monad-node (fn-node "⌊") (num-node 2)))
|
|
||||||
|
|
||||||
(apl-test "parse: monadic of name"
|
|
||||||
(parse "⍴x")
|
|
||||||
(monad-node (fn-node "⍴") (name-node "x")))
|
|
||||||
|
|
||||||
; ---- dyadic functions ----
|
|
||||||
|
|
||||||
(apl-test "parse: dyadic plus"
|
|
||||||
(parse "2+3")
|
|
||||||
(dyad-node (fn-node "+") (num-node 2) (num-node 3)))
|
|
||||||
|
|
||||||
(apl-test "parse: dyadic times"
|
|
||||||
(parse "2×3")
|
|
||||||
(dyad-node (fn-node "×") (num-node 2) (num-node 3)))
|
|
||||||
|
|
||||||
(apl-test "parse: dyadic with names"
|
|
||||||
(parse "x+y")
|
|
||||||
(dyad-node (fn-node "+") (name-node "x") (name-node "y")))
|
|
||||||
|
|
||||||
; ---- right-to-left evaluation ----
|
|
||||||
|
|
||||||
(apl-test "parse: right-to-left 2×3+4"
|
|
||||||
(parse "2×3+4")
|
|
||||||
(dyad-node (fn-node "×") (num-node 2)
|
|
||||||
(dyad-node (fn-node "+") (num-node 3) (num-node 4))))
|
|
||||||
|
|
||||||
(apl-test "parse: right-to-left chain"
|
|
||||||
(parse "1+2×3-4")
|
|
||||||
(dyad-node (fn-node "+") (num-node 1)
|
|
||||||
(dyad-node (fn-node "×") (num-node 2)
|
|
||||||
(dyad-node (fn-node "-") (num-node 3) (num-node 4)))))
|
|
||||||
|
|
||||||
; ---- parenthesized subexpressions ----
|
|
||||||
|
|
||||||
(apl-test "parse: parens override order"
|
|
||||||
(parse "(2+3)×4")
|
|
||||||
(dyad-node (fn-node "×")
|
|
||||||
(dyad-node (fn-node "+") (num-node 2) (num-node 3))
|
|
||||||
(num-node 4)))
|
|
||||||
|
|
||||||
(apl-test "parse: nested parens"
|
|
||||||
(parse "((2+3))")
|
|
||||||
(dyad-node (fn-node "+") (num-node 2) (num-node 3)))
|
|
||||||
|
|
||||||
(apl-test "parse: paren in dyadic right"
|
|
||||||
(parse "2×(3+4)")
|
|
||||||
(dyad-node (fn-node "×") (num-node 2)
|
|
||||||
(dyad-node (fn-node "+") (num-node 3) (num-node 4))))
|
|
||||||
|
|
||||||
; ---- operators → derived functions ----
|
|
||||||
|
|
||||||
(apl-test "parse: reduce +"
|
|
||||||
(parse "+/x")
|
|
||||||
(monad-node (derived-fn "/" (fn-node "+")) (name-node "x")))
|
|
||||||
|
|
||||||
(apl-test "parse: reduce iota"
|
|
||||||
(parse "+/⍳5")
|
|
||||||
(monad-node (derived-fn "/" (fn-node "+"))
|
|
||||||
(monad-node (fn-node "⍳") (num-node 5))))
|
|
||||||
|
|
||||||
(apl-test "parse: scan"
|
|
||||||
(parse "+\\x")
|
|
||||||
(monad-node (derived-fn "\\" (fn-node "+")) (name-node "x")))
|
|
||||||
|
|
||||||
(apl-test "parse: each"
|
|
||||||
(parse "⍳¨x")
|
|
||||||
(monad-node (derived-fn "¨" (fn-node "⍳")) (name-node "x")))
|
|
||||||
|
|
||||||
(apl-test "parse: commute"
|
|
||||||
(parse "-⍨3")
|
|
||||||
(monad-node (derived-fn "⍨" (fn-node "-")) (num-node 3)))
|
|
||||||
|
|
||||||
(apl-test "parse: stacked ops"
|
|
||||||
(parse "+/¨x")
|
|
||||||
(monad-node (derived-fn "¨" (derived-fn "/" (fn-node "+"))) (name-node "x")))
|
|
||||||
|
|
||||||
; ---- outer product ----
|
|
||||||
|
|
||||||
(apl-test "parse: outer product monadic"
|
|
||||||
(parse "∘.×")
|
|
||||||
(outer-node (fn-node "×")))
|
|
||||||
|
|
||||||
(apl-test "parse: outer product dyadic names"
|
|
||||||
(parse "x ∘.× y")
|
|
||||||
(dyad-node (outer-node (fn-node "×")) (name-node "x") (name-node "y")))
|
|
||||||
|
|
||||||
(apl-test "parse: outer product dyadic strands"
|
|
||||||
(parse "1 2 3 ∘.× 4 5 6")
|
|
||||||
(dyad-node (outer-node (fn-node "×"))
|
|
||||||
(list :vec (num-node 1) (num-node 2) (num-node 3))
|
|
||||||
(list :vec (num-node 4) (num-node 5) (num-node 6))))
|
|
||||||
|
|
||||||
; ---- inner product ----
|
|
||||||
|
|
||||||
(apl-test "parse: inner product"
|
|
||||||
(parse "+.×")
|
|
||||||
(derived-fn2 "." (fn-node "+") (fn-node "×")))
|
|
||||||
|
|
||||||
(apl-test "parse: inner product applied"
|
|
||||||
(parse "a +.× b")
|
|
||||||
(dyad-node (derived-fn2 "." (fn-node "+") (fn-node "×"))
|
|
||||||
(name-node "a") (name-node "b")))
|
|
||||||
|
|
||||||
; ---- dfn (anonymous function) ----
|
|
||||||
|
|
||||||
(apl-test "parse: simple dfn"
|
|
||||||
(parse "{⍺+⍵}")
|
|
||||||
(list :dfn (dyad-node (fn-node "+") (name-node "⍺") (name-node "⍵"))))
|
|
||||||
|
|
||||||
(apl-test "parse: monadic dfn"
|
|
||||||
(parse "{⍵×2}")
|
|
||||||
(list :dfn (dyad-node (fn-node "×") (name-node "⍵") (num-node 2))))
|
|
||||||
|
|
||||||
(apl-test "parse: dfn self-ref"
|
|
||||||
(parse "{⍵≤1:1 ⋄ ⍵×∇ ⍵-1}")
|
|
||||||
(list :dfn
|
|
||||||
(guard-node (dyad-node (fn-node "≤") (name-node "⍵") (num-node 1)) (num-node 1))
|
|
||||||
(dyad-node (fn-node "×") (name-node "⍵")
|
|
||||||
(monad-node (fn-node "∇") (dyad-node (fn-node "-") (name-node "⍵") (num-node 1))))))
|
|
||||||
|
|
||||||
; ---- dfn applied ----
|
|
||||||
|
|
||||||
(apl-test "parse: dfn as function"
|
|
||||||
(parse "{⍺+⍵} 3")
|
|
||||||
(monad-node
|
|
||||||
(list :dfn (dyad-node (fn-node "+") (name-node "⍺") (name-node "⍵")))
|
|
||||||
(num-node 3)))
|
|
||||||
|
|
||||||
; ---- multi-statement ----
|
|
||||||
|
|
||||||
(apl-test "parse: diamond separator"
|
|
||||||
(let ((result (parse "x←1 ⋄ x+2")))
|
|
||||||
(= (first result) :program))
|
|
||||||
true)
|
|
||||||
|
|
||||||
(apl-test "parse: diamond first stmt"
|
|
||||||
(let ((result (parse "x←1 ⋄ x+2")))
|
|
||||||
(nth result 1))
|
|
||||||
(assign-node "x" (num-node 1)))
|
|
||||||
|
|
||||||
(apl-test "parse: diamond second stmt"
|
|
||||||
(let ((result (parse "x←1 ⋄ x+2")))
|
|
||||||
(nth result 2))
|
|
||||||
(dyad-node (fn-node "+") (name-node "x") (num-node 2)))
|
|
||||||
|
|
||||||
; ---- combined summary ----
|
|
||||||
|
|
||||||
(define apl-parse-test-count (- apl-test-count 46))
|
|
||||||
(define apl-parse-test-pass (- apl-test-pass 46))
|
|
||||||
|
|
||||||
(define apl-test-summary
|
|
||||||
(str
|
|
||||||
"tokenizer 46/46 | "
|
|
||||||
"parser " apl-parse-test-pass "/" apl-parse-test-count
|
|
||||||
(if (= (len apl-test-fails) 0) "" (str " FAILS: " apl-test-fails))))
|
|
||||||
@@ -1,369 +0,0 @@
|
|||||||
; APL scalar primitives test suite
|
|
||||||
; Requires: lib/apl/runtime.sx
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Test framework
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define apl-rt-count 0)
|
|
||||||
(define apl-rt-pass 0)
|
|
||||||
(define apl-rt-fails (list))
|
|
||||||
|
|
||||||
; Element-wise list comparison (handles both List and ListRef)
|
|
||||||
(define
|
|
||||||
lists-eq
|
|
||||||
(fn
|
|
||||||
(a b)
|
|
||||||
(if
|
|
||||||
(and (= (len a) 0) (= (len b) 0))
|
|
||||||
true
|
|
||||||
(if
|
|
||||||
(not (= (len a) (len b)))
|
|
||||||
false
|
|
||||||
(if
|
|
||||||
(not (= (first a) (first b)))
|
|
||||||
false
|
|
||||||
(lists-eq (rest a) (rest b)))))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
apl-rt-test
|
|
||||||
(fn
|
|
||||||
(name actual expected)
|
|
||||||
(begin
|
|
||||||
(set! apl-rt-count (+ apl-rt-count 1))
|
|
||||||
(if
|
|
||||||
(equal? actual expected)
|
|
||||||
(set! apl-rt-pass (+ apl-rt-pass 1))
|
|
||||||
(append! apl-rt-fails {:actual actual :expected expected :name name})))))
|
|
||||||
|
|
||||||
; Test that a ravel equals a plain list (handles ListRef vs List)
|
|
||||||
(define
|
|
||||||
ravel-test
|
|
||||||
(fn
|
|
||||||
(name arr expected-list)
|
|
||||||
(begin
|
|
||||||
(set! apl-rt-count (+ apl-rt-count 1))
|
|
||||||
(let
|
|
||||||
((actual (get arr :ravel)))
|
|
||||||
(if
|
|
||||||
(lists-eq actual expected-list)
|
|
||||||
(set! apl-rt-pass (+ apl-rt-pass 1))
|
|
||||||
(append! apl-rt-fails {:actual actual :expected expected-list :name name}))))))
|
|
||||||
|
|
||||||
; Test a scalar ravel value (single-element list)
|
|
||||||
(define
|
|
||||||
scalar-test
|
|
||||||
(fn (name arr expected-val) (ravel-test name arr (list expected-val))))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Array constructor tests
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(apl-rt-test
|
|
||||||
"scalar: shape is empty list"
|
|
||||||
(get (apl-scalar 5) :shape)
|
|
||||||
(list))
|
|
||||||
|
|
||||||
(apl-rt-test
|
|
||||||
"scalar: ravel has one element"
|
|
||||||
(get (apl-scalar 5) :ravel)
|
|
||||||
(list 5))
|
|
||||||
|
|
||||||
(apl-rt-test "scalar: rank 0" (array-rank (apl-scalar 5)) 0)
|
|
||||||
|
|
||||||
(apl-rt-test "scalar? returns true for scalar" (scalar? (apl-scalar 5)) true)
|
|
||||||
|
|
||||||
(apl-rt-test "scalar: zero" (get (apl-scalar 0) :ravel) (list 0))
|
|
||||||
|
|
||||||
(apl-rt-test
|
|
||||||
"vector: shape is (3)"
|
|
||||||
(get (apl-vector (list 1 2 3)) :shape)
|
|
||||||
(list 3))
|
|
||||||
|
|
||||||
(apl-rt-test
|
|
||||||
"vector: ravel matches input"
|
|
||||||
(get (apl-vector (list 1 2 3)) :ravel)
|
|
||||||
(list 1 2 3))
|
|
||||||
|
|
||||||
(apl-rt-test "vector: rank 1" (array-rank (apl-vector (list 1 2 3))) 1)
|
|
||||||
|
|
||||||
(apl-rt-test
|
|
||||||
"scalar? returns false for vector"
|
|
||||||
(scalar? (apl-vector (list 1 2 3)))
|
|
||||||
false)
|
|
||||||
|
|
||||||
(apl-rt-test
|
|
||||||
"make-array: rank 2"
|
|
||||||
(array-rank (make-array (list 2 3) (list 1 2 3 4 5 6)))
|
|
||||||
2)
|
|
||||||
|
|
||||||
(apl-rt-test
|
|
||||||
"make-array: shape"
|
|
||||||
(get (make-array (list 2 3) (list 1 2 3 4 5 6)) :shape)
|
|
||||||
(list 2 3))
|
|
||||||
|
|
||||||
(apl-rt-test
|
|
||||||
"array-ref: first element"
|
|
||||||
(array-ref (apl-vector (list 10 20 30)) 0)
|
|
||||||
10)
|
|
||||||
|
|
||||||
(apl-rt-test
|
|
||||||
"array-ref: last element"
|
|
||||||
(array-ref (apl-vector (list 10 20 30)) 2)
|
|
||||||
30)
|
|
||||||
|
|
||||||
(apl-rt-test "enclose: wraps in rank-0" (scalar? (enclose 42)) true)
|
|
||||||
|
|
||||||
(apl-rt-test
|
|
||||||
"enclose: ravel contains value"
|
|
||||||
(get (enclose 42) :ravel)
|
|
||||||
(list 42))
|
|
||||||
|
|
||||||
(apl-rt-test "disclose: unwraps rank-0" (disclose (enclose 42)) 42)
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Shape primitive tests
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(ravel-test "⍴ scalar: returns empty" (apl-shape (apl-scalar 5)) (list))
|
|
||||||
|
|
||||||
(ravel-test
|
|
||||||
"⍴ vector: returns (3)"
|
|
||||||
(apl-shape (apl-vector (list 1 2 3)))
|
|
||||||
(list 3))
|
|
||||||
|
|
||||||
(ravel-test
|
|
||||||
"⍴ matrix: returns (2 3)"
|
|
||||||
(apl-shape (make-array (list 2 3) (list 1 2 3 4 5 6)))
|
|
||||||
(list 2 3))
|
|
||||||
|
|
||||||
(ravel-test
|
|
||||||
", ravel scalar: vector of 1"
|
|
||||||
(apl-ravel (apl-scalar 5))
|
|
||||||
(list 5))
|
|
||||||
|
|
||||||
(apl-rt-test
|
|
||||||
", ravel vector: same elements"
|
|
||||||
(get (apl-ravel (apl-vector (list 1 2 3))) :ravel)
|
|
||||||
(list 1 2 3))
|
|
||||||
|
|
||||||
(apl-rt-test
|
|
||||||
", ravel matrix: all elements"
|
|
||||||
(get (apl-ravel (make-array (list 2 3) (list 1 2 3 4 5 6))) :ravel)
|
|
||||||
(list 1 2 3 4 5 6))
|
|
||||||
|
|
||||||
(scalar-test "≢ tally scalar: 1" (apl-tally (apl-scalar 5)) 1)
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"≢ tally vector: first dimension"
|
|
||||||
(apl-tally (apl-vector (list 1 2 3)))
|
|
||||||
3)
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"≢ tally matrix: first dimension"
|
|
||||||
(apl-tally (make-array (list 2 3) (list 1 2 3 4 5 6)))
|
|
||||||
2)
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"≡ depth flat vector: 0"
|
|
||||||
(apl-depth (apl-vector (list 1 2 3)))
|
|
||||||
0)
|
|
||||||
|
|
||||||
(scalar-test "≡ depth scalar: 0" (apl-depth (apl-scalar 5)) 0)
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"≡ depth nested (enclose in vector): 1"
|
|
||||||
(apl-depth (enclose (apl-vector (list 1 2 3))))
|
|
||||||
1)
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; ⍳ iota tests
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(apl-rt-test
|
|
||||||
"⍳5 shape is (5)"
|
|
||||||
(get (apl-iota (apl-scalar 5)) :shape)
|
|
||||||
(list 5))
|
|
||||||
|
|
||||||
(ravel-test "⍳5 ravel is 1..5" (apl-iota (apl-scalar 5)) (list 1 2 3 4 5))
|
|
||||||
|
|
||||||
(ravel-test "⍳1 ravel is (1)" (apl-iota (apl-scalar 1)) (list 1))
|
|
||||||
|
|
||||||
(ravel-test "⍳0 ravel is empty" (apl-iota (apl-scalar 0)) (list))
|
|
||||||
|
|
||||||
(apl-rt-test "apl-io is 1" apl-io 1)
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Arithmetic broadcast tests
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"+ scalar scalar: 3+4=7"
|
|
||||||
(apl-add (apl-scalar 3) (apl-scalar 4))
|
|
||||||
7)
|
|
||||||
|
|
||||||
(ravel-test
|
|
||||||
"+ vector scalar: +10"
|
|
||||||
(apl-add (apl-vector (list 1 2 3)) (apl-scalar 10))
|
|
||||||
(list 11 12 13))
|
|
||||||
|
|
||||||
(ravel-test
|
|
||||||
"+ scalar vector: 10+"
|
|
||||||
(apl-add (apl-scalar 10) (apl-vector (list 1 2 3)))
|
|
||||||
(list 11 12 13))
|
|
||||||
|
|
||||||
(ravel-test
|
|
||||||
"+ vector vector"
|
|
||||||
(apl-add (apl-vector (list 1 2 3)) (apl-vector (list 4 5 6)))
|
|
||||||
(list 5 7 9))
|
|
||||||
|
|
||||||
(scalar-test "- negate monadic" (apl-neg-m (apl-scalar 5)) -5)
|
|
||||||
|
|
||||||
(scalar-test "- dyadic 10-3=7" (apl-sub (apl-scalar 10) (apl-scalar 3)) 7)
|
|
||||||
|
|
||||||
(scalar-test "× signum positive" (apl-signum (apl-scalar 7)) 1)
|
|
||||||
|
|
||||||
(scalar-test "× signum negative" (apl-signum (apl-scalar -3)) -1)
|
|
||||||
|
|
||||||
(scalar-test "× signum zero" (apl-signum (apl-scalar 0)) 0)
|
|
||||||
|
|
||||||
(scalar-test "× dyadic 3×4=12" (apl-mul (apl-scalar 3) (apl-scalar 4)) 12)
|
|
||||||
|
|
||||||
(scalar-test "÷ reciprocal 1÷4=0.25" (apl-recip (apl-scalar 4)) 0.25)
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"÷ dyadic 10÷4=2.5"
|
|
||||||
(apl-div (apl-scalar 10) (apl-scalar 4))
|
|
||||||
2.5)
|
|
||||||
|
|
||||||
(scalar-test "⌈ ceiling 2.3→3" (apl-ceil (apl-scalar 2.3)) 3)
|
|
||||||
|
|
||||||
(scalar-test "⌈ max 3 5 → 5" (apl-max (apl-scalar 3) (apl-scalar 5)) 5)
|
|
||||||
|
|
||||||
(scalar-test "⌊ floor 2.7→2" (apl-floor (apl-scalar 2.7)) 2)
|
|
||||||
|
|
||||||
(scalar-test "⌊ min 3 5 → 3" (apl-min (apl-scalar 3) (apl-scalar 5)) 3)
|
|
||||||
|
|
||||||
(scalar-test "* exp monadic e^0=1" (apl-exp (apl-scalar 0)) 1)
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"* pow dyadic 2^10=1024"
|
|
||||||
(apl-pow (apl-scalar 2) (apl-scalar 10))
|
|
||||||
1024)
|
|
||||||
|
|
||||||
(scalar-test "⍟ ln 1=0" (apl-ln (apl-scalar 1)) 0)
|
|
||||||
|
|
||||||
(scalar-test "| abs positive" (apl-abs (apl-scalar 5)) 5)
|
|
||||||
|
|
||||||
(scalar-test "| abs negative" (apl-abs (apl-scalar -5)) 5)
|
|
||||||
|
|
||||||
(scalar-test "| mod 3|7=1" (apl-mod (apl-scalar 3) (apl-scalar 7)) 1)
|
|
||||||
|
|
||||||
(scalar-test "! factorial 5!=120" (apl-fact (apl-scalar 5)) 120)
|
|
||||||
|
|
||||||
(scalar-test "! factorial 0!=1" (apl-fact (apl-scalar 0)) 1)
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"! binomial 4 choose 2 = 6"
|
|
||||||
(apl-binomial (apl-scalar 4) (apl-scalar 2))
|
|
||||||
6)
|
|
||||||
|
|
||||||
(scalar-test "○ pi×0=0" (apl-pi-times (apl-scalar 0)) 0)
|
|
||||||
|
|
||||||
(scalar-test "○ trig sin(0)=0" (apl-trig (apl-scalar 1) (apl-scalar 0)) 0)
|
|
||||||
|
|
||||||
(scalar-test "○ trig cos(0)=1" (apl-trig (apl-scalar 2) (apl-scalar 0)) 1)
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Comparison tests
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(scalar-test "< less: 3<5 → 1" (apl-lt (apl-scalar 3) (apl-scalar 5)) 1)
|
|
||||||
|
|
||||||
(scalar-test "< less: 5<3 → 0" (apl-lt (apl-scalar 5) (apl-scalar 3)) 0)
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"≤ le equal: 3≤3 → 1"
|
|
||||||
(apl-le (apl-scalar 3) (apl-scalar 3))
|
|
||||||
1)
|
|
||||||
|
|
||||||
(scalar-test "= eq: 5=5 → 1" (apl-eq (apl-scalar 5) (apl-scalar 5)) 1)
|
|
||||||
|
|
||||||
(scalar-test "= ne: 5=6 → 0" (apl-eq (apl-scalar 5) (apl-scalar 6)) 0)
|
|
||||||
|
|
||||||
(scalar-test "≥ ge: 5≥3 → 1" (apl-ge (apl-scalar 5) (apl-scalar 3)) 1)
|
|
||||||
|
|
||||||
(scalar-test "> gt: 5>3 → 1" (apl-gt (apl-scalar 5) (apl-scalar 3)) 1)
|
|
||||||
|
|
||||||
(scalar-test "≠ ne: 5≠3 → 1" (apl-ne (apl-scalar 5) (apl-scalar 3)) 1)
|
|
||||||
|
|
||||||
(ravel-test
|
|
||||||
"comparison vector broadcast: 1 2 3 < 2 → 1 0 0"
|
|
||||||
(apl-lt (apl-vector (list 1 2 3)) (apl-scalar 2))
|
|
||||||
(list 1 0 0))
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Logical tests
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(scalar-test "~ not 0 → 1" (apl-not (apl-scalar 0)) 1)
|
|
||||||
|
|
||||||
(scalar-test "~ not 1 → 0" (apl-not (apl-scalar 1)) 0)
|
|
||||||
|
|
||||||
(ravel-test
|
|
||||||
"~ not vector: 1 0 1 0 → 0 1 0 1"
|
|
||||||
(apl-not (apl-vector (list 1 0 1 0)))
|
|
||||||
(list 0 1 0 1))
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"∧ and 1∧1 → 1"
|
|
||||||
(apl-and (apl-scalar 1) (apl-scalar 1))
|
|
||||||
1)
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"∧ and 1∧0 → 0"
|
|
||||||
(apl-and (apl-scalar 1) (apl-scalar 0))
|
|
||||||
0)
|
|
||||||
|
|
||||||
(scalar-test "∨ or 0∨1 → 1" (apl-or (apl-scalar 0) (apl-scalar 1)) 1)
|
|
||||||
|
|
||||||
(scalar-test "∨ or 0∨0 → 0" (apl-or (apl-scalar 0) (apl-scalar 0)) 0)
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"⍱ nor 0⍱0 → 1"
|
|
||||||
(apl-nor (apl-scalar 0) (apl-scalar 0))
|
|
||||||
1)
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"⍱ nor 1⍱0 → 0"
|
|
||||||
(apl-nor (apl-scalar 1) (apl-scalar 0))
|
|
||||||
0)
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"⍲ nand 1⍲1 → 0"
|
|
||||||
(apl-nand (apl-scalar 1) (apl-scalar 1))
|
|
||||||
0)
|
|
||||||
|
|
||||||
(scalar-test
|
|
||||||
"⍲ nand 1⍲0 → 1"
|
|
||||||
(apl-nand (apl-scalar 1) (apl-scalar 0))
|
|
||||||
1)
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; plus-m identity test
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(scalar-test "+ monadic identity: +5 → 5" (apl-plus-m (apl-scalar 5)) 5)
|
|
||||||
|
|
||||||
; ============================================================
|
|
||||||
; Summary
|
|
||||||
; ============================================================
|
|
||||||
|
|
||||||
(define
|
|
||||||
apl-scalar-summary
|
|
||||||
(str
|
|
||||||
"scalar "
|
|
||||||
apl-rt-pass
|
|
||||||
"/"
|
|
||||||
apl-rt-count
|
|
||||||
(if (= (len apl-rt-fails) 0) "" (str " FAILS: " apl-rt-fails))))
|
|
||||||
@@ -1,168 +0,0 @@
|
|||||||
(define apl-glyph-set
|
|
||||||
(list "+" "-" "×" "÷" "*" "⍟" "⌈" "⌊" "|" "!" "?" "○" "~" "<" "≤" "=" "≥" ">" "≠"
|
|
||||||
"∊" "∧" "∨" "⍱" "⍲" "," "⍪" "⍴" "⌽" "⊖" "⍉" "↑" "↓" "⊂" "⊃" "⊆"
|
|
||||||
"∪" "∩" "⍳" "⍸" "⌷" "⍋" "⍒" "⊥" "⊤" "⊣" "⊢" "⍎" "⍕"
|
|
||||||
"⍺" "⍵" "∇" "/" "\\" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@" "¯"))
|
|
||||||
|
|
||||||
(define apl-glyph?
|
|
||||||
(fn (ch)
|
|
||||||
(some (fn (g) (= g ch)) apl-glyph-set)))
|
|
||||||
|
|
||||||
(define apl-digit?
|
|
||||||
(fn (ch)
|
|
||||||
(and (string? ch) (>= ch "0") (<= ch "9"))))
|
|
||||||
|
|
||||||
(define apl-alpha?
|
|
||||||
(fn (ch)
|
|
||||||
(and (string? ch)
|
|
||||||
(or (and (>= ch "a") (<= ch "z"))
|
|
||||||
(and (>= ch "A") (<= ch "Z"))
|
|
||||||
(= ch "_")))))
|
|
||||||
|
|
||||||
(define apl-tokenize
|
|
||||||
(fn (source)
|
|
||||||
(let ((pos 0)
|
|
||||||
(src-len (len source))
|
|
||||||
(tokens (list)))
|
|
||||||
|
|
||||||
(define tok-push!
|
|
||||||
(fn (type value)
|
|
||||||
(append! tokens {:type type :value value})))
|
|
||||||
|
|
||||||
(define cur-sw?
|
|
||||||
(fn (ch)
|
|
||||||
(and (< pos src-len) (starts-with? (slice source pos) ch))))
|
|
||||||
|
|
||||||
(define cur-byte
|
|
||||||
(fn ()
|
|
||||||
(if (< pos src-len) (nth source pos) nil)))
|
|
||||||
|
|
||||||
(define advance!
|
|
||||||
(fn ()
|
|
||||||
(set! pos (+ pos 1))))
|
|
||||||
|
|
||||||
(define consume!
|
|
||||||
(fn (ch)
|
|
||||||
(set! pos (+ pos (len ch)))))
|
|
||||||
|
|
||||||
(define find-glyph
|
|
||||||
(fn ()
|
|
||||||
(let ((rem (slice source pos)))
|
|
||||||
(let ((matches (filter (fn (g) (starts-with? rem g)) apl-glyph-set)))
|
|
||||||
(if (> (len matches) 0) (first matches) nil)))))
|
|
||||||
|
|
||||||
(define read-digits!
|
|
||||||
(fn (acc)
|
|
||||||
(if (and (< pos src-len) (apl-digit? (cur-byte)))
|
|
||||||
(let ((ch (cur-byte)))
|
|
||||||
(begin
|
|
||||||
(advance!)
|
|
||||||
(read-digits! (str acc ch))))
|
|
||||||
acc)))
|
|
||||||
|
|
||||||
(define read-ident-cont!
|
|
||||||
(fn ()
|
|
||||||
(when (and (< pos src-len)
|
|
||||||
(let ((ch (cur-byte)))
|
|
||||||
(or (apl-alpha? ch) (apl-digit? ch))))
|
|
||||||
(begin
|
|
||||||
(advance!)
|
|
||||||
(read-ident-cont!)))))
|
|
||||||
|
|
||||||
(define read-string!
|
|
||||||
(fn (acc)
|
|
||||||
(cond
|
|
||||||
((>= pos src-len) acc)
|
|
||||||
((cur-sw? "'")
|
|
||||||
(if (and (< (+ pos 1) src-len) (cur-sw? "'"))
|
|
||||||
(begin
|
|
||||||
(advance!)
|
|
||||||
(advance!)
|
|
||||||
(read-string! (str acc "'")))
|
|
||||||
(begin (advance!) acc)))
|
|
||||||
(true
|
|
||||||
(let ((ch (cur-byte)))
|
|
||||||
(begin
|
|
||||||
(advance!)
|
|
||||||
(read-string! (str acc ch))))))))
|
|
||||||
|
|
||||||
(define skip-line!
|
|
||||||
(fn ()
|
|
||||||
(when (and (< pos src-len) (not (cur-sw? "\n")))
|
|
||||||
(begin
|
|
||||||
(advance!)
|
|
||||||
(skip-line!)))))
|
|
||||||
|
|
||||||
(define scan!
|
|
||||||
(fn ()
|
|
||||||
(when (< pos src-len)
|
|
||||||
(let ((ch (cur-byte)))
|
|
||||||
(cond
|
|
||||||
((or (= ch " ") (= ch "\t") (= ch "\r"))
|
|
||||||
(begin (advance!) (scan!)))
|
|
||||||
((= ch "\n")
|
|
||||||
(begin (advance!) (tok-push! :newline nil) (scan!)))
|
|
||||||
((cur-sw? "⍝")
|
|
||||||
(begin (skip-line!) (scan!)))
|
|
||||||
((cur-sw? "⋄")
|
|
||||||
(begin (consume! "⋄") (tok-push! :diamond nil) (scan!)))
|
|
||||||
((= ch "(")
|
|
||||||
(begin (advance!) (tok-push! :lparen nil) (scan!)))
|
|
||||||
((= ch ")")
|
|
||||||
(begin (advance!) (tok-push! :rparen nil) (scan!)))
|
|
||||||
((= ch "[")
|
|
||||||
(begin (advance!) (tok-push! :lbracket nil) (scan!)))
|
|
||||||
((= ch "]")
|
|
||||||
(begin (advance!) (tok-push! :rbracket nil) (scan!)))
|
|
||||||
((= ch "{")
|
|
||||||
(begin (advance!) (tok-push! :lbrace nil) (scan!)))
|
|
||||||
((= ch "}")
|
|
||||||
(begin (advance!) (tok-push! :rbrace nil) (scan!)))
|
|
||||||
((= ch ";")
|
|
||||||
(begin (advance!) (tok-push! :semi nil) (scan!)))
|
|
||||||
((cur-sw? "←")
|
|
||||||
(begin (consume! "←") (tok-push! :assign nil) (scan!)))
|
|
||||||
((= ch ":")
|
|
||||||
(let ((start pos))
|
|
||||||
(begin
|
|
||||||
(advance!)
|
|
||||||
(if (and (< pos src-len) (apl-alpha? (cur-byte)))
|
|
||||||
(begin
|
|
||||||
(read-ident-cont!)
|
|
||||||
(tok-push! :keyword (slice source start pos)))
|
|
||||||
(tok-push! :colon nil))
|
|
||||||
(scan!))))
|
|
||||||
((and (cur-sw? "¯")
|
|
||||||
(< (+ pos (len "¯")) src-len)
|
|
||||||
(apl-digit? (nth source (+ pos (len "¯")))))
|
|
||||||
(begin
|
|
||||||
(consume! "¯")
|
|
||||||
(let ((digits (read-digits! "")))
|
|
||||||
(tok-push! :num (- 0 (parse-int digits 0))))
|
|
||||||
(scan!)))
|
|
||||||
((apl-digit? ch)
|
|
||||||
(begin
|
|
||||||
(let ((digits (read-digits! "")))
|
|
||||||
(tok-push! :num (parse-int digits 0)))
|
|
||||||
(scan!)))
|
|
||||||
((= ch "'")
|
|
||||||
(begin
|
|
||||||
(advance!)
|
|
||||||
(let ((s (read-string! "")))
|
|
||||||
(tok-push! :str s))
|
|
||||||
(scan!)))
|
|
||||||
((or (apl-alpha? ch) (cur-sw? "⎕"))
|
|
||||||
(let ((start pos))
|
|
||||||
(begin
|
|
||||||
(if (cur-sw? "⎕") (consume! "⎕") (advance!))
|
|
||||||
(read-ident-cont!)
|
|
||||||
(tok-push! :name (slice source start pos))
|
|
||||||
(scan!))))
|
|
||||||
(true
|
|
||||||
(let ((g (find-glyph)))
|
|
||||||
(if g
|
|
||||||
(begin (consume! g) (tok-push! :glyph g) (scan!))
|
|
||||||
(begin (advance!) (scan!))))))))))
|
|
||||||
|
|
||||||
(scan!)
|
|
||||||
tokens)))
|
|
||||||
831
lib/ruby/parser.sx
Normal file
831
lib/ruby/parser.sx
Normal 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
92
lib/ruby/test.sh
Executable 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
439
lib/ruby/tests/parse.sx
Normal 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
210
lib/ruby/tests/tokenizer.sx
Normal 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
549
lib/ruby/tokenizer.sx
Normal 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)))
|
||||||
@@ -48,19 +48,19 @@ Core mapping:
|
|||||||
## Roadmap
|
## Roadmap
|
||||||
|
|
||||||
### Phase 1 — tokenizer + parser
|
### Phase 1 — tokenizer + parser
|
||||||
- [x] Tokenizer: Unicode glyphs (the full APL set: `+ - × ÷ * ⍟ ⌈ ⌊ | ! ? ○ ~ < ≤ = ≥ > ≠ ∊ ∧ ∨ ⍱ ⍲ , ⍪ ⍴ ⌽ ⊖ ⍉ ↑ ↓ ⊂ ⊃ ⊆ ∪ ∩ ⍳ ⍸ ⌷ ⍋ ⍒ ⊥ ⊤ ⊣ ⊢ ⍎ ⍕ ⍝`), operators (`/ \ ¨ ⍨ ∘ . ⍣ ⍤ ⍥ @`), numbers (`¯` for negative, `1E2`, `1J2` complex deferred), characters (`'a'`, `''` escape), strands (juxtaposition of literals: `1 2 3`), names, comments `⍝ …`
|
- [ ] Tokenizer: Unicode glyphs (the full APL set: `+ - × ÷ * ⍟ ⌈ ⌊ | ! ? ○ ~ < ≤ = ≥ > ≠ ∊ ∧ ∨ ⍱ ⍲ , ⍪ ⍴ ⌽ ⊖ ⍉ ↑ ↓ ⊂ ⊃ ⊆ ∪ ∩ ⍳ ⍸ ⌷ ⍋ ⍒ ⊥ ⊤ ⊣ ⊢ ⍎ ⍕ ⍝`), operators (`/ \ ¨ ⍨ ∘ . ⍣ ⍤ ⍥ @`), numbers (`¯` for negative, `1E2`, `1J2` complex deferred), characters (`'a'`, `''` escape), strands (juxtaposition of literals: `1 2 3`), names, comments `⍝ …`
|
||||||
- [x] Parser: right-to-left; classify each token as function, operator, value, or name; resolve valence positionally; dfn `{…}` body, tradfn `∇` header, guards `:`; outer product `∘.f`, inner product `f.g`, derived fns `f/ f¨ f⍨ f⍣n`
|
- [ ] Parser: right-to-left; classify each token as function, operator, value, or name; resolve valence positionally; dfn `{…}` body, tradfn `∇` header, guards `:`, control words `:If :While :For …` (Dyalog-style)
|
||||||
- [x] Unit tests in `lib/apl/tests/parse.sx`
|
- [ ] Unit tests in `lib/apl/tests/parse.sx`
|
||||||
|
|
||||||
### Phase 2 — array model + scalar primitives
|
### Phase 2 — array model + scalar primitives
|
||||||
- [x] Array constructor: `make-array shape ravel`, `scalar v`, `vector v…`, `enclose`/`disclose`
|
- [ ] Array constructor: `make-array shape ravel`, `scalar v`, `vector v…`, `enclose`/`disclose`
|
||||||
- [x] Shape arithmetic: `⍴` (shape), `,` (ravel), `≢` (tally / first-axis-length), `≡` (depth)
|
- [ ] Shape arithmetic: `⍴` (shape), `,` (ravel), `≢` (tally / first-axis-length), `≡` (depth)
|
||||||
- [x] Scalar arithmetic primitives broadcast: `+ - × ÷ ⌈ ⌊ * ⍟ | ! ○`
|
- [ ] Scalar arithmetic primitives broadcast: `+ - × ÷ ⌈ ⌊ * ⍟ | ! ○`
|
||||||
- [x] Scalar comparison primitives: `< ≤ = ≥ > ≠`
|
- [ ] Scalar comparison primitives: `< ≤ = ≥ > ≠`
|
||||||
- [x] Scalar logical: `~ ∧ ∨ ⍱ ⍲`
|
- [ ] Scalar logical: `~ ∧ ∨ ⍱ ⍲`
|
||||||
- [x] Index generator: `⍳n` (vector 1..n or 0..n-1 depending on `⎕IO`)
|
- [ ] Index generator: `⍳n` (vector 1..n or 0..n-1 depending on `⎕IO`)
|
||||||
- [x] `⎕IO` = 1 default (Dyalog convention)
|
- [ ] `⎕IO` = 1 default (Dyalog convention)
|
||||||
- [x] 40+ tests in `lib/apl/tests/scalar.sx`
|
- [ ] 40+ tests in `lib/apl/tests/scalar.sx`
|
||||||
|
|
||||||
### Phase 3 — structural primitives + indexing
|
### Phase 3 — structural primitives + indexing
|
||||||
- [ ] Reshape `⍴`, ravel `,`, transpose `⍉` (full + dyadic axis spec)
|
- [ ] Reshape `⍴`, ravel `,`, transpose `⍉` (full + dyadic axis spec)
|
||||||
@@ -108,9 +108,7 @@ Core mapping:
|
|||||||
|
|
||||||
_Newest first._
|
_Newest first._
|
||||||
|
|
||||||
- 2026-04-26: Phase 2 complete — array model + 7 scalar primitive groups; 82/82 tests; lib/apl/runtime.sx + lib/apl/tests/scalar.sx
|
- _(none yet)_
|
||||||
- 2026-04-26: parser (Phase 1 step 2) — 44/44 parser tests green (90/90 total); right-to-left segment algorithm; derived fns, outer/inner product, dfns with guards, strand handling; `lib/apl/parser.sx` + `lib/apl/tests/parse.sx`
|
|
||||||
- 2026-04-25: tokenizer (Phase 1 step 1) — 46/46 tests green; Unicode-aware starts-with? scanner for multi-byte APL glyphs; `lib/apl/tokenizer.sx` + `lib/apl/tests/parse.sx`
|
|
||||||
|
|
||||||
## Blockers
|
## Blockers
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user