diff --git a/fcore/search-list.sml b/fcore/search-list.sml deleted file mode 100644 index f5052a8..0000000 --- a/fcore/search-list.sml +++ /dev/null @@ -1,252 +0,0 @@ -structure SearchList = -struct - val empty = PersistentVector.empty - - fun backtrackFull (pos, hd, absIdx, tl, acc, searchPos, searchString, prevTl) = - if pos < 0 then - case prevTl of - prevHd :: prevTl => - let - val tl = hd :: tl - in - backtrackFull - ( String.size prevHd - 1 - , prevHd - , absIdx - , tl - , acc - , searchPos - , searchString - , prevTl - ) - end - | [] => - (* Should never be called *) - raise Fail "SearchList.backtrackFull error: line 24\n" - else if searchPos <= 1 then - (* we are trying to backtrack to index 1, - * and then continue are search from here *) - loopSearch (pos, hd, absIdx, tl, acc, 0, searchString, prevTl) - else - backtrackFull - (pos - 1, hd, absIdx - 1, tl, acc, searchPos - 1, searchString, prevTl) - - and loopSearch (pos, hd, absIdx, tl, acc, searchPos, searchString, prevTl) = - if pos = String.size hd then - case tl of - newHd :: newTl => - loopSearch - ( 0 - , newHd - , absIdx - , newTl - , acc - , searchPos - , searchString - , hd :: prevTl - ) - | [] => acc - else - let - val bufferChr = String.sub (hd, pos) - val searchChr = String.sub (searchString, searchPos) - in - if bufferChr = searchChr then - if searchPos + 1 = String.size searchString then - (* we fully matched the search string *) - let - val foundIdx = absIdx - String.size searchString + 1 - val acc = PersistentVector.append (foundIdx, absIdx, acc) - in - loopSearch - (pos + 1, hd, absIdx + 1, tl, acc, 0, searchString, prevTl) - end - else - loopSearch - ( pos + 1 - , hd - , absIdx + 1 - , tl - , acc - , searchPos + 1 - , searchString - , prevTl - ) - else - (if searchPos = 0 then - loopSearch - (pos + 1, hd, absIdx + 1, tl, acc, 0, searchString, prevTl) - else - backtrackFull - (pos, hd, absIdx, tl, acc, searchPos, searchString, prevTl)) - end - - fun search ({rightStrings, leftStrings, ...}: LineGap.t, searchString) = - case rightStrings of - hd :: tl => - loopSearch (0, hd, 0, tl, PersistentVector.empty, 0, searchString, []) - | [] => PersistentVector.empty - - (* Prerequisite: move buffer/LineGap to start *) - fun build (buffer, searchString) = - if String.size searchString > 0 then search (buffer, searchString) - else PersistentVector.empty - - fun backtrackRange - (pos, hd, absIdx, tl, acc, searchPos, searchString, finish, prevTl) = - if pos < 0 then - case prevTl of - prevHd :: prevTl => - let - val tl = hd :: tl - in - backtrackRange - ( String.size prevHd - 1 - , prevHd - , absIdx - , tl - , acc - , searchPos - , searchString - , finish - , prevTl - ) - end - | [] => - (* Should never be called *) - raise Fail "SearchList.backtrackRange error: line 120\n" - else if searchPos <= 1 then - loopRange (pos, hd, absIdx, tl, acc, 0, searchString, finish, prevTl) - else - backtrackRange - ( pos - 1 - , hd - , absIdx - 1 - , tl - , acc - , searchPos - 1 - , searchString - , finish - , prevTl - ) - - and loopRange - (pos, hd, absIdx, tl, acc, searchPos, searchString, finish, prevTl) = - if pos = String.size hd then - case tl of - newHd :: newTl => - let - val prevTl = hd :: prevTl - in - loopRange - ( 0 - , newHd - , absIdx - , newTl - , acc - , searchPos - , searchString - , finish - , prevTl - ) - end - | [] => acc - else if absIdx = finish then - acc - else - let - val bufferChr = String.sub (hd, pos) - val searchChr = String.sub (searchString, searchPos) - in - if bufferChr = searchChr then - if searchPos + 1 = String.size searchString then - (* full match *) - let - val foundIdx = absIdx - String.size searchString + 1 - val acc = PersistentVector.append (foundIdx, absIdx, acc) - in - loopRange - ( pos + 1 - , hd - , absIdx + 1 - , tl - , acc - , 0 - , searchString - , finish - , prevTl - ) - end - else - loopRange - ( pos + 1 - , hd - , absIdx + 1 - , tl - , acc - , searchPos + 1 - , searchString - , finish - , prevTl - ) - else - ((if searchPos = 0 then - loopRange - ( pos + 1 - , hd - , absIdx + 1 - , tl - , acc - , 0 - , searchString - , finish - , prevTl - ) - else - backtrackRange - ( pos - , hd - , absIdx - , tl - , acc - , searchPos - , searchString - , finish - , prevTl - ))) - end - - fun searchRange (buffer: LineGap.t, searchString, finish) = - let - val {rightStrings, idx = absIdx, ...} = buffer - in - case rightStrings of - hd :: tl => - loopRange - ( 0 - , hd - , absIdx - , tl - , PersistentVector.empty - , 0 - , searchString - , finish - , [] - ) - | [] => PersistentVector.empty - end - - fun buildRange (buffer, searchString, finishIdx) = - if String.size searchString > 0 then - case Nfa.parse searchString of - SOME nfa => - Nfa.getMatchesInRange - (#idx buffer, finishIdx, buffer : LineGap.t, nfa) - | NONE => (buffer, PersistentVector.empty) - else - (buffer, PersistentVector.empty) - - fun nextMatch (cursorIdx, searchList, count) = raise Fail "todo: reimplement" - - fun prevMatch (cursorIdx, searchList, count) = raise Fail "todo: reimplement" -end diff --git a/fcore/search-list/dfa-gen.sml b/fcore/search-list/dfa-gen.sml index 4f65d6c..1c96a32 100644 --- a/fcore/search-list/dfa-gen.sml +++ b/fcore/search-list/dfa-gen.sml @@ -501,7 +501,7 @@ struct end fun fromString str = - case ParseDfa.parse (str, 0) of + case ParseDfa.parse (str ^ "\^@", 0) of SOME (ast, _) => ToDfa.convert ast | NONE => Vector.fromList [] @@ -513,7 +513,11 @@ struct end fun isFinal (dfa: dfa, curState) = + curState <> ~1 + andalso let val curTable = Vector.sub (dfa, curState) in Vector.sub (curTable, 0) <> ~1 end + + fun isDead curState = curState = ~1 end diff --git a/fcore/search-list/search-list.sml b/fcore/search-list/search-list.sml new file mode 100644 index 0000000..e723417 --- /dev/null +++ b/fcore/search-list/search-list.sml @@ -0,0 +1,190 @@ +structure SearchList = +struct + val empty = PersistentVector.empty + + fun backtrackFull (pos, hd, absIdx, tl, acc, searchPos, searchString, prevTl) = + if pos < 0 then + case prevTl of + prevHd :: prevTl => + let + val tl = hd :: tl + in + backtrackFull + ( String.size prevHd - 1 + , prevHd + , absIdx + , tl + , acc + , searchPos + , searchString + , prevTl + ) + end + | [] => + (* Should never be called *) + raise Fail "SearchList.backtrackFull error: line 24\n" + else if searchPos <= 1 then + (* we are trying to backtrack to index 1, + * and then continue are search from here *) + loopSearch (pos, hd, absIdx, tl, acc, 0, searchString, prevTl) + else + backtrackFull + (pos - 1, hd, absIdx - 1, tl, acc, searchPos - 1, searchString, prevTl) + + and loopSearch (pos, hd, absIdx, tl, acc, searchPos, searchString, prevTl) = + if pos = String.size hd then + case tl of + newHd :: newTl => + loopSearch + ( 0 + , newHd + , absIdx + , newTl + , acc + , searchPos + , searchString + , hd :: prevTl + ) + | [] => acc + else + let + val bufferChr = String.sub (hd, pos) + val searchChr = String.sub (searchString, searchPos) + in + if bufferChr = searchChr then + if searchPos + 1 = String.size searchString then + (* we fully matched the search string *) + let + val foundIdx = absIdx - String.size searchString + 1 + val acc = PersistentVector.append (foundIdx, absIdx, acc) + in + loopSearch + (pos + 1, hd, absIdx + 1, tl, acc, 0, searchString, prevTl) + end + else + loopSearch + ( pos + 1 + , hd + , absIdx + 1 + , tl + , acc + , searchPos + 1 + , searchString + , prevTl + ) + else + (if searchPos = 0 then + loopSearch + (pos + 1, hd, absIdx + 1, tl, acc, 0, searchString, prevTl) + else + backtrackFull + (pos, hd, absIdx, tl, acc, searchPos, searchString, prevTl)) + end + + fun search ({rightStrings, leftStrings, ...}: LineGap.t, searchString) = + case rightStrings of + hd :: tl => + loopSearch (0, hd, 0, tl, PersistentVector.empty, 0, searchString, []) + | [] => PersistentVector.empty + + (* Prerequisite: move buffer/LineGap to start *) + fun build (buffer, searchString) = + if String.size searchString > 0 then search (buffer, searchString) + else PersistentVector.empty + + fun rangeLoop + ( dfa + , bufferPos + , buffer + , finishIdx + , searchList + , curState + , startPos + , prevFinalPos + ) = + if bufferPos = #textLength buffer orelse bufferPos > finishIdx then + let + val searchList = + if prevFinalPos = ~1 then searchList + else PersistentVector.append (startPos, prevFinalPos, searchList) + in + (buffer, searchList) + end + else + let + val buffer = LineGap.goToIdx (bufferPos, buffer) + val chr = LineGap.sub (bufferPos, buffer) + val newState = DfaGen.nextState (dfa, curState, chr) + val prevFinalPos = + if DfaGen.isFinal (dfa, newState) then bufferPos else prevFinalPos + in + if DfaGen.isDead newState then + if prevFinalPos = ~1 then + (* no match found: restart search from `startPos + 1` *) + rangeLoop + ( dfa + , startPos + 1 + , buffer + , finishIdx + , searchList + , 0 + , startPos + 1 + , ~1 + ) + else + (* match found: append and continue *) + let + val searchList = + PersistentVector.append (startPos, prevFinalPos, searchList) + in + rangeLoop + ( dfa + , bufferPos + 1 + , buffer + , finishIdx + , searchList + , 0 + , bufferPos + 1 + , ~1 + ) + end + else + (* continue searching for match *) + rangeLoop + ( dfa + , bufferPos + 1 + , buffer + , finishIdx + , searchList + , newState + , startPos + , prevFinalPos + ) + end + + fun buildRange (buffer, searchString, finishIdx) = + if String.size searchString > 0 then + let + val dfa = DfaGen.fromString searchString + in + if Vector.length dfa = 0 then + (buffer, PersistentVector.empty) + else + rangeLoop + ( dfa + , #idx buffer + , buffer + , finishIdx + , PersistentVector.empty + , 0 + , #idx buffer + , ~1 + ) + end + else + (buffer, PersistentVector.empty) + + fun nextMatch (cursorIdx, searchList, count) = raise Fail "todo: reimplement" + + fun prevMatch (cursorIdx, searchList, count) = raise Fail "todo: reimplement" +end diff --git a/shf.mlb b/shf.mlb index 79630e8..af7e1e9 100644 --- a/shf.mlb +++ b/shf.mlb @@ -15,7 +15,7 @@ in fcore/persistent-vector.sml end fcore/search-list/dfa-gen.sml -fcore/search-list.sml +fcore/search-list/search-list.sml message-types/input-msg.sml message-types/draw-msg.sml