forth: String word set COMPARE/SEARCH/SLITERAL (+9)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
This commit is contained in:
@@ -381,6 +381,46 @@
|
||||
(dict-set! state "hold" (cons ch (get state "hold")))
|
||||
(forth-double-push-u state rest)))))))
|
||||
|
||||
(define
|
||||
forth-compare-bytes-loop
|
||||
(fn
|
||||
(state a1 u1 a2 u2 i)
|
||||
(cond
|
||||
((and (= i u1) (= i u2)) 0)
|
||||
((= i u1) -1)
|
||||
((= i u2) 1)
|
||||
(else
|
||||
(let
|
||||
((b1 (forth-mem-read state (+ a1 i)))
|
||||
(b2 (forth-mem-read state (+ a2 i))))
|
||||
(cond
|
||||
((< b1 b2) -1)
|
||||
((> b1 b2) 1)
|
||||
(else (forth-compare-bytes-loop state a1 u1 a2 u2 (+ i 1)))))))))
|
||||
|
||||
(define
|
||||
forth-match-at
|
||||
(fn
|
||||
(state a1 start a2 u2 j)
|
||||
(cond
|
||||
((= j u2) true)
|
||||
((not
|
||||
(=
|
||||
(forth-mem-read state (+ a1 (+ start j)))
|
||||
(forth-mem-read state (+ a2 j))))
|
||||
false)
|
||||
(else (forth-match-at state a1 start a2 u2 (+ j 1))))))
|
||||
|
||||
(define
|
||||
forth-search-bytes
|
||||
(fn
|
||||
(state a1 u1 a2 u2 i)
|
||||
(cond
|
||||
((= u2 0) 0)
|
||||
((> (+ i u2) u1) -1)
|
||||
((forth-match-at state a1 i a2 u2 0) i)
|
||||
(else (forth-search-bytes state a1 u1 a2 u2 (+ i 1))))))
|
||||
|
||||
(define
|
||||
forth-pic-S-loop
|
||||
(fn
|
||||
|
||||
Reference in New Issue
Block a user