diff --git a/fcore/search-list.sml b/fcore/search-list.sml index afe26c2..254a838 100644 --- a/fcore/search-list.sml +++ b/fcore/search-list.sml @@ -15,23 +15,59 @@ struct fun joinEndOfLeft (new, left) = case left of hd :: tail => - if isLessThanTarget (new, hd) then (hd ^ new) :: tail else new :: left + if isLessThanTarget (new, hd) then + let val newHd = Vector.concat [hd, new] + in newHd :: tail + end + else + new :: left | [] => new :: left fun joinStartOfRight (new, right) = case right of hd :: tail => - if isLessThanTarget (new, hd) then (new ^ hd) :: tail else new :: right + if isLessThanTarget (new, hd) then + let val newHd = Vector.concat [new, hd] + in newHd :: tail + end + else + new :: right | [] => new :: right - fun preferInsertLeft (new, left, right) = - case left of - hd :: tail => - if isLessThanTarget (hd, new) then - {left = (hd ^ new) :: tail, right = right} - else - {left = left, right = joinStartOfRight (new, right)} - | [] => {left = left, right = joinStartOfRight (new, right)} + fun insMiddle (new, hd, tl, left, right) = + let + val middle = BinSearch.equalOrMore (new, hd) + val leftSlice = VectorSlice.slice (hd, 0, SOME middle) + val rightLength = Vector.length hd - middle + val rightSlice = VectorSlice.slice (hd, middle, SOME rightLength) + + val new = Vector.fromList [new] + val new = VectorSlice.full new + in + if Vector.length hd < targetLength then + let val newHd = VectorSlice.concat [leftSlice, new, rightSlice] + in {left = joinEndOfLeft (newHd, tl), right = right} + end + else if middle < targetLength then + (* leftSlice is less than targetLength *) + let + val hd1 = VectorSlice.concat [leftSlice, new] + val hd2 = VectorSlice.vector rightSlice + in + { left = joinEndOfLeft (hd1, tl) + , right = joinStartOfRight (hd2, right) + } + end + else + let + val hd1 = VectorSlice.vector leftSlice + val hd2 = VectorSlice.concat [new, rightSlice] + in + { left = joinEndOfLeft (hd1, tl) + , right = joinStartOfRight (hd2, right) + } + end + end fun insLeft (new, left, right) = case left of @@ -39,67 +75,58 @@ struct let val first = Vector.sub (hd, 0) in - if first > new then + if new < first then insLeft (new, tl, joinStartOfRight (hd, right)) - else if first < new then + else if new > first then let val last = Vector.sub (hd, Vector.length hd - 1) in - if last > new then + if new < last then (* have to insert in middle *) - let - val middle = BinSearch.equalOrMore (new, hd) - val leftSlice = VectorSlice.slice (hd, 0, SOME middle) - val rightLength = Vector.length hd - middle - val rightSlice = - VectorSlice.slice (hd, middle, SOME rightLength) - - val new = Vector.fromList [new] - val new = VectorSlice.full new - in - if Vector.length hd < targetLength then - let - val newHd = - VectorSlice.concat [leftSlice, new, rightSlice] - in - {left = joinEndOfLeft (newHd, tl), right = right} - end - else if middle < targetLength then - (* leftSlice is less than targetLength *) - let - val hd1 = VectorSlice.concat [leftSlice, new] - val hd2 = VectorSlice.vector rightSlice - in - { left = joinEndOfLeft (hd1, tl) - , right = joinStartOfRight (hd2, right) - } - end - else - let - val hd1 = VectorSlice.vector leftSlice - val hd2 = VectorSlice.concat [new, rightSlice] - in - { left = joinEndOfLeft (hd1, tl) - , right = joinStartOfRight (hd2, right) - } - end - end - else if last < new then - (* have to insert new at end *) - if Vector.length hd < targetLength then - let val newHd = Vector.concat [hd, Vector.fromList [new]] - in {left = joinEndOfLeft (newHd, tl), right = right} - end - else - { left = left - , right = joinStartOfRight (Vector.fromList [hd], right) - } + insMiddle (new, hd, tl, left, right) + else if new > last then + (* have to insert new at end of left + * or start of right (both are equivalent) *) + { left = left + , right = joinStartOfRight (Vector.fromList [new], right) + } else - (* last = new so just return *) + (* new = last so just return *) {left = left, right = right} end else - (* first = new *) + (* new = first *) + {left = left, right = right} + end + | [] => {left = left, right = right} + + fun insRight (new, left, right) = + case right of + hd :: tl => + let + val last = Vector.sub (hd, Vector.length hd - 1) + in + if new > last then + insRight (new, joinEndOfLeft (hd, left), tl) + else if new < last then + let + val first = Vector.sub (hd, 0) + in + if new > first then + (* have to insert in middle *) + insMiddle (new, hd, tl, left, right) + else if new < first then + (* have to insert new at start of right + * or end of left (both are equivalent) *) + { left = left + , right = joinStartOfRight (Vector.fromList [new], right) + } + else + (* new = first so just return *) + {left = left, right = right} + end + else + (* new = last *) {left = left, right = right} end | [] => {left = left, right = right} diff --git a/shf b/shf index b4a34b3..751e7e1 100755 Binary files a/shf and b/shf differ diff --git a/shf.mlb b/shf.mlb index 358b329..824ac61 100644 --- a/shf.mlb +++ b/shf.mlb @@ -5,7 +5,6 @@ lib/brolib-sml/src/line_gap.sml lib/cozette-sml/fonts/cozette-ascii.mlb (* FUNCTIONAL CORE *) -fcore/bin-search.sml message-types/input-msg.sml message-types/draw-msg.sml message-types/mailbox-type.sml @@ -13,6 +12,8 @@ message-types/mailbox-type.sml fcore/app-type.sml fcore/app-with.sml +fcore/bin-search.sml +fcore/search-list.sml fcore/text-constants.sml ann "allowVectorExps true"