sx: step 6 — JS AdtValue + define-type + match
Mirror of OCaml Step 5 to the JavaScript host. Native ADT representation for define-type instances, with the same dict-shaped shim approach so spec-level match-pattern code in evaluator.sx works without changes. - platform.py typeOf: recognize ._adtv tag, return ._type (so (type-of (Just 42)) returns "Maybe" not "dict"). - platform.py adds makeAdtValue/isAdtValue helpers and registers PRIMITIVES["adt?"], "make-adt-value", "adt-value?". - platform.py inspect: format AdtValue as "(Ctor f1 f2 ...)" and register as a primitive (was missing entirely on JS). - fixups_js: hand-written define-type override that constructs AdtValue via makeAdtValue, with arity check, type/ctor predicates, and field accessors. Re-registered via registerSpecialForm so the CEK dispatch routes through it. - dict? unchanged: AdtValue still passes (no _adtv exclusion) so the existing (and (dict? v) (get v :_adt) ...) checks in spec predicates keep working. Tests: 2578 pass (was 2575), zero regressions. All 43 ADT tests pass on the JS host (was 40, the 3 new Step 5 tests for type-of / adt? / inspect are now green). Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1129,6 +1129,7 @@ PRIMITIVES_JS_MODULES: dict[str, str] = {
|
|||||||
PRIMITIVES["boolean?"] = function(x) { return x === true || x === false; };
|
PRIMITIVES["boolean?"] = function(x) { return x === true || x === false; };
|
||||||
PRIMITIVES["symbol?"] = function(x) { return x != null && x._sym === true; };
|
PRIMITIVES["symbol?"] = function(x) { return x != null && x._sym === true; };
|
||||||
PRIMITIVES["keyword?"] = function(x) { return x != null && x._kw === true; };
|
PRIMITIVES["keyword?"] = function(x) { return x != null && x._kw === true; };
|
||||||
|
PRIMITIVES["adt?"] = function(x) { return x !== null && typeof x === "object" && x._adtv === true; };
|
||||||
PRIMITIVES["component-affinity"] = componentAffinity;
|
PRIMITIVES["component-affinity"] = componentAffinity;
|
||||||
''',
|
''',
|
||||||
|
|
||||||
@@ -1933,12 +1934,30 @@ PLATFORM_JS_PRE = '''
|
|||||||
if (x._regexp) return "regexp";
|
if (x._regexp) return "regexp";
|
||||||
if (x._bytevector) return "bytevector";
|
if (x._bytevector) return "bytevector";
|
||||||
if (x._rational) return "rational";
|
if (x._rational) return "rational";
|
||||||
|
if (x._adtv) return x._type;
|
||||||
if (typeof Node !== "undefined" && x instanceof Node) return "dom-node";
|
if (typeof Node !== "undefined" && x instanceof Node) return "dom-node";
|
||||||
if (Array.isArray(x)) return "list";
|
if (Array.isArray(x)) return "list";
|
||||||
if (typeof x === "object") return "dict";
|
if (typeof x === "object") return "dict";
|
||||||
return "unknown";
|
return "unknown";
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// AdtValue — native algebraic data type instance (Step 6 mirror of OCaml Step 5).
|
||||||
|
// Constructed by define-type. Carries _adt:true plus _adtv:true tag so type-of
|
||||||
|
// returns the type name rather than "dict". dict? remains true (shim approach)
|
||||||
|
// so spec-level match-pattern in evaluator.sx works without changes.
|
||||||
|
function makeAdtValue(typeName, ctorName, fields) {
|
||||||
|
return {
|
||||||
|
_adtv: true,
|
||||||
|
_adt: true,
|
||||||
|
_type: typeName,
|
||||||
|
_ctor: ctorName,
|
||||||
|
_fields: fields
|
||||||
|
};
|
||||||
|
}
|
||||||
|
function isAdtValue(x) {
|
||||||
|
return x !== null && typeof x === "object" && x._adtv === true;
|
||||||
|
}
|
||||||
|
|
||||||
function symbolName(s) { return s.name; }
|
function symbolName(s) { return s.name; }
|
||||||
function keywordName(k) { return k.name; }
|
function keywordName(k) { return k.name; }
|
||||||
function makeSymbol(n) { return new Symbol(n); }
|
function makeSymbol(n) { return new Symbol(n); }
|
||||||
@@ -2126,7 +2145,16 @@ PLATFORM_JS_PRE = '''
|
|||||||
}
|
}
|
||||||
|
|
||||||
function error(msg) { throw new Error(msg); }
|
function error(msg) { throw new Error(msg); }
|
||||||
function inspect(x) { return JSON.stringify(x); }
|
function inspect(x) {
|
||||||
|
if (x !== null && typeof x === "object" && x._adtv === true) {
|
||||||
|
var fs = x._fields || [];
|
||||||
|
if (fs.length === 0) return "(" + x._ctor + ")";
|
||||||
|
var parts = [];
|
||||||
|
for (var i = 0; i < fs.length; i++) parts.push(inspect(fs[i]));
|
||||||
|
return "(" + x._ctor + " " + parts.join(" ") + ")";
|
||||||
|
}
|
||||||
|
return JSON.stringify(x);
|
||||||
|
}
|
||||||
function debugLog() { console.error.apply(console, ["[sx-debug]"].concat(Array.prototype.slice.call(arguments))); }
|
function debugLog() { console.error.apply(console, ["[sx-debug]"].concat(Array.prototype.slice.call(arguments))); }
|
||||||
|
|
||||||
'''
|
'''
|
||||||
@@ -2450,6 +2478,7 @@ CEK_FIXUPS_JS = '''
|
|||||||
// Platform functions — defined in platform_js.py, not in .sx spec files.
|
// Platform functions — defined in platform_js.py, not in .sx spec files.
|
||||||
// Spec defines self-register via js-emit-define; these are the platform interface.
|
// Spec defines self-register via js-emit-define; these are the platform interface.
|
||||||
PRIMITIVES["type-of"] = typeOf;
|
PRIMITIVES["type-of"] = typeOf;
|
||||||
|
PRIMITIVES["inspect"] = inspect;
|
||||||
PRIMITIVES["symbol-name"] = symbolName;
|
PRIMITIVES["symbol-name"] = symbolName;
|
||||||
PRIMITIVES["keyword-name"] = keywordName;
|
PRIMITIVES["keyword-name"] = keywordName;
|
||||||
PRIMITIVES["callable?"] = isCallable;
|
PRIMITIVES["callable?"] = isCallable;
|
||||||
@@ -4103,7 +4132,56 @@ def fixups_js(has_html, has_sx, has_dom, has_signals=False, has_deps=False, has_
|
|||||||
function clearStores() { _storeRegistry = {}; return NIL; }
|
function clearStores() { _storeRegistry = {}; return NIL; }
|
||||||
PRIMITIVES["def-store"] = defStore;
|
PRIMITIVES["def-store"] = defStore;
|
||||||
PRIMITIVES["use-store"] = useStore;
|
PRIMITIVES["use-store"] = useStore;
|
||||||
PRIMITIVES["clear-stores"] = clearStores;''']
|
PRIMITIVES["clear-stores"] = clearStores;
|
||||||
|
|
||||||
|
// -----------------------------------------------------------------------
|
||||||
|
// define-type override — produces native AdtValue instances (Step 6).
|
||||||
|
// The transpiled sfDefineType from evaluator.sx creates plain dict
|
||||||
|
// instances. We override here to construct AdtValue via makeAdtValue so
|
||||||
|
// type-of returns the type name and adt? can distinguish from dicts.
|
||||||
|
// dict? still returns true for AdtValue (shim) so spec-level match-pattern
|
||||||
|
// continues to work without changes.
|
||||||
|
// -----------------------------------------------------------------------
|
||||||
|
var _sfDefineTypeAdt = function(args, env) {
|
||||||
|
var typeSym = first(args);
|
||||||
|
var ctorSpecs = rest(args);
|
||||||
|
var typeName = symbolName(typeSym);
|
||||||
|
var ctorNames = map(function(spec) { return symbolName(first(spec)); }, ctorSpecs);
|
||||||
|
if (!isSxTruthy(envHas(env, "*adt-registry*"))) {
|
||||||
|
envBind(env, "*adt-registry*", {});
|
||||||
|
}
|
||||||
|
envGet(env, "*adt-registry*")[typeName] = ctorNames;
|
||||||
|
envBind(env, typeName + "?", function(v) { return isAdtValue(v) && v._type === typeName; });
|
||||||
|
for (var _i = 0; _i < ctorSpecs.length; _i++) {
|
||||||
|
(function(spec) {
|
||||||
|
var cn = symbolName(first(spec));
|
||||||
|
var fieldNames = map(function(f) { return symbolName(f); }, rest(spec));
|
||||||
|
var arity = fieldNames.length;
|
||||||
|
envBind(env, cn, function() {
|
||||||
|
var ctorArgs = Array.prototype.slice.call(arguments, 0);
|
||||||
|
if (ctorArgs.length !== arity) {
|
||||||
|
throw new Error(cn + ": expected " + arity + " args, got " + ctorArgs.length);
|
||||||
|
}
|
||||||
|
return makeAdtValue(typeName, cn, ctorArgs);
|
||||||
|
});
|
||||||
|
envBind(env, cn + "?", function(v) { return isAdtValue(v) && v._ctor === cn; });
|
||||||
|
for (var _j = 0; _j < fieldNames.length; _j++) {
|
||||||
|
(function(idx, fieldName) {
|
||||||
|
envBind(env, cn + "-" + fieldName, function(v) {
|
||||||
|
if (!isAdtValue(v)) throw new Error(cn + "-" + fieldName + ": not an ADT");
|
||||||
|
if (idx >= v._fields.length) throw new Error(cn + "-" + fieldName + ": index out of bounds");
|
||||||
|
return v._fields[idx];
|
||||||
|
});
|
||||||
|
})(_j, fieldNames[_j]);
|
||||||
|
}
|
||||||
|
})(ctorSpecs[_i]);
|
||||||
|
}
|
||||||
|
return NIL;
|
||||||
|
};
|
||||||
|
PRIMITIVES["sf-define-type"] = _sfDefineTypeAdt;
|
||||||
|
registerSpecialForm("define-type", _sfDefineTypeAdt);
|
||||||
|
PRIMITIVES["make-adt-value"] = makeAdtValue;
|
||||||
|
PRIMITIVES["adt-value?"] = isAdtValue;''']
|
||||||
if has_deps:
|
if has_deps:
|
||||||
lines.append('''
|
lines.append('''
|
||||||
// Platform deps functions (native JS, not transpiled — need explicit registration)
|
// Platform deps functions (native JS, not transpiled — need explicit registration)
|
||||||
|
|||||||
@@ -190,7 +190,7 @@ these when operands are known numbers/lists.
|
|||||||
| 3 — tokenizer :end/:line | [x] | 023bc2d8 |
|
| 3 — tokenizer :end/:line | [x] | 023bc2d8 |
|
||||||
| 4 — parser spans complete | [x] | b7ad5152 (subsumed by 023bc2d8) |
|
| 4 — parser spans complete | [x] | b7ad5152 (subsumed by 023bc2d8) |
|
||||||
| 5 — OCaml AdtValue + define-type + match | [x] | 1f49242a |
|
| 5 — OCaml AdtValue + define-type + match | [x] | 1f49242a |
|
||||||
| 6 — JS AdtValue + define-type + match | [ ] | — |
|
| 6 — JS AdtValue + define-type + match | [x] | (pending) |
|
||||||
| 7 — nested patterns | [ ] | — |
|
| 7 — nested patterns | [ ] | — |
|
||||||
| 8 — exhaustiveness warnings | [ ] | — |
|
| 8 — exhaustiveness warnings | [ ] | — |
|
||||||
| 9 — parser feature registry | [ ] | — |
|
| 9 — parser feature registry | [ ] | — |
|
||||||
|
|||||||
File diff suppressed because one or more lines are too long
Reference in New Issue
Block a user