commit de9c334dfaf01264cca9a1ed4c59c620c622c710 parent b3adb450f4281bfc41d02d868877e5e4115ca3c4 Author: James Eversole <james@eversole.co> Date: Sat, 24 Oct 2026 16:14:19 -0500 Align all current library equation heads with AST-equivalence validation Diffstat:
35 files changed, 210 insertions(+), 210 deletions(-)
diff --git a/lib/arboricx/arboricx.tri b/lib/arboricx/arboricx.tri @@ -55,21 +55,21 @@ runArboricxArgs = (bs args : errHostCodecFailed = 14 -hostTreeTag = 0 +hostTreeTag = 0 hostStringTag = 1 hostNumberTag = 2 -hostBoolTag = 3 -hostListTag = 4 -hostBytesTag = 5 +hostBoolTag = 3 +hostListTag = 4 +hostBytesTag = 5 -hostTree = (value : pair hostTreeTag value) +hostTree = (value : pair hostTreeTag value) hostString = (characters : pair hostStringTag characters) hostNumber = (n : pair hostNumberTag n) -hostBool = (b : pair hostBoolTag b) -hostList = (xs : pair hostListTag xs) -hostBytes = (bytes : pair hostBytesTag bytes) +hostBool = (b : pair hostBoolTag b) +hostList = (xs : pair hostListTag xs) +hostBytes = (bytes : pair hostBytesTag bytes) -hostValueTag = (hostValue : fst hostValue) +hostValueTag = (hostValue : fst hostValue) hostValuePayload = (hostValue : snd hostValue) hostBool? = (value : or? (equal? value false) (equal? value true)) @@ -129,9 +129,9 @@ runArboricxByNameToList = (nameBytes bs args : runArboricxByNameToBytes = (nameBytes bs args : runArboricxByNameToTyped hostBytesTag nameBytes bs args) -runArboricxToTree = (bs args : runArboricxByNameToTyped hostTreeTag [] bs args) +runArboricxToTree = (bs args : runArboricxByNameToTyped hostTreeTag [] bs args) runArboricxToString = (bs args : runArboricxByNameToTyped hostStringTag [] bs args) runArboricxToNumber = (bs args : runArboricxByNameToTyped hostNumberTag [] bs args) -runArboricxToBool = (bs args : runArboricxByNameToTyped hostBoolTag [] bs args) -runArboricxToList = (bs args : runArboricxByNameToTyped hostListTag [] bs args) -runArboricxToBytes = (bs args : runArboricxByNameToTyped hostBytesTag [] bs args) +runArboricxToBool = (bs args : runArboricxByNameToTyped hostBoolTag [] bs args) +runArboricxToList = (bs args : runArboricxByNameToTyped hostListTag [] bs args) +runArboricxToBytes = (bs args : runArboricxByNameToTyped hostBytesTag [] bs args) diff --git a/lib/arboricx/common.tri b/lib/arboricx/common.tri @@ -11,7 +11,7 @@ arboricxManifestSectionId = [(0) (0) (0) (1)] arboricxNodesSectionId = [(0) (0) (0) (2)] -- Manifest magic and version constants -arboricxManifestMagic = [(65) (82) (66) (77) (78) (70) (83) (84)] +arboricxManifestMagic = [(65) (82) (66) (77) (78) (70) (83) (84)] arboricxManifestMajorVersion = [(0) (1)] arboricxManifestMinorVersion = [(0) (1)] @@ -86,14 +86,14 @@ sectionRecordReserved2 record = case record of (_, (_, (_, (_, (_, (_, (_, value))))))) = value _ = t -lookupSectionRecord sectionId directory = find (record : bytesEq? sectionId (sectionRecordId record)) directory +lookupSectionRecord sectionId directory = find (record : bytesEq? sectionId (sectionRecordId record)) directory sectionDirectoryHasId? sectionId directory = any? (record : bytesEq? sectionId (sectionRecordId record)) directory sectionDirectoryHasDuplicateIds? directory = case directory of [] = false [record | rest] = or? (sectionDirectoryHasId? (sectionRecordId record) rest) (sectionDirectoryHasDuplicateIds? rest) _ = true -errUnsupportedSection = 17 +errUnsupportedSection = 17 errInvalidSectionRange = 18 sectionRecordSupported? record = (and? (and? (equal? (sectionRecordVersion record) [0 1]) @@ -133,8 +133,8 @@ byteSlice = (offset length bytes : bytesTake length (bytesDrop offset bytes)) -- Unchecked canonical-byte fold; readers validate octets before this conversion. -- Remove the independent broken adder rather than preserving its representation bug. beBytesToNat bytes = foldl (acc byte : N.add (N.multiply acc 256) byte) 0 bytes -u32BEBytesToNat = beBytesToNat -u64BEBytesToNat = beBytesToNat +u32BEBytesToNat = beBytesToNat +u64BEBytesToNat = beBytesToNat arboricxHeaderMajorVersion record = case record of (value, _) = value diff --git a/lib/arboricx/handlers.tri b/lib/arboricx/handlers.tri @@ -17,7 +17,7 @@ -- Outcomes carry a status beside the complete response so logging does not -- parse response bytes. Only completed application routes emit access events; -- parser/protocol rejections remain owned by the scoped HTTP transport. -reply status bytes = H.pure [status bytes] +reply status bytes = H.pure [status bytes] error status message = reply status (HTTP.errorResponse status message) load digest = do H.bind @@ -50,11 +50,11 @@ get lookup target = case Store.stripPrefix Store.packagePrefix target of (t digest) = load digest _ = reply 404 HTTP.notFoundResponse -route _ "GET" "/" _ _ = reply 200 (HTTP.htmlResponse Store.htmlLandingPage) -route _ "GET" "/_arboricx/health" _ _ = reply 200 (HTTP.okResponse "OK\n") -route lookup "GET" target _ _ = get lookup target -route _ "POST" "/_arboricx/bundle" _ body = publish body -route _ _ _ _ _ = reply 404 HTTP.notFoundResponse +route _ "GET" "/" _ _ = reply 200 (HTTP.htmlResponse Store.htmlLandingPage) +route _ "GET" "/_arboricx/health" _ _ = reply 200 (HTTP.okResponse "OK\n") +route lookup "GET" target _ _ = get lookup target +route _ "POST" "/_arboricx/bundle" _ body = publish body +route _ _ _ _ _ = reply 404 HTTP.notFoundResponse request lookup method target headers body = H.label "registry-request" <| do H.bind outcome <- route lookup method target headers body diff --git a/lib/arboricx/inspect.tri b/lib/arboricx/inspect.tri @@ -45,15 +45,15 @@ renderSummary summary = (append "stored-nodes\t" (append (showNumber (fst summar (append "\n" (renderExports (snd summary))))) -- Stable human-facing categories alongside the numeric codec diagnostic. -describeError 1 = "Unexpected end of input" -describeError 2 = "Unexpected bytes or invalid bundle magic" -describeError 3 = "Unexpected byte" -describeError 4 = "Missing required section" -describeError 5 = "Unsupported bundle version or header" -describeError 6 = "Duplicate section" -describeError 7 = "Duplicate node record" -describeError 8 = "Invalid node payload" -describeError 9 = "Invalid node reference or export root" +describeError 1 = "Unexpected end of input" +describeError 2 = "Unexpected bytes or invalid bundle magic" +describeError 3 = "Unexpected byte" +describeError 4 = "Missing required section" +describeError 5 = "Unsupported bundle version or header" +describeError 6 = "Duplicate section" +describeError 7 = "Duplicate node record" +describeError 8 = "Invalid node payload" +describeError 9 = "Invalid node reference or export root" describeError 10 = "Invalid manifest magic" describeError 11 = "Unsupported manifest version" describeError 12 = "Trailing manifest bytes" @@ -62,4 +62,4 @@ describeError 15 = "Invalid binary input" describeError 16 = "Invalid binary count" describeError 17 = "Unsupported section" describeError 18 = "Invalid section range or truncated container" -describeError _ = "Unrecognized bundle diagnostic" +describeError _ = "Unrecognized bundle diagnostic" diff --git a/lib/arboricx/manifest.tri b/lib/arboricx/manifest.tri @@ -76,11 +76,11 @@ readManifestCore = (do bindParser pureParser (pair schema (pair bundleType (pair treeCalculus (pair treeHashAlgorithm (pair treeHashDomain (pair treeNodePayload (pair runtimeSemantics (pair runtimeEvaluation (pair runtimeAbi (pair capabilities (pair closureByte (pair roots exports))))))))))))) -- Metadata tag constants (u16 values) -tagPackage = [(0) (1)] -tagVersion = [(0) (2)] +tagPackage = [(0) (1)] +tagVersion = [(0) (2)] tagDescription = [(0) (3)] -tagLicense = [(0) (4)] -tagCreatedBy = [(0) (5)] +tagLicense = [(0) (4)] +tagCreatedBy = [(0) (5)] -- Read a single TLV entry: u16 tag + u32 length + value bytes. -- Returns the pair (tag, value) and remaining input. @@ -109,12 +109,12 @@ readManifestComplete bytes = (bindResult (readManifest bytes) -- Lookup a metadata value by tag from a TLV list. -- Returns nothing if not found, just value if found. -lookupMetadata tlvs tag = (maybeMap snd (find (entry : equal? (fst entry) tag) tlvs)) -exportName entry = fst entry -exportRoot entry = fst (snd entry) -exportNameEq? name entry = equal? name (exportName entry) +lookupMetadata tlvs tag = (maybeMap snd (find (entry : equal? (fst entry) tag) tlvs)) +exportName entry = fst entry +exportRoot entry = fst (snd entry) +exportNameEq? name entry = equal? name (exportName entry) findExportByName exports name = find (exportNameEq? name) exports -getExportNames exports = map exportName exports +getExportNames exports = map exportName exports mainExportName = "main" diff --git a/lib/arboricx/nodes.tri b/lib/arboricx/nodes.tri @@ -99,7 +99,7 @@ readNodesSectionComplete bytes = (bindResult (readNodesSection bytes) (value rest : case rest of [] = ok value rest _ = err errUnexpectedBytes rest)) -nodesSectionCount = fst +nodesSectionCount = fst nodesSectionRecords = snd readArboricxNodesSection bytes = (bindResult (readArboricxContainer bytes) diff --git a/lib/arboricx/server.tri b/lib/arboricx/server.tri @@ -5,13 +5,13 @@ -- Store root is trusted configuration. Every read/write entrypoint must validate -- a hash before passing it to these pure path constructors. -pathJoin parent child = append parent (append "/" child) -objectDir root shard = pathJoin (pathJoin root "objects") shard +pathJoin parent child = append parent (append "/" child) +objectDir root shard = pathJoin (pathJoin root "objects") shard hashShard [a | [b | [c | _]]] = [a b c] -hashShard [a | [b | _]] = [a b] -hashShard [a | _] = [a] -hashShard _ = [] +hashShard [a | [b | _]] = [a b] +hashShard [a | _] = [a] +hashShard _ = [] bundleObjectPath root hash = pathJoin (objectDir root (hashShard hash)) (append hash ".arboricx") @@ -19,16 +19,16 @@ bundleObjectPath root hash = pathJoin (objectDir root (hashShard hash)) (append -- range predicates, reject malformed numeral trees without normalizing them. -- Disjoint compact-bit ranges: 48..55, 56..57, 97, 98..99, -- 100..101, 102. Every captured bit is checked as an exact Boolean. -bundleBit? t = true +bundleBit? t = true bundleBit? (t t) = true -bundleBit? _ = false +bundleBit? _ = false bundleHexByte? (a, (b, (c, 6))) = and? (bundleBit? a) (and? (bundleBit? b) (bundleBit? c)) -bundleHexByte? (a, 28) = bundleBit? a -bundleHexByte? 97 = true -bundleHexByte? (a, 49) = bundleBit? a -bundleHexByte? (a, 50) = bundleBit? a -bundleHexByte? 102 = true -bundleHexByte? _ = false +bundleHexByte? (a, 28) = bundleBit? a +bundleHexByte? 97 = true +bundleHexByte? (a, 49) = bundleBit? a +bundleHexByte? (a, 50) = bundleBit? a +bundleHexByte? 102 = true +bundleHexByte? _ = false -- The counter is internal and canonical. At zero inspect only the list shape: -- never force the 65th byte or its suffix, even for arbitrary malformed trees. @@ -63,9 +63,9 @@ stripPrefix [wanted | prefix] [byte | rest] = case byte of stripPrefix _ _ = nothing -bundleHashPrefix = "/_arboricx/bundle/hash/" -bundlePath = "/_arboricx/bundle" -healthPath = "/_arboricx/health" +bundleHashPrefix = "/_arboricx/bundle/hash/" +bundlePath = "/_arboricx/bundle" +healthPath = "/_arboricx/health" bundleContentType = "application/vnd.arboricx.bundle" htmlLandingPage = "<!DOCTYPE html><html><head><meta name='viewport' content='width=device-width, initial-scale=1'><title>Arboricx Server</title></head><body><h1>Arboricx Server</h1><p>Bundle registry</p><p><a href='https://git.eversole.co/James/tricu'>Made with Love (and trees, lots of trees)</a></p></body></html>" diff --git a/lib/arboricx/streaming-v2.tri b/lib/arboricx/streaming-v2.tri @@ -118,17 +118,17 @@ connection root limit sink client = IO.bind (Transport.recvHeaders client) (repl _ = Transport.respond client "" (HTTP.badRequestResponse "Bad Request\n")) worker root limit sink [client] = connection root limit sink client -worker _ _ _ _ = IO.fail "Invalid connection handoff" +worker _ _ _ _ = IO.fail "Invalid connection handoff" settle ticket = IO.require (IO.join ticket) (outcome : case outcome of ["completed" _] = IO.pure t ["failed" _ _] = IO.bind (Registry.writeLogV2 "registry connection failed\n") (_ : IO.pure t) ["cancelled" reason _] = IO.cancelled reason _ = IO.fail "Invalid connection task outcome") -drain [] = IO.pure t +drain [] = IO.pure t drain [ticket | rest] = IO.bind (settle ticket) (_ : drain rest) -drain _ = IO.fail "Invalid connection tickets" +drain _ = IO.fail "Invalid connection tickets" next (t count) = B.just (N.predecessor count) -next _ = t +next _ = t -- FIFO bounded admission: consume the oldest ticket before accepting beyond the -- configured window. No discarded tickets, detached tasks or unbounded backlog in -- the language. A slow oldest connection can delay admission; no deadline promise. diff --git a/lib/base.tri b/lib/base.tri @@ -53,7 +53,7 @@ resultIsErr result = matchResult (errR rest : true) (val rest : false) result not? = matchBool false true -and? = matchBool id (_ : false) +and? = matchBool id (_ : false) -- Normalize truthiness without inspecting the right argument after success. or? left right = matchBool true (matchBool true false right) left @@ -83,8 +83,8 @@ equal? = y (self : triage -- Unchecked successor for internal canonical-natural loops. succ = N.successor -ok value rest = pair true (pair value rest) -err msg rest = pair false (pair msg rest) +ok value rest = pair true (pair value rest) +err msg rest = pair false (pair msg rest) matchResult errCase okCase result = matchPair @@ -103,7 +103,7 @@ matchResult errCase okCase result = -- --------------------------------------------------------------------------- nothing = t -just x = t x +just x = t x matchMaybe nothingCase justCase maybe = triage @@ -199,7 +199,7 @@ div @nat? @nonZero? =@nat? N.quotient mod @nat? @nonZero? =@nat? N.remainder pow @nat? @nat? =@nat? N.power even? = N.even -odd? = N.odd +odd? = N.odd min @nat? @nat? =@nat? N.minimum max @nat? @nat? =@nat? N.maximum @@ -432,7 +432,7 @@ partition pred xs = (let rec strLength = length strAppend = append -strEq? = equal? +strEq? = equal? strEmpty? = emptyList? startsWith? prefix input = (let rec @@ -566,7 +566,7 @@ zipWith f xs ys = (let rec -- policy can apply it explicitly to checkContract's Result. -- --------------------------------------------------------------------------- -contractOk = (value : (rest : ok value rest)) +contractOk = (value : (rest : ok value rest)) contractErr = (msg : (rest : err msg rest)) -- Default contract kernel. Return the contract Result unchanged. @@ -733,8 +733,8 @@ fn2 arg1C arg2C resC f rest = fnContract arg1C (fnContract arg2C resC) f rest -- 2 = exceptE -- --------------------------------------------------------------------------- -pureE = (value : pair 0 value) -bindE = (action k : pair 1 (pair action k)) +pureE = (value : pair 0 value) +bindE = (action k : pair 1 (pair action k)) exceptE = (tag value k : pair 2 (pair tag (pair value k))) pureM = pureE diff --git a/lib/binary.tri b/lib/binary.tri @@ -1,17 +1,17 @@ !import base * !export * -errUnexpectedEof = 1 +errUnexpectedEof = 1 errUnexpectedBytes = 2 -errUnexpectedByte = 3 +errUnexpectedByte = 3 unit = t -- Byte streams are proper lists of canonical naturals in 0..255. -- Prefix readers inspect only consumed cells; readBytes 0 never inspects input. errInvalidBinaryInput = 15 -errInvalidCount = 16 -binaryByte? byte = and? (isNat? byte) (lte_? byte 255) +errInvalidCount = 16 +binaryByte? byte = and? (isNat? byte) (lte_? byte 255) binaryBytes? bytes = case bytes of [] = true [byte | rest] = and? (binaryByte? byte) (binaryBytes? rest) @@ -65,7 +65,7 @@ readU32BEBytes = (bs : read4 bs) pureParser = value bs : ok value bs failParser = code bs : err code bs -mapParser = f p bs : mapResult f (p bs) +mapParser = f p bs : mapResult f (p bs) bindParser = p f bs : bindResult (p bs) f thenParser = p q bs : bindResult (p bs) (_ : q) @@ -98,9 +98,9 @@ readWhile predicate bytes = (let rec (predicate value)))) in walk bytes []) -readUntil predicate = readWhile (value : not? (predicate value)) -readRemaining bytes = lazyBool (_ : ok bytes []) (_ : err errInvalidBinaryInput bytes) (binaryBytes? bytes) -peekU8 bytes = bindResult (readU8 bytes) (value _ : ok value bytes) +readUntil predicate = readWhile (value : not? (predicate value)) +readRemaining bytes = lazyBool (_ : ok bytes []) (_ : err errInvalidBinaryInput bytes) (binaryBytes? bytes) +peekU8 bytes = bindResult (readU8 bytes) (value _ : ok value bytes) eof? bytes = case bytes of [] = ok unit bytes _ = err errUnexpectedBytes bytes diff --git a/lib/bytes.tri b/lib/bytes.tri @@ -9,10 +9,10 @@ bytesHead = headMaybe bytesTail = matchList nothing (_ r : just r) -bytesLength = length -bytesAppend = append -bytesTake = take -bytesDrop = drop +bytesLength = length +bytesAppend = append +bytesTake = take +bytesDrop = drop bytesSplitAt = splitAt -bytesEq? = equal? +bytesEq? = equal? diff --git a/lib/handlers.tri b/lib/handlers.tri @@ -32,7 +32,7 @@ fail kind service operation detail = B.pair 103 [kind service operation detail] -- Handlers execute outside their own installation scope, so forwarding is an -- ordinary request there. At other call sites it uses the current environment. -- Service names select routes; host operations use OS process authority. -forward = request +forward = request liftIO action = request "host.io" "run" action -- Boundary constructors snapshot the actual lexical environment during diff --git a/lib/handlers/artifacts.tri b/lib/handlers/artifacts.tri @@ -48,9 +48,9 @@ checkedDigest service digest next = H.checkWith Store.bundleHashC digest next loadFrom service digest = checkedDigest service digest (checked : H.checkedRequest service "load" B.anyC loadReplyC checked) -load digest = loadFrom "artifacts" digest +load digest = loadFrom "artifacts" digest publishTo service bytes = H.checkedRequest service "publish" bytesC publishReplyC bytes -publish bytes = publishTo "artifacts" bytes +publish bytes = publishTo "artifacts" bytes loadReplyC value{((t t), (bytes, t))} rest = case B.checkContract bytesC bytes of ((t t), _) = B.contractOk value rest diff --git a/lib/handlers/log.tri b/lib/handlers/log.tri @@ -16,13 +16,13 @@ eventC value{[level fields payload]} rest = case B.listOf B.anyC fields rest of eventC _ rest = B.contractErr "expected [level context payload]" rest -- Log sinks return ordinary Result unit; errors remain application-visible. -replyC value{((t t), (t, t))} rest = B.contractOk value rest +replyC value{((t t), (t, t))} rest = B.contractOk value rest replyC value{(t, (message, t))} rest = B.contractOk value rest -replyC _ rest = B.contractErr "expected log Result with empty remainder" rest +replyC _ rest = B.contractErr "expected log Result with empty remainder" rest emit level payload = H.checkedRequest "logging" "emit" eventC replyC [level [] payload] -info payload = emit "info" payload -warn payload = emit "warn" payload +info payload = emit "info" payload +warn payload = emit "warn" payload contextHandler fields "emit" event{[level inner payload]} = H.forward "logging" "emit" [level (B.append fields inner) payload] @@ -31,8 +31,8 @@ withContext fields action = case B.checkContract (B.listOf B.anyC) fields of ((t t), (checked, t)) = H.handle "logging" (contextHandler checked) action _ = H.fail "invalid-request" "logging" "context" "context must be a proper list" -sinkHandler sink "emit" event = H.checkRequest "logging" "emit" eventC event sink -sinkHandler _ operation payload = H.forward "logging" operation payload +sinkHandler sink "emit" event = H.checkRequest "logging" "emit" eventC event sink +sinkHandler _ operation payload = H.forward "logging" operation payload withSink sink action = H.handle "logging" (sinkHandler sink) action capture action = H.collect "logging" "emit" eventC (B.ok t t) action discard action = withSink (_ : H.pure (B.ok t t)) action diff --git a/lib/http.tri b/lib/http.tri @@ -8,7 +8,7 @@ -- --------------------------------------------------------------------------- maxHeaderBytes = 65536 -maxBodyBytes = 1048576 +maxBodyBytes = 1048576 crlfcrlf = pair 13 (pair 10 (pair 13 (pair 10 t))) @@ -37,11 +37,11 @@ lookupStatusPhrase _ _ = "Internal Server Error" statusPhrase code = lookupStatusPhrase code statusPhrases statusLine code phrase = append "HTTP/1.1 " (append (showNumber code) (append " " (append phrase "\r\n"))) -headerLine key value = append key (append ": " (append value "\r\n")) +headerLine key value = append key (append ": " (append value "\r\n")) httpAppendResponseHeader accumulated (key, value) = append accumulated (headerLine key value) -- Preserve the old pair-projection fallback for malformed response-header items. -httpAppendResponseHeader accumulated _ = append accumulated (headerLine "" "") +httpAppendResponseHeader accumulated _ = append accumulated (headerLine "" "") buildResponse status headers body = (append (statusLine status (statusPhrase status)) @@ -84,7 +84,7 @@ headerEndState 2 13 = 3 headerEndState _ 13 = 1 headerEndState 3 10 = 4 headerEndState 1 10 = 2 -headerEndState _ _ = 0 +headerEndState _ _ = 0 httpHeadersOnly [byte | rest] state reversed = (let accumulated = pair byte reversed @@ -96,7 +96,7 @@ httpHeadersOnly _ _ reversed = reverse reversed headersOnly bytes = httpHeadersOnly bytes 0 [] responseForMethod "HEAD" response = headersOnly response -responseForMethod _ response = response +responseForMethod _ response = response -- --------------------------------------------------------------------------- -- Request line parsing @@ -109,15 +109,15 @@ httpLineError code found rest consumed = (parserReplyFail (parserDiagnostic code "CRLF" found t ["http-line"]) rest consumed false) -httpScanLine [13 10 | rest] reversed = parserReplyOk (reverse reversed) rest true false +httpScanLine [13 10 | rest] reversed = parserReplyOk (reverse reversed) rest true false httpScanLine input{[13 | _]} reversed = httpLineError 2 13 input (not? (emptyList? reversed)) httpScanLine input{[10 | _]} reversed = httpLineError 2 10 input (not? (emptyList? reversed)) -httpScanLine [byte | rest] reversed = httpScanLine rest (pair byte reversed) -httpScanLine [] reversed = httpLineError 1 t [] (not? (emptyList? reversed)) -httpScanLine input reversed = httpLineError 2 input input (not? (emptyList? reversed)) +httpScanLine [byte | rest] reversed = httpScanLine rest (pair byte reversed) +httpScanLine [] reversed = httpLineError 1 t [] (not? (emptyList? reversed)) +httpScanLine input reversed = httpLineError 2 input input (not? (emptyList? reversed)) httpLineReply input = httpScanLine input [] -httpBadRequest = err 400 "Bad Request\n" +httpBadRequest = err 400 "Bad Request\n" -- Unlike the old pair-only helper, this Result distinguishes a blank CRLF -- line from truncated/malformed input. Both callers propagate the failure. @@ -222,19 +222,19 @@ httpLengthDigits _ _ = httpBadRequest -- Input is a finite canonical byte list, with no OWS: parseHeaders already -- trims field edges. Empty strings, signs, commas and interior whitespace fail. parseContentLengthValue input{[_ | _]} = httpLengthDigits input 0 -parseContentLengthValue _ = httpBadRequest +parseContentLengthValue _ = httpBadRequest -- Input names are normalized by parseHeaders. Select the sole raw length -- before decoding: duplicate fields and unsupported transfer coding are 400 -- regardless of field order or whether a length would otherwise exceed limits. -- This server supports Content-Length framing only, not chunked decoding. -httpSelectLength [] t = ok nothing t -httpSelectLength [] (t value) = parseContentLengthValue value -httpSelectLength [("transfer-encoding", _) | _] _ = httpBadRequest -httpSelectLength [("content-length", value) | rest] t = httpSelectLength rest (just value) -httpSelectLength [("content-length", _) | _] _ = httpBadRequest -httpSelectLength [(_, _) | rest] selected = httpSelectLength rest selected -httpSelectLength _ _ = httpBadRequest +httpSelectLength [] t = ok nothing t +httpSelectLength [] (t value) = parseContentLengthValue value +httpSelectLength [("transfer-encoding", _) | _] _ = httpBadRequest +httpSelectLength [("content-length", value) | rest] t = httpSelectLength rest (just value) +httpSelectLength [("content-length", _) | _] _ = httpBadRequest +httpSelectLength [(_, _) | rest] selected = httpSelectLength rest selected +httpSelectLength _ _ = httpBadRequest contentLength headers = httpSelectLength headers nothing @@ -246,11 +246,11 @@ bodyReadState remaining reversed rest = pair remaining (pair reversed rest) -- State is (remaining, (reversed body, unused input)); zero consumes nothing. -- remaining is a canonical natural supplied by the bounded length decoder. -takeBodyBytes bytes 0 reversed = bodyReadState 0 reversed bytes +takeBodyBytes bytes 0 reversed = bodyReadState 0 reversed bytes -- The zero equation above excludes underflow. Specialized predecessor avoids -- a full-width comparison/subtraction per byte of a canonical body counter. takeBodyBytes [byte | rest] remaining reversed = takeBodyBytes rest (Nat.predecessor remaining) (pair byte reversed) -takeBodyBytes _ remaining reversed = bodyReadState remaining reversed [] +takeBodyBytes _ remaining reversed = bodyReadState remaining reversed [] -- Retain the existing receive-size buckets, expressed as native comparisons -- rather than bit shifts. Zero is handled before asking for another chunk. @@ -266,17 +266,17 @@ recvChunkMax4096 remaining = httpRecvBucket remaining [4096 1024 256 64 16] -- Request validation -- --------------------------------------------------------------------------- -validMethod? "GET" = true +validMethod? "GET" = true validMethod? "POST" = true validMethod? "HEAD" = true -validMethod? _ = false +validMethod? _ = false validVersion? "HTTP/1.1" = true validVersion? "HTTP/1.0" = true -validVersion? _ = false +validVersion? _ = false validTarget? [47 | _] = true -validTarget? _ = false +validTarget? _ = false -- Keep error precedence: method, version, then target. Headers are validated -- separately; accepting them here does not select body framing. diff --git a/lib/intensionalContracts.tri b/lib/intensionalContracts.tri @@ -11,7 +11,7 @@ fullTree? = (guardC "not a full binary tree" full -- Numeric contracts validate shape before inspecting bits or comparing values. evenC? = andC nat? (guardC "not even" even?) -oddC? = andC nat? (guardC "not odd" odd?) +oddC? = andC nat? (guardC "not odd" odd?) -- Exactly one set bit in a validated canonical natural. powerOfTwo? = (andC nat? (guardC "not a power of two" oneBit) diff --git a/lib/io-v2.tri b/lib/io-v2.tri @@ -91,8 +91,8 @@ verifyIndexedTree reader limit tree = request "indexed-tree" 1 "verify" [reader encodeUTF8 text = request "utf8" 1 "encode" text decodeUTF8 final bytes = request "utf8" 1 "decode" [final bytes] -readSome reader limit = request "stream" 1 "read" (B.pair reader limit) -writeSome writer bytes = request "stream" 1 "write" (B.pair writer bytes) +readSome reader limit = request "stream" 1 "read" (B.pair reader limit) +writeSome writer bytes = request "stream" 1 "write" (B.pair writer bytes) -- Whole-stream SHA-256 authentication into an anonymous read-only file. -- Result: [reader size]. Scope-owned; disk <= limit, native chunks <=4096. -- An EOF probe may consume one byte beyond the limit on failure. diff --git a/lib/io-v2/http-transport.tri b/lib/io-v2/http-transport.tri @@ -51,7 +51,7 @@ fields router client method target version raw = case HTTP.parseHeaders raw of _ = respond client method (HTTP.badRequestResponse "Bad Request\n") _ = respond client "" (HTTP.badRequestResponse "Bad Request\n") handleWith router client ((t t), ((method, (target, version)), raw)) = fields router client method target version raw -handleWith _ client _ = respond client "" (HTTP.badRequestResponse "Bad Request\n") +handleWith _ client _ = respond client "" (HTTP.badRequestResponse "Bad Request\n") -- Response callbacks run only after the same request grammar/body checks. They -- may send a bounded native body; framing errors use the ordinary byte response. diff --git a/lib/io-v2/objects.tri b/lib/io-v2/objects.tri @@ -37,7 +37,7 @@ validDigest value = let rec in walk 64 value shard [a b c | _] = [a b c] -shard _ = [] +shard _ = [] objects root = B.append root "/objects" shardPath root digest = B.append (objects root) (B.pair 47 (shard digest)) objectPath root digest = B.append (shardPath root digest) (B.pair 47 digest) diff --git a/lib/io-v2/storage.tri b/lib/io-v2/storage.tri @@ -19,12 +19,12 @@ checkedLimit limit next = case B.isNat? limit of -- A fixed composition supplies 4096 structural steps without a per-byte -- numeric countdown. Each step preserves the proper-list failure sentinel; -- reaching the bound leaves the suffix for the next chunk to validate. -chunkEnd rest = [[] rest] +chunkEnd rest = [[] rest] chunkStep next [] = [[] []] chunkStep next [c | rest] = case next rest of [prefix after] = [(B.pair c prefix) after] _ = [] -chunkStep _ _ = [] +chunkStep _ _ = [] doubleStep step next = step (step next) chunkSteps = chunkStep |> doubleStep |> doubleStep |> doubleStep |> doubleStep @@ -33,9 +33,9 @@ chunkSteps = chunkStep chunk bytes = chunkSteps chunkEnd bytes -- Only host-produced proper chunks, or prefixes checked by chunk, reach here. -- Count their cells directly, preserving the public base.length contract. -chunkLength [] = 0 +chunkLength [] = 0 chunkLength [_ | rest] = N.successor (chunkLength rest) -chunkLength _ = 0 +chunkLength _ = 0 flatten chunks = B.foldr (suffix chunk : B.append chunk suffix) [] (B.reverse chunks) readCount 0 = 1 readCount remaining = case N.lte remaining 4096 of diff --git a/lib/io-v2/text.tri b/lib/io-v2/text.tri @@ -71,9 +71,9 @@ readCount remaining = case N.lte remaining 4093 of _ = 4093 -- Native reads produce proper byte lists. Counting that spine needs no -- transforming collection contract; raw octets still reach strict UTF-8 decode. -sourceChunkLength [] = 0 +sourceChunkLength [] = 0 sourceChunkLength [_ | rest] = N.successor (sourceChunkLength rest) -sourceChunkLength _ = 0 +sourceChunkLength _ = 0 readLoop reader limit remaining carry first rawChunks textChunks = IO.bind (IO.readSome reader (readCount remaining)) (received : case received of ((t t), (("eof", t), t)) = IO.bind (IO.decodeUTF8 1 carry) (decoded : case decoded of diff --git a/lib/math/native.tri b/lib/math/native.tri @@ -45,8 +45,8 @@ compare a b = (triage (bbit br : triage (bitOrder abit bbit) (_ : t t) (_ _ : t t t) (compare ar br)) b) a) -isEqual order = triage (t t) (_ : t) (_ _ : t) order -isLess order = triage t (_ : t t) (_ _ : t) order +isEqual order = triage (t t) (_ : t) (_ _ : t) order +isLess order = triage t (_ : t t) (_ _ : t) order isGreater order = triage t (_ : t) (_ _ : t t) order -- Equality may stop at the first differing low bit; ordering cannot. equal a b = (triage @@ -67,8 +67,8 @@ odd value = triage t (_ : t) (bit rest : bit) value even value = not (odd value) -- Discard a redundant high zero bit when rebuilding after subtraction. -node bit rest = choose (t bit rest) (choose t (t bit rest) (zero rest)) bit -double value = node t value +node bit rest = choose (t bit rest) (choose t (t bit rest) (zero rest)) bit +double value = node t value successor value = (triage (t (t t) t) (_ : t) (bit rest : triage (t (t t) rest) (_ : t t (successor rest)) (_ _ : t) bit) value) predecessor value = (triage t (_ : t) @@ -123,7 +123,7 @@ divMod dividend divisor = (lazy (lt shifted divisor)) partial)) -quotient a b = triage t (_ : t) (q r : q) (divMod a b) +quotient a b = triage t (_ : t) (q r : q) (divMod a b) remainder a b = triage t (_ : t) (q r : r) (divMod a b) -- Exponentiation by squaring; 0^0 = 1. Do not square an unused final factor. diff --git a/lib/packages/base.tri b/lib/packages/base.tri @@ -7,6 +7,6 @@ -- Small public foundation for Result-aware command-line consumers. -- matchResult receives failure first, success second; each handler gets -- a payload and a remainder. showNumber accepts canonical naturals. -append = B.append +append = B.append matchResult = B.matchResult -showNumber = C.showNumber +showNumber = C.showNumber diff --git a/lib/parser.tri b/lib/parser.tri @@ -12,9 +12,9 @@ parserDiagnostic code expected found location contexts = pair code (pair expected (pair found (pair location contexts))) -parserDiagnosticCode diagnostic = fst diagnostic +parserDiagnosticCode diagnostic = fst diagnostic parserDiagnosticExpected diagnostic = fst (snd diagnostic) -parserDiagnosticFound diagnostic = fst (snd (snd diagnostic)) +parserDiagnosticFound diagnostic = fst (snd (snd diagnostic)) parserDiagnosticLocation diagnostic = fst (snd (snd (snd diagnostic))) parserDiagnosticContexts diagnostic = snd (snd (snd (snd diagnostic))) @@ -35,9 +35,9 @@ parserReplyOk value rest consumed committed = parserReplyFail diagnostic rest consumed committed = pair false (pair diagnostic (pair rest (pair consumed committed))) -parserReplyPayload reply = fst (snd reply) -parserReplyRest reply = fst (snd (snd reply)) -parserReplyConsumed reply = fst (snd (snd (snd reply))) +parserReplyPayload reply = fst (snd reply) +parserReplyRest reply = fst (snd (snd reply)) +parserReplyConsumed reply = fst (snd (snd (snd reply))) parserReplyCommitted reply = snd (snd (snd (snd reply))) -- Match only the status projection. Destructuring the whole reply here would @@ -71,7 +71,7 @@ parserBind parser next input = (parserMatchReply (value rest consumed committed : parserMergeFlags consumed committed (next value rest)) (parser input)) -parserThen first second = parserBind first (_ : second) +parserThen first second = parserBind first (_ : second) parserBefore first second = parserBind first (value : parserMap (_ : value) second) -- Compose a character lexer and a token parser without discarding either @@ -121,7 +121,7 @@ parserAttempt parser input = parserReplyOk value rest consumed committed) (parser input) -parserUnexpectedEof = parserDiagnostic 1 t t t t +parserUnexpectedEof = parserDiagnostic 1 t t t t parserUnexpectedToken token = parserDiagnostic 2 t token t t parserAny input = @@ -182,7 +182,7 @@ parserSome parser = parserBind parser (first : parserMap (rest : pair first rest) (parserMany parser)) -parserTakeWhile predicate = parserMany (parserSatisfy predicate) +parserTakeWhile predicate = parserMany (parserSatisfy predicate) parserTakeWhile1 predicate = parserSome (parserSatisfy predicate) parserBetween open content close = diff --git a/lib/recursion/list.tri b/lib/recursion/list.tri @@ -6,7 +6,7 @@ -- Decisions carry exact booleans, not numbers or truthy trees. listContinue state = pair (t t) state -listStop state = pair t state +listStop state = pair t state -- step head tail state -> decision. Continue consumes the current cell; -- Stop commits its state but retains the whole unconsumed suffix, including diff --git a/lib/source/ast.tri b/lib/source/ast.tri @@ -6,26 +6,26 @@ -- node = pair kind (pair payload (pair start end)) sourceAstNode kind payload start end = pair kind (pair payload (pair start end)) -sourceAstKind node = fst node +sourceAstKind node = fst node sourceAstPayload node = fst (snd node) -sourceAstStart node = fst (snd (snd node)) -sourceAstEnd node = snd (snd (snd node)) - -sourceAstLeafKind = 1 -sourceAstNameKind = 2 -sourceAstApplyKind = 3 -sourceAstLambdaKind = 4 -sourceAstGroupKind = 5 -sourceAstNumberKind = 6 -sourceAstStringKind = 7 -sourceAstListKind = 8 -sourceAstLetKind = 9 -sourceAstPipeKind = 10 -sourceAstDoKind = 11 +sourceAstStart node = fst (snd (snd node)) +sourceAstEnd node = snd (snd (snd node)) + +sourceAstLeafKind = 1 +sourceAstNameKind = 2 +sourceAstApplyKind = 3 +sourceAstLambdaKind = 4 +sourceAstGroupKind = 5 +sourceAstNumberKind = 6 +sourceAstStringKind = 7 +sourceAstListKind = 8 +sourceAstLetKind = 9 +sourceAstPipeKind = 10 +sourceAstDoKind = 11 sourceAstEquationsKind = 12 -sourceAstPatternKind = 13 -sourceAstCaseKind = 14 -sourceAstRecKind = 15 +sourceAstPatternKind = 13 +sourceAstCaseKind = 14 +sourceAstRecKind = 15 -- Case keeps source order and spans; its matcher is an ordinary unary equation -- group. No generated surface identifier can capture a user's lexical name. @@ -51,18 +51,18 @@ sourceAstFunction? node = case sourceAstKind node of sourceAstEquations equations start end = sourceAstNode sourceAstEquationsKind equations start end -sourceAstDoOperator node = fst (sourceAstPayload node) -sourceAstDoStatements node = snd (sourceAstPayload node) +sourceAstDoOperator node = fst (sourceAstPayload node) +sourceAstDoStatements node = snd (sourceAstPayload node) sourceAstDoStatementBinder statement = fst statement -sourceAstDoStatementValue statement = snd statement +sourceAstDoStatementValue statement = snd statement sourceAstPipeDirection node = fst (sourceAstPayload node) -sourceAstPipeLeft node = fst (snd (sourceAstPayload node)) -sourceAstPipeRight node = snd (snd (sourceAstPayload node)) +sourceAstPipeLeft node = fst (snd (sourceAstPayload node)) +sourceAstPipeRight node = snd (snd (sourceAstPayload node)) -sourceAstLetName node = sourceTokenPayload (fst (sourceAstPayload node)) +sourceAstLetName node = sourceTokenPayload (fst (sourceAstPayload node)) sourceAstLetValue node = fst (snd (sourceAstPayload node)) -sourceAstLetBody node = snd (snd (sourceAstPayload node)) +sourceAstLetBody node = snd (snd (sourceAstPayload node)) sourceAstLeaf token = sourceAstNode sourceAstLeafKind t diff --git a/lib/source/core.tri b/lib/source/core.tri @@ -5,19 +5,19 @@ -- node = pair kind (pair payload (pair start end)) sourceCoreNode kind payload start end = pair kind (pair payload (pair start end)) -sourceCoreKind node = fst node +sourceCoreKind node = fst node sourceCorePayload node = fst (snd node) -sourceCoreStart node = fst (snd (snd node)) -sourceCoreEnd node = snd (snd (snd node)) +sourceCoreStart node = fst (snd (snd node)) +sourceCoreEnd node = snd (snd (snd node)) -sourceCoreLeafKind = 1 -sourceCoreBoundKind = 2 -sourceCoreApplyKind = 3 -sourceCoreLambdaKind = 4 +sourceCoreLeafKind = 1 +sourceCoreBoundKind = 2 +sourceCoreApplyKind = 3 +sourceCoreLambdaKind = 4 sourceCoreExternalKind = 5 -sourceCoreNumberKind = 6 -sourceCoreStringKind = 7 -sourceCoreListKind = 8 +sourceCoreNumberKind = 6 +sourceCoreStringKind = 7 +sourceCoreListKind = 8 sourceCoreLeaf start end = sourceCoreNode sourceCoreLeafKind t start end sourceCoreBound index start end = diff --git a/lib/source/equations.tri b/lib/source/equations.tri @@ -29,8 +29,8 @@ sourceEquationError label input = sourceEquationFromToken tag token = (sourceEquationPattern tag (sourceTokenPayload token) (sourceTokenStart token) (sourceTokenEnd token)) sourceEquationWildcard token = sourceEquationPattern 0 t (sourceTokenStart token) (sourceTokenEnd token) -sourceEquationLeaf token = sourceEquationPattern 1 t (sourceTokenStart token) (sourceTokenEnd token) -sourceEquationLiteral token = sourceEquationFromToken 5 token +sourceEquationLeaf token = sourceEquationPattern 1 t (sourceTokenStart token) (sourceTokenEnd token) +sourceEquationLiteral token = sourceEquationFromToken 5 token sourceEquationPair left right = (sourceEquationPattern 3 (pair left right) (sourceAstStart left) (sourceAstEnd right)) sourceEquationNil token = sourceEquationLeaf token diff --git a/lib/source/lexer.tri b/lib/source/lexer.tri @@ -16,11 +16,11 @@ sourcePositionOffset = lexerPositionOffset sourceStart = lexerStart sourcePositionAdvance = lexerAdvance -sourceToken = lexerToken -sourceTokenKind = lexerTokenKind +sourceToken = lexerToken +sourceTokenKind = lexerTokenKind sourceTokenPayload = lexerTokenPayload -sourceTokenStart = lexerTokenStart -sourceTokenEnd = lexerTokenEnd +sourceTokenStart = lexerTokenStart +sourceTokenEnd = lexerTokenEnd sourceTokenT = 1 sourceTokenName = 2 @@ -54,7 +54,7 @@ sourceTokenRec = 27 -- Use binary TC math here; general tree equality and position arithmetic remain -- the prelude operations. The math module is namespaced to avoid shadowing them. sourceAsciiLetter? character = N.letter character -sourceAsciiDigit? character = N.digit character +sourceAsciiDigit? character = N.digit character sourceNameStart? character = or? (sourceAsciiLetter? character) (equal? character 95) diff --git a/lib/source/lock.tri b/lib/source/lock.tri @@ -10,7 +10,7 @@ -- selected by that reference (the native import / re-export profile selects -- a manifest's whole public interface). No ambient alias is read by a -- locked build. The manifest remains authoritative for its export hashes. -sourceLockHeader = "arboricx.source-lock.v1\n" +sourceLockHeader = "arboricx.source-lock.v1\n" sourceLockPath root name = append root (append "/locks/" name) sourceLockRow ref hash entry = append "pin\t" (append (sourceModuleEscape ref) diff --git a/lib/source/object.tri b/lib/source/object.tri @@ -25,11 +25,11 @@ -- Native executable objects preserve sharing as name-neutral indexed bundles. -- The flat codec below remains an independent data codec with its own domain; -- it is not the native executable publication format. -sourceObjectTreeDomain = "arboricx.indexed-tree.v1" +sourceObjectTreeDomain = "arboricx.indexed-tree.v1" sourceObjectFlatTreeDomain = "arboricx.tree-term.v1" sourceObjectManifestDomain = "arboricx.module-manifest.v1" -sourceObjectTreeAbi = "arboricx.abi.tree.v1" -sourceObjectTreeKind = "arboricx.indexed-tree.v1" +sourceObjectTreeAbi = "arboricx.abi.tree.v1" +sourceObjectTreeKind = "arboricx.indexed-tree.v1" -- Build directly onto a suffix. Appending each encoded left subtree copies -- its byte list once per enclosing fork and retains huge intermediate lists @@ -92,9 +92,9 @@ sourceObjectDigest domain payload = -- Native math assumes canonical naturals. Keep the existing behavior for -- arbitrary trees: only canonical bytes use the binary comparison fast path. -- Canonical-byte helpers stay private; malformed trees retain the reference path. -sourceObjectByteLeaf? value = triage true (_ : false) (_ _ : false) value -sourceObjectByteBit? value = triage true (child : sourceObjectByteLeaf? child) (_ _ : false) value -sourceObjectByteOne? value = triage false (child : sourceObjectByteLeaf? child) (_ _ : false) value +sourceObjectByteLeaf? value = triage true (_ : false) (_ _ : false) value +sourceObjectByteBit? value = triage true (child : sourceObjectByteLeaf? child) (_ _ : false) value +sourceObjectByteOne? value = triage false (child : sourceObjectByteLeaf? child) (_ _ : false) value -- Eight statically bounded structural steps avoid numeric countdown work for -- every digest byte. Inspect the rest shape before the bit, as in the bounded -- recognizer; an invalid bit or exhausted bound must not force deeper fields. diff --git a/lib/source/pattern.tri b/lib/source/pattern.tri @@ -83,7 +83,7 @@ spShiftContext ctx = (spContext (pair t (spFuel ctx)) spBind ctx name value = (spContext (spFuel ctx) (pair (pair name value) (spCaptures ctx)) (spPending ctx)) spSave ctx value = spContext (spFuel ctx) (spCaptures ctx) (pair value (spPending ctx)) -spPop ctx = spContext (spFuel ctx) (spCaptures ctx) (snd (spPending ctx)) +spPop ctx = spContext (spFuel ctx) (spCaptures ctx) (snd (spPending ctx)) spCaptureAt captures index = (lazyList (_ : nothing) (entry rest : lazyBool (_ : just (snd entry)) @@ -308,5 +308,5 @@ sourceLowerEquationsWith select equations = (lazyList -- Selection is explicit; the optimized backend retains delayed construction. -sourceLowerEquations = sourceLowerEquationsWith spCase +sourceLowerEquations = sourceLowerEquationsWith spCase sourceLowerStableEquations = sourceLowerEquationsWith spDirectCase diff --git a/lib/source/program.tri b/lib/source/program.tri @@ -11,11 +11,11 @@ -- coalesce into one located equation body; unique all-name singleton heads -- take the ordinary lambda path. Program parsing is distinct from the -- single-expression gate. -sourceProgramDefinitions program = fst program -sourceProgramFinal program = snd program -sourceDefinitionName definition = sourceTokenPayload (fst definition) +sourceProgramDefinitions program = fst program +sourceProgramFinal program = snd program +sourceDefinitionName definition = sourceTokenPayload (fst definition) sourceDefinitionPosition definition = sourceTokenStart (fst definition) -sourceDefinitionBody definition = snd definition +sourceDefinitionBody definition = snd definition sourceProgramSkipNewlines = parserMap (_ : t) (parserMany (sourceGateExpect sourceTokenNewline)) diff --git a/lib/source/stable.tri b/lib/source/stable.tri @@ -144,19 +144,19 @@ stableCachedEliminate node = case sourceCoreKind node of (elements rest) (sourceCoreStart node)) pending) in elements (sourceCorePayload node)) _ = stableCachedNode 4 node (sourceCoreStart node) 0 0 -stableBracket term = stableCachedToPlain (stableCachedBracket (stableCachedFromPlain term)) +stableBracket term = stableCachedToPlain (stableCachedBracket (stableCachedFromPlain term)) stableEliminate node = stableCachedToPlain (stableCachedEliminate node) -- Native wait and Z, with self-first workers: Z f x = f (Z f) x. -- All applications below construct trees out of already-normal arguments. -stableI = sourceCoreFixI -stableSelf = sourceCoreFixSelf -stableWait = sourceCoreFixWait +stableI = sourceCoreFixI +stableSelf = sourceCoreFixSelf +stableWait = sourceCoreFixWait stableWaitSelf = sourceCoreFixWaitSelf -stableFix = sourceCoreFix +stableFix = sourceCoreFix -stableBind result next = lazyResult (problem rest : err problem rest) (value unused : next value) result -stableCompileCore core = sourceRunTerm (stableEliminate core) +stableBind result next = lazyResult (problem rest : err problem rest) (value unused : next value) result +stableCompileCore core = sourceRunTerm (stableEliminate core) -- Determine self-reference with the ordinary lexical free-name traversal. A -- parameter/local/pattern capture of the same spelling is not recursion. @@ -164,7 +164,7 @@ sourceDefinitionSelfRecursive definition = (lazyMaybe (_ : false) (_ : true) (sourceFindBinder (map sourceAstPayload (sourceFreeNames (sourceDefinitionBody definition))) (sourceDefinitionName definition))) -sourceRecursiveFunction = sourceAstFunction? +sourceRecursiveFunction = sourceAstFunction? sourceRecursiveBody definition = sourceAstLambda (fst definition) (sourceDefinitionBody definition) -- Wrap self only for ordering; compile the original definitions below. This diff --git a/lib/source/staged-list-experiment.tri b/lib/source/staged-list-experiment.tri @@ -36,7 +36,7 @@ stagedListFour node = (lazyBool -- Force dependency derived from an actual consumed tree, always Leaf once -- its constructor is available. Unlike a constant token this blocks building -- closed callback work while the list input remains abstract. -stagedListToken index = spApp4 (spLit triage) (spLit t) (spLam (spLit t)) (spLam (spLam (spLit t))) (spVar index) +stagedListToken index = spApp4 (spLit triage) (spLit t) (spLam (spLit t)) (spLam (spLam (spLit t))) (spVar index) stagedListProtect body index = S.stageFinish (spApp (S.stageThunk body) (stagedListToken index)) stagedListDone body = (stagedListProtect (y S.stageShift_ (y S.stageShift_ (y S.stageBody_ body false 0) 1) 1) 1)