From c932ad59e1f52035220e33cd43fed197c7e661b0 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 24 Apr 2026 11:02:49 +0000 Subject: [PATCH] HS: repeat property for-loops + where (+3 tests) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Re-applied from worktree-agent-a7c6dca2be5bbada0 (commit c4241d57) onto HEAD that already has clusters 30, 26, 27 runtime changes — straight cherry-pick conflicted on the cluster-30 log-all block and cluster-27 intersection helper, so the logical diff was replayed surgically. Parser (parse-atom object-literal): - obj-collect now `append`s pairs in source order instead of `cons`'ing, so `{foo:1, bar:2, baz:3}` reaches hs-make-object as `((foo 1) (bar 2) (baz 3))`. Compiler (emit-for, array-index emission): - emit-for detects `for x in COLL where COND` (parser wraps COLL as `(coll-where INNER COND)`) and rewrites the filter lambda to bind the for-loop variable name rather than the default `it`, so `where x.val > 10` sees the right binding. Also unwraps `coll-where` so filter targets the real inner coll. - emit-for now wraps a symbol collection with `cek-try` (not the broken `hs-safe-call`, which has an uninitialised CEK call-ref in the WASM build) so `for prop in x` after `set x to {…}` iterates x's keys instead of nil. - array-index emits `(hs-index obj key)` instead of `(nth obj key)`, which only worked on lists. Runtime: - New polymorphic `hs-index` dispatches to get / nth / host-get based on target type (dict / list / string / otherwise). - `hs-put-at!` default branch now detects DOM elements via `hs-element?` and delegates to `hs-put!`, so `put X at end of elt` on a DOM node appends innerHTML instead of crashing. - `hs-make-object` tracks insertion order in a hidden `_order` list; `hs-for-each` and `hs-coerce` (Keys / Entries / Map branches) prefer `_order` when present, filtering the marker out of output. Suite hs-upstream-repeat: 25/30 → 28/30 (+3). Smoke 0-195 unchanged at 165/195. --- lib/hyperscript/compiler.sx | 29 +++++- lib/hyperscript/parser.sx | 3 +- lib/hyperscript/runtime.sx | 133 +++++++++++++++++---------- shared/static/wasm/sx/hs-compiler.sx | 29 +++++- shared/static/wasm/sx/hs-parser.sx | 3 +- shared/static/wasm/sx/hs-runtime.sx | 133 +++++++++++++++++---------- 6 files changed, 216 insertions(+), 114 deletions(-) diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index 800da93f..6dc0430d 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -337,14 +337,33 @@ (ast) (let ((var-name (nth ast 1)) - (raw-coll (hs-to-sx (nth ast 2))) - (collection + (raw-coll-ast (nth ast 2)) + (where-cond + (if + (and + (list? raw-coll-ast) + (= (first raw-coll-ast) (quote coll-where))) + (hs-to-sx (nth raw-coll-ast 2)) + nil)) + (inner-coll-ast + (if where-cond (nth raw-coll-ast 1) raw-coll-ast)) + (raw-coll (hs-to-sx inner-coll-ast)) + (safe-coll (if (symbol? raw-coll) (list - (quote hs-safe-call) - (list (quote fn) (list) raw-coll)) + (quote cek-try) + (list (quote fn) (list) raw-coll) + (list (quote fn) (list (quote _e)) nil)) raw-coll)) + (collection + (if + where-cond + (list + (quote filter) + (list (quote fn) (list (make-symbol var-name)) where-cond) + safe-coll) + safe-coll)) (body (hs-to-sx (nth ast 3)))) (if (and (> (len ast) 4) (= (nth ast 4) :index)) @@ -839,7 +858,7 @@ (list (quote hs-beep) (hs-to-sx (nth ast 1)))) ((= head (quote array-index)) (list - (quote nth) + (quote hs-index) (hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 2)))) ((= head (quote array-slice)) diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index c009c2b1..cb2f3bf9 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -244,7 +244,8 @@ ((value (cond ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (cond ((= v "true") true) ((= v "false") false) ((= v "null") nil) (true (list (quote ref) v)))))) ((= (tp-type) "colon") (do (adv!) (parse-expr))) (true (parse-expr))))) (do (when (= (tp-type) "comma") (adv!)) - (obj-collect (cons (list key value) acc)))))))) + (obj-collect + (append acc (list (list key value)))))))))) (list (quote object-literal) (obj-collect (list))))) ((and (= typ "op") (= val "\\")) (do diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index 72ea0918..c419cf05 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -387,6 +387,21 @@ ;; Fetch a URL, parse response according to format. ;; (hs-fetch url format) — format is "json" | "text" | "html" +(define + hs-index + (fn + (obj key) + (cond + ((nil? obj) nil) + ((dict? obj) (get obj key)) + ((list? obj) (nth obj key)) + ((string? obj) (nth obj key)) + (true (host-get obj key))))) + +;; ── Type coercion ─────────────────────────────────────────────── + +;; Coerce a value to a type by name. +;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc. (define hs-put-at! (fn @@ -399,16 +414,19 @@ (cons value target) (append target (list value)))) (true - (do - (cond - ((= pos "end") (host-call target "push" value)) - ((= pos "start") (host-call target "unshift" value))) - target))))) + (cond + ((hs-element? target) (do (hs-put! value pos target) target)) + (true + (do + (cond + ((= pos "end") (host-call target "push" value)) + ((= pos "start") (host-call target "unshift" value))) + target))))))) -;; ── Type coercion ─────────────────────────────────────────────── +;; ── Object creation ───────────────────────────────────────────── -;; Coerce a value to a type by name. -;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc. +;; Make a new object of a given type. +;; (hs-make type-name) — creates empty object/collection (define hs-dict-without (fn @@ -429,27 +447,27 @@ (host-call (host-global "Reflect") "deleteProperty" out key) out))))) -;; ── Object creation ───────────────────────────────────────────── +;; ── Behavior installation ─────────────────────────────────────── -;; Make a new object of a given type. -;; (hs-make type-name) — creates empty object/collection +;; Install a behavior on an element. +;; A behavior is a function that takes (me ...params) and sets up features. +;; (hs-install behavior-fn me ...args) (define hs-set-on! (fn (props target) (for-each (fn (k) (host-set! target k (get props k))) (keys props)))) -;; ── Behavior installation ─────────────────────────────────────── - -;; Install a behavior on an element. -;; A behavior is a function that takes (me ...params) and sets up features. -;; (hs-install behavior-fn me ...args) -(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url)))) - ;; ── Measurement ───────────────────────────────────────────────── ;; Measure an element's bounding rect, store as local variables. ;; Returns a dict with x, y, width, height, top, left, right, bottom. +(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url)))) + +;; Return the current text selection as a string. In the browser this is +;; `window.getSelection().toString()`. In the mock test runner, a test +;; setup stashes the desired selection text at `window.__test_selection` +;; and the fallback path returns that so tests can assert on the result. (define hs-scroll! (fn @@ -462,10 +480,11 @@ ((= position "bottom") (dict :block "end")) (true (dict :block "start"))))))) -;; Return the current text selection as a string. In the browser this is -;; `window.getSelection().toString()`. In the mock test runner, a test -;; setup stashes the desired selection text at `window.__test_selection` -;; and the fallback path returns that so tests can assert on the result. + +;; ── Transition ────────────────────────────────────────────────── + +;; Transition a CSS property to a value, optionally with duration. +;; (hs-transition target prop value duration) (define hs-halt! (fn @@ -486,11 +505,6 @@ (host-call ev "stopPropagation"))))) (when (not (= mode "the-event")) (raise (list "hs-return" nil)))))) - -;; ── Transition ────────────────────────────────────────────────── - -;; Transition a CSS property to a value, optionally with duration. -;; (hs-transition target prop value duration) (define hs-select! (fn (target) (host-call target "select" (list)))) (define @@ -619,6 +633,10 @@ hs-query-first (fn (sel) (host-call (host-global "document") "querySelector" sel))) + + + + (define hs-query-last (fn @@ -627,12 +645,9 @@ ((all (dom-query-all (dom-body) sel))) (if (> (len all) 0) (nth all (- (len all) 1)) nil)))) - - - - (define hs-first (fn (scope sel) (dom-query-all scope sel))) - +;; ── Sandbox/test runtime additions ────────────────────────────── +;; Property access — dot notation and .length (define hs-last (fn @@ -640,8 +655,7 @@ (let ((all (dom-query-all scope sel))) (if (> (len all) 0) (nth all (- (len all) 1)) nil)))) -;; ── Sandbox/test runtime additions ────────────────────────────── -;; Property access — dot notation and .length +;; DOM query stub — sandbox returns empty list (define hs-repeat-times (fn @@ -659,7 +673,7 @@ ((= signal "hs-continue") (do-repeat (+ i 1))) (true (do-repeat (+ i 1)))))))) (do-repeat 0))) -;; DOM query stub — sandbox returns empty list +;; Method dispatch — obj.method(args) (define hs-repeat-forever (fn @@ -675,7 +689,9 @@ ((= signal "hs-continue") (do-forever)) (true (do-forever)))))) (do-forever))) -;; Method dispatch — obj.method(args) + +;; ── 0.9.90 features ───────────────────────────────────────────── +;; beep! — debug logging, returns value unchanged (define hs-repeat-while (fn @@ -688,9 +704,7 @@ ((= signal "hs-break") nil) ((= signal "hs-continue") (hs-repeat-while cond-fn thunk)) (true (hs-repeat-while cond-fn thunk))))))) - -;; ── 0.9.90 features ───────────────────────────────────────────── -;; beep! — debug logging, returns value unchanged +;; Property-based is — check obj.key truthiness (define hs-repeat-until (fn @@ -702,13 +716,13 @@ ((= signal "hs-continue") (if (cond-fn) nil (hs-repeat-until cond-fn thunk))) (true (if (cond-fn) nil (hs-repeat-until cond-fn thunk))))))) -;; Property-based is — check obj.key truthiness +;; Array slicing (inclusive both ends) (define hs-for-each (fn (fn-body collection) (let - ((items (cond ((list? collection) collection) ((dict? collection) (keys collection)) ((nil? collection) (list)) (true (list))))) + ((items (cond ((list? collection) collection) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) ((nil? collection) (list)) (true (list))))) (define do-loop (fn @@ -722,7 +736,7 @@ ((= signal "hs-continue") (do-loop (rest remaining))) (true (do-loop (rest remaining)))))))) (do-loop items)))) -;; Array slicing (inclusive both ends) +;; Collection: sorted by (begin (define hs-append @@ -750,7 +764,7 @@ ((hs-element? target) (dom-insert-adjacent-html target "beforeend" (str value))) (true nil))))) -;; Collection: sorted by +;; Collection: sorted by descending (define hs-sender (fn @@ -758,7 +772,7 @@ (let ((detail (host-get event "detail"))) (if detail (host-get detail "sender") nil)))) -;; Collection: sorted by descending +;; Collection: split by (define hs-host-to-sx (fn @@ -812,7 +826,7 @@ (dict-set! out k (hs-host-to-sx (host-get v k)))) (host-call (host-global "Object") "keys" v)) out))))))))))) -;; Collection: split by +;; Collection: joined by (define hs-fetch (fn @@ -822,7 +836,7 @@ (let ((raw (perform (list "io-fetch" url fmt)))) (cond ((= fmt "json") (hs-host-to-sx raw)) (true raw)))))) -;; Collection: joined by + (define hs-json-escape (fn @@ -958,11 +972,17 @@ ((= type-name "Selector") (str value)) ((= type-name "Fragment") value) ((= type-name "Values") (hs-as-values value)) - ((= type-name "Keys") (if (dict? value) (sort (keys value)) value)) + ((= type-name "Keys") + (if + (dict? value) + (sort (filter (fn (k) (not (= k "_order"))) (keys value))) + value)) ((= type-name "Entries") (if (dict? value) - (map (fn (k) (list k (get value k))) (keys value)) + (let + ((ks (if (dict-has? value "_order") (get value "_order") (filter (fn (k) (not (= k "_order"))) (keys value))))) + (map (fn (k) (list k (get value k))) ks)) value)) ((= type-name "Reversed") (if (list? value) (reverse value) value)) ((= type-name "Unique") @@ -998,7 +1018,9 @@ ((= type-name "Map") (if (dict? value) - (map (fn (k) (list k (get value k))) (keys value)) + (let + ((ks (if (dict-has? value "_order") (get value "_order") (filter (fn (k) (not (= k "_order"))) (keys value))))) + (map (fn (k) (list k (get value k))) ks)) value)) (true value)))) @@ -2012,11 +2034,20 @@ (fn (pairs) (let - ((d {})) + ((d {}) (order (list))) (do (for-each - (fn (pair) (dict-set! d (first pair) (nth pair 1))) + (fn + (pair) + (let + ((k (first pair))) + (do + (when + (not (dict-has? d k)) + (set! order (append order (list k)))) + (dict-set! d k (nth pair 1))))) pairs) + (when (not (empty? order)) (dict-set! d "_order" order)) d)))) (define diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index 800da93f..6dc0430d 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -337,14 +337,33 @@ (ast) (let ((var-name (nth ast 1)) - (raw-coll (hs-to-sx (nth ast 2))) - (collection + (raw-coll-ast (nth ast 2)) + (where-cond + (if + (and + (list? raw-coll-ast) + (= (first raw-coll-ast) (quote coll-where))) + (hs-to-sx (nth raw-coll-ast 2)) + nil)) + (inner-coll-ast + (if where-cond (nth raw-coll-ast 1) raw-coll-ast)) + (raw-coll (hs-to-sx inner-coll-ast)) + (safe-coll (if (symbol? raw-coll) (list - (quote hs-safe-call) - (list (quote fn) (list) raw-coll)) + (quote cek-try) + (list (quote fn) (list) raw-coll) + (list (quote fn) (list (quote _e)) nil)) raw-coll)) + (collection + (if + where-cond + (list + (quote filter) + (list (quote fn) (list (make-symbol var-name)) where-cond) + safe-coll) + safe-coll)) (body (hs-to-sx (nth ast 3)))) (if (and (> (len ast) 4) (= (nth ast 4) :index)) @@ -839,7 +858,7 @@ (list (quote hs-beep) (hs-to-sx (nth ast 1)))) ((= head (quote array-index)) (list - (quote nth) + (quote hs-index) (hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 2)))) ((= head (quote array-slice)) diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index c009c2b1..cb2f3bf9 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -244,7 +244,8 @@ ((value (cond ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (cond ((= v "true") true) ((= v "false") false) ((= v "null") nil) (true (list (quote ref) v)))))) ((= (tp-type) "colon") (do (adv!) (parse-expr))) (true (parse-expr))))) (do (when (= (tp-type) "comma") (adv!)) - (obj-collect (cons (list key value) acc)))))))) + (obj-collect + (append acc (list (list key value)))))))))) (list (quote object-literal) (obj-collect (list))))) ((and (= typ "op") (= val "\\")) (do diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index 72ea0918..c419cf05 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -387,6 +387,21 @@ ;; Fetch a URL, parse response according to format. ;; (hs-fetch url format) — format is "json" | "text" | "html" +(define + hs-index + (fn + (obj key) + (cond + ((nil? obj) nil) + ((dict? obj) (get obj key)) + ((list? obj) (nth obj key)) + ((string? obj) (nth obj key)) + (true (host-get obj key))))) + +;; ── Type coercion ─────────────────────────────────────────────── + +;; Coerce a value to a type by name. +;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc. (define hs-put-at! (fn @@ -399,16 +414,19 @@ (cons value target) (append target (list value)))) (true - (do - (cond - ((= pos "end") (host-call target "push" value)) - ((= pos "start") (host-call target "unshift" value))) - target))))) + (cond + ((hs-element? target) (do (hs-put! value pos target) target)) + (true + (do + (cond + ((= pos "end") (host-call target "push" value)) + ((= pos "start") (host-call target "unshift" value))) + target))))))) -;; ── Type coercion ─────────────────────────────────────────────── +;; ── Object creation ───────────────────────────────────────────── -;; Coerce a value to a type by name. -;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc. +;; Make a new object of a given type. +;; (hs-make type-name) — creates empty object/collection (define hs-dict-without (fn @@ -429,27 +447,27 @@ (host-call (host-global "Reflect") "deleteProperty" out key) out))))) -;; ── Object creation ───────────────────────────────────────────── +;; ── Behavior installation ─────────────────────────────────────── -;; Make a new object of a given type. -;; (hs-make type-name) — creates empty object/collection +;; Install a behavior on an element. +;; A behavior is a function that takes (me ...params) and sets up features. +;; (hs-install behavior-fn me ...args) (define hs-set-on! (fn (props target) (for-each (fn (k) (host-set! target k (get props k))) (keys props)))) -;; ── Behavior installation ─────────────────────────────────────── - -;; Install a behavior on an element. -;; A behavior is a function that takes (me ...params) and sets up features. -;; (hs-install behavior-fn me ...args) -(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url)))) - ;; ── Measurement ───────────────────────────────────────────────── ;; Measure an element's bounding rect, store as local variables. ;; Returns a dict with x, y, width, height, top, left, right, bottom. +(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url)))) + +;; Return the current text selection as a string. In the browser this is +;; `window.getSelection().toString()`. In the mock test runner, a test +;; setup stashes the desired selection text at `window.__test_selection` +;; and the fallback path returns that so tests can assert on the result. (define hs-scroll! (fn @@ -462,10 +480,11 @@ ((= position "bottom") (dict :block "end")) (true (dict :block "start"))))))) -;; Return the current text selection as a string. In the browser this is -;; `window.getSelection().toString()`. In the mock test runner, a test -;; setup stashes the desired selection text at `window.__test_selection` -;; and the fallback path returns that so tests can assert on the result. + +;; ── Transition ────────────────────────────────────────────────── + +;; Transition a CSS property to a value, optionally with duration. +;; (hs-transition target prop value duration) (define hs-halt! (fn @@ -486,11 +505,6 @@ (host-call ev "stopPropagation"))))) (when (not (= mode "the-event")) (raise (list "hs-return" nil)))))) - -;; ── Transition ────────────────────────────────────────────────── - -;; Transition a CSS property to a value, optionally with duration. -;; (hs-transition target prop value duration) (define hs-select! (fn (target) (host-call target "select" (list)))) (define @@ -619,6 +633,10 @@ hs-query-first (fn (sel) (host-call (host-global "document") "querySelector" sel))) + + + + (define hs-query-last (fn @@ -627,12 +645,9 @@ ((all (dom-query-all (dom-body) sel))) (if (> (len all) 0) (nth all (- (len all) 1)) nil)))) - - - - (define hs-first (fn (scope sel) (dom-query-all scope sel))) - +;; ── Sandbox/test runtime additions ────────────────────────────── +;; Property access — dot notation and .length (define hs-last (fn @@ -640,8 +655,7 @@ (let ((all (dom-query-all scope sel))) (if (> (len all) 0) (nth all (- (len all) 1)) nil)))) -;; ── Sandbox/test runtime additions ────────────────────────────── -;; Property access — dot notation and .length +;; DOM query stub — sandbox returns empty list (define hs-repeat-times (fn @@ -659,7 +673,7 @@ ((= signal "hs-continue") (do-repeat (+ i 1))) (true (do-repeat (+ i 1)))))))) (do-repeat 0))) -;; DOM query stub — sandbox returns empty list +;; Method dispatch — obj.method(args) (define hs-repeat-forever (fn @@ -675,7 +689,9 @@ ((= signal "hs-continue") (do-forever)) (true (do-forever)))))) (do-forever))) -;; Method dispatch — obj.method(args) + +;; ── 0.9.90 features ───────────────────────────────────────────── +;; beep! — debug logging, returns value unchanged (define hs-repeat-while (fn @@ -688,9 +704,7 @@ ((= signal "hs-break") nil) ((= signal "hs-continue") (hs-repeat-while cond-fn thunk)) (true (hs-repeat-while cond-fn thunk))))))) - -;; ── 0.9.90 features ───────────────────────────────────────────── -;; beep! — debug logging, returns value unchanged +;; Property-based is — check obj.key truthiness (define hs-repeat-until (fn @@ -702,13 +716,13 @@ ((= signal "hs-continue") (if (cond-fn) nil (hs-repeat-until cond-fn thunk))) (true (if (cond-fn) nil (hs-repeat-until cond-fn thunk))))))) -;; Property-based is — check obj.key truthiness +;; Array slicing (inclusive both ends) (define hs-for-each (fn (fn-body collection) (let - ((items (cond ((list? collection) collection) ((dict? collection) (keys collection)) ((nil? collection) (list)) (true (list))))) + ((items (cond ((list? collection) collection) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) ((nil? collection) (list)) (true (list))))) (define do-loop (fn @@ -722,7 +736,7 @@ ((= signal "hs-continue") (do-loop (rest remaining))) (true (do-loop (rest remaining)))))))) (do-loop items)))) -;; Array slicing (inclusive both ends) +;; Collection: sorted by (begin (define hs-append @@ -750,7 +764,7 @@ ((hs-element? target) (dom-insert-adjacent-html target "beforeend" (str value))) (true nil))))) -;; Collection: sorted by +;; Collection: sorted by descending (define hs-sender (fn @@ -758,7 +772,7 @@ (let ((detail (host-get event "detail"))) (if detail (host-get detail "sender") nil)))) -;; Collection: sorted by descending +;; Collection: split by (define hs-host-to-sx (fn @@ -812,7 +826,7 @@ (dict-set! out k (hs-host-to-sx (host-get v k)))) (host-call (host-global "Object") "keys" v)) out))))))))))) -;; Collection: split by +;; Collection: joined by (define hs-fetch (fn @@ -822,7 +836,7 @@ (let ((raw (perform (list "io-fetch" url fmt)))) (cond ((= fmt "json") (hs-host-to-sx raw)) (true raw)))))) -;; Collection: joined by + (define hs-json-escape (fn @@ -958,11 +972,17 @@ ((= type-name "Selector") (str value)) ((= type-name "Fragment") value) ((= type-name "Values") (hs-as-values value)) - ((= type-name "Keys") (if (dict? value) (sort (keys value)) value)) + ((= type-name "Keys") + (if + (dict? value) + (sort (filter (fn (k) (not (= k "_order"))) (keys value))) + value)) ((= type-name "Entries") (if (dict? value) - (map (fn (k) (list k (get value k))) (keys value)) + (let + ((ks (if (dict-has? value "_order") (get value "_order") (filter (fn (k) (not (= k "_order"))) (keys value))))) + (map (fn (k) (list k (get value k))) ks)) value)) ((= type-name "Reversed") (if (list? value) (reverse value) value)) ((= type-name "Unique") @@ -998,7 +1018,9 @@ ((= type-name "Map") (if (dict? value) - (map (fn (k) (list k (get value k))) (keys value)) + (let + ((ks (if (dict-has? value "_order") (get value "_order") (filter (fn (k) (not (= k "_order"))) (keys value))))) + (map (fn (k) (list k (get value k))) ks)) value)) (true value)))) @@ -2012,11 +2034,20 @@ (fn (pairs) (let - ((d {})) + ((d {}) (order (list))) (do (for-each - (fn (pair) (dict-set! d (first pair) (nth pair 1))) + (fn + (pair) + (let + ((k (first pair))) + (do + (when + (not (dict-has? d k)) + (set! order (append order (list k)))) + (dict-set! d k (nth pair 1))))) pairs) + (when (not (empty? order)) (dict-set! d "_order" order)) d)))) (define