ghci-hexcalc-0.1.1.0: GHCi as a Hex Calculator interactive

Copyright(c) 2018 Takenobu Tani
LicenseBSD3
MaintainerTakenobu Tani <takenobu.hs@gmail.com>
Stabilityexperimental
Portabilitynon-portable (GHC Extensions)
Safe HaskellNone
LanguageHaskell2010

Data.GHex

Contents

Description

This module defines operations for an interactive hex-caluclator using GHCi. This is a simple and casual interactive tool like Perl and Excel for daily work.

Interactive oriented features:

  • Short-named operators and functions
  • Show values in hexadecimal format by default
  • Suppress type annotation of numeric literals by type inference
  • Postfix-notation available
  • Highlight available

Example of use:

ghci> (1 .<< 16) .| 0xf .& 3
0x0000_0000_0001_0003
ghci> 0xff .@dec
"255"

See also web page.

Synopsis

Basic data type

data Hex Source #

Basic type

>>> 255 :: Hex
0x0000_0000_0000_00ff
Instances
Bounded Hex Source # 
Instance details

Defined in Data.GHex

Methods

minBound :: Hex #

maxBound :: Hex #

Enum Hex Source # 
Instance details

Defined in Data.GHex

Methods

succ :: Hex -> Hex #

pred :: Hex -> Hex #

toEnum :: Int -> Hex #

fromEnum :: Hex -> Int #

enumFrom :: Hex -> [Hex] #

enumFromThen :: Hex -> Hex -> [Hex] #

enumFromTo :: Hex -> Hex -> [Hex] #

enumFromThenTo :: Hex -> Hex -> Hex -> [Hex] #

Eq Hex Source # 
Instance details

Defined in Data.GHex

Methods

(==) :: Hex -> Hex -> Bool #

(/=) :: Hex -> Hex -> Bool #

Integral Hex Source # 
Instance details

Defined in Data.GHex

Methods

quot :: Hex -> Hex -> Hex #

rem :: Hex -> Hex -> Hex #

div :: Hex -> Hex -> Hex #

mod :: Hex -> Hex -> Hex #

quotRem :: Hex -> Hex -> (Hex, Hex) #

divMod :: Hex -> Hex -> (Hex, Hex) #

toInteger :: Hex -> Integer #

Num Hex Source # 
Instance details

Defined in Data.GHex

Methods

(+) :: Hex -> Hex -> Hex #

(-) :: Hex -> Hex -> Hex #

(*) :: Hex -> Hex -> Hex #

negate :: Hex -> Hex #

abs :: Hex -> Hex #

signum :: Hex -> Hex #

fromInteger :: Integer -> Hex #

Ord Hex Source # 
Instance details

Defined in Data.GHex

Methods

compare :: Hex -> Hex -> Ordering #

(<) :: Hex -> Hex -> Bool #

(<=) :: Hex -> Hex -> Bool #

(>) :: Hex -> Hex -> Bool #

(>=) :: Hex -> Hex -> Bool #

max :: Hex -> Hex -> Hex #

min :: Hex -> Hex -> Hex #

Read Hex Source # 
Instance details

Defined in Data.GHex

Real Hex Source # 
Instance details

Defined in Data.GHex

Methods

toRational :: Hex -> Rational #

Show Hex Source # 
Instance details

Defined in Data.GHex

Methods

showsPrec :: Int -> Hex -> ShowS #

show :: Hex -> String #

showList :: [Hex] -> ShowS #

Bits Hex Source # 
Instance details

Defined in Data.GHex

Methods

(.&.) :: Hex -> Hex -> Hex #

(.|.) :: Hex -> Hex -> Hex #

xor :: Hex -> Hex -> Hex #

complement :: Hex -> Hex #

shift :: Hex -> Int -> Hex #

rotate :: Hex -> Int -> Hex #

zeroBits :: Hex #

bit :: Int -> Hex #

setBit :: Hex -> Int -> Hex #

clearBit :: Hex -> Int -> Hex #

complementBit :: Hex -> Int -> Hex #

testBit :: Hex -> Int -> Bool #

bitSizeMaybe :: Hex -> Maybe Int #

bitSize :: Hex -> Int #

isSigned :: Hex -> Bool #

shiftL :: Hex -> Int -> Hex #

unsafeShiftL :: Hex -> Int -> Hex #

shiftR :: Hex -> Int -> Hex #

unsafeShiftR :: Hex -> Int -> Hex #

rotateL :: Hex -> Int -> Hex #

rotateR :: Hex -> Int -> Hex #

popCount :: Hex -> Int #

FiniteBits Hex Source # 
Instance details

Defined in Data.GHex

Logical operations

(.&) :: Hex -> Hex -> Hex infixl 7 Source #

Bitwise "and"

>>> 0x1234 .& 0xff
0x0000_0000_0000_0034

(.|) :: Hex -> Hex -> Hex infixl 5 Source #

Bitwise "or"

>>> 0xf000 .| 0xa
0x0000_0000_0000_f00a

(.^) :: Hex -> Hex -> Hex infixl 6 Source #

Bitwise "xor"

>>> 0xf .^ 0xa
0x0000_0000_0000_0005

inv :: Hex -> Hex Source #

Bitwise "not"

>>> inv 1
0xffff_ffff_ffff_fffe

Arithmetic operations

(./) :: Hex -> Hex -> Hex infixl 7 Source #

Integer div

>>> 0x1000 ./ 16
0x0000_0000_0000_0100

(.%) :: Hex -> Hex -> Hex infixl 7 Source #

Integer mod

>>> 18 .% 16
0x0000_0000_0000_0002

neg :: Hex -> Hex Source #

Negate

>>> neg 1
0xffff_ffff_ffff_ffff

signext :: Hex -> Int -> Hex Source #

Sign extention

>>> signext 0x80 7
0xffff_ffff_ffff_ff80
>>> signext 0x7fff 15
0x0000_0000_0000_7fff

Shift operations

(.<<) :: Hex -> Int -> Hex infixl 8 Source #

Logical left shift

>>> 1 .<< 16
0x0000_0000_0001_0000

(.>>) :: Hex -> Int -> Hex infixl 8 Source #

Logical right shift

>>> 0x0f00 .>> 4
0x0000_0000_0000_00f0

Generate bits and bytes with position

bit1 :: Int -> Hex Source #

Set a bit

>>> bit1 15
0x0000_0000_0000_8000

bits :: Int -> Int -> Hex Source #

Set bits from n1 to n2

>>> bits 15 8
0x0000_0000_0000_ff00

bitList :: [Int] -> Hex Source #

Set bits with List

>>> bitList [15, 8, 1]
0x0000_0000_0000_8102

byte1 :: Int -> Hex Source #

Set a byte

>>> byte1 2
0x0000_0000_00ff_0000

bytes :: Int -> Int -> Hex Source #

Set bytes from n1 to n2

>>> bytes  3 2
0x0000_0000_ffff_0000

mask :: Int -> Hex Source #

Mask bits from 0 to n

>>> mask 7
0x0000_0000_0000_00ff

Extract and replace bits

gets :: Hex -> Int -> Int -> Hex Source #

Extract bits from n1 to n2

>>> gets 0xabcd 15 12
0x0000_0000_0000_000a

puts :: Hex -> Int -> Int -> Hex -> Hex Source #

Replace bits from n1 to n2

>>> puts 0xabcd 15 12 0b111
0x0000_0000_0000_7bcd

getBit1 :: Hex -> Int -> Hex Source #

Extract a bit

>>> getBit1 (bit1 6) 6
0x0000_0000_0000_0001

getByte1 :: Hex -> Int -> Hex Source #

Extract a byte

>>> getByte1 0x12345678 2
0x0000_0000_0000_0034

getBits :: Hex -> Int -> Int -> Hex Source #

Synonym to gets

getBytes :: Hex -> Int -> Int -> Hex Source #

Extract bytes from n1 to n2

>>> getBytes 0x12345678 2 1
0x0000_0000_0000_3456

putBit1 :: Hex -> Int -> Hex -> Hex Source #

Replace a bit

>>> putBit1 0 7 1
0x0000_0000_0000_0080

putBits :: Hex -> Int -> Int -> Hex -> Hex Source #

Synonym to puts

putBytes :: Hex -> Int -> Int -> Hex -> Hex Source #

Replace bytes from n1 to n2

>>> putBytes 0x12345678 3 2 0xfedc
0x0000_0000_fedc_5678

Set and clear bits

sbits :: Hex -> Int -> Int -> Hex Source #

Set bits from n1 to n2 of x1

>>> sbits 0x1234 11 8
0x0000_0000_0000_1f34

cbits :: Hex -> Int -> Int -> Hex Source #

Clear bits from n1 to n2 of x1

>>> cbits 0x1234 7 4
0x0000_0000_0000_1204

Get asserted bit positions and count bits

pos1 :: Hex -> [Int] Source #

Get bit positions asserted with 1

>>> pos1 0x0080
[7]

pos0 :: Hex -> [Int] Source #

Get bit positions asserted with 0

>>> pos0 $ inv 0x0100
[8]

range1 :: Hex -> (Int, Int) Source #

Get upper and lower boundaries of asserted bits

>>> range1 0x0f000000
(27,24)

count1 :: Hex -> Int Source #

Count bit-1

>>> count1 0b11001
3

count0 :: Hex -> Int Source #

Count bit-0

>>> count0 0xf
60

Permute

bitrev :: Hex -> Hex Source #

Reverse bits

>>> bitrev 0x00a1
0x8500_0000_0000_0000

byterev :: Hex -> Hex Source #

Reverse bytes

>>> byterev 0x12341111cdef
0xefcd_1111_3412_0000

gather :: Hex -> Hex -> Hex Source #

Gather bits

>>> gather 0x12345678 0x0ff000f0
0x0000_0000_0000_0237

scatter :: Hex -> Hex -> Hex -> Hex Source #

Scatter bits

>>> scatter 0x12345678 0xff00ff00 0xabcd
0x0000_0000_ab34_cd78

Split and merge

splitBits :: Hex -> [Int] Source #

Split bits to List

>>> splitBits 0xa
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0]

splitBytes :: Hex -> [Int] Source #

Split bytes to List

>>> splitBytes 0xff10
[0,0,0,0,0,0,255,16]

mergeBits :: [Int] -> Hex Source #

Merge bits from List

>>> mergeBits [1,0,1,0,0,0,0,0]
0x0000_0000_0000_00a0

mergeBytes :: [Int] -> Hex Source #

Merge bytes from List

>>> mergeBytes [0xff, 0x1, 0xa]
0x0000_0000_00ff_010a

splitSized :: [Int] -> Hex -> [(Int, Hex)] Source #

Split bits to pair of (length,Hex)

>>> splitSized [2,4,4] 0xabcd
[(2,0x0000_0000_0000_0003),(4,0x0000_0000_0000_000c),(4,0x0000_0000_0000_000d)]

mergeSized :: [(Int, Hex)] -> Hex Source #

Merge bits from pair of (length,Hex)

>>> mergeSized [(2,0x3),(4,0xc),(4,0xd)]
0x0000_0000_0000_03cd

(.++) :: (Int, Hex) -> (Int, Hex) -> (Int, Hex) infixl 5 Source #

Concatinate pairs of (length,Hex)

>>> (3,0b101) .++ (2,0b11)
(5,0x0000_0000_0000_0017)
>>> (4,0xa) .++ (4,0xb) .++ (8,0xcd)
(16,0x0000_0000_0000_abcd)
>>> (4,0xe) .++ (4,0xf) .@snd
0x0000_0000_0000_00ef

Predefined-constants

Unit constants

Ei, Pi, Ti, Gi, Mi and Ki. It's not E(10^18), ... K(10^3).

>>> exa == 2^60
True
>>> peta == 2^50
True
>>> tera == 2^40
True
>>> giga == 2^30
True
>>> mega == 2^20
True
>>> kilo == 2^10
True

exa :: Hex Source #

Ei: 2^60

peta :: Hex Source #

Pi: 2^50

tera :: Hex Source #

Ti: 2^40

giga :: Hex Source #

Gi: 2^30

mega :: Hex Source #

Mi: 2^20

kilo :: Hex Source #

Ki: 2^10

Utility constants

Several constants are also predefined.

>>> zero
0x0000_0000_0000_0000
>>> one
0x0000_0000_0000_0001
>>> all0
0x0000_0000_0000_0000
>>> all1
0xffff_ffff_ffff_ffff

These can be also used for type inference.

>>> 256*3-1 + zero
0x0000_0000_0000_02ff

one :: Hex Source #

0x1

all1 :: Hex Source #

inv 0x0

Implementation constants

Implementation information of size.

hexBitSize :: Int Source #

Bit size of Hex type. It's 64 on x86_64.

hexBitSeq :: [Int] Source #

Number sequence. [hexBitSeq-1, hexBitSeq-2, .. 0]

hexByteSize :: Int Source #

Byte size of Hex type. It's 8 of x86_64.

hexByteSeq :: [Int] Source #

Number sequence. [hexByteSeq-1, hexByteSeq-2, .. 0]

Postfix notation

(.@) :: a -> (a -> b) -> b infixl 0 Source #

Operator for postfix notation (same as Data.Function.(&))

>>> 255 .@hex
"0x0000_0000_0000_00ff"
>>> 0xf1 .@bin
"0b1111_0001"
>>> 2^12 .@dec
"4096"
>>> 4 * giga .@pos1
[32]
0x0 .@color (bits 31 24)
0b0000_0000_0000_0000_0000_0000_0000_0000_1111_1111_0000_0000_0000_0000_0000_0000
                                          ^^^^ ^^^^

Formatting for hex, bin, dec, floating and etc.

Formatting utilities.

>>> 255 .@hex
"0x0000_0000_0000_00ff"
>>> 255 .@bin
"0b1111_1111"
>>> 0xff .@dec
"255"
>>> 0x3fc00000 .@float
"1.5"
>>> 2^32 .@decG
"4"
>>> map (hexN 12) [0..3]
["0x000","0x001","0x002","0x003"]
>>> 0xffffffffffffffff .@signed
"-1"
>>> strip "0b" "0b1101"
"1101"
>>> strip "_" "0x1234_5678_9abc_def0"
"0x123456789abcdef0"

Hexadecimal formatting

hex :: Hex -> String Source #

Hexadecimal formatting with maximum-bit length

hexN :: Int -> Hex -> String Source #

Hexadecimal formatting with N-bit length

hex8 :: Hex -> String Source #

Hexadecimal formatting with 8-bit length

hex16 :: Hex -> String Source #

Hexadecimal formatting with 16-bit length

hex32 :: Hex -> String Source #

Hexadecimal formatting with 32-bit length

hex64 :: Hex -> String Source #

Hexadecimal formatting with 64-bit length

Binary formatting

bin :: Hex -> String Source #

Binary formatting with auto-adjusted length

binN :: Int -> Hex -> String Source #

Binary formatting with N-bit length

bin8 :: Hex -> String Source #

Binary formatting with 8-bit length

bin16 :: Hex -> String Source #

Binary formatting with 16-bit length

bin32 :: Hex -> String Source #

Binary formatting with 32-bit length

bin64 :: Hex -> String Source #

Binary formatting with 64-bit length

Decimal formatting

dec :: Hex -> String Source #

Decimal formatting

decE :: Hex -> String Source #

Decimal formatting with exa unit

decP :: Hex -> String Source #

Decimal formatting with pata unit

decT :: Hex -> String Source #

Decimal formatting with tera unit

decG :: Hex -> String Source #

Decimal formatting with giga unit

decM :: Hex -> String Source #

Decimal formatting with mega unit

decK :: Hex -> String Source #

Decimal formatting with kilo unit

signed :: Hex -> String Source #

Signed decimal formatting

Floating formatting

float :: Hex -> String Source #

Float formatting

double :: Hex -> String Source #

Double formatting

Miscellaneous formatting

strip :: String -> String -> String Source #

Strip strings

Sized data formatting for (length,Hex)

hexSized :: (Int, Hex) -> String Source #

Hexadecimal formatting for pair of (length,Hex)

>>> (8,254) .@hexSized
"0xfe"

binSized :: (Int, Hex) -> String Source #

Binary formatting for pair of (length,Hex)

>>> (8,0x71) .@binSized
"0b0111_0001"

Hilighting and pretty-print

color :: Hex -> Hex -> IO () Source #

Highlight the specified bit

ghci> 0xff .@color (bits 7 4)
0b0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_1111_1111
                                                                        ^^^^
ghci> 0xffffffff .@color mega
0b0000_0000_0000_0000_0000_0000_0000_0000_1111_1111_1111_1111_1111_1111_1111_1111
                                                       ^
ghci> 0 .@color (bitList [54,53,4,3,2])
0b0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000
             ^^                                                            ^ ^^

ppr :: (Hex -> String) -> Hex -> IO () Source #

Output value by IO (not String)

>>> 0xf0 .@ppr bin
0b1111_0000

Input and convert

inputRawHexIO :: IO Hex Source #

Input hexadecimal string and convert to Hex type

It reads only hexadecimal characters, [0-9a-fA-F]. That is, other characters, such as ',',:,-, are ignored. It is useful for reading from various command output, such as od, hexdump and etc.

ghci> inputRawHexIO
ff aa  (your input)
ghci>x = it
ghci>x
0x0000_0000_0000_ffaa
ghci> inputRawHexIO
0123:abcd:ffff  (your input)
ghci>x = it
ghci>x
0x0000_0123_abcd_ffff

Floating convert

float2hex :: Float -> Hex Source #

Convert Float to Hex type

>>> float2hex 1.0
0x0000_0000_3f80_0000

hex2float :: Hex -> Float Source #

Convert Hex to Float type

>>> hex2float 0x3fc00000
1.5

double2hex :: Double -> Hex Source #

Convert Double to Hex type

>>> double2hex 1.0
0x3ff0_0000_0000_0000

hex2double :: Hex -> Double Source #

Convert Hex to Double type

>>> hex2double 0x40091eb851eb851f
3.14

Miscellaneous

cls :: IO () Source #

Clear screen with ANSI sequences

usage :: IO () Source #

Show simple usage

Properties

Properties for QuickCheck testing

(inv $ inv x) == x
(neg $ neg x) == x
(neg x) == (inv x + 1)
(x .& y) == (inv ((inv x) .| (inv y)))             -- De Morgan
(x .^ y) == (((x .& (inv y)) .| ((inv x) .& y)))   -- xor
(\(x,y) -> (y /= 0)) |=> (\(x,y) -> ((x ./ y)*y + (x .% y)) == x)       -- div and mod
(\(x,n) -> (n >= 0)) |=> (\(x,n) -> (x .<< n) == (x * (2^n)))                 -- left shift
(\(x,n) -> (n >= 0)) |=> (\(x,n) -> (x .>> n) == (bitrev ((bitrev x) .<< n))) -- right shift
(>= 0) |=> (\x -> (bit1 x) == (2^x))
(>= 0) |=> (\x -> (byte1 x) == (0xff .<< (8*x)))
(\(x1,x2) -> (x1 >= x2 && x2 >= 0)) |=> (\(x1,x2) -> (bits x1 x2) == (sum $ map (2^) [x2..x1]))
(\(x1,x2) -> (x1 >= x2 && x2 >= 0)) |=> (\(x1,x2) -> (gets all0 x1 x2) == all0)
(\(x1,x2) -> (x1 >= x2 && x2 >= 0)) |=> (\(x1,x2) -> ((gets x x1 x2) .<< x2) == (x .& bits x1 x2))
(\(x1,x2) -> (x1 >= x2 && x2 >= 0)) |=> (\(x1,x2) -> (puts x x1 x2 $ gets x x1 x2) == x)
(\(x1,x2) -> (x1 >= x2 && x2 >= 0)) |=> (\(x1,x2) -> (gather x (bits x1 x2)) == (gets x x1 x2))
(\(x1,x2) -> (x1 > x2 && x2 >= 0)) |=> (\(x1,x2) -> (gather x3 (bit1 x1 .| bit1 x2)) == (((getBit1 x3 x1) .<< 1) .| (getBit1 x3 x2)))
(\(x1,x2) -> (x1 >= x2 && x2 >= 0)) |=> (\(x1,x2) -> (scatter x1 x2 $ gather x1 x2) == x1)
(\(x1,x2) -> (x1 >= x2 && x2 >= 0)) |=> (\(x1,x2) -> (sbits all0 x1 x2) == (bits x1 x2))
(\(x1,x2) -> (x1 >= x2 && x2 >= 0)) |=> (\(x1,x2) -> (sbits all0 x1 x2) == (puts all0 x1 x2 all1))
(\(x1,x2) -> (x1 >= x2 && x2 >= 0)) |=> (\(x1,x2) -> (cbits all1 x1 x2) == (inv(bits x1 x2)))
(\(x1,x2) -> (x1 >= x2 && x2 >= 0)) |=> (\(x1,x2) -> (cbits all1 x1 x2) == (puts all1 x1 x2 all0))
(\(x1,x2) -> (x1 >= x2 && x2 >= 0)) |=> (\(x1,x2) -> (cbits x x1 x2) == (inv (sbits (inv x) x1 x2)))
(x .@pos1 .@bitList) == x
(x .@pos0 .@bitList) == (inv x)
(\(x1,x2) -> (x1 >= x2 && x2 >= 0 && x1 < hexBitSize)) |=> (\(x1,x2) -> (range1 $ bits x1 x2) == (x1,x2))
(count1 x) == (length $ pos1 x)
((count1 x) + (count0 x)) == hexBitSize
(mergeBits $ splitBits x) == x
(mergeBytes $ splitBytes x) == x
(bitrev $ bitrev x) == x
(byterev $ byterev x) == x
(\(a1,a2,x1,x2) -> (a1 >= 1 && a2 >= 1 && (a1+a2) <= hexBitSize)) |=> (\(a1,a2,x1,x2) -> ((a1,x1) .++ (a2,x2)) == ((a1+a2), (mergeBits $ (lastN a1 $ splitBits x1) ++ (lastN a2 $ splitBits x2))))
(\(a1,a2,x1,x2) -> (a1 >= 1 && a2 >= 1 && (a1+a2) <= hexBitSize)) |=> (\(a1,a2,x1,x2) -> ((a1,x1) .++ (a2,x2)) == ((a1+a2), (mergeSized [(a1,x1),(a2,x2)])))
(\(a1,a2,x1,x2) -> (a1 >= 1 && a2 >= 1 && (a1+a2) <= hexBitSize)) |=> (\(a1,a2,x1,x2) -> (mergeSized $ splitSized [a1,a2] x1) == (x1 .& (mask (a1+a2-1))))
(\n -> (n >= 0 && x `testBit` n)) |=> (\n -> ((signext x n) .| (sbits x (n-1) 0)) == all1)
(\n -> (n >= 0 && (not(x `testBit` n)))) |=> (\n -> ((signext x n) .& (cbits x (n-1) 0)) == all0)
(\x -> (not(x `testBit` (hexBitSize-1)))) |=> (\x -> (signed x) == (dec x))
(\x -> (x `testBit` (hexBitSize-1))) |=> (\x -> (signed x) == show(-1 * (fromIntegral $ ((inv x) + 1))::Int))
(hex2double $ double2hex x) == x
(double2hex $ hex2double x) == x
(hex2float $ float2hex x) == x
(\x -> (x <= 0xffffffff)) |=> (\x -> ((float2hex $ hex2float x) == x))