Move SSD area pruning to typed Kotlin
ober
a3eec139ed4557c1a44ddb4113e875b891bc2d54
--- a/.build.yml +++ b/.build.yml @@ -5,7 +5,7 @@ packages: - make=4.4.1-r4 sources: # Build dependency: full immutable commit, mirrored in dependencies.lock.json. - - "https://git.sr.ht/~lisp/jerboa#d5742f47587e045650cbfaebd2e11484e45772dc" + - "https://git.sr.ht/~lisp/jerboa#060bf67c52967edad54111e041996bdbe88e82c9" # The second source is the build subject selected by the SourceHut submitter. - https://git.sr.ht/~lisp/jerboa-android tasks: @@ -14,6 +14,6 @@ tasks: test "$(apk info -v chez-scheme)" = chez-scheme-10.3.0-r2 test "$(apk info -v git)" = git-2.54.0-r0 test "$(apk info -v make)" = make-4.4.1-r4 - test "$(git -C ../jerboa rev-parse HEAD)" = d5742f47587e045650cbfaebd2e11484e45772dc - test "$(git -C ../jerboa rev-parse 'HEAD^{tree}')" = 3f7ddb8a9e1e72c81768f8a8b090ffd8dc0fe015 + test "$(git -C ../jerboa rev-parse HEAD)" = 060bf67c52967edad54111e041996bdbe88e82c9 + test "$(git -C ../jerboa rev-parse 'HEAD^{tree}')" = 4a5faf71c0a5a678e5574d42ca1519899b71f26e JERBOA="chez --libdirs .:../jerboa/lib --script" make test --- a/dependencies.lock.json +++ b/dependencies.lock.json @@ -11,8 +11,8 @@ "generator_runtime": { "name": "jerboa", "repository": "https://git.sr.ht/~lisp/jerboa", - "commit": "d5742f47587e045650cbfaebd2e11484e45772dc", - "tree": "3f7ddb8a9e1e72c81768f8a8b090ffd8dc0fe015" + "commit": "060bf67c52967edad54111e041996bdbe88e82c9", + "tree": "4a5faf71c0a5a678e5574d42ca1519899b71f26e" }, "assurance_tools": { "osv_scanner": { --- a/scripts/verify-supply-chain.sh +++ b/scripts/verify-supply-chain.sh @@ -3,8 +3,8 @@ set -eu repo=$(CDPATH= cd -- "$(dirname -- "$0")/.." && pwd -P) lock="$repo/dependencies.lock.json" -jerboa_commit=d5742f47587e045650cbfaebd2e11484e45772dc # gitsafe:ignore -jerboa_tree=3f7ddb8a9e1e72c81768f8a8b090ffd8dc0fe015 # gitsafe:ignore +jerboa_commit=060bf67c52967edad54111e041996bdbe88e82c9 # gitsafe:ignore +jerboa_tree=4a5faf71c0a5a678e5574d42ca1519899b71f26e # gitsafe:ignore gradle_sha=20f1b1176237254a6fc204d8434196fa11a4cfb387567519c61556e8710aed78 jdk_macos_sha=8fa1eff40bb637a33613b2ccb8b12c70dc3661cc22cf8e784943715769a05336 jdk_linux_sha=d8afc263758141a66e0e3aafc321e783f7016696f4eaea067d340a269037d331 --- a/templates/ssd-review.ss +++ b/templates/ssd-review.ss @@ -332,6 +332,7 @@ SsdSession-ssdArea SsdSession-ssdArea-set! ssdSessionCellInsideSsdArea ssdSessionGroupInsideSsdArea ssdSessionFindCellById ssdSessionRecomputeGroup + ssdSessionSetSsdArea ssdSessionPruneGroupsOutsideSsdArea ssdSessionNextCellId ssdSessionNextGroupId) (type Int32) (type FloatArray) @@ -365,6 +366,81 @@ (rectCenterInside (SsdGroup-bbox group) (nullable-get (SsdSession-ssdArea session))))) + (def (appendSsdAreaNote (existing : String)) : String + (if (string-blank? existing) + "Outside SSD area" + (string-append existing "; Outside SSD area"))) + (def (ssdSessionSuppressedGroupPresent? (session : SsdSession) + (id : String)) : Bool + (for/fold ((found #f)) + ((i (in-range (int32 0) + (list-size (SsdSession-suppressedGroups session))))) + (if found + found + (equal? + (SsdGroup-id (list-ref (SsdSession-suppressedGroups session) i)) + id)))) + (def (ssdSessionGroupsOutsideArea (session : SsdSession) + (area : FloatArray)) : (MutableList SsdGroup) + (for/fold ((out (mutable-list-empty SsdGroup))) + ((i (in-range (int32 0) (list-size (SsdSession-groups session))))) + (let ((group (list-ref (SsdSession-groups session) i))) + (if (rectCenterInside (SsdGroup-bbox group) area) + out + (begin + (mutable-list-add! out group) + out))))) + (def (ssdSessionPruneGroupsOutsideSsdArea (session : SsdSession)) : Int32 + (if (nullable-null? (SsdSession-ssdArea session)) + (int32 0) + (let ((outside (ssdSessionGroupsOutsideArea + session + (nullable-get (SsdSession-ssdArea session))))) + (if (and (> (list-size outside) (int32 0)) + (>= (list-size outside) (list-size (SsdSession-groups session)))) + (int32 0) + (begin + (for/fold ((ignored (int32 0))) + ((i (in-range (int32 0) (list-size outside)))) + (let ((group (list-ref outside i))) + (begin + (mutable-list-remove! (SsdSession-groups session) group) + (SsdGroup-status-set! group "suppressed") + (SsdGroup-notes-set! + group + (appendSsdAreaNote (SsdGroup-notes group))) + (if (ssdSessionSuppressedGroupPresent? + session + (SsdGroup-id group)) + (begin) + (mutable-list-add! + (SsdSession-suppressedGroups session) + group)) + ignored))) + (list-size outside)))))) + (def (ssdSessionSetSsdArea (session : SsdSession) (area : FloatArray)) : Int32 + (begin + (SsdSession-ssdArea-set! + session + (nullable-some + (float-array + (if (< (float-array-ref area (int32 0)) + (float-array-ref area (int32 2))) + (float-array-ref area (int32 0)) + (float-array-ref area (int32 2))) + (if (< (float-array-ref area (int32 1)) + (float-array-ref area (int32 3))) + (float-array-ref area (int32 1)) + (float-array-ref area (int32 3))) + (if (> (float-array-ref area (int32 0)) + (float-array-ref area (int32 2))) + (float-array-ref area (int32 0)) + (float-array-ref area (int32 2))) + (if (> (float-array-ref area (int32 1)) + (float-array-ref area (int32 3))) + (float-array-ref area (int32 1)) + (float-array-ref area (int32 3)))))) + (ssdSessionPruneGroupsOutsideSsdArea session))) (def (ssdSessionFindCellById (session : SsdSession) (id : String)) : (Nullable SsdCell) (for/fold ((found (nullable-none SsdCell))) @@ -3470,31 +3546,6 @@ "" "fun ssdSessionCellsById(session: SsdSession): Map<String, SsdCell> = session.cells.associateBy { it.id }" "" - "fun ssdSessionSetSsdArea(session: SsdSession, area: FloatArray): Int {" - " session.ssdArea = floatArrayOf(" - " min(area[0], area[2])," - " min(area[1], area[3])," - " max(area[0], area[2])," - " max(area[1], area[3])" - " )" - " return ssdSessionPruneGroupsOutsideSsdArea(session)" - "}" - "" - "fun ssdSessionPruneGroupsOutsideSsdArea(session: SsdSession): Int {" - " val area = session.ssdArea ?: return 0" - " val outside = session.groups.filter { group -> !rectCenterInside(group.bbox, area) }.toList()" - " if (outside.isNotEmpty() && outside.size >= session.groups.size) return 0" - " outside.forEach { group ->" - " session.groups.remove(group)" - " group.status = \"suppressed\"" - " group.notes = if (group.notes.isBlank()) \"Outside SSD area\" else \"${group.notes}; Outside SSD area\"" - " if (session.suppressedGroups.none { it.id == group.id }) {" - " session.suppressedGroups.add(group)" - " }" - " }" - " return outside.size" - "}" - "" "fun ssdSessionToTruthJson(session: SsdSession): JSONObject {" " val cellsById = ssdSessionCellsById(session)" " val groupsJson = JSONArray()"