quox/lib/Quox/NatExtra.idr

95 lines
2.3 KiB
Idris
Raw Normal View History

2022-04-11 17:33:32 -04:00
module Quox.NatExtra
import public Data.Nat
2022-05-10 16:40:44 -04:00
import Data.Nat.Division
import Data.SnocList
import Data.Vect
2023-11-05 09:38:13 -05:00
import Data.String
2022-04-11 17:33:32 -04:00
2022-05-02 16:38:37 -04:00
%default total
2022-04-11 17:33:32 -04:00
public export
data LTE' : Nat -> Nat -> Type where
LTERefl : LTE' n n
LTESuccR : LTE' m n -> LTE' m (S n)
%builtin Natural LTE'
2022-04-12 10:48:23 -04:00
public export %hint
2022-04-11 17:33:32 -04:00
lteZero' : {n : Nat} -> LTE' 0 n
lteZero' {n = 0} = LTERefl
lteZero' {n = S n} = LTESuccR lteZero'
2022-04-12 10:48:23 -04:00
public export %hint
2022-04-11 17:33:32 -04:00
lteSucc' : LTE' m n -> LTE' (S m) (S n)
lteSucc' LTERefl = LTERefl
lteSucc' (LTESuccR p) = LTESuccR $ lteSucc' p
public export
2022-04-23 18:21:30 -04:00
fromLte : {n : Nat} -> LTE m n -> LTE' m n
fromLte LTEZero = lteZero'
fromLte (LTESucc p) = lteSucc' $ fromLte p
2022-04-11 17:33:32 -04:00
public export
toLte : {n : Nat} -> m `LTE'` n -> m `LTE` n
toLte LTERefl = reflexive
toLte (LTESuccR p) = lteSuccRight (toLte p)
2022-05-10 16:40:44 -04:00
private
0 baseNZ : n `GTE` 2 => NonZero n
baseNZ @{LTESucc _} = SIsNonZero
parameters {base : Nat} {auto 0 _ : base `GTE` 2} (chars : Vect base Char)
private
showAtBase' : List Char -> Nat -> List Char
showAtBase' acc 0 = acc
showAtBase' acc k =
let dig = natToFinLT (modNatNZ k base baseNZ) @{boundModNatNZ {}} in
showAtBase' (index dig chars :: acc)
(assert_smaller k $ divNatNZ k base baseNZ)
export
showAtBase : Nat -> String
showAtBase = pack . showAtBase' []
2023-11-05 09:38:13 -05:00
namespace Nat
export
showHex : Nat -> String
showHex = showAtBase $ fromList $ unpack "0123456789abcdef"
namespace Int
export
showHex : Int -> String
showHex x =
if x < 0 then "-" ++ Nat.showHex (cast (-x)) else Nat.showHex (cast x)
namespace Int
export
fromHexit : Char -> Maybe Int
fromHexit c =
if c >= '0' && c <= '9' then Just $ ord c - ord '0'
else if c >= 'a' && c <= 'f' then Just $ ord c - ord 'a' + 10
else if c >= 'A' && c <= 'F' then Just $ ord c - ord 'A' + 10
else Nothing
private
fromHex' : Int -> String -> Maybe Int
fromHex' acc str = case strM str of
StrNil => Just acc
StrCons c cs => fromHex' (16 * acc + !(fromHexit c)) (assert_smaller str cs)
export %inline
fromHex : String -> Maybe Int
2023-11-30 08:47:27 -05:00
fromHex str = do guard $ str /= ""; fromHex' 0 str
2023-11-05 09:38:13 -05:00
namespace Nat
export
fromHexit : Char -> Maybe Nat
fromHexit = map cast . Int.fromHexit
export %inline
fromHex : String -> Maybe Nat
fromHex = map cast . Int.fromHex