commit a731e795e9dc59556a16bd404ffce861a526c276
parent 4a5f37a8d56f569536861d30a74d9f45467495d6
Author: James Eversole <james@eversole.co>
Date: Sun, 18 Oct 2026 11:13:54 -0500
Index stable compiler name lookup with shared resolver and ordering machinery
Lazy persistent structural trie preserves first binding and opaque values. Share lookup-aware pattern/scope resolution and ordered compilation instead of shipping the experimental duplicate visitor. Keep association-list entrypoint contracts. Inspector-visible compiler helper trees intentionally change; frozen full builds still reproduce identical application outputs.
Integrated 28-module matched full builds: Haskell R-C-C-R totals 241.05/201.16/201.52/242.81s; Zig 389.17/304.54s. Complete manifests and three bundles agree. 294 independent index lookups, poison/persistence/wrong-worker controls, 75 source outcomes, 46 local controls, 38 ordering controls, and 2 AST replies pass. Fixtures and promotion remain pending fresh acceptance.
Diffstat:
13 files changed, 498 insertions(+), 163 deletions(-)
diff --git a/bootstrap/compiler-source-map.v1 b/bootstrap/compiler-source-map.v1
@@ -1,6 +1,7 @@
arboricx.source-map.v1
+native source_index source.index lib/source/index.tri prelude
native source_map source.map lib/source/map.tri prelude,io,source_object,source_module,source_resolve,source_build
-native source_unit source.unit lib/source/unit.tri prelude,parser,source_order,source_compile,source_program,source_resolve,source_ast,source_stable
+native source_unit source.unit lib/source/unit.tri prelude,parser,source_order,source_compile,source_program,source_resolve,source_ast,source_stable,source_index
native prelude prelude lib/prelude.tri base,bytes,conversions
native io io lib/io.tri base
native source_object source.object lib/source/object.tri prelude,io,native_math
@@ -8,7 +9,7 @@ native source_module source.module lib/source/module.tri prelude,io,source_objec
native source_resolve source.resolve lib/source/resolve.tri prelude,parser,source_parser,source_ast,source_lexer,source_core,source_equations,source_pattern
native source_build source.build lib/source/build.tri prelude,io,source_object,source_module,source_lock,source_bundle,source_resolve,source_unit
native parser parser lib/parser.tri prelude
-native source_order source.order lib/source/order.tri prelude,parser,graph,source_program,source_resolve,source_ast,source_equations
+native source_order source.order lib/source/order.tri prelude,parser,graph,source_program,source_resolve,source_ast,source_equations,source_index
native source_compile source.compile lib/source/compile.tri prelude,parser,source_resolve,source_core
native source_program source.program lib/source/program.tri prelude,parser,source_parser,source_lexer,source_ast,source_equations
native source_ast source.ast lib/source/ast.tri prelude,source_lexer
diff --git a/docs/validation.md b/docs/validation.md
@@ -1245,3 +1245,23 @@ checks above. Changes also require compiler source/diagnostic, HTTP header and
UTF-8 boundary checks; classifier tests alone are not consumer or generation
acceptance. Performance measurements must use matched complete workloads, not
only individual predicates.
+
+## Compiler name-index controls (opt-in)
+
+```sh
+python3 test/name_index.py result/bin/tricu --directory "$FRESH_CHECK"
+# Also select a rebuilt source_unit bundle, with unqualified export names:
+python3 test/name_index.py result/bin/tricu --directory "$FRESH_UNIT_CHECK" \
+ --unit "$UNIT_BUNDLE" --reference "$REFERENCE_COMPILER_LIBRARY"
+```
+
+The first rebuilds `source_index` and its current prelude dependencies through
+an authenticated packaged compiler. It checks complete results against host
+first-match lookup, persistent overrides, misses, opaque values, partial-key/tail
+demand controls, and a deliberately wrong worker. The optional module check uses
+75 independent source outcomes (shared with `source_equations.py`), compares
+complete reference/candidate results, and checks environment precedence and
+demand. Selected unit/reference artifacts are fingerprinted, not source-freshness
+certified by this option; select audited rebuilt artifacts. Finite poison tests
+are not a general termination-equivalence proof. This check neither accepts a
+generation nor publishes fixtures.
diff --git a/lib/source/index.tri b/lib/source/index.tri
@@ -0,0 +1,41 @@
+!import prelude *
+!export sourceIndexBuild
+!export sourceIndexPut
+!export sourceIndexGet
+
+-- A prefix trie of the Leaf/Stem/Fork preorder of a key tree. Complete tree
+-- encodings are prefix-free. Empty = Leaf, terminal = Stem opaque-value,
+-- branch = Fork leaf-child (Fork stem-child fork-child).
+-- Build is lazy and first-binding-wins; put overrides one key. Values are
+-- never inspected. Compiler callers supply proper binding lists and finite keys.
+sourceIndexLeaf index = triage t (_ : t) (a bc : a) index
+sourceIndexStem index = triage t (_ : t) (a bc : fst bc) index
+sourceIndexFork index = triage t (_ : t) (a bc : snd bc) index
+
+sourceIndexPutPending pending value index = (lazyList
+ (_ : just value)
+ (key rest : triage
+ (pair (sourceIndexPutPending rest value (sourceIndexLeaf index))
+ (pair (sourceIndexStem index) (sourceIndexFork index)))
+ (child : pair (sourceIndexLeaf index)
+ (pair (sourceIndexPutPending (pair child rest) value (sourceIndexStem index))
+ (sourceIndexFork index)))
+ (left right : pair (sourceIndexLeaf index)
+ (pair (sourceIndexStem index)
+ (sourceIndexPutPending (pair left (pair right rest)) value (sourceIndexFork index))))
+ key)
+ pending)
+sourceIndexPut key value index = sourceIndexPutPending [key] value index
+sourceIndexBuild entries = (lazyList (_ : t)
+ (entry rest : sourceIndexPut (fst entry) (snd entry) (sourceIndexBuild rest)) entries)
+sourceIndexGetPending pending index = (triage nothing
+ (value : lazyList (_ : just value) (_ _ : nothing) pending)
+ (a bc : lazyList (_ : nothing)
+ (key rest : triage
+ (sourceIndexGetPending rest a)
+ (child : sourceIndexGetPending (pair child rest) (fst bc))
+ (left right : sourceIndexGetPending (pair left (pair right rest)) (snd bc))
+ key)
+ pending)
+ index)
+sourceIndexGet index key = sourceIndexGetPending [key] index
diff --git a/lib/source/order.tri b/lib/source/order.tri
@@ -5,6 +5,7 @@
!import source_resolve *
!import source_ast *
!import source_equations *
+!import source_index *
!export *
sourceFindDefinition definitions name = (let rec
@@ -118,7 +119,7 @@ sourceDefinitionGraph definitions = (map
-- Validate each located free name and retain its local edge in the same pass.
-- Do not deduplicate/reorder edges: their order determines cycle witnesses.
-- A local definition wins over an external with the same spelling.
-sourceAnalyzeNames names definitions environment = (let rec
+sourceAnalyzeNamesUsing findDefinition findExternal names = (let rec
walk names = (lazyList
(_ : ok t t)
(node rest : lazyMaybe
@@ -126,18 +127,18 @@ sourceAnalyzeNames names definitions environment = (let rec
(_ : err (parserDiagnostic 20 (sourceAstPayload node) t
(sourceAstStart node) t) node)
(_ : walk rest)
- (sourceFindExternal environment (sourceAstPayload node)))
+ (findExternal (sourceAstPayload node)))
(_ : lazyResult
(diagnostic missing : err diagnostic missing)
(dependencies unused : ok (pair (sourceAstPayload node) dependencies) t)
(walk rest))
- (sourceFindDefinition definitions (sourceAstPayload node))) names)
+ (findDefinition (sourceAstPayload node))) names)
in walk names)
-- Equation validation still precedes names in each definition. Only after all
-- definitions succeed may final-expression validation and graph sorting run.
-- The reversed accumulator is constructor-only; reverse once on completion.
-sourceAnalyzeDefinitions definitions environment = (let rec
+sourceAnalyzeDefinitionsUsing findDefinition findExternal definitions = (let rec
walk pending reversed = (lazyList
(_ : ok (reverse reversed) t)
(definition rest : lazyResult
@@ -146,8 +147,7 @@ sourceAnalyzeDefinitions definitions environment = (let rec
(diagnostic missing : err diagnostic missing)
(dependencies unused : walk rest
(pair (pair (sourceDefinitionName definition) dependencies) reversed))
- (sourceAnalyzeNames (sourceFreeNames (sourceDefinitionBody definition))
- definitions environment))
+ (sourceAnalyzeNamesUsing findDefinition findExternal (sourceFreeNames (sourceDefinitionBody definition))))
(sourceEquationValidate (sourceDefinitionBody definition))) pending)
in walk definitions t)
@@ -158,12 +158,12 @@ sourceOrderCycle definitions name =
(sourceDefinitionPosition definition) (pair name t))
(sourceFindDefinition definitions name)
-orderGateProgram environment program = (let definitions = sourceProgramDefinitions program in
+orderGateProgramUsing analyze environment program = (let definitions = sourceProgramDefinitions program in
let proceed reply next = (lazyResult
(diagnostic rest : err diagnostic rest) (value unused : next value) reply) in
do proceed
sourceCheckDuplicates definitions
- graph <- sourceAnalyzeDefinitions definitions environment
+ graph <- analyze definitions
sourceCheckFinalNames (sourceProgramFinal program) definitions environment
(lazyResult
(cycle unused : err (sourceOrderCycle definitions cycle) t)
@@ -185,3 +185,16 @@ sourceFreeVisit node bound = (case sourceAstKind node of
append (sourceFreeVisit (sourceAstLetValue node) nested)
(sourceFreeVisit (sourceAstLetBody node) nested))
_ = sourceFreeOrdinary sourceFreeVisit node bound)
+
+sourceAnalyzeNames names definitions environment = sourceAnalyzeNamesUsing
+ (sourceFindDefinition definitions) (sourceFindExternal environment) names
+sourceAnalyzeDefinitions definitions environment = sourceAnalyzeDefinitionsUsing
+ (sourceFindDefinition definitions) (sourceFindExternal environment) definitions
+orderGateProgram environment program = orderGateProgramUsing
+ (definitions : sourceAnalyzeDefinitions definitions environment) environment program
+
+-- Values (including definition bodies) are opaque to index construction.
+sourceDefinitionIndex definitions = sourceIndexBuild
+ (map (definition : pair (sourceDefinitionName definition) definition) definitions)
+sourceAnalyzeIndexedDefinitions external definitions = sourceAnalyzeDefinitionsUsing
+ (sourceIndexGet (sourceDefinitionIndex definitions)) (sourceIndexGet external) definitions
diff --git a/lib/source/resolve.tri b/lib/source/resolve.tri
@@ -23,7 +23,7 @@ sourceFindExternal entries name = (let rec
(_ : find rest) (equal? (fst entry) name)) entries)
in find entries)
-sourceResolveName node binders environment =
+sourceResolveNameWithLookup lookup node binders environment =
lazyMaybe
(_ : lazyMaybe
(_ : err
@@ -32,7 +32,7 @@ sourceResolveName node binders environment =
node)
(tree : ok (sourceCoreExternal tree
(sourceAstStart node) (sourceAstEnd node)) t)
- (sourceFindExternal environment (sourceAstPayload node)))
+ (lookup environment (sourceAstPayload node)))
(index : ok (sourceCoreBound index
(sourceAstStart node) (sourceAstEnd node)) t)
(sourceFindBinder binders (sourceAstPayload node))
@@ -132,45 +132,45 @@ sourceResolvePatternChild resolve pattern child binders environment = (lazyResul
(diagnostic remainder : err diagnostic remainder)
(core unused : ok (sourceResolvePatternNode pattern core) t)
(resolve child binders environment))
-sourceResolvePattern pattern binders environment = (let tag = sourceEquationTag pattern in
+sourceResolvePatternLookup lookup pattern binders environment = (let tag = sourceEquationTag pattern in
let payload = sourceEquationPayload pattern in
- lazyBool (_ : sourceResolvePatternChild sourceResolvePattern pattern payload binders environment)
+ lazyBool (_ : sourceResolvePatternChild (sourceResolvePatternLookup lookup) pattern payload binders environment)
(_ : lazyBool
(_ : lazyResult (diagnostic remainder : err diagnostic remainder)
(left unused : lazyResult (diagnostic remainder : err diagnostic remainder)
(right unused : ok (sourceResolvePatternNode pattern (pair left right)) t)
- (sourceResolvePattern (snd payload) binders environment))
- (sourceResolvePattern (fst payload) binders environment))
+ (sourceResolvePatternLookup lookup (snd payload) binders environment))
+ (sourceResolvePatternLookup lookup (fst payload) binders environment))
(_ : lazyBool
(_ : lazyResult (diagnostic remainder : err diagnostic remainder)
(child unused : ok (sourceResolvePatternNode pattern (pair (fst payload) child)) t)
- (sourceResolvePattern (snd payload) binders environment))
+ (sourceResolvePatternLookup lookup (snd payload) binders environment))
(_ : lazyBool
- (_ : sourceResolvePatternChild sourceResolveName pattern payload binders environment)
+ (_ : sourceResolvePatternChild (sourceResolveNameWithLookup lookup) pattern payload binders environment)
(_ : ok (sourceResolvePatternNode pattern payload) t) (equal? tag 7))
(equal? tag 6)) (equal? tag 3)) (equal? tag 2))
-sourceResolveEquation resolve equation binders environment = (lazyResult
+sourceResolveEquationLookup lookup resolve equation binders environment = (lazyResult
(diagnostic remainder : err diagnostic remainder)
(patterns unused : lazyResult (diagnostic remainder : err diagnostic remainder)
(body unused : ok (sourceEquation patterns body) t)
(resolve (snd equation)
(append (reverse (sourceEquationCollect (fst equation) sourceEquationCaptures)) binders)
environment))
- (sourceResolveElements (fst equation) sourceResolvePattern binders environment))
-sourceResolveEquationsWith lower resolve node binders environment = (lazyResult
+ (sourceResolveElements (fst equation) (sourceResolvePatternLookup lookup) binders environment))
+sourceResolveEquationsWithLookup lookup lower resolve node binders environment = (lazyResult
(diagnostic remainder : err diagnostic remainder)
(_ unused : lazyResult (diagnostic remainder : err diagnostic remainder)
(equations unused : lazyResult (diagnostic remainder : err diagnostic remainder)
(core unused : ok (sourceCoreWithSpan core (sourceAstStart node) (sourceAstEnd node)) t)
(lower equations))
- (sourceResolveElements (sourceAstPayload node) (sourceResolveEquation resolve) binders environment))
+ (sourceResolveElements (sourceAstPayload node) (sourceResolveEquationLookup lookup resolve) binders environment))
(sourceEquationCheckGroup node))
sourceResolveEquations = sourceResolveEquationsWith sourceLowerEquations
-sourceResolveOrdinary resolve node binders environment = (case sourceAstKind node of
+sourceResolveOrdinaryWithLookup lookup resolve node binders environment = (case sourceAstKind node of
^sourceAstLeafKind = ok (sourceCoreLeaf (sourceAstStart node) (sourceAstEnd node)) t
- ^sourceAstNameKind = sourceResolveName node binders environment
+ ^sourceAstNameKind = sourceResolveNameWithLookup lookup node binders environment
^sourceAstApplyKind = sourceResolveApply resolve node binders environment
^sourceAstLambdaKind = sourceResolveLambda resolve node binders environment
^sourceAstGroupKind = sourceResolveGroup resolve node binders environment
@@ -182,7 +182,7 @@ sourceResolveOrdinary resolve node binders environment = (case sourceAstKind nod
^sourceAstLetKind = sourceResolveLocal resolve node binders environment
^sourceAstPipeKind = sourceResolvePipe resolve node binders environment
^sourceAstDoKind = sourceResolveDo resolve node binders environment
- ^sourceAstEquationsKind = sourceResolveEquations resolve node binders environment
+ ^sourceAstEquationsKind = sourceResolveEquationsWithLookup lookup sourceLowerEquations resolve node binders environment
_ = err (parserDiagnostic 21 t (sourceAstKind node) (sourceAstStart node) t) node)
resolveGateAst = (environment node :
@@ -225,13 +225,23 @@ sourceResolve node binders environment = (case sourceAstKind node of
^sourceAstRecKind = sourceResolveRec sourceResolve node binders environment
_ = sourceResolveOrdinary sourceResolve node binders environment)
--- Keep the ordinary visitor/backend unchanged. The stable visitor intercepts
+-- Backend selection is unchanged. The stable visitor intercepts
-- equation groups, including those reached through local/case/recursive bodies;
-- all other resolution, lexical scope and diagnostic ordering are shared.
-sourceResolveStable node binders environment = (case sourceAstKind node of
- ^sourceAstCaseKind = sourceResolveCase sourceResolveStable node binders environment
- ^sourceAstRecKind = sourceResolveRec sourceResolveStable node binders environment
- ^sourceAstEquationsKind = sourceResolveEquationsWith sourceLowerStableEquations
- sourceResolveStable node binders environment
- _ = sourceResolveOrdinary sourceResolveStable node binders environment)
-resolveStableGateAst environment node = sourceResolveStable node t environment
+sourceResolveStableWithLookup lookup node binders environment = (case sourceAstKind node of
+ ^sourceAstCaseKind = sourceResolveCase (sourceResolveStableWithLookup lookup) node binders environment
+ ^sourceAstRecKind = sourceResolveRec (sourceResolveStableWithLookup lookup) node binders environment
+ ^sourceAstEquationsKind = sourceResolveEquationsWithLookup lookup sourceLowerStableEquations
+ (sourceResolveStableWithLookup lookup) node binders environment
+ _ = sourceResolveOrdinaryWithLookup lookup (sourceResolveStableWithLookup lookup) node binders environment)
+resolveStableGateAstWithLookup lookup environment node = sourceResolveStableWithLookup lookup node t environment
+
+-- Association-list entrypoints retain their lookup contract. The native stable
+-- module path supplies a tree index to the same scope/pattern visitor.
+sourceResolveName = sourceResolveNameWithLookup sourceFindExternal
+sourceResolvePattern = sourceResolvePatternLookup sourceFindExternal
+sourceResolveEquation = sourceResolveEquationLookup sourceFindExternal
+sourceResolveEquationsWith = sourceResolveEquationsWithLookup sourceFindExternal
+sourceResolveOrdinary = sourceResolveOrdinaryWithLookup sourceFindExternal
+sourceResolveStable = sourceResolveStableWithLookup sourceFindExternal
+resolveStableGateAst = resolveStableGateAstWithLookup sourceFindExternal
diff --git a/lib/source/stable.tri b/lib/source/stable.tri
@@ -23,6 +23,8 @@
!export sourceStablePrepare
!export orderStableProgram
!export sourceCompileStableDefinition
+!export sourceCompileStableDefinitionWith
+!export orderStableProgramWith
-- Stable native abstraction backend. Selected explicitly by the unit/build API.
-- Barry Jay, Reflective Programs in Tree Calculus, sections 4.2, 4.4-4.5.
@@ -179,13 +181,15 @@ sourceStablePrepare definitions = (lazyList (_ : ok [] t)
(_ : ok definition t) (sourceDefinitionSelfRecursive definition))
(prepared : stableBind (sourceStablePrepare rest) (remaining : ok (pair prepared remaining) t)))
definitions)
-orderStableProgram environment program = (stableBind
+orderStableProgramWith orderProgram environment program = (stableBind
(sourceStablePrepare (sourceProgramDefinitions program))
- (definitions : orderGateProgram environment (pair definitions (sourceProgramFinal program))))
+ (definitions : orderProgram environment (pair definitions (sourceProgramFinal program))))
-sourceCompileStableDefinition environment definition = (let recursive = sourceDefinitionSelfRecursive definition in
- stableBind (resolveStableGateAst environment (lazyBool
+sourceCompileStableDefinitionWith resolve environment definition = (let recursive = sourceDefinitionSelfRecursive definition in
+ stableBind (resolve environment (lazyBool
(_ : sourceRecursiveBody definition) (_ : sourceDefinitionBody definition) recursive))
(core : stableBind (stableCompileCore core)
(tree : ok (lazyBool (_ : stableFix tree) (_ : tree) recursive) t)))
+orderStableProgram = orderStableProgramWith orderGateProgram
+sourceCompileStableDefinition = sourceCompileStableDefinitionWith resolveStableGateAst
diff --git a/lib/source/unit.tri b/lib/source/unit.tri
@@ -6,28 +6,37 @@
!import source_resolve *
!import source_ast *
!import source_stable *
+!import source_index *
!export *
-- Build definition bindings in stable dependency order, including unused
-- definitions. The reducer may defer normalization of unused body trees.
--- Extend the association list at the head in O(1); resolution sees local
--- definitions before supplied external bindings.
+-- Association-list entrypoints extend at the head; both representations resolve
+-- compiled locals before supplied external bindings.
sourceCompileDefinition environment definition = (lazyResult
(diagnostic remainder : err diagnostic remainder)
(core unused : sourceCompileCore core)
(resolveGateAst environment (sourceDefinitionBody definition)))
-sourceCompileOrderedWith compileDefinition names definitions external = (let rec
- walk pending compiled = (lazyList
+-- Both environments use the same ordered traversal and failure protocol.
+-- The index extends persistently; the list facade retains its original append.
+sourceCompileOrderedUsing findDefinition compileDefinition extend names external = (let rec
+ walk pending environment compiled = (lazyList
(_ : ok compiled t)
(name rest : lazyMaybe
(_ : err (parserDiagnostic 33 name t t t) name)
(definition : lazyResult
(diagnostic remainder : err diagnostic remainder)
- (tree unused : walk rest (pair (pair name tree) compiled))
- (compileDefinition (append compiled external) definition))
- (sourceFindDefinition definitions name)) pending)
- in walk names t)
+ (tree unused : walk rest (extend name tree environment)
+ (pair (pair name tree) compiled))
+ (compileDefinition environment definition))
+ (findDefinition name)) pending)
+ in walk names external t)
+sourceCompileOrderedWith compileDefinition names definitions external = sourceCompileOrderedUsing
+ (sourceFindDefinition definitions)
+ (compiled definition : compileDefinition (append compiled external) definition)
+ (name tree compiled : pair (pair name tree) compiled) names t
+
sourceCompileOrdered names definitions external =
sourceCompileOrderedWith sourceCompileDefinition names definitions external
@@ -79,16 +88,14 @@ sourceModuleCheckShadows imports definitions = (let rec
(sourceFindDefinition definitions (fst binding))) remaining)
in walk imports)
-compileModuleDefinitionsWith orderProgram compileDefinition environment characters =
+compileModuleDefinitionsUsing compileProgram environment characters =
parserMatchReply
(diagnostic remainder consumed committed : err diagnostic remainder)
(program remainder consumed committed :
lazyMaybe
(_ : (do stableBind
sourceModuleCheckShadows environment (sourceProgramDefinitions program)
- ordered <- orderProgram environment program
- compiled <- sourceCompileOrderedWith compileDefinition ordered
- (sourceProgramDefinitions program) environment
+ compiled <- compileProgram environment program
ok (reverse compiled) t))
(expression : err
(parserDiagnostic 42 "definitions only" t
@@ -96,11 +103,26 @@ compileModuleDefinitionsWith orderProgram compileDefinition environment characte
(sourceProgramFinal program))
(parseGateProgram characters)
+compileModuleDefinitionsWith orderProgram compileDefinition = compileModuleDefinitionsUsing
+ (environment program : do stableBind
+ ordered <- orderProgram environment program
+ sourceCompileOrderedWith compileDefinition ordered (sourceProgramDefinitions program) environment)
+
+-- The native stable path shares one external index between ordering and
+-- resolution, then inserts each compiled local without inspecting its value.
+sourceCompileStableModuleProgram environment program = (let external = sourceIndexBuild environment in
+ do stableBind
+ ordered <- orderStableProgramWith
+ (orderGateProgramUsing (sourceAnalyzeIndexedDefinitions external)) environment program
+ sourceCompileOrderedUsing (sourceIndexGet (sourceDefinitionIndex (sourceProgramDefinitions program)))
+ (sourceCompileStableDefinitionWith (resolveStableGateAstWithLookup sourceIndexGet))
+ sourceIndexPut ordered external)
+
-- Backend selection is explicit. Existing entrypoints retain optimized trees.
compileModuleDefinitions environment characters =
compileModuleDefinitionsWith orderGateProgram sourceCompileDefinition environment characters
compileStableModuleDefinitions environment characters =
- compileModuleDefinitionsWith orderStableProgram sourceCompileStableDefinition environment characters
+ compileModuleDefinitionsUsing sourceCompileStableModuleProgram environment characters
-- Preserve the established gate API: callers interested only in the root
-- do not have to inspect (or force) the compiled definition environment.
diff --git a/test/NameIndex.hs b/test/NameIndex.hs
@@ -0,0 +1,58 @@
+-- Complete-result host model; partial inputs below are demand controls, not a totality proof.
+module Main where
+import Runtime
+import Wire
+import TreeObservation
+import qualified Data.ByteString as B
+import qualified Data.Text as Text
+import qualified Data.Vector as V
+import qualified Data.Map.Strict as M
+import Control.Monad
+import Control.Exception
+import System.Environment
+import Data.List (isInfixOf)
+load path = do
+ b<-B.readFile path >>= either fail pure . decodeBundle
+ either fail pure(verifyBundle b)
+ let ns=reconstructBundleTerms(bundleNodes b)
+ pure(M.fromList[(Text.unpack(exportName e),ns V.! fromIntegral(exportRoot e))|e<-manifestExports(bundleManifest b)])
+keys 0=[Leaf]
+keys n=Leaf:map Stem(keys(n-1))++[Fork a b|a<-keys(n-1),b<-keys(n-1)]
+main=do
+ [path]<-getArgs;c<-load path
+ let build=c M.!"sourceIndexBuild";get=c M.!"sourceIndexGet";put=c M.!"sourceIndexPut"
+ fetch index key=apply(apply get index)key
+ entries xs=ofList[Fork k v|(k,v)<-xs]
+ ks=keys 3++map(ofString.show)[0..100::Int]++map ofString ["","a","aa","aaa","a.b","a?","a%","A","alpha.beta","alpha.better"]
+ bs=[(k,ofNumber(toInteger i))|(i,k)<-zip[0..]ks]
+ index=apply build(entries(bs++reverse bs))
+ forM_ ks $ \k -> do
+ let actual=fetch index k;expected=maybe Leaf Stem(lookup k bs)
+ forceTreeShared actual;unless(actual==expected)(fail "first-binding mismatch")
+ let overwritten=apply(apply(apply put (ofString "new"))(ofNumber 77))index
+ forM_ [(ofString "new",Stem(ofNumber 77)),(ofString "missing",Leaf)] $ \(k,e)->do
+ let a=fetch overwritten k
+ forceTreeShared a
+ unless(a==e)(fail "put/miss mismatch")
+ let updated=apply(apply(apply put Leaf)(ofNumber 999))index
+ forM_ [(fetch updated Leaf,Stem(ofNumber 999)),(fetch index Leaf,Stem(ofNumber 0))] $ \(a,e)->do
+ forceTreeShared a;unless(a==e)(fail "persistent overwrite")
+ let poison=error "poison forced"::T
+ present (Stem _)=True;present _=False
+ controls=[ ("opaque hit",fetch(apply build(entries[(Leaf,poison)]))Leaf,True)
+ , ("opaque miss",fetch(apply build(entries[(Leaf,poison)]))(Stem Leaf),False)
+ , ("first hit before bad key",fetch(apply build(entries[(Leaf,Leaf),(poison,poison)]))Leaf,True)
+ , ("first hit before bad tail",fetch(apply build(Fork(Fork Leaf Leaf)poison))Leaf,True)
+ , ("empty ignores query",fetch Leaf poison,False)
+ , ("mismatch ignores query child",fetch(apply build(entries[(Leaf,poison)]))(Stem poison),False)
+ , ("mismatched stem child",fetch(apply build(entries[(Stem poison,poison),(Leaf,Leaf)]))Leaf,True)
+ , ("mismatched left ignores right",fetch(apply build(entries[(Fork Leaf poison,poison),(Fork(Stem Leaf)Leaf,Leaf)]))(Fork(Stem Leaf)Leaf),True)]
+ forM_ controls $ \(label,a,e)->do
+ actual<-evaluate(present a);unless(actual==e)(fail label)
+ forM_ [fetch(apply build(entries[(poison,Leaf),(Leaf,Leaf)]))Leaf,
+ fetch(apply build(entries[(Fork poison Leaf,Leaf),(Fork Leaf Leaf,Leaf)]))(Fork Leaf Leaf)] $ \a->do
+ failure<-try(evaluate(present a))::IO(Either SomeException Bool)
+ case failure of
+ Left e | "poison forced" `isInfixOf` displayException e -> pure()
+ _ -> fail "earlier poisoned key incorrectly bypassed"
+ putStrLn("PASS "++show(length ks)++" complete lookups, put/miss, "++show(length controls)++" demand controls")
diff --git a/test/NameIndexUnit.hs b/test/NameIndexUnit.hs
@@ -0,0 +1,69 @@
+-- Independent corpus and complete-result/demand comparisons for the selected module compiler.
+module Main where
+import Runtime
+import Wire
+import TreeObservation
+import ContentStore.Indexed(encodeIndexedTree)
+import qualified Data.ByteString as B
+import qualified Data.Text as Text
+import qualified Data.Vector as V
+import qualified Data.Map.Strict as M
+import Control.Monad
+import Control.Exception
+import Data.List(isInfixOf)
+import System.Environment
+load p=do
+ b<-B.readFile p >>= either fail pure . decodeBundle
+ either fail pure(verifyBundle b)
+ let ns=reconstructBundleTerms(bundleNodes b)
+ pure(M.fromList[(Text.unpack(exportName e),ns V.! fromIntegral(exportRoot e))|e<-manifestExports(bundleManifest b)])
+fstT(Fork a _)=a
+fstT _=error "pair"
+sndT(Fork _ b)=b
+sndT _=error "pair"
+list=either error id.toList
+str=either error id.toString
+project (Fork status (Fork value _))=case status of
+ Leaf->Fork Leaf(Fork value Leaf)
+ Stem Leaf->case lookup "main" [(str(fstT binding),sndT binding)|binding<-list value] of
+ Just main->Fork(Stem Leaf)(Fork main Leaf)
+ Nothing->error "main absent"
+ _->error "status"
+project _=error "result"
+main=do
+ [fixture,adapter,corpus]<-getArgs
+ original<-load fixture;candidate<-load adapter;golden<-load corpus
+ let ref=original M.!"source_unit.compileStableModuleDefinitions"
+ cand=candidate M.!"compileStableModuleDefinitions"
+ rows=list(golden M.!"fixtures")
+ forM_ rows $ \row->do
+ let label=str(fstT row);rest=sndT row;truth=fstT rest;input=sndT rest
+ environment=fstT input;source=fstT(sndT input);expected=sndT(sndT input)
+ a=apply(apply ref environment)source;b=apply(apply cand environment)source
+ ab<-encodeIndexedTree a;bb<-encodeIndexedTree b
+ unless(ab==bb)(fail(label++": complete compiler result differs"))
+ actual<-encodeIndexedTree(project b);target<-encodeIndexedTree expected
+ unless((actual==target)==(truth/=Leaf))(fail(label++": independent source outcome differs"))
+ putStrLn("PASS "++label)
+ let poison=error "opaque environment poison"::T
+ env xs=ofList[Fork(ofString n)v|(n,v)<-xs]
+ controls=[("duplicate external",env[("outside",ofNumber 23),("outside",ofNumber 24)],"main = outside"),
+ ("unused poison",env[("unused",poison),("outside",ofNumber 23)],"main = outside"),
+ ("unused selected namespace",env[("outside",poison)],"main = 23"),
+ ("shadow before missing",env[("main",poison)],"main = missing"),
+ ("parse before environment",poison,"main = (")]
+ forM_ controls $ \(label,environment,source)->do
+ let a=apply(apply ref environment)(ofString source);b=apply(apply cand environment)(ofString source)
+ ab<-encodeIndexedTree a;bb<-encodeIndexedTree b
+ unless(ab==bb)(fail(label++": full result/demand mismatch"))
+ when(label `elem` ["duplicate external","unused poison","unused selected namespace"]) $
+ unless(project b==Fork(Stem Leaf)(Fork(ofNumber 23)Leaf))(fail(label++": expected 23"))
+ putStrLn("PASS "++label)
+ forM_ [ref,cand] $ \compiler->do
+ let badTail=Fork(Fork(ofString "outside")(ofNumber 23))poison
+ answer=apply(apply compiler badTail)(ofString "main = outside")
+ failed<-try(encodeIndexedTree answer)::IO(Either SomeException B.ByteString)
+ case failed of
+ Left e | "opaque environment poison" `isInfixOf` displayException e ->pure()
+ _ ->fail "module shadow scan demand changed"
+ putStrLn("PASS "++show(length rows)++" complete-result comparisons and independent outcomes")
diff --git a/test/name_index.py b/test/name_index.py
@@ -0,0 +1,89 @@
+#!/usr/bin/env python3
+"""Rebuild the current index; check complete results, persistence and demand.
+
+Optional --unit selects an artifact-only stable module compiler for independent
+source outcomes and complete comparisons with --reference (published by default).
+No compiler generation, publication or acceptance is performed here.
+"""
+import argparse
+import hashlib
+import json
+from pathlib import Path
+import subprocess
+from bundle_dag import merge_bundles
+from pattern_lowering import audit
+from shipped_compiler import verify
+from source_equation_cases import cases, quoted
+
+ROOT = Path(__file__).resolve().parent.parent
+
+
+def main():
+ p = argparse.ArgumentParser(description=__doc__)
+ p.add_argument('tricu', type=Path)
+ p.add_argument('--directory', type=Path, required=True)
+ p.add_argument('--unit', type=Path)
+ p.add_argument('--reference', type=Path, default=ROOT/'test/fixtures/compiler-library.arboricx')
+ args = p.parse_args()
+ out = args.directory.resolve(); out.mkdir(parents=True, exist_ok=False)
+ ws = out/'workspace'; ws.mkdir(); (ws/'tricu.workspace').write_text('tricu.workspace.v1\n')
+ host = args.tricu.resolve(); compiler = verify(); sha = lambda p: hashlib.sha256(p.read_bytes()).hexdigest()
+ report = dict(complete=False, compiler_sha256=compiler['sha256'], runtime_sha256=sha(host), commands=[])
+
+ def run(argv, seconds=300, reject=False):
+ command = list(map(str, argv))
+ r = subprocess.run(command, capture_output=True, text=True, cwd=ROOT, timeout=seconds)
+ report['commands'].append(dict(argv=command, code=r.returncode, stdout=r.stdout, stderr=r.stderr))
+ (out/'report.json').write_text(json.dumps(report, indent=2)+'\n')
+ if reject:
+ assert r.returncode and 'first-binding mismatch' in r.stderr, r
+ elif r.returncode:
+ raise RuntimeError(r.stdout[-4000:]+r.stderr[-4000:])
+
+ paths = dict(source_index='lib/source/index.tri', prelude='lib/prelude.tri', base='lib/base.tri',
+ bytes='lib/bytes.tri', conversions='lib/conversions.tri', native_math='lib/math/native.tri')
+ for alias, path in paths.items(): (ws/(alias+'.tri')).write_bytes((ROOT/path).read_bytes())
+ report['sources'] = {path: sha(ROOT/path) for path in paths.values()}
+
+ def compile(alias):
+ output = out/(alias+'.arboricx')
+ run([host, 'arboricx', 'compile', '--file', ws/(alias+'.tri'), '--store', out/'store',
+ '--output', output, '--compile-timeout', '240', '+RTS', '-N1', '-M8192m', '-RTS'])
+ return output
+
+ index = compile('source_index')
+ report['modules'] = audit(ws, out/'store', compiler['sha256'], {})
+ expr = ('let f=builtins.getFlake "git+file://'+str(ROOT)+'";'
+ 'p=f.inputs.nixpkgs.legacyPackages.x86_64-linux;'
+ 'in p.haskellPackages.ghcWithPackages(h:[h.cryptonite h.memory h.base16-bytestring h.vector])')
+
+ def build(name):
+ exe = out/name
+ run(['nix', 'shell', '--impure', '--expr', expr, '--command', 'ghc', '-O2', '-rtsopts',
+ '-XOverloadedStrings', '-XLambdaCase', '-XMultiWayIf', '-XScopedTypeVariables',
+ '-isrc', '-outputdir', out/(name+'-objects'), ROOT/'test'/(name+'.hs'), '-o', exe])
+ return exe
+
+ checks = build('NameIndex'); run([checks, index, '+RTS', '-M2048m', '-RTS'])
+ (ws/'wrong.tri').write_text('!export wrong\nwrong index key = t\n')
+ bad = compile('wrong'); wrong = out/'wrong-index.arboricx'
+ merge_bundles(wrong, [(index, [('sourceIndexBuild','sourceIndexBuild'), ('sourceIndexPut','sourceIndexPut')]),
+ (bad, [('wrong','sourceIndexGet')])], prune_unreachable=True)
+ run([checks, wrong, '+RTS', '-M2048m', '-RTS'], reject=True)
+ report['wrong_subject_rejected'] = True
+ if args.unit:
+ (ws/'parser.tri').write_bytes((ROOT/'lib/parser.tri').read_bytes())
+ rows = ['(pair '+quoted(label)+' (pair '+('true' if truth else 'false')+' (pair '+env+
+ ' (pair '+quoted(source)+' '+expected+'))))' for label,source,expected,env,truth in cases]
+ (ws/'corpus.tri').write_text('!import prelude *\n!import parser *\n!export fixtures\nfixtures = [\n'+
+ '\n'.join(rows)+'\n]\n')
+ corpus = compile('corpus'); checker = build('NameIndexUnit')
+ run([checker, args.reference.resolve(), args.unit.resolve(), corpus, '+RTS', '-M8192m', '-RTS'])
+ report['unit'] = dict(sha256=sha(args.unit), reference_sha256=sha(args.reference),
+ cases=len(cases), complete_results=True, environment_controls=6)
+ report.update(complete=True, index_sha256=sha(index))
+ (out/'report.json').write_text(json.dumps(report, indent=2)+'\n')
+ print('PASS name index: complete model, persistence, demand, wrong-subject and source provenance')
+
+
+if __name__ == '__main__': main()
diff --git a/test/source_equation_cases.py b/test/source_equation_cases.py
@@ -0,0 +1,118 @@
+"""Independent source/diagnostic expectations shared by compiler entrypoint tests."""
+import json
+
+def quoted(value):
+ return json.dumps(value, ensure_ascii=False)
+
+
+def position(source, needle, occurrence=1, shift=0):
+ offset = -1
+ for _ in range(occurrence):
+ offset = source.index(needle, offset + 1)
+ offset += shift
+ line = source[:offset].count("\n") + 1
+ column = offset - source.rfind("\n", 0, offset)
+ return f"(pair {line} (pair {column} {offset}))"
+
+
+cases = []
+
+
+def good(name, source, value, environment="[]"):
+ cases.append((name, source, f"(ok {value} t)", environment, True))
+
+
+def bad(name, source, code, expected, found, needle=None, occurrence=1, shift=0):
+ location = position(source, needle, occurrence, shift) if needle else "t"
+ cases.append((name, source,
+ f"(err (parserDiagnostic {code} {expected} {found} {location} t) t)",
+ "[]", True))
+
+
+good("Leaf", "f t = 23\nf _ = 24\nmain = f t", "23")
+good("Stem", "f (t x) = x\nf _ = 24\nmain = f (t 23)", "23")
+good("Fork", "f (t x y) = [x y]\nf _ = []\nmain = f (t 23 24)", "[23 24]")
+good("Pair", "f (x, y) = [y x]\nf _ = []\nmain = f (t 23 24)", "[24 23]")
+good("Whole", "f all{x, y} = all\nf _ = t\nmain = f (t 23 24)", "(t 23 24)")
+good("WholeSpace", "f all {t x} = all\nf _ = t\nmain = f (t 23)", "(t 23)")
+good("NestedWhole", "f outer{t inner{t x} y} = [outer inner x y]\nf _ = []\nmain = f (t (t 23) 24)", "[(t (t 23) 24) (t 23) 23 24]")
+good("NestedSibling", "f ((t (t x)), (y, z)) = [x y z]\nf _ = []\nmain = f (t (t (t 23)) (t 24 25))", "[23 24 25]")
+good("Nil", "f [] = 23\nf _ = 24\nmain = f []", "23")
+good("Cons", "f [x | xs] = [x xs]\nf _ = []\nmain = f [23 24]", "[23 [24]]")
+good("ExactList", "f [x y] = [y x]\nf _ = []\nmain = f [23 24]", "[24 23]")
+good("ListMiss", "f [x y] = 23\nf _ = 24\nmain = f [23 24 25]", "24")
+good("WholeList", "f all{[x | xs]} = [all x xs]\nf _ = []\nmain = f [23 24]", "[[23 24] 23 [24]]")
+good("WholeWildcard", "f all{_} = all\nmain = f 23", "23")
+good("Number", "f 23 = 24\nf _ = 25\nmain = f 23", "24")
+good("String", 'f "a\\nb" = 24\nf _ = 25\nmain = f "a\\nb"', "24")
+good("False", "f t = 23\nf (t t) = 24\nf _ = 25\nmain = f t", "23")
+good("True", "f t = 23\nf (t t) = 24\nf _ = 25\nmain = f (t t)", "24")
+good("InvalidBoolStem", "f t = 23\nf (t t) = 24\nf _ = 25\nmain = f (t 23)", "25")
+good("InvalidBoolFork", "f t = 23\nf (t t) = 24\nf _ = 25\nmain = f (t t t)", "25")
+good("TwoArgs", "f t child = child\nf _ _ = 24\nmain = f t 23", "23")
+good("Partial", "f t x = x\nf _ _ = 24\npartial = f t\nmain = partial 23", "23")
+good("Closure", "f (t x) = y : [x y]\nf _ = y : [t y]\nmain = f (t 23) 24", "[23 24]")
+good("CaptureShadow", "x = 99\nf x = x\nmain = f 23", "23")
+good("FailedCapture", "f (x, t) = x\nf _ = 24\nmain = f (t 23 99)", "24")
+good("Ordered", "f x = 23\nf t = 24\nf _ = 25\nmain = f t", "23")
+good("BodyNoFallthrough", 'f t = err "body" t\nf _ = 24\nmain = f t', '(err "body" t)', '[(pair "err" err)]')
+good("PinForward", "f ^expected = 23\nf _ = 24\nexpected = 25\nmain = f 25", "23")
+good("PinMiss", "expected = 25\nf ^expected = 23\nf _ = 24\nmain = f 26", "24")
+good("QualifiedPin", "f ^Outer.value = 23\nf _ = 24\nmain = f 25", "23", '[(pair "Outer.value" 25)]')
+good("LocalLet", "main = let\n f t = 23\n f _ = 24\n g x = f x\nin g t", "23")
+good("LocalWhere", "main = g t where\n f t = 23\n f _ = 24\n g x = f x", "23")
+good("LocalPin", "main = let expected = 25 in let\n f ^expected = 23\n f _ = 24\nin f expected", "23")
+good("LocalClosure", "main = (outer : let\n f (t x) = y : [outer x y]\n f _ = y : [outer t y]\nin f (t 23) 24) 25", "[25 23 24]")
+good("InlineLet", "main = let f x = x in f 23", "23")
+good("InlineWhere", "main = f 23 where f x = x", "23")
+good("CommentGroup", "f t = 23\n-- same group\n\nf _ = 24\nmain = f t", "23")
+good("BlockComment", "f t = 23\n|-same group-|\nf _ = 24\nmain = f t", "23")
+good("DeeperBody", "f t = (x : x)\n 23\nf _ = 24\nmain = f t", "23")
+good("NestedLet", "main = let\n f t = let\n g t = 23\n g _ = 24\n in g t\n f _ = 25\nin f t", "23")
+good("LocalOuterShadow", "f x = 23\nmain = let f x = f x in f t", "23")
+good("LocalEarlierPin", "main = let\n expected = 25\n f ^expected = 23\n f _ = 24\nin f 25", "23")
+good("PatternBodyDependency", "f (t x) = helper x\nf _ = 24\nmain = f (t 23)\nhelper x = x", "23")
+
+good("ZeroIsLeaf", "f 0 = 23\nf _ = 24\nmain = f t", "23")
+good("MultilineTreePattern", "f (t\n x\n y) = [x y]\nf _ = []\nmain = f (t 23 24)", "[23 24]")
+good("MultilinePairPattern", "f (x\n ,\n y) = [x y]\nf _ = []\nmain = f (t 23 24)", "[23 24]")
+good("NestedPinScope", "f (t x) = let\n g ^x = 23\n g _ = 24\nin g x\nf _ = 25\nmain = f (t 26)", "23")
+
+worker = ("worker self t = 0\nworker self (t x) = 0\n"
+ "worker self whole{x, y} = self whole\nworker _ _ = 0\n"
+ "loop input = y worker input\n")
+good("LazyLater", worker + "f t = 23\nf x = loop x\nmain = f t", "23", '[(pair "y" y)]')
+good("LazyEarlier", worker + "f (t x y) = loop (t x y)\nf _ = 23\nmain = f t", "23", '[(pair "y" y)]')
+good("UnreachedPin", worker + "main = (outer : let expected = loop outer in let\n f t ^expected = 24\n f _ _ = 23\nin f (t 99) t) (t 23 24)", "23", '[(pair "y" y)]')
+
+bad("DuplicateCapture", "f x x = x\nmain = f t t", 48, '"unique capture"', '"x"', "x", 2)
+bad("WholeDuplicate", "f x{x} = x\nmain = f t", 48, '"unique capture"', '"x"', "x", 2)
+bad("PinCollision", "x = 25\nf x ^x = x\nf _ _ = t\nmain = f t t", 48, '"pin outside equation captures"', '"x"', "^x", shift=1)
+bad("PinLaterCapture", "x = 25\nf ^x x = x\nf _ _ = t\nmain = f t t", 48, '"pin outside equation captures"', '"x"', "^x", shift=1)
+bad("Catchall", "f t = 23\nmain = f t", 48, '"final irrefutable equation"', "t", "23")
+bad("Arity", "f t x = x\nf _ = 23\nmain = t", 48, '"consistent arity"', "1", "23")
+bad("Redefinition", "f t = 23\nf _ = 24\ng x = x\nf _ = 25\nmain = t", 30, '"f"', '"f"', "f _", 2)
+bad("ZeroArity", "f = 23\nf = 24\nmain = t", 30, '"f"', '"f"', "f =", 2)
+bad("LocalRedefinition", "main = let\n f x = x\n g x = x\n f x = x\nin t", 30, '"f"', '"f"', "f x", 2)
+bad("LocalForward", "main = let\n f x = g x\n g x = x\nin f t", 20, '"g"', "t", "g x")
+bad("LocalSelf", "main = let\n f x = f x\nin f t", 20, '"f"', "t", "f x", 2)
+bad("MissingPin", "f ^missing = 23\nf _ = 24\nmain = f t", 20, '"missing"', "t", "missing")
+bad("EmptyWhole", "f all{} = 23\nf _ = 24\nmain = t", 48, '"pattern"', "23", "}")
+bad("TooManyChildren", "f (t x y z) = 23\nf _ = 24\nmain = t", 48, '"at most two tree children"', "4", ")")
+bad("EmptyPrefix", "f [|tail] = 23\nf _ = 24\nmain = t", 48, '"nonempty list prefix"', "11", "=")
+bad("WildcardNoCapture", "f _ = _\nmain = f t", 20, '"_"', "t", "_", 2)
+bad("LetIndent", "main = let\nf x = x\nin f t", 40, '"indented local block"', "2", "f x")
+bad("WhereIndent", "main = f t where\nf x = x", 40, '"indented local block"', "2", "f x")
+bad("AnnotatedGroup", "f x@missing = x\nf y = y\nmain = t", 30, '"f"', '"f"', "f y")
+bad("DuplicateBeforeMissing", "f x x = missing\nmain = t", 48, '"unique capture"', '"x"', "x", 2)
+bad("ArityBeforeMissing", "f t x = missing\nf _ = t\nmain = t", 48, '"consistent arity"', "1", "f _ = t", shift=6)
+bad("CatchallBeforeMissing", "f t = missing\nmain = t", 48, '"final irrefutable equation"', "t", "missing")
+bad("LocalDuplicateBeforeMissing", "main = let\n f x x = missing\nin t", 48, '"unique capture"', '"x"', "x", 2)
+# The source syntax really checks values and original locations, rather than
+# merely succeeding for everything. Both controls must return false.
+cases.append(("WrongValue", cases[0][1], "(ok 99 t)", "[]", False))
+missing = "f ^missing = 23\nf _ = 24\nmain = f t"
+cases.append(("WrongLocation", missing,
+ '(err (parserDiagnostic 20 "missing" t (pair 1 (pair 5 4)) t) t)', "[]", False))
+
+
diff --git a/test/source_equations.py b/test/source_equations.py
@@ -23,125 +23,14 @@ tricu = str(args.tricu.resolve())
generation = args.generation.resolve()
-def quoted(value):
- return json.dumps(value, ensure_ascii=False)
-
-
-def position(source, needle, occurrence=1, shift=0):
- offset = -1
- for _ in range(occurrence):
- offset = source.index(needle, offset + 1)
- offset += shift
- line = source[:offset].count("\n") + 1
- column = offset - source.rfind("\n", 0, offset)
- return f"(pair {line} (pair {column} {offset}))"
-
-
-cases = []
-
-
-def good(name, source, value, environment="[]"):
- cases.append((name, source, f"(ok {value} t)", environment, True))
-
-
-def bad(name, source, code, expected, found, needle=None, occurrence=1, shift=0):
- location = position(source, needle, occurrence, shift) if needle else "t"
- cases.append((name, source,
- f"(err (parserDiagnostic {code} {expected} {found} {location} t) t)",
- "[]", True))
-
-
-good("Leaf", "f t = 23\nf _ = 24\nmain = f t", "23")
-good("Stem", "f (t x) = x\nf _ = 24\nmain = f (t 23)", "23")
-good("Fork", "f (t x y) = [x y]\nf _ = []\nmain = f (t 23 24)", "[23 24]")
-good("Pair", "f (x, y) = [y x]\nf _ = []\nmain = f (t 23 24)", "[24 23]")
-good("Whole", "f all{x, y} = all\nf _ = t\nmain = f (t 23 24)", "(t 23 24)")
-good("WholeSpace", "f all {t x} = all\nf _ = t\nmain = f (t 23)", "(t 23)")
-good("NestedWhole", "f outer{t inner{t x} y} = [outer inner x y]\nf _ = []\nmain = f (t (t 23) 24)", "[(t (t 23) 24) (t 23) 23 24]")
-good("NestedSibling", "f ((t (t x)), (y, z)) = [x y z]\nf _ = []\nmain = f (t (t (t 23)) (t 24 25))", "[23 24 25]")
-good("Nil", "f [] = 23\nf _ = 24\nmain = f []", "23")
-good("Cons", "f [x | xs] = [x xs]\nf _ = []\nmain = f [23 24]", "[23 [24]]")
-good("ExactList", "f [x y] = [y x]\nf _ = []\nmain = f [23 24]", "[24 23]")
-good("ListMiss", "f [x y] = 23\nf _ = 24\nmain = f [23 24 25]", "24")
-good("WholeList", "f all{[x | xs]} = [all x xs]\nf _ = []\nmain = f [23 24]", "[[23 24] 23 [24]]")
-good("WholeWildcard", "f all{_} = all\nmain = f 23", "23")
-good("Number", "f 23 = 24\nf _ = 25\nmain = f 23", "24")
-good("String", 'f "a\\nb" = 24\nf _ = 25\nmain = f "a\\nb"', "24")
-good("False", "f t = 23\nf (t t) = 24\nf _ = 25\nmain = f t", "23")
-good("True", "f t = 23\nf (t t) = 24\nf _ = 25\nmain = f (t t)", "24")
-good("InvalidBoolStem", "f t = 23\nf (t t) = 24\nf _ = 25\nmain = f (t 23)", "25")
-good("InvalidBoolFork", "f t = 23\nf (t t) = 24\nf _ = 25\nmain = f (t t t)", "25")
-good("TwoArgs", "f t child = child\nf _ _ = 24\nmain = f t 23", "23")
-good("Partial", "f t x = x\nf _ _ = 24\npartial = f t\nmain = partial 23", "23")
-good("Closure", "f (t x) = y : [x y]\nf _ = y : [t y]\nmain = f (t 23) 24", "[23 24]")
-good("CaptureShadow", "x = 99\nf x = x\nmain = f 23", "23")
-good("FailedCapture", "f (x, t) = x\nf _ = 24\nmain = f (t 23 99)", "24")
-good("Ordered", "f x = 23\nf t = 24\nf _ = 25\nmain = f t", "23")
-good("BodyNoFallthrough", 'f t = err "body" t\nf _ = 24\nmain = f t', '(err "body" t)', '[(pair "err" err)]')
-good("PinForward", "f ^expected = 23\nf _ = 24\nexpected = 25\nmain = f 25", "23")
-good("PinMiss", "expected = 25\nf ^expected = 23\nf _ = 24\nmain = f 26", "24")
-good("QualifiedPin", "f ^Outer.value = 23\nf _ = 24\nmain = f 25", "23", '[(pair "Outer.value" 25)]')
-good("LocalLet", "main = let\n f t = 23\n f _ = 24\n g x = f x\nin g t", "23")
-good("LocalWhere", "main = g t where\n f t = 23\n f _ = 24\n g x = f x", "23")
-good("LocalPin", "main = let expected = 25 in let\n f ^expected = 23\n f _ = 24\nin f expected", "23")
-good("LocalClosure", "main = (outer : let\n f (t x) = y : [outer x y]\n f _ = y : [outer t y]\nin f (t 23) 24) 25", "[25 23 24]")
-good("InlineLet", "main = let f x = x in f 23", "23")
-good("InlineWhere", "main = f 23 where f x = x", "23")
-good("CommentGroup", "f t = 23\n-- same group\n\nf _ = 24\nmain = f t", "23")
-good("BlockComment", "f t = 23\n|-same group-|\nf _ = 24\nmain = f t", "23")
-good("DeeperBody", "f t = (x : x)\n 23\nf _ = 24\nmain = f t", "23")
-good("NestedLet", "main = let\n f t = let\n g t = 23\n g _ = 24\n in g t\n f _ = 25\nin f t", "23")
-good("LocalOuterShadow", "f x = 23\nmain = let f x = f x in f t", "23")
-good("LocalEarlierPin", "main = let\n expected = 25\n f ^expected = 23\n f _ = 24\nin f 25", "23")
-good("PatternBodyDependency", "f (t x) = helper x\nf _ = 24\nmain = f (t 23)\nhelper x = x", "23")
-
-good("ZeroIsLeaf", "f 0 = 23\nf _ = 24\nmain = f t", "23")
-good("MultilineTreePattern", "f (t\n x\n y) = [x y]\nf _ = []\nmain = f (t 23 24)", "[23 24]")
-good("MultilinePairPattern", "f (x\n ,\n y) = [x y]\nf _ = []\nmain = f (t 23 24)", "[23 24]")
-good("NestedPinScope", "f (t x) = let\n g ^x = 23\n g _ = 24\nin g x\nf _ = 25\nmain = f (t 26)", "23")
-
-worker = ("worker self t = 0\nworker self (t x) = 0\n"
- "worker self whole{x, y} = self whole\nworker _ _ = 0\n"
- "loop input = y worker input\n")
-good("LazyLater", worker + "f t = 23\nf x = loop x\nmain = f t", "23", '[(pair "y" y)]')
-good("LazyEarlier", worker + "f (t x y) = loop (t x y)\nf _ = 23\nmain = f t", "23", '[(pair "y" y)]')
-good("UnreachedPin", worker + "main = (outer : let expected = loop outer in let\n f t ^expected = 24\n f _ _ = 23\nin f (t 99) t) (t 23 24)", "23", '[(pair "y" y)]')
-
-bad("DuplicateCapture", "f x x = x\nmain = f t t", 48, '"unique capture"', '"x"', "x", 2)
-bad("WholeDuplicate", "f x{x} = x\nmain = f t", 48, '"unique capture"', '"x"', "x", 2)
-bad("PinCollision", "x = 25\nf x ^x = x\nf _ _ = t\nmain = f t t", 48, '"pin outside equation captures"', '"x"', "^x", shift=1)
-bad("PinLaterCapture", "x = 25\nf ^x x = x\nf _ _ = t\nmain = f t t", 48, '"pin outside equation captures"', '"x"', "^x", shift=1)
-bad("Catchall", "f t = 23\nmain = f t", 48, '"final irrefutable equation"', "t", "23")
-bad("Arity", "f t x = x\nf _ = 23\nmain = t", 48, '"consistent arity"', "1", "23")
-bad("Redefinition", "f t = 23\nf _ = 24\ng x = x\nf _ = 25\nmain = t", 30, '"f"', '"f"', "f _", 2)
-bad("ZeroArity", "f = 23\nf = 24\nmain = t", 30, '"f"', '"f"', "f =", 2)
-bad("LocalRedefinition", "main = let\n f x = x\n g x = x\n f x = x\nin t", 30, '"f"', '"f"', "f x", 2)
-bad("LocalForward", "main = let\n f x = g x\n g x = x\nin f t", 20, '"g"', "t", "g x")
-bad("LocalSelf", "main = let\n f x = f x\nin f t", 20, '"f"', "t", "f x", 2)
-bad("MissingPin", "f ^missing = 23\nf _ = 24\nmain = f t", 20, '"missing"', "t", "missing")
-bad("EmptyWhole", "f all{} = 23\nf _ = 24\nmain = t", 48, '"pattern"', "23", "}")
-bad("TooManyChildren", "f (t x y z) = 23\nf _ = 24\nmain = t", 48, '"at most two tree children"', "4", ")")
-bad("EmptyPrefix", "f [|tail] = 23\nf _ = 24\nmain = t", 48, '"nonempty list prefix"', "11", "=")
-bad("WildcardNoCapture", "f _ = _\nmain = f t", 20, '"_"', "t", "_", 2)
-bad("LetIndent", "main = let\nf x = x\nin f t", 40, '"indented local block"', "2", "f x")
-bad("WhereIndent", "main = f t where\nf x = x", 40, '"indented local block"', "2", "f x")
-bad("AnnotatedGroup", "f x@missing = x\nf y = y\nmain = t", 30, '"f"', '"f"', "f y")
-bad("DuplicateBeforeMissing", "f x x = missing\nmain = t", 48, '"unique capture"', '"x"', "x", 2)
-bad("ArityBeforeMissing", "f t x = missing\nf _ = t\nmain = t", 48, '"consistent arity"', "1", "f _ = t", shift=6)
-bad("CatchallBeforeMissing", "f t = missing\nmain = t", 48, '"final irrefutable equation"', "t", "missing")
-bad("LocalDuplicateBeforeMissing", "main = let\n f x x = missing\nin t", 48, '"unique capture"', '"x"', "x", 2)
-# The source syntax really checks values and original locations, rather than
-# merely succeeding for everything. Both controls must return false.
-cases.append(("WrongValue", cases[0][1], "(ok 99 t)", "[]", False))
-missing = "f ^missing = 23\nf _ = 24\nmain = f t"
-cases.append(("WrongLocation", missing,
- '(err (parserDiagnostic 20 "missing" t (pair 1 (pair 5 4)) t) t)', "[]", False))
+from source_equation_cases import cases, quoted, position
manager = contextlib.nullcontext(args.directory.resolve()) if args.directory else tempfile.TemporaryDirectory(prefix="source-equations-")
with manager as directory:
root = Path(directory)
root.mkdir(parents=True, exist_ok=True)
+ (root / "tricu.workspace").write_text("tricu.workspace.v1\n")
store = str(root / "store")
def run(command, timeout=None):
diff --git a/tricu.workspace b/tricu.workspace
@@ -27,6 +27,7 @@ source_compile lib/source/compile.tri
source_core lib/source/core.tri
source_equations lib/source/equations.tri
source_export_cache lib/source/export-cache.tri
+source_index lib/source/index.tri
source_lexer lib/source/lexer.tri
source_lock lib/source/lock.tri
source_map lib/source/map.tri
