Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
73 lines (58 sloc) 2 KB
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hardware.Model (
Ptr(Ptr), SKI(S,K,I,T,L), Output(Output), W(W),
binarize, unbinarize, binarizePtr
) where
import CLaSH.Prelude
import Text.Printf (printf)
-- Machine word
data W = W (BitVector 64)
instance Show W where
show (W v) = printf "[W 0x%02x 0x%08x 0x%08x]" tag a b
where
tag = toInteger $ slice d63 d60 v
a = toInteger $ slice d59 d30 v
b = toInteger $ slice d29 d0 v
-- 30-bit pointers to 64-bit words
-- Why? We want to fit two pointers plus 3 tag bits in a word.
-- This way, a whole SKI fits in a word.
newtype Ptr = Ptr (Unsigned 30) deriving (Show, Enum, Num)
-- SKI combinators.
-- We also have T (which represents the conjuction of two SKIs).
-- For example, the program (KSI) is represented as T (T K S) I.
-- We also have "L" combinators, which are like I except they produce output.
-- If a program terminates, it should terminate on an L.
data SKI = S | K | I | T Ptr Ptr | L Output deriving (Show)
-- 32-bit output values
data Output = Output (Unsigned 32) deriving (Show)
binarize :: SKI -> BitVector 64
binarize ski = case ski of
S -> tag 0 ++# 0
K -> tag 1 ++# 0
I -> tag 2 ++# 0
T a b -> tag 3 ++# binarizePtr a ++# binarizePtr b
L o -> tag 4 ++# 0 ++# binarizeOutput o
where
-- Just makes it clear that the tag should be 4 bits long.
tag :: BitVector 4 -> BitVector 4
tag x = x
binarizePtr :: Ptr -> BitVector 30
binarizePtr (Ptr ptr) = pack ptr
binarizeOutput :: Output -> BitVector 32
binarizeOutput (Output o) = pack o
unbinarize :: BitVector 64 -> SKI
unbinarize w = case tag of
0 -> S
1 -> K
2 -> I
3 -> T a b
4 -> L o
where
tag = slice d63 d60 w
a = unbinarizePtr $ slice d59 d30 w
b = unbinarizePtr $ slice d29 d0 w
o = unbinarizeOutput $ slice d31 d0 w
unbinarizePtr :: BitVector 30 -> Ptr
unbinarizePtr w = Ptr (unpack w)
unbinarizeOutput :: BitVector 32 -> Output
unbinarizeOutput w = Output (unpack w)