Commit 7d5f8035 authored by simonpj's avatar simonpj
Browse files

Test Trac #2045

parent b5b9d5e8
{-# LANGUAGE EmptyDataDecls #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
-- Trac #2045
-- ghc -fhpc --make Vhdl.hs -o gencirc -Wall
module ShouleCompile where
writeDefinitions :: Generic b
=> b -> IO ()
writeDefinitions out =
do let define v s =
case s of
Bool True -> port "vcc" []
Bool False -> port "gnd" []
Inv x -> port "inv" [x]
And [] -> define v (Bool True)
And [x] -> port "id" [x]
And [x,y] -> port "and2" [x,y]
And (x:xs) -> define (w 0) (And xs)
>> define v (And [x,w 0])
Or [] -> define v (Bool False)
Or [x] -> port "id" [x]
Or [x,y] -> port "or2" [x,y]
Or (x:xs) -> define (w 0) (Or xs)
>> define v (Or [x,w 0])
Xor [] -> define v (Bool False)
Xor [x] -> port "id" [x]
Xor [x,y] -> port "xor2" [x,y]
Xor (x:xs) -> define (w 0) (Or xs)
>> define (w 1) (Inv (w 0))
>> define (w 2) (And [x, w 1])
>> define (w 3) (Inv x)
>> define (w 4) (Xor xs)
>> define (w 5) (And [w 3, w 4])
>> define v (Or [w 2, w 5])
Multi a1 a2 a3 a4 -> multi a1 a2 a3 a4
where
w i = v ++ "_" ++ show i
multi n "RAMB16_S18" opts args =
do putStr $
" "
++ " : "
++ "RAMB16_S18"
++ "\ngeneric map ("
++ opts
++ mapTo "DOP" [0,1] (get 16 2 outs)
++ mapTo "ADDR" [0..9] (get 0 10 args)
where
outs = map (\i -> "o" ++ show i ++ "_" ++ v) [1..n]
get :: Int -> Int -> [a] -> [a]
get n' m xs = take m (drop n' xs)
mapTo s' (n':ns) (x:xs) = s' ++ "(" ++ show n' ++ ")"
++ " => " ++ x ++ ",\n"
++ mapTo s' ns xs
mapTo _ _ _ = ""
multi n "RAMB16_S18_S18" opts args =
do putStr $
opts
++ mapTo "DOA" [0..15] (get 0 16 outs)
++ mapTo "DOB" [0..15] (get 18 16 outs)
++ mapTo "DOPA" [0,1] (get 16 2 outs)
++ mapTo "DOPB" [0,1] (get 34 2 outs)
++ mapTo "ADDRA" [0..9] (get 0 10 args)
++ mapTo "ADDRB" [0..9] (get 10 10 args)
++ mapTo "DIA" [0..15] (get 20 16 args)
++ mapTo "DIB" [0..15] (get 38 16 args)
++ mapTo "DIPA" [0,1] (get 36 2 args)
++ mapTo "DIPB" [0,1] (get 54 2 args)
++ head (get 56 1 args)
++ head (get 57 1 args)
where
outs = map (\i -> "o" ++ show i ++ "_" ++ v) [1..n]
get :: Int -> Int -> [a] -> [a]
get _ _ = id
mapTo s' (n':ns) (x:xs) = s' ++ "(" ++ show n' ++ ")"
++ " => " ++ x ++ ",\n"
++ mapTo s' ns xs
mapTo _ _ _ = ""
multi _ _ _ _ = undefined
port n args | n == "id" =
do putStr $
" "
++ v ++ " <= " ++ (head args) ++ ";\n"
port _ _ = undefined
netlistIO define (struct out)
return ()
netlistIO :: (v -> S v -> IO ()) -> f Symbol -> IO (f v)
netlistIO = undefined
data Struct a
class Generic a where
struct :: a -> Struct Symbol
struct = undefined
instance Generic (Signal a)
data Signal a
data Symbol
data S s
= Bool Bool
| Inv s
| And [s]
| Or [s]
| Xor [s]
| Multi Int String String [s]
......@@ -267,6 +267,7 @@ test('FD4', normal, compile, [''])
test('faxen', normal, compile, [''])
test('T1495', normal, compile, [''])
test('T2045', normal, compile, ['']) # Needs -fhpc
# Omitting temporarily
test('syn-perf', normal, compile, ['-fcontext-stack=30'])
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment