erlang: list comprehensions (+12 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

This commit is contained in:
2026-04-25 06:19:14 +00:00
parent 8e809614ba
commit 193b0c04be
6 changed files with 172 additions and 10 deletions

View File

@@ -281,12 +281,56 @@
(fn
(st)
(er-expect! st "punct" "[")
(if
(cond
(er-is? st "punct" "]")
(do (er-advance! st) {:type "nil"})
(let
((elems (list (er-parse-expr-prec st 0))))
(er-parse-list-tail st elems)))))
:else (let
((first (er-parse-expr-prec st 0)))
(cond
(er-is? st "punct" "||") (er-parse-list-comp st first)
:else (er-parse-list-tail st (list first)))))))
(define
er-parse-list-comp
(fn
(st head)
(er-advance! st)
(let
((quals (list (er-parse-lc-qualifier st))))
(er-parse-list-comp-tail st head quals))))
(define
er-parse-list-comp-tail
(fn
(st head quals)
(cond
(er-is? st "punct" ",")
(do
(er-advance! st)
(append! quals (er-parse-lc-qualifier st))
(er-parse-list-comp-tail st head quals))
(er-is? st "punct" "]")
(do (er-advance! st) {:head head :qualifiers quals :type "lc"})
:else (error
(str
"Erlang parse: expected ',' or ']' in list comprehension, got '"
(er-cur-value st)
"'")))))
(define
er-parse-lc-qualifier
(fn
(st)
(let
((e (er-parse-expr-prec st 0)))
(cond
(er-is? st "punct" "<-")
(do
(er-advance! st)
(let
((source (er-parse-expr-prec st 0)))
{:kind "gen" :pattern e :source source}))
:else {:kind "filter" :expr e}))))
(define
er-parse-list-tail

View File

@@ -1,11 +1,11 @@
{
"language": "erlang",
"total_pass": 444,
"total": 444,
"total_pass": 456,
"total": 456,
"suites": [
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
{"name":"parse","pass":52,"total":52,"status":"ok"},
{"name":"eval","pass":260,"total":260,"status":"ok"},
{"name":"eval","pass":272,"total":272,"status":"ok"},
{"name":"runtime","pass":39,"total":39,"status":"ok"},
{"name":"ring","pass":4,"total":4,"status":"ok"},
{"name":"ping-pong","pass":4,"total":4,"status":"ok"},

View File

@@ -1,12 +1,12 @@
# Erlang-on-SX Scoreboard
**Total: 444 / 444 tests passing**
**Total: 456 / 456 tests passing**
| | Suite | Pass | Total |
|---|---|---|---|
| ✅ | tokenize | 62 | 62 |
| ✅ | parse | 52 | 52 |
| ✅ | eval | 260 | 260 |
| ✅ | eval | 272 | 272 |
| ✅ | runtime | 39 | 39 |
| ✅ | ring | 4 | 4 |
| ✅ | ping-pong | 4 | 4 |

View File

@@ -902,6 +902,41 @@
(nm (if (er-atom? reason) reason (nth (get reason :elements) 0)))))
"badarg")
;; ── list comprehensions ───────────────────────────────────────
(er-eval-test "lc map double"
(ev "hd([X * 2 || X <- [1, 2, 3]])") 2)
(er-eval-test "lc map sum"
(ev "lists:foldl(fun (X, Acc) -> X + Acc end, 0, [X * 2 || X <- [1, 2, 3]])")
12)
(er-eval-test "lc length"
(ev "length([X || X <- [1, 2, 3, 4, 5]])") 5)
(er-eval-test "lc filter sum"
(ev "lists:foldl(fun (X, Acc) -> X + Acc end, 0, [X || X <- [1, 2, 3, 4, 5], X rem 2 =:= 0])")
6)
(er-eval-test "lc filter only"
(ev "length([X || X <- [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], X > 5])")
5)
(er-eval-test "lc empty source"
(get (ev "[X || X <- []]") :tag) "nil")
(er-eval-test "lc all filtered"
(get (ev "[X || X <- [1, 2, 3], X > 100]") :tag) "nil")
(er-eval-test "lc cartesian length"
(ev "length([{X, Y} || X <- [1, 2, 3], Y <- [a, b]])")
6)
(er-eval-test "lc pattern match"
(ev "lists:foldl(fun (X, Acc) -> X + Acc end, 0, [V || {ok, V} <- [{ok, 1}, {error, x}, {ok, 2}, {ok, 3}]])")
6)
(er-eval-test "lc nested generators"
(ev "length([{X, Y} || X <- [1, 2, 3], Y <- [10, 20, 30], X + Y > 12])")
7)
(er-eval-test "lc squares"
(ev "lists:foldl(fun (X, Acc) -> X + Acc end, 0, [X*X || X <- [1, 2, 3, 4, 5]])")
55)
;; First {ok, X} tuple: head of [{ok,a}, {ok,b}] is {ok, a}.
(er-eval-test "lc tuple capture"
(nm (nth (get (get (ev "[{ok, X} || X <- [a, b]]") :head) :elements) 0))
"ok")
(define
er-eval-test-summary
(str "eval " er-eval-test-pass "/" er-eval-test-count))

View File

@@ -123,6 +123,7 @@
(= ty "send") (er-eval-send node env)
(= ty "receive") (er-eval-receive node env)
(= ty "try") (er-eval-try node env)
(= ty "lc") (er-eval-lc node env)
(= ty "match") (er-eval-match node env)
:else (error (str "Erlang eval: unsupported node type '" ty "'"))))))
@@ -1281,3 +1282,84 @@
(do
(er-env-restore! env snap)
(er-eval-of-clauses clauses subject env (+ i 1))))))))
;; ── list comprehensions ─────────────────────────────────────────
;; `[E || Pat <- Source, FilterExpr, ...]`. Walk qualifiers in order:
;; generators iterate their source list and bind the pattern (with
;; env snapshot/restore so each iteration starts from the same
;; baseline); filters skip when falsy. At the end of the qualifier
;; chain, evaluate `head` and append to the accumulator. Build the
;; final cons chain in O(n) with a single right-fold.
(define
er-eval-lc
(fn
(node env)
(let
((acc (list)))
(er-lc-walk (get node :qualifiers) 0 (get node :head) env acc)
(er-list-from-sx-list acc))))
(define
er-lc-walk
(fn
(quals i head env acc)
(if
(>= i (len quals))
(append! acc (er-eval-expr head env))
(let
((q (nth quals i)))
(cond
(= (get q :kind) "gen")
(let
((src (er-eval-expr (get q :source) env)))
(er-lc-iter-gen
src
(get q :pattern)
quals
i
head
env
acc))
(= (get q :kind) "filter")
(when
(er-truthy? (er-eval-expr (get q :expr) env))
(er-lc-walk quals (+ i 1) head env acc))
:else (error "Erlang LC: unknown qualifier"))))))
(define
er-lc-iter-gen
(fn
(src pat quals i head env acc)
(cond
(er-nil? src) nil
(er-cons? src)
(let
((snap (er-env-copy env)))
(when
(er-match! pat (get src :head) env)
(er-lc-walk quals (+ i 1) head env acc))
(er-env-restore! env snap)
(er-lc-iter-gen
(get src :tail)
pat
quals
i
head
env
acc))
:else (error "Erlang LC: generator source is not a list"))))
(define
er-list-from-sx-list
(fn
(xs)
(let
((acc (list (er-mk-nil))))
(for-each
(fn
(i)
(let
((j (- (- (len xs) 1) i)))
(set-nth! acc 0 (er-mk-cons (nth xs j) (nth acc 0)))))
(range 0 (len xs)))
(nth acc 0))))