rose-ash/lib/smalltalk/tests/parse.sx

;; Smalltalk parser tests.
;;
;; Reuses helpers (st-test, st-deep=?) from tokenize.sx. Counters reset
;; here so this file's summary covers parse tests only.

(set! st-test-pass 0)
(set! st-test-fail 0)
(set! st-test-fails (list))

;; ── 1. Atoms ──
(st-test "int" (st-parse-expr "42") {:type "lit-int" :value 42})
(st-test "float" (st-parse-expr "3.14") {:type "lit-float" :value 3.14})
(st-test "string" (st-parse-expr "'hi'") {:type "lit-string" :value "hi"})
(st-test "char" (st-parse-expr "$x") {:type "lit-char" :value "x"})
(st-test "symbol" (st-parse-expr "#foo") {:type "lit-symbol" :value "foo"})
(st-test "binary symbol" (st-parse-expr "#+") {:type "lit-symbol" :value "+"})
(st-test "keyword symbol" (st-parse-expr "#at:put:") {:type "lit-symbol" :value "at:put:"})
(st-test "nil" (st-parse-expr "nil") {:type "lit-nil"})
(st-test "true" (st-parse-expr "true") {:type "lit-true"})
(st-test "false" (st-parse-expr "false") {:type "lit-false"})
(st-test "self" (st-parse-expr "self") {:type "self"})
(st-test "super" (st-parse-expr "super") {:type "super"})
(st-test "ident" (st-parse-expr "x") {:type "ident" :name "x"})
(st-test "negative int" (st-parse-expr "-3") {:type "lit-int" :value -3})

;; ── 2. Literal arrays ──
(st-test
  "literal array of ints"
  (st-parse-expr "#(1 2 3)")
  {:type "lit-array"
   :elements (list
               {:type "lit-int" :value 1}
               {:type "lit-int" :value 2}
               {:type "lit-int" :value 3})})

(st-test
  "literal array mixed"
  (st-parse-expr "#(1 #foo 'x' true)")
  {:type "lit-array"
   :elements (list
               {:type "lit-int" :value 1}
               {:type "lit-symbol" :value "foo"}
               {:type "lit-string" :value "x"}
               {:type "lit-true"})})

(st-test
  "literal array bare ident is symbol"
  (st-parse-expr "#(foo bar)")
  {:type "lit-array"
   :elements (list
               {:type "lit-symbol" :value "foo"}
               {:type "lit-symbol" :value "bar"})})

(st-test
  "nested literal array"
  (st-parse-expr "#(1 (2 3) 4)")
  {:type "lit-array"
   :elements (list
               {:type "lit-int" :value 1}
               {:type "lit-array"
                :elements (list
                            {:type "lit-int" :value 2}
                            {:type "lit-int" :value 3})}
               {:type "lit-int" :value 4})})

(st-test
  "byte array"
  (st-parse-expr "#[1 2 3]")
  {:type "lit-byte-array" :elements (list 1 2 3)})

;; ── 3. Unary messages ──
(st-test
  "unary single"
  (st-parse-expr "x foo")
  {:type "send"
   :receiver {:type "ident" :name "x"}
   :selector "foo"
   :args (list)})

(st-test
  "unary chain"
  (st-parse-expr "x foo bar baz")
  {:type "send"
   :receiver {:type "send"
              :receiver {:type "send"
                         :receiver {:type "ident" :name "x"}
                         :selector "foo"
                         :args (list)}
              :selector "bar"
              :args (list)}
   :selector "baz"
   :args (list)})

(st-test
  "unary on literal"
  (st-parse-expr "42 printNl")
  {:type "send"
   :receiver {:type "lit-int" :value 42}
   :selector "printNl"
   :args (list)})

;; ── 4. Binary messages ──
(st-test
  "binary single"
  (st-parse-expr "1 + 2")
  {:type "send"
   :receiver {:type "lit-int" :value 1}
   :selector "+"
   :args (list {:type "lit-int" :value 2})})

(st-test
  "binary left-assoc"
  (st-parse-expr "1 + 2 + 3")
  {:type "send"
   :receiver {:type "send"
              :receiver {:type "lit-int" :value 1}
              :selector "+"
              :args (list {:type "lit-int" :value 2})}
   :selector "+"
   :args (list {:type "lit-int" :value 3})})

(st-test
  "binary same precedence l-to-r"
  (st-parse-expr "1 + 2 * 3")
  {:type "send"
   :receiver {:type "send"
              :receiver {:type "lit-int" :value 1}
              :selector "+"
              :args (list {:type "lit-int" :value 2})}
   :selector "*"
   :args (list {:type "lit-int" :value 3})})

;; ── 5. Precedence: unary binds tighter than binary ──
(st-test
  "unary tighter than binary"
  (st-parse-expr "3 + 4 factorial")
  {:type "send"
   :receiver {:type "lit-int" :value 3}
   :selector "+"
   :args (list
           {:type "send"
            :receiver {:type "lit-int" :value 4}
            :selector "factorial"
            :args (list)})})

;; ── 6. Keyword messages ──
(st-test
  "keyword single"
  (st-parse-expr "x at: 1")
  {:type "send"
   :receiver {:type "ident" :name "x"}
   :selector "at:"
   :args (list {:type "lit-int" :value 1})})

(st-test
  "keyword chain"
  (st-parse-expr "x at: 1 put: 'a'")
  {:type "send"
   :receiver {:type "ident" :name "x"}
   :selector "at:put:"
   :args (list {:type "lit-int" :value 1} {:type "lit-string" :value "a"})})

;; ── 7. Precedence: binary tighter than keyword ──
(st-test
  "binary tighter than keyword"
  (st-parse-expr "x at: 1 + 2")
  {:type "send"
   :receiver {:type "ident" :name "x"}
   :selector "at:"
   :args (list
           {:type "send"
            :receiver {:type "lit-int" :value 1}
            :selector "+"
            :args (list {:type "lit-int" :value 2})})})

(st-test
  "keyword absorbs trailing unary"
  (st-parse-expr "a foo: b bar")
  {:type "send"
   :receiver {:type "ident" :name "a"}
   :selector "foo:"
   :args (list
           {:type "send"
            :receiver {:type "ident" :name "b"}
            :selector "bar"
            :args (list)})})

;; ── 8. Parens override precedence ──
(st-test
  "paren forces grouping"
  (st-parse-expr "(1 + 2) * 3")
  {:type "send"
   :receiver {:type "send"
              :receiver {:type "lit-int" :value 1}
              :selector "+"
              :args (list {:type "lit-int" :value 2})}
   :selector "*"
   :args (list {:type "lit-int" :value 3})})

;; ── 9. Cascade ──
(st-test
  "simple cascade"
  (st-parse-expr "x m1; m2")
  {:type "cascade"
   :receiver {:type "ident" :name "x"}
   :messages (list
               {:selector "m1" :args (list)}
               {:selector "m2" :args (list)})})

(st-test
  "cascade with binary and keyword"
  (st-parse-expr "Stream new nl; tab; print: 1")
  {:type "cascade"
   :receiver {:type "send"
              :receiver {:type "ident" :name "Stream"}
              :selector "new"
              :args (list)}
   :messages (list
               {:selector "nl" :args (list)}
               {:selector "tab" :args (list)}
               {:selector "print:" :args (list {:type "lit-int" :value 1})})})

;; ── 10. Blocks ──
(st-test
  "empty block"
  (st-parse-expr "[]")
  {:type "block" :params (list) :temps (list) :body (list)})

(st-test
  "block one expr"
  (st-parse-expr "[1 + 2]")
  {:type "block"
   :params (list)
   :temps (list)
   :body (list
           {:type "send"
            :receiver {:type "lit-int" :value 1}
            :selector "+"
            :args (list {:type "lit-int" :value 2})})})

(st-test
  "block with params"
  (st-parse-expr "[:a :b | a + b]")
  {:type "block"
   :params (list "a" "b")
   :temps (list)
   :body (list
           {:type "send"
            :receiver {:type "ident" :name "a"}
            :selector "+"
            :args (list {:type "ident" :name "b"})})})

(st-test
  "block with temps"
  (st-parse-expr "[| t | t := 1. t]")
  {:type "block"
   :params (list)
   :temps (list "t")
   :body (list
           {:type "assign" :name "t" :expr {:type "lit-int" :value 1}}
           {:type "ident" :name "t"})})

(st-test
  "block with params and temps"
  (st-parse-expr "[:x | | t | t := x + 1. t]")
  {:type "block"
   :params (list "x")
   :temps (list "t")
   :body (list
           {:type "assign"
            :name "t"
            :expr {:type "send"
                   :receiver {:type "ident" :name "x"}
                   :selector "+"
                   :args (list {:type "lit-int" :value 1})}}
           {:type "ident" :name "t"})})

;; ── 11. Assignment / return / statements ──
(st-test
  "assignment"
  (st-parse-expr "x := 1")
  {:type "assign" :name "x" :expr {:type "lit-int" :value 1}})

(st-test
  "return"
  (st-parse-expr "1")
  {:type "lit-int" :value 1})

(st-test
  "return statement at top level"
  (st-parse "^ 1")
  {:type "seq" :temps (list)
   :exprs (list {:type "return" :expr {:type "lit-int" :value 1}})})

(st-test
  "two statements"
  (st-parse "x := 1. y := 2")
  {:type "seq" :temps (list)
   :exprs (list
            {:type "assign" :name "x" :expr {:type "lit-int" :value 1}}
            {:type "assign" :name "y" :expr {:type "lit-int" :value 2}})})

(st-test
  "trailing dot allowed"
  (st-parse "1. 2.")
  {:type "seq" :temps (list)
   :exprs (list {:type "lit-int" :value 1} {:type "lit-int" :value 2})})

;; ── 12. Method headers ──
(st-test
  "unary method"
  (st-parse-method "factorial ^ self * (self - 1) factorial")
  {:type "method"
   :selector "factorial"
   :params (list)
   :temps (list)
   :pragmas (list)
   :body (list
           {:type "return"
            :expr {:type "send"
                   :receiver {:type "self"}
                   :selector "*"
                   :args (list
                           {:type "send"
                            :receiver {:type "send"
                                       :receiver {:type "self"}
                                       :selector "-"
                                       :args (list {:type "lit-int" :value 1})}
                            :selector "factorial"
                            :args (list)})}})})

(st-test
  "binary method"
  (st-parse-method "+ other ^ 'plus'")
  {:type "method"
   :selector "+"
   :params (list "other")
   :temps (list)
   :pragmas (list)
   :body (list {:type "return" :expr {:type "lit-string" :value "plus"}})})

(st-test
  "keyword method"
  (st-parse-method "at: i put: v ^ v")
  {:type "method"
   :selector "at:put:"
   :params (list "i" "v")
   :temps (list)
   :pragmas (list)
   :body (list {:type "return" :expr {:type "ident" :name "v"}})})

(st-test
  "method with temps"
  (st-parse-method "twice: x | t | t := x + x. ^ t")
  {:type "method"
   :selector "twice:"
   :params (list "x")
   :temps (list "t")
   :pragmas (list)
   :body (list
           {:type "assign"
            :name "t"
            :expr {:type "send"
                   :receiver {:type "ident" :name "x"}
                   :selector "+"
                   :args (list {:type "ident" :name "x"})}}
           {:type "return" :expr {:type "ident" :name "t"}})})

(list st-test-pass st-test-fail)