Clean up some assert_total instances (#1644)

This commit is contained in:
Nick Drozd 2021-06-29 16:05:40 -05:00 committed by GitHub
parent 39d596f3b9
commit 9cb20f3653
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 16 additions and 14 deletions

View File

@ -53,7 +53,7 @@ newArrayCopy newsize arr
then pure () then pure ()
else do el <- primIO $ prim__arrayGet old pos else do el <- primIO $ prim__arrayGet old pos
primIO $ prim__arraySet new pos el primIO $ prim__arraySet new pos el
assert_total (copyFrom old new (pos - 1)) copyFrom old new $ assert_smaller pos (pos - 1)
export export
toList : HasIO io => IOArray elem -> io (List (Maybe elem)) toList : HasIO io => IOArray elem -> io (List (Maybe elem))
@ -75,8 +75,7 @@ fromList ns
where where
addToArray : Int -> List (Maybe elem) -> IOArray elem -> io () addToArray : Int -> List (Maybe elem) -> IOArray elem -> io ()
addToArray loc [] arr = pure () addToArray loc [] arr = pure ()
addToArray loc (Nothing :: ns) arr addToArray loc (Nothing :: ns) arr = addToArray (loc + 1) ns arr
= assert_total (addToArray (loc + 1) ns arr)
addToArray loc (Just el :: ns) arr addToArray loc (Just el :: ns) arr
= do primIO $ prim__arraySet (content arr) loc (Just el) = do primIO $ prim__arraySet (content arr) loc (Just el)
assert_total (addToArray (loc + 1) ns arr) addToArray (loc + 1) ns arr

View File

@ -588,7 +588,7 @@ unpack str = unpack' (prim__cast_IntegerInt (natToInteger (length str)) - 1) str
unpack' pos str acc unpack' pos str acc
= if pos < 0 = if pos < 0
then acc then acc
else assert_total $ unpack' (pos - 1) str (assert_total (prim__strIndex str pos)::acc) else unpack' (assert_smaller pos (pos - 1)) str $ (assert_total $ prim__strIndex str pos) :: acc
-- This function runs fast when compiled but won't compute at compile time. -- This function runs fast when compiled but won't compute at compile time.
-- If you need to unpack strings at compile time, use Prelude.unpack. -- If you need to unpack strings at compile time, use Prelude.unpack.

View File

@ -236,6 +236,7 @@ export
Weaken CaseTree where Weaken CaseTree where
weakenNs ns t = insertCaseNames zero ns t weakenNs ns t = insertCaseNames zero ns t
total
getNames : (forall vs . NameMap Bool -> Term vs -> NameMap Bool) -> getNames : (forall vs . NameMap Bool -> Term vs -> NameMap Bool) ->
NameMap Bool -> CaseTree vars -> NameMap Bool NameMap Bool -> CaseTree vars -> NameMap Bool
getNames add ns sc = getSet ns sc getNames add ns sc = getSet ns sc
@ -249,8 +250,7 @@ getNames add ns sc = getSet ns sc
getAltSets : NameMap Bool -> List (CaseAlt vs) -> NameMap Bool getAltSets : NameMap Bool -> List (CaseAlt vs) -> NameMap Bool
getAltSets ns [] = ns getAltSets ns [] = ns
getAltSets ns (a :: as) getAltSets ns (a :: as) = getAltSets (getAltSet ns a) as
= assert_total $ getAltSets (getAltSet ns a) as
getSet : NameMap Bool -> CaseTree vs -> NameMap Bool getSet : NameMap Bool -> CaseTree vs -> NameMap Bool
getSet ns (Case _ x ty xs) = getAltSets ns xs getSet ns (Case _ x ty xs) = getAltSets ns xs

View File

@ -850,11 +850,12 @@ Eq a => Eq (Binder a) where
(==) = eqBinderBy (==) (==) = eqBinderBy (==)
export export
total
Eq (Term vars) where Eq (Term vars) where
(==) (Local _ _ idx _) (Local _ _ idx' _) = idx == idx' (==) (Local _ _ idx _) (Local _ _ idx' _) = idx == idx'
(==) (Ref _ _ n) (Ref _ _ n') = n == n' (==) (Ref _ _ n) (Ref _ _ n') = n == n'
(==) (Meta _ _ i args) (Meta _ _ i' args') (==) (Meta _ _ i args) (Meta _ _ i' args')
= assert_total (i == i' && args == args') = i == i' && assert_total (args == args')
(==) (Bind _ _ b sc) (Bind _ _ b' sc') (==) (Bind _ _ b sc) (Bind _ _ b' sc')
= assert_total (b == b' && sc == believe_me sc') = assert_total (b == b' && sc == believe_me sc')
(==) (App _ f a) (App _ f' a') = f == f' && a == a' (==) (App _ f a) (App _ f' a') = f == f' && a == a'
@ -869,11 +870,12 @@ Eq (Term vars) where
-- Check equality, ignoring variable naming -- Check equality, ignoring variable naming
export export
total
eqTerm : Term vs -> Term vs' -> Bool eqTerm : Term vs -> Term vs' -> Bool
eqTerm (Local _ _ idx _) (Local _ _ idx' _) = idx == idx' eqTerm (Local _ _ idx _) (Local _ _ idx' _) = idx == idx'
eqTerm (Ref _ _ n) (Ref _ _ n') = n == n' eqTerm (Ref _ _ n) (Ref _ _ n') = n == n'
eqTerm (Meta _ _ i args) (Meta _ _ i' args') eqTerm (Meta _ _ i args) (Meta _ _ i' args')
= assert_total (i == i' && all (uncurry eqTerm) (zip args args')) = i == i' && assert_total (all (uncurry eqTerm) (zip args args'))
eqTerm (Bind _ _ b sc) (Bind _ _ b' sc') eqTerm (Bind _ _ b sc) (Bind _ _ b' sc')
= assert_total (eqBinderBy eqTerm b b') && eqTerm sc sc' = assert_total (eqBinderBy eqTerm b b') && eqTerm sc sc'
eqTerm (App _ f a) (App _ f' a') = eqTerm f f' && eqTerm a a' eqTerm (App _ f a) (App _ f' a') = eqTerm f f' && eqTerm a a'

View File

@ -25,7 +25,7 @@ spec a b = loop (fastUnpack a) (fastUnpack b) where
||| Dynamic programming ||| Dynamic programming
export export
compute : HasIO io => String -> String -> io Nat compute : HasIO io => String -> String -> io Nat
compute a b = assert_total $ do compute a b = do
let w = strLength a let w = strLength a
let h = strLength b let h = strLength b
-- In mat[i][j], we store the distance between -- In mat[i][j], we store the distance between
@ -43,7 +43,8 @@ compute a b = assert_total $ do
-- We introduce a specialised `read` for ease of use -- We introduce a specialised `read` for ease of use
let get = \i, j => case !(read {io} mat i j) of let get = \i, j => case !(read {io} mat i j) of
Nothing => idris_crash "INTERNAL ERROR: Badly initialised matrix" Nothing => assert_total $
idris_crash "INTERNAL ERROR: Badly initialised matrix"
Just n => pure n Just n => pure n
-- We fill the matrix from the bottom up, using the same formula we used -- We fill the matrix from the bottom up, using the same formula we used
@ -53,8 +54,8 @@ compute a b = assert_total $ do
-- here we change Levenshtein slightly so that we may only substitute -- here we change Levenshtein slightly so that we may only substitute
-- alpha / numerical characters for similar ones. This avoids suggesting -- alpha / numerical characters for similar ones. This avoids suggesting
-- "#" as a replacement for an out of scope "n". -- "#" as a replacement for an out of scope "n".
let cost = let c = strIndex a (i-1) let cost = let c = assert_total $ strIndex a (i-1)
d = strIndex b (j-1) d = assert_total $ strIndex b (j-1)
in if c == d then 0 else in if c == d then 0 else
if isAlpha c && isAlpha d then 1 else if isAlpha c && isAlpha d then 1 else
if isDigit c && isDigit d then 1 else 2 if isDigit c && isDigit d then 1 else 2

View File

@ -19,7 +19,7 @@ stripQuotes = stripSurrounds 1 1
export export
lowerFirst : String -> Bool lowerFirst : String -> Bool
lowerFirst "" = False lowerFirst "" = False
lowerFirst str = assert_total (isLower (prim__strHead str)) lowerFirst str = isLower $ assert_total $ prim__strHead str
escapeGeneric : Char -> List Char -> String -> String escapeGeneric : Char -> List Char -> String -> String
escapeGeneric esc toEscape = pack . foldr escape [] . unpack escapeGeneric esc toEscape = pack . foldr escape [] . unpack