include old haskell files
This commit is contained in:
parent
bc96438a06
commit
3db48e8232
|
@ -0,0 +1,72 @@
|
||||||
|
module add-assoc where
|
||||||
|
|
||||||
|
open import Data.Nat using (ℕ; zero; suc; _+_)
|
||||||
|
open import Relation.Binary.PropositionalEquality using (_≡_; refl; cong)
|
||||||
|
|
||||||
|
|
||||||
|
-- `+-assoc` is an identifier like `add-assoc`. Nothing special
|
||||||
|
+-assoc : Set
|
||||||
|
+-assoc = ∀ (a b c : ℕ) → a + (b + c) ≡ (a + b) + c -- enunciation
|
||||||
|
|
||||||
|
{- DOUBT:
|
||||||
|
Why is this not type checking?
|
||||||
|
|
||||||
|
+-assoc = ∀ (a b c : ℕ) → a + (b + c) → (a + b) + c -- enunciation
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
-- an object of this type is the proof
|
||||||
|
+-assoc-proof : ∀ (a b c : ℕ) → a + (b + c) ≡ (a + b) + c
|
||||||
|
+-assoc-proof zero b c = refl
|
||||||
|
+-assoc-proof (suc a) b c = cong suc (+-assoc-proof a b c) -- generated from doing case-split on 'a'
|
||||||
|
-- agda assigns a unique id to each hole
|
||||||
|
-- C-c C-, (comma) to get info about hole under cursor
|
||||||
|
-- For the above hole, it shows:
|
||||||
|
--
|
||||||
|
-- Goal: a + (b + c) ≡ a + b + c
|
||||||
|
-- ————————————————————————————————————————————————————————————
|
||||||
|
-- c : ℕ
|
||||||
|
-- b : ℕ
|
||||||
|
-- a : ℕ
|
||||||
|
--
|
||||||
|
-- `(a + b) + c` is shown as `a + b + c` as `+` is left associative.
|
||||||
|
-- So both are same.
|
||||||
|
|
||||||
|
{- Doing case split -}
|
||||||
|
-- With cursor on the hole, press: C-c C-c
|
||||||
|
-- It will ask name of variable to do case split on.
|
||||||
|
-- We say 'a', here.
|
||||||
|
-- Initial clause will be replaced by two new ones
|
||||||
|
--
|
||||||
|
-- > +-assoc-proof zero b c = {!!} -- a replaced by zero
|
||||||
|
-- > +-assoc-proof (suc a) b c = {!!} -- a replaced by (suc a)
|
||||||
|
--
|
||||||
|
-- doing refl (by C-c C-r) finishes first case
|
||||||
|
--
|
||||||
|
-- Doing C-c C-, on remaining goal says:
|
||||||
|
-- >
|
||||||
|
-- > Goal: suc (a + (b + c)) ≡ suc (a + b + c)
|
||||||
|
-- > ————————————————————————————————————————————————————————————
|
||||||
|
-- > c : ℕ
|
||||||
|
-- > b : ℕ
|
||||||
|
-- > a : ℕ
|
||||||
|
-- >
|
||||||
|
--
|
||||||
|
-- The cong function handles cases where goal is like
|
||||||
|
-- f(arg1) ≡ f(arg2)
|
||||||
|
-- in which case we only have to show that arg1 ≡ arg2
|
||||||
|
-- congruence of equality
|
||||||
|
--
|
||||||
|
-- we _write_ `cong suc` inside the remaining hole and do a `refl` with C-c C-r
|
||||||
|
-- to get this goal:
|
||||||
|
--
|
||||||
|
-- > ?2 : a + (b + c) ≡ a + b + c
|
||||||
|
--
|
||||||
|
-- A recursive call to `+-assoc-proof` can finish this off.
|
||||||
|
-- Write `+-assoc-proof a b c` into the last hole
|
||||||
|
-- and solve it with C-c C-space
|
||||||
|
--
|
||||||
|
-- So the final proof is:
|
||||||
|
--
|
||||||
|
-- +-assoc-proof zero b c = refl
|
||||||
|
-- +-assoc-proof (suc a) b c = cong suc (+-assoc-proof a b c) -- generated from doing case-split on 'a'
|
|
@ -0,0 +1,101 @@
|
||||||
|
|
||||||
|
-- False: a datatype without constructors
|
||||||
|
data False : Set where
|
||||||
|
|
||||||
|
-- True: a record type without fields => has
|
||||||
|
-- only a single element, which is the empty
|
||||||
|
-- record
|
||||||
|
record True : Set where
|
||||||
|
|
||||||
|
trivial : True
|
||||||
|
|
||||||
|
-- same as 'trivial = _' as agda can
|
||||||
|
-- figure out what the '_' stands for
|
||||||
|
trivial = record{}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
open import Data.Bool
|
||||||
|
isTrue : Bool -> Set
|
||||||
|
isTrue true = True
|
||||||
|
isTrue false = False
|
||||||
|
|
||||||
|
{-
|
||||||
|
data Nat : Set where
|
||||||
|
zero : Nat
|
||||||
|
suc : Nat → Nat
|
||||||
|
|
||||||
|
|
||||||
|
add : Nat → Nat → Nat
|
||||||
|
add zero y = y
|
||||||
|
add (suc x) y = suc (add x y)
|
||||||
|
-}
|
||||||
|
|
||||||
|
-- _<_ : Nat → Nat → Bool
|
||||||
|
-- _ < zero = false
|
||||||
|
|
||||||
|
open import Data.Nat
|
||||||
|
open import Data.Bool
|
||||||
|
-- infix 40 _<_
|
||||||
|
_⇐_ : ℕ → ℕ → Bool
|
||||||
|
_⇐_ zero zero = false
|
||||||
|
_⇐_ zero _ = true
|
||||||
|
_⇐_ (suc x) y = _⇐_ x y
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{-
|
||||||
|
** Doubts
|
||||||
|
*** true
|
||||||
|
Anologous to Coq's
|
||||||
|
|
||||||
|
Inductive True : Prop := I.
|
||||||
|
Inductive False : Prop := .
|
||||||
|
|
||||||
|
??
|
||||||
|
|
||||||
|
But then again, those are propositions whereas the agda
|
||||||
|
version deals with Set.
|
||||||
|
Or is that how agda deals with propositions as well?
|
||||||
|
Had heard that there was no separation unlike in the case of Coq,
|
||||||
|
between the world of propositions and types
|
||||||
|
|
||||||
|
*** Check?
|
||||||
|
Equivalent of Check nat. of coq?
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-
|
||||||
|
open import Data.String
|
||||||
|
|
||||||
|
s : String
|
||||||
|
s = "hello"
|
||||||
|
-}
|
||||||
|
|
||||||
|
|
||||||
|
{-
|
||||||
|
{-
|
||||||
|
Here is a comment above a module.
|
||||||
|
-}
|
||||||
|
module hello where --this is a comment! --fooo@.. jjwjw
|
||||||
|
open import Data.Bool
|
||||||
|
open import Data.String
|
||||||
|
not-comment : Bool -> Set
|
||||||
|
{- but this is OK {-
|
||||||
|
and indeed -}
|
||||||
|
they can be nested -}
|
||||||
|
s : String
|
||||||
|
s = "{- This is not a comment {- Notice the bad nesting -}"
|
||||||
|
not-comment b = {- another comment -} ? --more end-of-line
|
||||||
|
-}
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-
|
||||||
|
data Bool : Set where
|
||||||
|
true : Bool
|
||||||
|
false : Bool
|
||||||
|
|
||||||
|
not : Bool -> Bool
|
||||||
|
not true = false
|
||||||
|
not false = true
|
||||||
|
-}
|
|
@ -0,0 +1,134 @@
|
||||||
|
Type = Set
|
||||||
|
|
||||||
|
data Bool : Type where
|
||||||
|
true false : Bool
|
||||||
|
|
||||||
|
not : Bool → Bool
|
||||||
|
not true = false
|
||||||
|
not false = true
|
||||||
|
|
||||||
|
idBool : Bool → Bool
|
||||||
|
idBool x = x
|
||||||
|
|
||||||
|
idBool' : Bool → Bool
|
||||||
|
idBool' = λ (x : Bool) → x
|
||||||
|
|
||||||
|
id' : (X : Type) → X → X
|
||||||
|
id' X x = x
|
||||||
|
|
||||||
|
id : {X : Type} → X → X
|
||||||
|
id x = x
|
||||||
|
|
||||||
|
idBool'' : Bool → Bool
|
||||||
|
idBool'' = id' _ -- asdf
|
||||||
|
|
||||||
|
example : {P Q : Type} → P → (Q → P)
|
||||||
|
example {P} {Q} p = f
|
||||||
|
where
|
||||||
|
f : Q → P
|
||||||
|
f _ = p
|
||||||
|
|
||||||
|
|
||||||
|
example2 : {P Q : Type} → P → (Q → P)
|
||||||
|
example2 {P} {Q} p = (λ q → p)
|
||||||
|
|
||||||
|
|
||||||
|
-- example : {P Q : Type} → P → (Q → P)
|
||||||
|
-- example {P} {Q} p = f
|
||||||
|
-- example : {P Q : Type} → P → (Q → P)
|
||||||
|
-- example {P} {Q} p = f
|
||||||
|
|
||||||
|
-- open import binary-products
|
||||||
|
--
|
||||||
|
-- ex : {P Q : Type} → P x Q → Q x
|
||||||
|
|
||||||
|
data ℕ : Type where
|
||||||
|
zero : ℕ
|
||||||
|
succ : ℕ → ℕ
|
||||||
|
|
||||||
|
three : ℕ
|
||||||
|
three = succ (succ (succ zero))
|
||||||
|
|
||||||
|
{-# BUILTIN NATURAL ℕ #-}
|
||||||
|
-- a pragma
|
||||||
|
three' : ℕ
|
||||||
|
three' = 3 -- same as three
|
||||||
|
|
||||||
|
-- Dependent types again
|
||||||
|
D : Bool → Type
|
||||||
|
D true = ℕ
|
||||||
|
D false = Bool
|
||||||
|
|
||||||
|
-- 'mix-fix' operator
|
||||||
|
if_then_else : {X : Type} → Bool → X → X → X
|
||||||
|
if true then x else y = x
|
||||||
|
if false then x else y = y
|
||||||
|
|
||||||
|
if[_]_then_else_ : (X : Bool → Type)
|
||||||
|
→ (b : Bool)
|
||||||
|
→ X true
|
||||||
|
→ X false
|
||||||
|
→ X b
|
||||||
|
if[ X ] true then x else y = x
|
||||||
|
if[ X ] false then x else y = y
|
||||||
|
|
||||||
|
-- Π type
|
||||||
|
unfamiliar : (b : Bool) → D b
|
||||||
|
unfamiliar b = if[ D ] b then 3 else false
|
||||||
|
|
||||||
|
-- A type indexed by a type
|
||||||
|
data List (A : Type) : Type where
|
||||||
|
[] : List A
|
||||||
|
_::_ : A → List A → List A
|
||||||
|
|
||||||
|
ff : Type → Type
|
||||||
|
ff = List
|
||||||
|
-- okay, list is indeed Type → Type
|
||||||
|
|
||||||
|
sample-list₀ : List ℕ
|
||||||
|
sample-list₀ = 0 :: (1 :: (2 :: [])) -- brackets not really needed here, it's right associative
|
||||||
|
|
||||||
|
infix 10 _::_
|
||||||
|
|
||||||
|
-- brackets not really needed here, it's right associative
|
||||||
|
-- sample-list1 : List ℕ
|
||||||
|
-- sample-list1 = 0 :: 1 :: 2 :: []
|
||||||
|
|
||||||
|
length : {X : Type} → List X → ℕ
|
||||||
|
length [] = 0
|
||||||
|
length (x :: xs) = succ (length xs)
|
||||||
|
|
||||||
|
-- arbitrary recursive definitions not possible. Just like Coq.
|
||||||
|
-- Recursions got to be structurally smaller.
|
||||||
|
-- On a sub-term.
|
||||||
|
|
||||||
|
|
||||||
|
ℕ-elim : {A : ℕ → Type}
|
||||||
|
→ A 0 -- base case
|
||||||
|
→ ((k : ℕ) → A k → A (succ k)) -- induction step
|
||||||
|
→ (n : ℕ) → A n
|
||||||
|
ℕ-elim {A} a f = h
|
||||||
|
where
|
||||||
|
h : (n : ℕ) → A n
|
||||||
|
h zero = a
|
||||||
|
h (succ n) = f n IH
|
||||||
|
where
|
||||||
|
IH : A n
|
||||||
|
IH = h n -- induction hypothesis
|
||||||
|
|
||||||
|
ℕ-elim' : {A : ℕ → Type}
|
||||||
|
→ A 0 -- base case
|
||||||
|
→ ((k : ℕ) → A k → A (succ k)) -- induction step
|
||||||
|
→ (n : ℕ) → A n
|
||||||
|
ℕ-elim' {A} a f zero = a
|
||||||
|
ℕ-elim' {A} a f (succ n) = f n (ℕ-elim' a f n)
|
||||||
|
|
||||||
|
|
||||||
|
-- Elimination principal for lists
|
||||||
|
List-elim : {X : Type} (A : List X → Type)
|
||||||
|
→ A [] -- base case
|
||||||
|
→ ((x : X) (xs : List X) → A xs → A (x :: xs)) -- induction step
|
||||||
|
→ (xs : List X) → A xs
|
||||||
|
List-elim {X} A a f = h
|
||||||
|
where
|
||||||
|
h : (xs : List X)
|
|
@ -0,0 +1,73 @@
|
||||||
|
{-
|
||||||
|
https://agda.readthedocs.io/en/latest/getting-started/a-taste-of-agda.html#programming-with-dependent-types-vectors
|
||||||
|
|
||||||
|
Do:
|
||||||
|
|
||||||
|
- `C-c C-l`: saves, loads and type checks the file
|
||||||
|
-}
|
||||||
|
|
||||||
|
-- file name has to be same as that of top-level module
|
||||||
|
module vectors where
|
||||||
|
-- This module can afterwards be imported like (in same directory)
|
||||||
|
-- `open import vectors using (Vector; _::_)`
|
||||||
|
|
||||||
|
-- Import type `ℕ` and its constructors `zero` and `suc` from `Data.Nat`
|
||||||
|
open import Data.Nat using (ℕ; zero; suc)
|
||||||
|
|
||||||
|
-- Define `Vector` type
|
||||||
|
-- 'a typed list'
|
||||||
|
-- the `A` argument means dependent typing. So `Vector` is actually a _family_ of types.
|
||||||
|
-- the `ℕ` in the type is an 'index' (indexed type). Here, `Vector` has only one index.
|
||||||
|
-- Here, the index represents the length of the vector.
|
||||||
|
data Vector (A : Set) : ℕ → Set where
|
||||||
|
[] : Vector A zero
|
||||||
|
_::_ : ∀ {n : ℕ} (x : A) (xs : Vector A n) → Vector A (suc n)
|
||||||
|
|
||||||
|
-- define precedence level of `_::_`
|
||||||
|
infixr 5 _::_
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
open import Data.Fin using (Fin; zero; suc)
|
||||||
|
-- > Agda allows overloading of constructor names, and disambiguates
|
||||||
|
-- > between them based on the expected type where they are used.'
|
||||||
|
-- So, `Fin.zero` vs `Nat.zero` conflict is minimized.
|
||||||
|
|
||||||
|
-- Function to get i-th element in a vector
|
||||||
|
|
||||||
|
-- generalizable variables
|
||||||
|
-- https://agda.readthedocs.io/en/latest/language/generalization-of-declared-variables.html#generalization-of-declared-variables
|
||||||
|
variable
|
||||||
|
A : Set
|
||||||
|
n : ℕ
|
||||||
|
|
||||||
|
--lookup (A : Set) (n : ℕ) : Vector A n → Fin n → ℕ
|
||||||
|
--lookup : Vector A n → A
|
||||||
|
--lookup (x :: xs) zero = x
|
||||||
|
--lookup (x :: xs) (suc i) = lookup xs i
|
||||||
|
|
||||||
|
lookup : Vector A n → Fin n → A
|
||||||
|
lookup (x :: xs) zero = x
|
||||||
|
lookup (x :: xs) (suc i) = lookup xs i
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{- More
|
||||||
|
https://agda.readthedocs.io/en/latest/language/mixfix-operators.html#mixfix-operators
|
||||||
|
|
||||||
|
** Find type of an expression
|
||||||
|
C-c C-d RET <expression>
|
||||||
|
|
||||||
|
Eg:
|
||||||
|
|
||||||
|
```
|
||||||
|
1 :: []
|
||||||
|
```
|
||||||
|
(space around the `::` is needed as `1::[]` is an agda identifier)
|
||||||
|
|
||||||
|
gives
|
||||||
|
|
||||||
|
```
|
||||||
|
Vector ℕ 1
|
||||||
|
```
|
||||||
|
-}
|
|
@ -0,0 +1,24 @@
|
||||||
|
#include<stdio.h>
|
||||||
|
int main()
|
||||||
|
{
|
||||||
|
int arr[2];
|
||||||
|
arr[0] = 0;
|
||||||
|
arr[2] = 2; //compcert gave no error!
|
||||||
|
printf("arr[0] = %d\n", arr[0]);
|
||||||
|
printf("arr[2] = %d\n", arr[2]); //compcert still gave no error!!
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
/*
|
||||||
|
Gave error like gcc when I tried using printf without header file:
|
||||||
|
|
||||||
|
arr-bounds-out.c:6: warning: implicit declaration of function 'printf' is invalid in C99 [-Wimplicit-function-declaration]
|
||||||
|
arr-bounds-out.c:6: warning: 'printf' is declared without a function prototype
|
||||||
|
*/
|
||||||
|
|
||||||
|
/*
|
||||||
|
Out of bound array access gave no error! Instead printed the value:
|
||||||
|
|
||||||
|
arr[0] = 0
|
||||||
|
arr[2] = 2
|
||||||
|
*/
|
|
@ -0,0 +1,6 @@
|
||||||
|
#include<stdio.h>
|
||||||
|
int main()
|
||||||
|
{
|
||||||
|
printf("hello world!\n");
|
||||||
|
return 0;
|
||||||
|
}
|
|
@ -0,0 +1,25 @@
|
||||||
|
#include<stdio.h>
|
||||||
|
|
||||||
|
int a()
|
||||||
|
{
|
||||||
|
printf("a ");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
int b()
|
||||||
|
{
|
||||||
|
printf("b ");
|
||||||
|
return 2;
|
||||||
|
}
|
||||||
|
|
||||||
|
int c()
|
||||||
|
{
|
||||||
|
printf("c ");
|
||||||
|
return 3;
|
||||||
|
}
|
||||||
|
|
||||||
|
int main()
|
||||||
|
{
|
||||||
|
printf("rv: %d\n", a() + b() + c());
|
||||||
|
return 0;
|
||||||
|
}
|
|
@ -0,0 +1,21 @@
|
||||||
|
#include<stdio.h>
|
||||||
|
int main()
|
||||||
|
{
|
||||||
|
int a = 0;
|
||||||
|
a = a++ + ++a;
|
||||||
|
//printf("%d\n", a);
|
||||||
|
return a;
|
||||||
|
|
||||||
|
/*
|
||||||
|
a++ + ++a
|
||||||
|
|
||||||
|
0++ + ++a
|
||||||
|
0 + ++1
|
||||||
|
0 + 2
|
||||||
|
2
|
||||||
|
|
||||||
|
a++ + ++0
|
||||||
|
1++ + 1
|
||||||
|
3
|
||||||
|
*/
|
||||||
|
}
|
|
@ -0,0 +1,32 @@
|
||||||
|
import Clash.Prelude
|
||||||
|
import Clash.Explicit.Testbench
|
||||||
|
|
||||||
|
foo
|
||||||
|
:: Applicative f
|
||||||
|
=> (a -> b -> c)
|
||||||
|
-> f a
|
||||||
|
-> f b
|
||||||
|
-> f c
|
||||||
|
foo fn x y = fn <$> x <*> y
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System (Signed 8)
|
||||||
|
-> Signal System (Signed 8)
|
||||||
|
-> Signal System (Signed 8)
|
||||||
|
topEntity = exposeClockResetEnable $ foo (+)
|
||||||
|
|
||||||
|
|
||||||
|
testBench :: Signal System Bool
|
||||||
|
testBench = done
|
||||||
|
where
|
||||||
|
--testInput = stimuliGenerator clk rst $(listToVecTH [2 :: Signed 8, 5, 7]) $(listToVecTH [3 :: Signed 8, 1, 5])
|
||||||
|
--expectOutput = outputVerifier' clk rst $(listToVecTH [5 :: Signed 8, 12])
|
||||||
|
testInput = stimuliGenerator clk rst ((2 :: Signed 8) :> 5 :> 7 :> Nil) ((3 :: Signed 8) :> 1 :> 5 :> Nil)
|
||||||
|
expectOutput = outputVerifier' clk rst ((5 :: Signed 8) :> 12 :> Nil)
|
||||||
|
done = expectOutput (topEntity clk rst en testInput)
|
||||||
|
en = enableGen
|
||||||
|
clk = tbSystemClockGen (not <$> done)
|
||||||
|
rst = systemResetGen
|
|
@ -0,0 +1,39 @@
|
||||||
|
module FIR where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
|
||||||
|
-- Dot product?
|
||||||
|
dotp :: SaturatingNum a
|
||||||
|
=> Vec (n + 1) a
|
||||||
|
-> Vec (n + 1) a
|
||||||
|
-> a
|
||||||
|
dotp as bs =
|
||||||
|
fold boundedAdd -- Sum up the resultant list
|
||||||
|
(zipWith boundedMul as bs) -- Multiply corresponding values
|
||||||
|
|
||||||
|
fir
|
||||||
|
:: (HiddenClockResetEnable dom
|
||||||
|
, Default a
|
||||||
|
, KnownNat n
|
||||||
|
, SaturatingNum a
|
||||||
|
, NFDataX a)
|
||||||
|
=> Vec (n+1) a -> Signal dom a -> Signal dom a
|
||||||
|
fir coeffs x_t = y_t
|
||||||
|
where
|
||||||
|
y_t = dotp coeffs <$> bundle xs
|
||||||
|
xs = window x_t
|
||||||
|
|
||||||
|
topEntity ::
|
||||||
|
Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System (Signed 16)
|
||||||
|
-> Signal System (Signed 16)
|
||||||
|
topEntity = exposeClockResetEnable (fir (2:>3:>(-2):>8:>Nil))
|
||||||
|
|
||||||
|
testBench :: Signal System Bool
|
||||||
|
testBench = done
|
||||||
|
where
|
||||||
|
done =
|
||||||
|
rst = tbsystemClockGen
|
|
@ -0,0 +1,45 @@
|
||||||
|
module FullAdder where
|
||||||
|
|
||||||
|
-- import qualified Prelude.Bool as Bool
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
-- | A | B | S | C |
|
||||||
|
-- |---+---+---+---|
|
||||||
|
-- | 0 | 0 | 0 | 0 |
|
||||||
|
-- | 0 | 1 | 1 | 0 |
|
||||||
|
-- | 1 | 0 | 1 | 0 |
|
||||||
|
-- | 1 | 1 | 0 | 1 |
|
||||||
|
|
||||||
|
mac :: (Num a) => a -> (a, a) -> (a, a)
|
||||||
|
mac acc (x, y) = (acc + x*y, acc)
|
||||||
|
|
||||||
|
fulladder
|
||||||
|
:: Bool -- ^ cin
|
||||||
|
-> (Bool, Bool) -- ^ a and b
|
||||||
|
-> (Bool, Bool) -- ^ cout and s
|
||||||
|
fulladder False (False, False) = (False, False)
|
||||||
|
fulladder True (False, False) = (False, True)
|
||||||
|
fulladder False (False, True) = (False, True)
|
||||||
|
fulladder True (False, True) = (True, False)
|
||||||
|
fulladder False (True, False) = (False, True)
|
||||||
|
fulladder True (True, False) = (True, False)
|
||||||
|
fulladder False (True, True) = (True, False)
|
||||||
|
fulladder True (True, True) = (True, True)
|
||||||
|
|
||||||
|
fulladderS
|
||||||
|
:: (HiddenClockResetEnable dom)
|
||||||
|
=> Signal dom (Bool, Bool) -- ^
|
||||||
|
-> Signal dom Bool -- ^
|
||||||
|
fulladderS = mealy fulladder False
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System (Bool, Bool)
|
||||||
|
-> Signal System Bool
|
||||||
|
topEntity = exposeClockResetEnable fulladderS
|
||||||
|
|
||||||
|
-- clashi
|
||||||
|
-- λ> :l FullAdder.hs
|
||||||
|
-- λ> :vhdl
|
|
@ -0,0 +1,70 @@
|
||||||
|
module LastReg where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
lastval
|
||||||
|
:: Maybe b -- ^ trigger (reset) value
|
||||||
|
-> Maybe a -- ^ value saved in register
|
||||||
|
-> Maybe a -- ^ output value of last
|
||||||
|
lastval (Just _) reg = reg
|
||||||
|
lastval Nothing _ = Nothing
|
||||||
|
|
||||||
|
lastregnextval
|
||||||
|
:: Maybe a -- ^ v signal value
|
||||||
|
-> Maybe a -- ^ value saved in register
|
||||||
|
-> Maybe a -- ^ next value for register
|
||||||
|
lastregnextval Nothing Nothing = Nothing
|
||||||
|
lastregnextval Nothing (Just reg) = Just reg
|
||||||
|
lastregnextval (Just v) _ = Just v
|
||||||
|
|
||||||
|
|
||||||
|
lastS
|
||||||
|
:: (HiddenClockResetEnable dom,
|
||||||
|
NFDataX a)
|
||||||
|
=> Signal dom (Maybe a) -- ^ v signal
|
||||||
|
-> Signal dom (Maybe b) -- ^ r (reset) signal
|
||||||
|
-> Signal dom (Maybe a) -- ^ output signal
|
||||||
|
lastS v rst = lastval <$> rst <*> reg
|
||||||
|
where
|
||||||
|
reg = register Nothing (lastregnextval <$> v <*> reg)
|
||||||
|
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System (Maybe Int)
|
||||||
|
-> Signal System (Maybe Int)
|
||||||
|
-> Signal System (Maybe Int)
|
||||||
|
topEntity = exposeClockResetEnable lastS
|
||||||
|
|
||||||
|
|
||||||
|
-- import qualified Data.List as L
|
||||||
|
-- *LastReg L> L.take 6 $ simulate @System (lastS (fromList [Just 1, Just 2, Nothing, Just 3, Just 4, Nothing])) [Nothing, Just 1, Just 1, Nothing, Nothing, Just 1]
|
||||||
|
-- [Nothing,Just 2,Just 2,Nothing,Nothing,Just 4]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- -- | Calculate output, next state
|
||||||
|
-- -- output Nothing means no change in state
|
||||||
|
-- last
|
||||||
|
-- ::
|
||||||
|
-- -> Maybe a -- ^ current state
|
||||||
|
-- -> Maybe a -- ^ v
|
||||||
|
-- -> Maybe b -- ^ r
|
||||||
|
-- -> Maybe a -- ^ new state
|
||||||
|
-- -> Maybe a -- ^ output
|
||||||
|
-- last Nothing Nothing _ = (Nothing, Nothing)
|
||||||
|
-- last Nothing (Just x) _ = (Just x, Nothing)
|
||||||
|
-- last (Just s) Nothing Nothing = (Just s, Nothing)
|
||||||
|
-- last (Just s) Nothing (Just _) = (Just s, Just s)
|
||||||
|
-- last (Just s) (Just x) Nothing = (Just x, Nothing)
|
||||||
|
-- last (Just s) (Just x) (Just _) = (Just x, Just s)
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,35 @@
|
||||||
|
-- | Multiply and accumulate
|
||||||
|
module MAC where
|
||||||
|
|
||||||
|
-- https://haskell-haddock.readthedocs.io/en/latest/markup.html
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
-- | Multiply and accumulate
|
||||||
|
mac' :: (Num a) =>
|
||||||
|
a -- ^ accumulator
|
||||||
|
-> (a, a) -- ^ next arguments
|
||||||
|
-> a -- ^ new accumulator
|
||||||
|
mac' acc (x, y) = acc + (x*y)
|
||||||
|
|
||||||
|
mac :: (Num a) => a -> (a, a) -> (a, a)
|
||||||
|
mac acc (x, y) = (acc + x*y, acc)
|
||||||
|
|
||||||
|
macS :: (HiddenClockResetEnable dom, Num a, NFDataX a) =>
|
||||||
|
Signal dom (a, a) -- ^
|
||||||
|
-> Signal dom a -- ^
|
||||||
|
macS = mealy mac 0
|
||||||
|
|
||||||
|
-- s = a
|
||||||
|
-- i = (a, a)
|
||||||
|
-- s,o = (a, a)
|
||||||
|
-- ie,
|
||||||
|
-- s,i,o = a,a,a
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System (Int, Int)
|
||||||
|
-> Signal System Int
|
||||||
|
topEntity = exposeClockResetEnable macS
|
|
@ -0,0 +1,26 @@
|
||||||
|
module Merge where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
merge
|
||||||
|
:: Maybe a
|
||||||
|
-> Maybe a
|
||||||
|
-> Maybe a
|
||||||
|
merge (Just x) _ = Just x
|
||||||
|
merge Nothing y = y
|
||||||
|
|
||||||
|
mergef
|
||||||
|
:: Applicative f
|
||||||
|
=> f (Maybe a)
|
||||||
|
-> f (Maybe a)
|
||||||
|
-> f (Maybe a)
|
||||||
|
mergef x y = Merge.merge <$> x <*> y
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System (Maybe (Signed 8))
|
||||||
|
-> Signal System (Maybe (Signed 8))
|
||||||
|
-> Signal System (Maybe (Signed 8))
|
||||||
|
topEntity = exposeClockResetEnable $ mergef
|
|
@ -0,0 +1,37 @@
|
||||||
|
-- https://github.com/clash-lang/clash-compiler/blob/master/examples/MatrixVect.hs
|
||||||
|
|
||||||
|
module MulVecMatrix where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
import qualified Data.List as L
|
||||||
|
|
||||||
|
row1 = 1 :> 2 :> 3 :> Nil
|
||||||
|
row2 = 4 :> 5 :> 6 :> Nil
|
||||||
|
row3 = 7 :> 8 :> 9 :> Nil
|
||||||
|
|
||||||
|
matrix = row1 :> row2 :> row3 :> Nil
|
||||||
|
-- [[1, 2, 3],
|
||||||
|
-- [4, 5, 6],
|
||||||
|
-- [7, 8, 9]]
|
||||||
|
|
||||||
|
dotProduct v1 v2 = foldr (+) 0
|
||||||
|
(zipWith (*) v1 v2)
|
||||||
|
-- λ> dotProduct [1,2,3] [4,5,6]
|
||||||
|
-- 32
|
||||||
|
|
||||||
|
mulVecMatrix m v = map (dotProduct v) m
|
||||||
|
|
||||||
|
topEntity :: Vec 3 (Signed 16) -> Vec 3 (Signed 16)
|
||||||
|
topEntity = mulVecMatrix matrix
|
||||||
|
{-# NOINLINE topEntity #-}
|
||||||
|
|
||||||
|
|
||||||
|
import Clash.Explicit.Testbench
|
||||||
|
testBench :: Signal System Bool
|
||||||
|
testBench = done
|
||||||
|
where
|
||||||
|
testInput = stimuliGenerator clk rst ((2 :> 3 :> 4 :> Nil) :> Nil)
|
||||||
|
expectedOutput = outputVerifier' clk rst ((20 :> 47 :> 74 :> Nil) :> Nil)
|
||||||
|
done = expectedOutput (topEntity <$> testInput)
|
||||||
|
clk = tbSystemClockGen (not <$> done)
|
||||||
|
rst = systemResetGen
|
|
@ -0,0 +1,43 @@
|
||||||
|
module SevenSegment where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
foo
|
||||||
|
:: KnownNat n
|
||||||
|
=> BitVector n
|
||||||
|
-> Vec 7 Bool
|
||||||
|
foo inp =
|
||||||
|
case (toInteger inp) of
|
||||||
|
0 -> (True :> True :> True :> True :> True :> True :> True :> Nil) -- 0
|
||||||
|
1 -> (False :> True :> True :> False :> False :> False :> False :> Nil) -- 1
|
||||||
|
_ -> (True :> True :> False :> False :> True :> False :> True :> Nil) -- Unknown
|
||||||
|
|
||||||
|
bar
|
||||||
|
:: (KnownNat n,
|
||||||
|
Functor f)
|
||||||
|
=> f (BitVector n)
|
||||||
|
-> f (Vec 7 Bool)
|
||||||
|
bar inp = foo <$> inp
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System (BitVector 7)
|
||||||
|
-> Signal System (Vec 7 Bool)
|
||||||
|
topEntity = exposeClockResetEnable bar
|
||||||
|
|
||||||
|
{-
|
||||||
|
GHC: Setting up GHC took: 0.006s
|
||||||
|
GHC: Compiling and loading modules took: 0.227s
|
||||||
|
Clash: Parsing and compiling primitives took 0.205s
|
||||||
|
GHC+Clash: Loading modules cumulatively took 0.553s
|
||||||
|
Clash: Compiling SevenSegment.topEntity
|
||||||
|
Clash: Normalization took 0.027s
|
||||||
|
[WARNING] Dubious primitive instantiation for GHC.Integer.Type.eqInteger#: GHC.Integer.Type.eqInteger#: Integers are dynamically sized in simulation, but fixed-length after synthesis. Use carefully. (disable with -fclash-no-prim-warn)
|
||||||
|
Clash: Netlist generation took 0.001s
|
||||||
|
Clash: Compiling SevenSegment.topEntity took 0.031s
|
||||||
|
Clash: Total compilation took 0.585s
|
||||||
|
-}
|
||||||
|
|
||||||
|
-- XXX: std.textio is imported in the vhdl generated. That's not synthesisable, right?
|
|
@ -0,0 +1,78 @@
|
||||||
|
module Streams where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
type ClockType = Int
|
||||||
|
|
||||||
|
-- data Stream a =
|
||||||
|
-- Cons a (Stream a)
|
||||||
|
--
|
||||||
|
-- merge
|
||||||
|
-- :: Stream (Maybe a)
|
||||||
|
-- -> Stream (Maybe a)
|
||||||
|
-- -> Stream (Maybe a)
|
||||||
|
-- merge (Cons (Just x') xs) (Cons _ ys) = Cons (Just x') (merge xs ys)
|
||||||
|
-- merge (Cons Nothing xs) (Cons y' ys) = Cons y' (merge xs ys)
|
||||||
|
|
||||||
|
-- merge' :: (Maybe a, Maybe a) -> Maybe a
|
||||||
|
-- merge' (Just x, _) = Just x
|
||||||
|
-- merge' (_, y) = y
|
||||||
|
|
||||||
|
|
||||||
|
merge
|
||||||
|
:: Maybe a -- State: Unused
|
||||||
|
-> (Maybe a, Maybe a) -- Input: values from 2 streams
|
||||||
|
-> (Maybe a, Maybe a) -- Output, next state
|
||||||
|
merge _ (Just x, _) = (Nothing, Just x)
|
||||||
|
merge _ (_, y) = (Nothing, y)
|
||||||
|
|
||||||
|
delay
|
||||||
|
:: Maybe ClockType -- State: Remaining time
|
||||||
|
-> (Maybe ClockType, Maybe ()) -- Input: d,r values
|
||||||
|
-> (Maybe ClockType, Maybe ()) -- Output, next state
|
||||||
|
-- XXX: Got to limit ClockType to greater than 0
|
||||||
|
delay (Just 0) (Nothing, Nothing) = (Nothing, Just ()) -- fire. No new delay.
|
||||||
|
delay (Just 0) (Just d, _) = (Just (d-1), Just ()) -- fire. New delay with/without reset signal
|
||||||
|
delay _ (Nothing, Just ()) = (Nothing, Nothing) -- reset when it wasn't about to fire
|
||||||
|
delay _ (Just d, Just r) = (Just (d-1), Nothing) -- set when it wasn't about to fire
|
||||||
|
|
||||||
|
mergeS
|
||||||
|
:: (HiddenClockResetEnable dom,
|
||||||
|
Num a,
|
||||||
|
NFDataX a)
|
||||||
|
=> Signal dom (Maybe a, Maybe a)
|
||||||
|
-> Signal dom (Maybe a)
|
||||||
|
mergeS = mealy Streams.merge Nothing
|
||||||
|
|
||||||
|
-- delayS
|
||||||
|
-- :: (HiddenClockResetEnable dom,
|
||||||
|
-- --Num a,
|
||||||
|
-- NFDataX a)
|
||||||
|
-- => Signal dom (Maybe a, Maybe ())
|
||||||
|
-- -> Signal dom (Maybe ())
|
||||||
|
-- -- XXX: There's a Clash.Prelude.delay: Could be something we can use
|
||||||
|
-- delayS = mealy Streams.delay Nothing
|
||||||
|
|
||||||
|
delayS
|
||||||
|
:: HiddenClockResetEnable dom
|
||||||
|
=> Signal dom (Maybe ClockType, Maybe ())
|
||||||
|
-> Signal dom (Maybe ())
|
||||||
|
delayS = mealy Streams.delay Nothing
|
||||||
|
|
||||||
|
-- topEntity ::
|
||||||
|
-- Clock System
|
||||||
|
-- -> Reset System
|
||||||
|
-- -> Enable System
|
||||||
|
-- -> Signal System (Maybe Int, Maybe Int)
|
||||||
|
-- -> Signal System (Maybe Int)
|
||||||
|
-- topEntity = exposeClockResetEnable Streams.mergeS
|
||||||
|
|
||||||
|
topEntity ::
|
||||||
|
Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System (Maybe ClockType, Maybe ())
|
||||||
|
-> Signal System (Maybe ())
|
||||||
|
topEntity = exposeClockResetEnable Streams.delayS
|
||||||
|
|
||||||
|
-- XXX: How to pass functions as arguments to clash functions
|
|
@ -0,0 +1,29 @@
|
||||||
|
module TimeMealy where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
-- | Transition function to be used for time TeSSLa operation
|
||||||
|
timefn
|
||||||
|
:: Int -- ^ state: current time
|
||||||
|
-> a -- ^ input: irrelevant
|
||||||
|
-> (Int, Int) -- ^ nextstate,output. output is current state itself
|
||||||
|
timefn t _ = (t+1, t)
|
||||||
|
|
||||||
|
timeS
|
||||||
|
:: HiddenClockResetEnable dom
|
||||||
|
=> Signal dom a
|
||||||
|
-> Signal dom Int
|
||||||
|
timeS = mealy timefn 0
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System (Maybe (Signed 8))
|
||||||
|
-> Signal System Int
|
||||||
|
topEntity = exposeClockResetEnable timeS
|
||||||
|
|
||||||
|
-- import qualified Data.List as L
|
||||||
|
-- *TimeMealy L> L.take 4 $ simulate @System timeS [1::Int, 2, 3, 4]
|
||||||
|
-- [0,1,2,3]
|
||||||
|
|
|
@ -0,0 +1,52 @@
|
||||||
|
module TimeReg where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
time
|
||||||
|
:: Maybe a -- ^ signal value
|
||||||
|
-> Int -- ^ time value present in register
|
||||||
|
-> Maybe Int -- ^ output
|
||||||
|
time Nothing _ = Nothing
|
||||||
|
time _ t = Just t
|
||||||
|
|
||||||
|
timeS
|
||||||
|
:: HiddenClockResetEnable dom
|
||||||
|
=> Signal dom (Maybe a)
|
||||||
|
-> Signal dom (Maybe Int)
|
||||||
|
timeS x = time <$> x <*> r
|
||||||
|
where
|
||||||
|
r = register 0 (r + 1)
|
||||||
|
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System (Maybe (Signed 8))
|
||||||
|
-> Signal System (Maybe Int)
|
||||||
|
topEntity = exposeClockResetEnable timeS
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- import qualified Data.List as L
|
||||||
|
-- *TimeReg L> L.take 5 $ simulate @System timeS [Just 0, Just 1, Nothing, Just 3, Nothing]
|
||||||
|
-- [Just 0,Just 1,Nothing,Just 3,Nothing]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- old output
|
||||||
|
-- import qualified Data.List as L
|
||||||
|
-- *TimeReg L> L.take 4 $ simulate @System timeS [Just 1::Maybe (Signed 8), Just 2, Nothing, Just 3, Just 4]
|
||||||
|
-- *TimeReg L> L.take 4 $ simulate @System timeS [Just 1, Just 2, Nothing, Just 3, Just 4]
|
||||||
|
-- [Just 0,Just 1,Nothing,Just 3]
|
||||||
|
-- [Just 1, Just 2, Nothing, Just 3, Just 4]
|
||||||
|
-- [Just 0,Just 1,Nothing,Just 3]
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,34 @@
|
||||||
|
module TimeSState where
|
||||||
|
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
newtype SState a = SState a deriving Show
|
||||||
|
|
||||||
|
instance Functor SState where
|
||||||
|
-- fmap :: (a -> b) -> SState a -> SState b
|
||||||
|
fmap f (SState x) = SState (f x)
|
||||||
|
-- *TimeMealy L> (\x -> x + 1) <$> (SState 3)
|
||||||
|
-- SState 4
|
||||||
|
|
||||||
|
|
||||||
|
instance Applicative SState where
|
||||||
|
-- pure :: a -> SState a
|
||||||
|
pure x = SState x
|
||||||
|
|
||||||
|
-- (<*>) :: SState (a -> b) -> SState a -> SState b
|
||||||
|
(SState f) <*> (SState x) = SState (f x)
|
||||||
|
-- *TimeMealy L> (+) <$> (SState 3) <*> (SState 2)
|
||||||
|
-- SState 5
|
||||||
|
|
||||||
|
|
||||||
|
instance Monad SState where
|
||||||
|
-- (>>=) :: SState a -> (a -> SState b) -> SState b
|
||||||
|
(SState x) >>= f = f x
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: Clock System
|
||||||
|
-> Reset System
|
||||||
|
-> Enable System
|
||||||
|
-> Signal System (Maybe (Signed 8))
|
||||||
|
-> Signal System Int
|
||||||
|
topEntity = exposeClockResetEnable timeS
|
|
@ -0,0 +1,20 @@
|
||||||
|
import Clash.Prelude
|
||||||
|
|
||||||
|
foo :: Bool -> a -> a -> a
|
||||||
|
foo False x y = x
|
||||||
|
foo True x y = y
|
||||||
|
|
||||||
|
topEntity
|
||||||
|
:: (Clock System,
|
||||||
|
Reset System,
|
||||||
|
Enable System)
|
||||||
|
-> Signal System Bool
|
||||||
|
-> Signal System Int
|
||||||
|
-> Signal System Int
|
||||||
|
-> Signal System Int
|
||||||
|
topEntity sel a b = exposeClockResetEnable $ (mux foo) <$> a <*> b
|
||||||
|
|
||||||
|
mux [True] [1] [2]
|
||||||
|
mux (pure True :-) (1 :-) (2 :-)
|
||||||
|
|
||||||
|
mux (True) (1) (2)
|
|
@ -0,0 +1,19 @@
|
||||||
|
data Stream a =
|
||||||
|
Cons a (Stream a)
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
-- | Return first n elements from a stream as a list
|
||||||
|
streamTake
|
||||||
|
:: Int -- ^ Number of elements to take
|
||||||
|
-> Stream a -- ^ Input stream
|
||||||
|
-> [a] -- ^ List of elements from input stream
|
||||||
|
streamTake 0 xs = []
|
||||||
|
streamTake n (Cons x xs) = x : streamTake (n-1) xs
|
||||||
|
|
||||||
|
x = Cons 0 $ Cons 1 $ Cons 2 x
|
||||||
|
|
||||||
|
{-
|
||||||
|
- *Main> streamTake 5 x
|
||||||
|
- [0,1,2,0,1]
|
||||||
|
- }
|
||||||
|
|
|
@ -0,0 +1,13 @@
|
||||||
|
data Foo d a = Nil d a
|
||||||
|
| Cons a (Foo d a)
|
||||||
|
|
||||||
|
|
||||||
|
--data Vect n a = Cons a (Vect n a)
|
||||||
|
|
||||||
|
--data Vect (n::Int) a = Cons a (Vect n a)
|
||||||
|
--data Vect n a = Cons a (Vect n a)
|
||||||
|
-- | Nil a
|
||||||
|
|
||||||
|
--a = Nil 3
|
||||||
|
|
||||||
|
--Is it possible to have a type which accepts two arguments? I was trying to have something like ` data Vect (n::Int) a = Cons a (Vect n a)`
|
|
@ -0,0 +1,13 @@
|
||||||
|
-- https://stackoverflow.com/questions/58528701/how-can-i-instance-functor-for-a-type-with-two-parameters
|
||||||
|
|
||||||
|
-- Tuple2
|
||||||
|
data T2 a b = T2 a b deriving Show
|
||||||
|
-- ghci> T2 2 3
|
||||||
|
-- T2 2 3
|
||||||
|
-- ghci> T2 2 True
|
||||||
|
-- T2 2 True
|
||||||
|
|
||||||
|
instance Functor m => Functor (T2 m) where
|
||||||
|
fmap f (T2 a) = T2 (\x -> fmap g (a x))
|
||||||
|
where
|
||||||
|
g, (r,s) = (f r, s)
|
|
@ -0,0 +1,29 @@
|
||||||
|
-- | https://en.wikibooks.org/wiki/Haskell/Understanding_monads/State#Turnstile_Example
|
||||||
|
|
||||||
|
import Control.Monad
|
||||||
|
-- import Control.Monad.State -- For [state]
|
||||||
|
|
||||||
|
newtype State s a = State {
|
||||||
|
-- a 'state processor'
|
||||||
|
runState :: s -> (a, s)
|
||||||
|
-- | | |
|
||||||
|
-- initial state | |
|
||||||
|
-- 'output value' |
|
||||||
|
-- Final state
|
||||||
|
}
|
||||||
|
|
||||||
|
state :: (s -> (a, s)) -> State s a
|
||||||
|
state = State
|
||||||
|
|
||||||
|
instance Functor (State s) where
|
||||||
|
fmap = liftM
|
||||||
|
|
||||||
|
instance Applicative (State s) where
|
||||||
|
pure = return
|
||||||
|
(<*>) = ap
|
||||||
|
|
||||||
|
instance Monad (State s) where
|
||||||
|
return :: a -> State s a
|
||||||
|
return x = state (\s -> (x, s))
|
||||||
|
|
||||||
|
(>>=) :: State s a -> (a -> State s b) -> State s b
|
|
@ -0,0 +1,24 @@
|
||||||
|
data Tree a = Empty
|
||||||
|
| Node (Tree a) a (Tree a)
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
|
||||||
|
-- | Assuming that 0 won't occur
|
||||||
|
-- Find maximum value in a tree
|
||||||
|
maxOfTree :: Tree Int -> Int
|
||||||
|
maxOfTree Empty = 0
|
||||||
|
maxOfTree (Node l x r) = max x (max (maxOfTree l) (maxOfTree r))
|
||||||
|
|
||||||
|
-- | Replace all elements in a tree with a value
|
||||||
|
replaceElems :: Tree Int -> Int -> Tree Int
|
||||||
|
replaceElems Empty x = Empty
|
||||||
|
replaceElems (Node l _ r) x = Node (replaceElems l x) x (replaceElems r x)
|
||||||
|
|
||||||
|
-- | Replace all elements in a tree with its maximum value
|
||||||
|
maxT :: Tree Int -> Tree Int
|
||||||
|
maxT t = replaceElems t (maxOfTree t)
|
||||||
|
|
||||||
|
|
||||||
|
sampleTree = Node (Node Empty 2 Empty) 3 (Node Empty 4 Empty)
|
||||||
|
rv = maxT sampleTree
|
||||||
|
-- Node (Node Empty 4 Empty) 4 (Node Empty 4 Empty)
|
|
@ -0,0 +1,30 @@
|
||||||
|
data Tree a = Empty
|
||||||
|
| Node (Tree a) a (Tree a) deriving Show
|
||||||
|
|
||||||
|
singleton :: a -> Tree a
|
||||||
|
singleton x = Node Empty x Empty
|
||||||
|
|
||||||
|
-- Return tree with all elements replaced by given value
|
||||||
|
ofShape :: Tree a -> a -> Tree a
|
||||||
|
ofShape Empty _ = Empty
|
||||||
|
ofShape (Node lt _ rt) x = Node (ofShape lt x) x (ofShape rt x)
|
||||||
|
|
||||||
|
-- Helper function does the following
|
||||||
|
--
|
||||||
|
-- Input :: a value x and a tree t
|
||||||
|
--
|
||||||
|
-- Output :: a tuple (t',m) where t' is a tree of the same shape as t but with
|
||||||
|
-- x at each of the nodes, and m is the maximum of all elements in t
|
||||||
|
--
|
||||||
|
helper :: Int -> Tree Int -> (Tree Int, Int)
|
||||||
|
helper _ Empty = (Empty, 0)
|
||||||
|
helper x (Node lt u rt) = (Node ls x rs, lmax `max` u `max` rmax)
|
||||||
|
where (ls,lmax) = helper x lt
|
||||||
|
(rs, rmax)= helper x rt
|
||||||
|
|
||||||
|
onePass :: Tree Int -> Tree Int
|
||||||
|
onePass t = tx
|
||||||
|
where (tx, mx) = helper mx t
|
||||||
|
|
||||||
|
mytree :: Tree Int
|
||||||
|
mytree = Node (singleton 8) 4 (Node (singleton 5) 2 (singleton 1))
|
|
@ -0,0 +1,24 @@
|
||||||
|
mergefn :: (Maybe a1) -> (Maybe a1) -> Maybe a1
|
||||||
|
mergefn a b =
|
||||||
|
case a of {
|
||||||
|
Just _ -> a;
|
||||||
|
Nothing -> b}
|
||||||
|
{-
|
||||||
|
- *Main> mergefn (Just 3) Nothing
|
||||||
|
- Just 3
|
||||||
|
- *Main> mergefn Nothing (Just 3)
|
||||||
|
- Just 3
|
||||||
|
-}
|
||||||
|
|
||||||
|
merge :: (Functor a2) -> (Applicative a2) -> ((Maybe a1) -> (Maybe a1) ->
|
||||||
|
Maybe a1) -> a2 -> a2 -> a2
|
||||||
|
merge ftor appl _ a b =
|
||||||
|
ap ftor appl (fmap ftor mergefn a) b
|
||||||
|
|
||||||
|
{-
|
||||||
|
mergefn :: (Maybe a1) -> (Maybe a1) -> Maybe a1
|
||||||
|
mergefn a b =
|
||||||
|
case a of {
|
||||||
|
Just _ -> a;
|
||||||
|
Nothing -> b}
|
||||||
|
-}
|
|
@ -0,0 +1,6 @@
|
||||||
|
(defun mem (e x)
|
||||||
|
(if (consp x)
|
||||||
|
(if (equal e (car list))
|
||||||
|
t
|
||||||
|
(mem e (cdr x))
|
||||||
|
nil)))
|
|
@ -0,0 +1,14 @@
|
||||||
|
FILENAME=Top.bs
|
||||||
|
MODNAME=mkTop
|
||||||
|
|
||||||
|
build: $(FILENAME)
|
||||||
|
bsc -sim -g $(MODNAME) $(FILENAME)
|
||||||
|
link: $(MODNAME).ba
|
||||||
|
bsc -sim -e $(MODNAME) -o a.out
|
||||||
|
sim: a.out
|
||||||
|
./a.out
|
||||||
|
|
||||||
|
.PHONY: clean
|
||||||
|
|
||||||
|
clean:
|
||||||
|
rm -rf *.so *.out *.h *.o *.ba *.bo *.cxx *.h
|
|
@ -0,0 +1,25 @@
|
||||||
|
{-
|
||||||
|
https://raw.githubusercontent.com/BSVLang/Main/master/Tutorials/Bluespec_Classic_Training/Examples/Eg02_HelloWorld.pdf
|
||||||
|
-}
|
||||||
|
package Top where
|
||||||
|
|
||||||
|
-- module name is mkTop
|
||||||
|
-- Empty is the interface part.
|
||||||
|
-- mkTop module has no interface. ie, no methods.
|
||||||
|
-- So it cannot interact with its environment.
|
||||||
|
mkTop :: Module Empty
|
||||||
|
|
||||||
|
-- mkTop's definition
|
||||||
|
mkTop =
|
||||||
|
module
|
||||||
|
rules
|
||||||
|
-- a rule named `"rl_print_answer"`
|
||||||
|
-- Here, always executed because of the True, I guess.
|
||||||
|
"rl_print_answer": when True ==> do
|
||||||
|
|
||||||
|
-- `$display` prints messages (with a newline appended)
|
||||||
|
$display "Hello, World!"
|
||||||
|
$display "answer is: %0d (or, in hex: 0x%0h)\n" 42 42
|
||||||
|
|
||||||
|
-- halts whole simulation to terminate. So, this rule can fire only once
|
||||||
|
$finish
|
Loading…
Reference in New Issue