├── .github ├── dependabot.yml └── workflows │ └── haskell.yml ├── .gitignore ├── LICENSE ├── README.md ├── demo ├── Makefile_generic ├── blinker │ ├── Blinker.hs │ ├── Blinker.pcf │ ├── CHANGELOG.md │ ├── Makefile │ ├── Setup.hs │ ├── bin │ │ ├── Clash.hs │ │ └── Clashi.hs │ ├── blinker.cabal │ ├── blinker.gif │ └── cabal.project ├── echo │ ├── Echo.hs │ ├── Echo.pcf │ ├── Main.hs │ ├── Makefile │ ├── bin │ │ ├── Clash.hs │ │ └── Clashi.hs │ ├── cabal.project │ ├── echo.cabal │ └── echo.gif ├── pcf_generic.pcf └── uart-led │ ├── Makefile │ ├── UartLed.hs │ ├── UartLed.pcf │ ├── bin │ ├── Clash.hs │ └── Clashi.hs │ ├── cabal.project │ └── uart-led.cabal └── veldt ├── CHANGELOG.md ├── Setup.hs ├── Veldt ├── Counter.hs ├── Ice40 │ └── Rgb.hs ├── PWM.hs ├── PWM │ └── Rgb.hs ├── Serial.hs └── Uart.hs ├── bin ├── Clash.hs └── Clashi.hs ├── cabal.project └── veldt.cabal /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | # To get started with Dependabot version updates, you'll need to specify which 2 | # package ecosystems to update and where the package manifests are located. 3 | # Please see the documentation for all configuration options: 4 | # https://docs.github.com/code-security/dependabot/dependabot-version-updates/configuration-options-for-the-dependabot.yml-file 5 | 6 | version: 2 7 | updates: 8 | - package-ecosystem: "github-actions" # See documentation for possible values 9 | directory: "/" # Location of package manifests 10 | schedule: 11 | interval: "weekly" 12 | -------------------------------------------------------------------------------- /.github/workflows/haskell.yml: -------------------------------------------------------------------------------- 1 | name: Haskell CI 2 | 3 | on: 4 | push: 5 | branches: [ main ] 6 | pull_request: 7 | branches: [ main ] 8 | schedule: 9 | # run at the start of every day 10 | - cron: '0 0 * * *' 11 | 12 | permissions: 13 | contents: read 14 | 15 | jobs: 16 | build: 17 | runs-on: ${{ matrix.os }} 18 | strategy: 19 | matrix: 20 | ghc: ['9.0', '9.8'] 21 | os: [ubuntu-20.04] 22 | 23 | name: ${{ matrix.os }} GHC ${{ matrix.ghc }} 24 | steps: 25 | - name: Checkout 26 | uses: actions/checkout@v4 27 | 28 | - name: Install icestorm prerequisites 29 | run: | 30 | sudo apt-get update 31 | sudo apt-get install build-essential clang bison flex libreadline-dev gawk tcl-dev libffi-dev git graphviz xdot pkg-config python python3 libftdi-dev qt5-default python3-dev libboost-all-dev cmake libeigen3-dev 32 | 33 | - name: Checkout icestorm 34 | uses: actions/checkout@v4 35 | with: 36 | repository: YosysHQ/icestorm 37 | path: icestorm 38 | 39 | - name: Install icestorm 40 | working-directory: icestorm 41 | run: | 42 | make 43 | sudo make install 44 | 45 | - name: Checkout nextpnr 46 | uses: actions/checkout@v4 47 | with: 48 | repository: YosysHQ/nextpnr 49 | path: nextpnr 50 | submodules: recursive 51 | 52 | - name: Install nextpnr 53 | working-directory: nextpnr 54 | run: | 55 | cmake -DARCH=ice40 -DCMAKE_INSTALL_PREFIX=/usr/local . 56 | make -j$(nproc) 57 | sudo make install 58 | 59 | - name: Checkout yosys 60 | uses: actions/checkout@v4 61 | with: 62 | repository: YosysHQ/yosys 63 | path: yosys 64 | submodules: true 65 | 66 | - name: Install yosys 67 | working-directory: yosys 68 | run: | 69 | make -j$(nproc) 70 | sudo make install 71 | 72 | - name: Setup Haskell 73 | uses: haskell-actions/setup@v2 74 | id: setup 75 | with: 76 | ghc-version: ${{ matrix.ghc }} 77 | 78 | - name: configure 79 | working-directory: veldt 80 | run: | 81 | cabal configure --enable-tests --enable-benchmarks --disable-documentation 82 | cabal build --dry-run 83 | 84 | - name: restore cache 85 | uses: actions/cache/restore@v4 86 | id: cache 87 | env: 88 | key: $${{ runner.os }}-ghc-${{ steps.setup.outputs.ghc-version }}-cabal-${{steps.setup.outputs.cabal-version }} 89 | with: 90 | path: ${{ steps.setup.outputs.cabal-store }} 91 | key: ${{ env.key }}-plan-${{ hashFiles('**/plan.json') }} 92 | restore-keys: ${{ env.key }}- 93 | 94 | - name: build dependencies 95 | working-directory: veldt 96 | run: cabal build all --only-dependencies 97 | 98 | - name: save cache 99 | uses: actions/cache/save@v4 100 | if: ${{ steps.cache.outputs.cache-primary-key != steps.cache.outputs.cache-matched-key }} 101 | with: 102 | path: ${{ steps.setup.outputs.cabal-store }} 103 | key: ${{ steps.cache.outputs.cache-primary-key }} 104 | 105 | - name: build 106 | working-directory: veldt 107 | run: cabal build all 108 | 109 | - name: Blinker 110 | working-directory: demo/blinker 111 | run: make 112 | 113 | - name: Echo 114 | working-directory: demo/echo 115 | run: make 116 | 117 | - name: Uart Led 118 | working-directory: demo/uart-led 119 | run: make 120 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *dist-newstyle 3 | *.asc 4 | *.bin 5 | *.hi 6 | *.json 7 | *.o 8 | demo/*/verilog/ 9 | .ghc.environment.* -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Standard Semiconductor 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Where Lions Roam: Haskell & Hardware on the VELDT 2 | 3 | ## Table of Contents 4 | 1. [Section 1: Introduction & Setup](#section-1-introduction--setup) 5 | 2. [Section 2: Fiat Lux](#section-2-fiat-lux) 6 | 1. [Learning to Count](#learning-to-count) 7 | 2. [Its a Vibe: PWM](#its-a-vibe-pwm) 8 | 3. [Drive: RGB Primitive](#drive-rgb-primitive) 9 | 4. [Fiat Lux: Blinker](#fiat-lux-blinker) 10 | 3. [Section 3: Roar](#section-3-roar) 11 | 1. [Serial for Breakfast](#serial-for-breakfast) 12 | 2. [UART My Art](#uart-my-art) 13 | 3. [Roar: Echo](#roar-echo) 14 | 4. [Section 4: Happylife](#section-4-happylife) 15 | 1. [DRY PWM](#dry-pwm) 16 | 2. [Happylife: UART LED](#happylife-uart-led) 17 | 18 | **Clicking on any header within this document will return to Table of Contents** 19 | 20 | ## [Section 1: Introduction & Setup](#table-of-contents) 21 | > And here were the lions now, fifteen feet away, so real, so feverishly and startlingly real that you could feel the prickling fur on your hand, and your mouth was stuffed with the dusty upholstery smell of their heated pelts, and the yellow of them was in your eyes like the yellow of an exquisite French tapestry, the yellows of lions and summer grass, and the sound of the matted lion lungs exhaling on the silent noontide, and the smell of meat from the panting, dripping mouths. 22 | 23 | > *The Veldt* by Ray Bradbury 24 | 25 | This is an opinionated guide to hardware design from first principles using Haskell and VELDT. We assume you are using the VELDT FPGA development board available to order from [standardsemiconductor.com](https://www.standardsemiconductor.com). We also assume you are using Linux, but this is only for getting the tools setup and running the examples. 26 | 27 | The code included in the examples is written in Haskell and compiled to Verilog using [Clash](https://clash-lang.org/). We find hardware design with Haskell to be an enriching experience, and if you are experimenting with HDLs or just starting out with hardware, give it a shot. As hardware designs scale so too does the language and the ability to abstractly compose machines which makes designing them a blast! Visit the [VELDT-info](https://github.com/standardsemiconductor/VELDT-info#clash) repo for instructions on installation and setup of Haskell and Clash tools. 28 | 29 | We use the Project IceStorm flow for synthesis, routing, and programming. These are excellent, well-maintained open source tools. For installation and setup instructions visit the [VELDT-info](https://github.com/standardsemiconductor/VELDT-info#project-icestorm) repo. 30 | 31 | This guide is split into several sections. Each section begins with construction of sub-components then culminates with an application which utilizes the sub-components. [Section 2](#section-2-fiat-lux) constructs a simple blinker, the "hello-world" of FPGAs. [Section 3](#section-3-roar) covers serializers and deserializers which are used to construct a UART. [Section 4](#section-4-happylife) ties together concepts from the previous sections with a demo of controlling the LED via UART. In the future we hope to add sections which demonstrate how to interact with the memory provided by VELDT, design a simple CPU with a custom ISA, and construct a System-On-Chip (SoC). 32 | 33 | By the end of the guide, you will have a library of commonly used hardware components along with a directory of applications demonstrating their usage. The library and demos explained in this guide are available in this repo, see the [veldt](veldt) and [demo](demo) directories. 34 | 35 | Finally, if you have any suggestions, comments, discussions, edits, additions etc. please open an issue in this repo. We value any and all contributions. Let's get started! 36 | 37 | ## [Section 2: Fiat Lux](#table-of-contents) 38 | > The nursery was silent. It was empty as a jungle glade at hot high noon. The walls were blank and two dimensional. Now, as George and Lydia Hadley stood in the center of the room, the walls began to purr and recede into crystalline distance, it seemed, and presently an African veldt appeared, in three dimensions, on all sides, in color reproduced to the final pebble and bit of straw. The ceiling above them became a deep sky with a hot yellow sun. 39 | 40 | > *The Veldt* by Ray Bradbury 41 | 42 | In this section we start by building a counter then, using the counter, construct a PWM. Equipped with our counter and PWM, we use the RGB LED Driver IP to create our first running application on VELDT; a blinker! 43 | 44 | ### [Learning to Count](#table-of-contents) 45 | We begin by creating a directory called "veldt" to contain our haskell library: 46 | ```console 47 | foo@bar:~/VELDT-getting-started$ mkdir veldt && cd veldt 48 | ``` 49 | We use the [clash-example-project](https://github.com/clash-lang/clash-starters/tree/main/simple) as a template. Specifically, we copy the `bin/`, `cabal.project`, and `simple.cabal` into our `veldt` directory. We need to change the project name in the `cabal.project` and `veldt.cabal` files from `simple` to `veldt`. Additionally, in the `veldt.cabal` file we add `mtl`, `lens`, and `interpolate` to the build-depends section. 50 | 51 | Your `cabal.project` file should look similar: 52 | ``` 53 | packages: 54 | veldt.cabal 55 | 56 | package clash-prelude 57 | -- 'large-tuples' generates tuple instances for various classes up to the 58 | -- GHC imposed maximum of 62 elements. This severely slows down compiling 59 | -- Clash, and triggers Template Haskell bugs on Windows. Hence, we disable 60 | -- it by default. This will be the default for Clash >=1.4. 61 | flags: -large-tuples 62 | ``` 63 | 64 | Your `veldt.cabal` file should look similar: 65 | ``` 66 | cabal-version: 2.4 67 | name: veldt 68 | version: 0.1 69 | license-file: LICENSE 70 | author: Standard Semiconductor 71 | maintainer: standard.semiconductor@gmail.com 72 | extra-source-files: CHANGELOG.md 73 | 74 | common common-options 75 | default-extensions: 76 | BangPatterns 77 | BinaryLiterals 78 | ConstraintKinds 79 | DataKinds 80 | DefaultSignatures 81 | DeriveAnyClass 82 | DeriveDataTypeable 83 | DeriveFoldable 84 | DeriveFunctor 85 | DeriveGeneric 86 | DeriveLift 87 | DeriveTraversable 88 | DerivingStrategies 89 | InstanceSigs 90 | KindSignatures 91 | LambdaCase 92 | NoStarIsType 93 | PolyKinds 94 | RankNTypes 95 | ScopedTypeVariables 96 | StandaloneDeriving 97 | TupleSections 98 | TypeApplications 99 | TypeFamilies 100 | TypeOperators 101 | ViewPatterns 102 | 103 | -- TemplateHaskell is used to support convenience functions such as 104 | -- 'listToVecTH' and 'bLit'. 105 | TemplateHaskell 106 | QuasiQuotes 107 | 108 | -- Prelude isn't imported by default as Clash offers Clash.Prelude 109 | NoImplicitPrelude 110 | ghc-options: 111 | -Wall -Wcompat 112 | -haddock 113 | 114 | -- Plugins to support type-level constraint solving on naturals 115 | -fplugin GHC.TypeLits.Extra.Solver 116 | -fplugin GHC.TypeLits.Normalise 117 | -fplugin GHC.TypeLits.KnownNat.Solver 118 | 119 | -- Clash needs access to the source code in compiled modules 120 | -fexpose-all-unfoldings 121 | 122 | -- Worker wrappers introduce unstable names for functions that might have 123 | -- blackboxes attached for them. You can disable this, but be sure to add 124 | -- a no-specialize pragma to every function with a blackbox. 125 | -fno-worker-wrapper 126 | default-language: Haskell2010 127 | build-depends: 128 | base, 129 | Cabal, 130 | mtl, 131 | lens, 132 | interpolate, 133 | 134 | -- clash-prelude will set suitable version bounds for the plugins 135 | clash-prelude >= 1.2.5 && < 1.5, 136 | ghc-typelits-natnormalise, 137 | ghc-typelits-extra, 138 | ghc-typelits-knownnat 139 | 140 | library 141 | import: common-options 142 | exposed-modules: Veldt.Counter 143 | default-language: Haskell2010 144 | 145 | -- Builds the executable 'clash', with veldt in scope 146 | executable clash 147 | main-is: bin/Clash.hs 148 | default-language: Haskell2010 149 | Build-Depends: base, clash-ghc, veldt 150 | if !os(Windows) 151 | ghc-options: -dynamic 152 | 153 | -- Builds the executable 'clashi', with veldt in scope 154 | executable clashi 155 | main-is: bin/Clashi.hs 156 | default-language: Haskell2010 157 | if !os(Windows) 158 | ghc-options: -dynamic 159 | build-depends: base, clash-ghc, veldt 160 | ``` 161 | We won't go through everything about this cabal file, but here are the highlights. 162 | 163 | The common-section has three major parts: 164 | 1. `default-extensions` extends the Haskell language, helps to reduce boilerplate, and cleans up syntax. `NoImplicitPrelude` is especially important, it says we don't want the standard Haskell prelude imported implicitly. Instead, we want to explicitly import the Clash prelude. More information about language extensions can be found in the [GHC users guide](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/exts.html). 165 | 2. `ghc-options` turns on warnings and activates plugins. 166 | 3. `build-depends` lists our library dependencies. We use monad transformers from `mtl` and `lens` to zoom and mutate substates. `interpolate` is used for inline primitives when we need Yosys to infer hardware IP. `base` provides standard haskell functions and types. The `ghc-typelits...` packages are plugins to help the Clash compiler infer and manipulate types. 167 | 168 | In the library section we import the `common-options` and list `exposed-modules` which are the modules we export from the library to be used in our demos. So far we see `Veldt.Counter`, we will create a directory `Veldt` with a file `Counter.hs`. This will have our counter source code. 169 | 170 | The last two parts define executables `clash` and `clashi` which we use to invoke the Clash compiler. More information about setting up a Clash project can be found in the [clash-starters repository](https://github.com/clash-lang/clash-starters/tree/main/simple#simple-starter-project). 171 | 172 | Create a directory `Veldt` with a file `Counter.hs`. 173 | ```console 174 | foo@bar:~/VELDT-getting-started/veldt$ mkdir Veldt && cd Veldt 175 | foo@bar:~/VELDT-getting-started/veldt/Veldt$ touch Counter.hs 176 | ``` 177 | 178 | Open `Counter.hs` in your favorite editor. Let's name the module, list the exports and import some useful packages: 179 | ```haskell 180 | module Veldt.Counter 181 | ( increment 182 | , incrementWhen 183 | , incrementUnless 184 | , decrement 185 | ) where 186 | 187 | import Clash.Prelude 188 | ``` 189 | The exported functions define the API for a counter. We want to be able to `increment` and `decrement` the counter. Additionally, we provide conditional increment functions `incrementWhen` and `incrementUnless`. Often when designing a new module, you won't know beforehand what the "right" API should look like. That's OK, start by writing what you think it should look like, then refactor as needed. The APIs shown throughout this guide were "found" over many months of rewrites and refactoring as the modules were used and combined in different ways. Even after many months, the APIs still change and the modules become more robust over time. Haskell makes it easy to refactor without fear, just let the types guide you; the compiler is your friend! 190 | 191 | The `increment` function returns the successor of the argument while also wrapping around the maximum bound. If the argument is equal to `maxBound` then return `minBound`; effectively wrapping around the bound. Otherwise, return the successor of the argument using `succ`. The `decrement` function is similar, except the function respects `minBound` and returns the predecessor using `pred`. 192 | ```haskell 193 | increment :: (Bounded a, Enum a, Eq a) => a -> a 194 | increment a 195 | | a == maxBound = minBound 196 | | otherwise = succ a 197 | 198 | decrement :: (Bounded a, Enum a, Eq a) => a -> a 199 | decrement a 200 | | a == minBound = maxBound 201 | | otherwise = pred a 202 | ``` 203 | Note, the `increment` and `decrement` functions have typeclass constraints `(Bounded a, Enum a, Eq a)`. The compiler will make sure the argument `a` is an instance of `Bounded`, `Enum`, and `Eq`. The typeclass constraint [`Bounded`](http://hackage.haskell.org/package/clash-prelude-1.8.1/docs/Clash-HaskellPrelude.html#t:Bounded) says our counter has a minimum and maximum value which gives us `minBound` and `maxBound`. Likewise [`Eq`](http://hackage.haskell.org/package/clash-prelude-1.8.1/docs/Clash-HaskellPrelude.html#t:Eq) lets us compare equality `==` and [`Enum`](http://hackage.haskell.org/package/clash-prelude-1.8.1/docs/Clash-HaskellPrelude.html#t:Enum) provides `succ` (successor) and `pred` (predecessor) functions on our polymorphic type `a`. Without these constraints the compiler would complain that it could not deduce the required typeclass. 204 | 205 | When designing your own counter functions be careful when using `succ` or `pred`. For example `succ 0 == (1 :: BitVector 8)` and `pred 4 == (3 :: Index 6)`, but `succ (4 :: Index 5)` is undefined and out of bounds because the type `Index 5` only has inhabitants `0`,`1`,`2`,`3`, and `4`; that is why we check for `maxBound` and `minBound` states in `increment` and `decrement`. 206 | 207 | Finally, we use our new `increment` function to implement a conditional increment `incrementWhen` and `incrementUnless`. The former will increment when a predicate is `True`, the latter when `False`. 208 | ```haskell 209 | incrementWhen :: (Bounded a, Enum a, Eq a) => (a -> Bool) -> a -> a 210 | incrementWhen p a 211 | | p a = increment a 212 | | otherwise = minBound 213 | 214 | incrementUnless :: (Bounded a, Enum a, Eq a) => (a -> Bool) -> a -> a 215 | incrementUnless p = incrementWhen (not . p) 216 | ``` 217 | Within `incrementWhen`, we apply our predicate argument `p` to the counter argument `a`. If the predicate evaluates to `True`, we return the incremented the counter value. Otherwise, return the minimum bound. To reduce and reuse code, we implement `incrementUnless` using `incrementWhen` and post-compose `not` to our predicate. Suppose we have `incrementUnless (== 3) :: Index 8 -> Index 8`, then the counter would be incremented if it does NOT equal 3. However, if the counter does equal 3, then the returned value is 0. 218 | 219 | Here is our completed counter: 220 | ```haskell 221 | module Veldt.Counter 222 | ( increment 223 | , incrementWhen 224 | , incrementUnless 225 | , decrement 226 | ) where 227 | 228 | import Clash.Prelude 229 | 230 | ------------- 231 | -- Counter -- 232 | ------------- 233 | increment :: (Bounded a, Enum a, Eq a) => a -> a 234 | increment a 235 | | a == maxBound = minBound 236 | | otherwise = succ a 237 | 238 | decrement :: (Bounded a, Enum a, Eq a) => a -> a 239 | decrement a 240 | | a == minBound = maxBound 241 | | otherwise = pred a 242 | 243 | incrementWhen :: (Bounded a, Enum a, Eq a) => (a -> Bool) -> a -> a 244 | incrementWhen p a 245 | | p a = increment a 246 | | otherwise = minBound 247 | 248 | incrementUnless :: (Bounded a, Enum a, Eq a) => (a -> Bool) -> a -> a 249 | incrementUnless p = incrementWhen (not . p) 250 | ``` 251 | To end this part, we clean and rebuild the library. You should not see any errors. 252 | ```console 253 | foo@bar:~/VELDT-getting-started/veldt$ cabal clean 254 | foo@bar:~/VELDT-getting-started/veldt$ cabal build 255 | ... 256 | [1 of 1] Compiling Veldt.Counter ... 257 | ``` 258 | You can find the full counter source code [here](veldt/Veldt/Counter.hs). We can now use our counter API to create a PWM. 259 | 260 | ### [Its a Vibe: PWM](#table-of-contents) 261 | Pulse Width Modulation or PWM is used to drive our LED. We use a technique called [time proportioning](https://en.wikipedia.org/wiki/Pulse-width_modulation#Time_proportioning) to generate the PWM signal with our counter. To begin let's create a `PWM.hs` file in the `Veldt` directory. 262 | ```console 263 | foo@bar:~/VELDT-getting-started/veldt/Veldt$ touch PWM.hs 264 | ``` 265 | We also need to expose the PWM module with cabal by editing the `exposed-modules` section of `veldt.cabal` to include `Veldt.PWM`. 266 | ``` 267 | ...... 268 | library 269 | ... 270 | exposed-modules: Veldt.Counter, 271 | Veldt.PWM 272 | ... 273 | ...... 274 | ``` 275 | Now begin editing the `PWM.hs` file. We start by naming the module, defining our exports, and importing useful packages. 276 | ```haskell 277 | module Veldt.PWM 278 | ( PWM 279 | , mkPWM 280 | , pwm 281 | , setDuty 282 | ) where 283 | 284 | import Clash.Prelude 285 | import Control.Lens 286 | import Control.Monad.RWS 287 | import Veldt.Counter 288 | ``` 289 | We export the type `PWM` and its smart constructor `mkPWM`. The monadic API consists of `pwm`, a PWM action, and a setter `setDuty` to mutate the duty cycle. In this module we will be using [lens](https://hackage.haskell.org/package/lens) to set, modify, and get sub-states. We use the RWS monad from [mtl](https://hackage.haskell.org/package/mtl) because it allows zooming, magnification, and scribing. Although zooming etc. is not used in this module, it will help composition in the future as our library grows. Finally we import our counter module. 290 | 291 | Next we define the `PWM` type and its constructor. Note how we use `makeLenses` to automatically create lenses for our `PWM` type. 292 | ```haskell 293 | data PWM a = PWM 294 | { _ctr :: a 295 | , _duty :: a 296 | } deriving (NFDataX, Generic) 297 | makeLenses ''PWM 298 | 299 | mkPWM :: Bounded a => a -> PWM a 300 | mkPWM = PWM minBound 301 | ``` 302 | The PWM state consists of a counter and a value used to control the duty cycle. Also, note that we keep `PWM` polymorphic. Our smart constructor `mkPWM` takes an initial duty cycle and creates a PWM with a counter initially set to the minimum bound. 303 | 304 | Let's define and implement `setDuty` which will update the `duty` cycle and reset the counter. 305 | ```haskell 306 | setDuty :: (Monoid w, Monad m, Bounded a) => a -> RWST r w (PWM a) m () 307 | setDuty d = do 308 | duty .= d 309 | ctr .= minBound 310 | ``` 311 | We use the [`.=`](https://hackage.haskell.org/package/lens-5.0.1/docs/Control-Lens-Setter.html#v:.-61-) lens operator to set the `duty` cycle and reset the `ctr` to `minBound`. We use `setDuty` to change the duty cycle of the PWM. For example, suppose we have `setDuty 25 :: RWST r w (PWM (Index 100)) m ()`, then the PWM will operate at 25% duty cycle. 312 | 313 | Finally, we tackle the `pwm` function. 314 | ```haskell 315 | pwm :: (Monoid w, Monad m, Ord a, Bounded a, Enum a) => RWST r w (PWM a) m Bit 316 | pwm = do 317 | d <- use duty 318 | c <- ctr <<%= increment 319 | return $ boolToBit $ c < d 320 | ``` 321 | First we bind `duty` to `d`. Next we `increment` the `ctr` and bind it's **old** value to `c` with [`<<%=`](https://hackage.haskell.org/package/lens-5.0.1/docs/Control-Lens-Lens.html#v:-60--60--37--61-). Last, we compare `c < d`, convert the [`boolToBit`](https://hackage.haskell.org/package/clash-prelude-1.8.1/docs/Clash-Class-BitPack.html#v:boolToBit), and `return` the bit. `boolToBit` simply maps `True` to `1 :: Bit` and `False` to `0 :: Bit`. Because we compare the `duty` `d` to the counter `c` with `<`, our type signature requires the underlying counter type `a` to be a member of the `Ord` typeclass. For example, if we have `pwm :: RWST r w (PWM (Index 4)) m Bit` and `duty` is bound to `3 :: Index 4`, (75% duty cycle, remember `Index 4` has inhabitants 0, 1, 2, 3), the output of `pwm` when run as a mealy machine would be: ... 1, 1, 1, 0, 1, 1, 1, 0, ... . 322 | 323 | Here is the complete `PWM.hs` source code: 324 | ```haskell 325 | module Veldt.PWM 326 | ( PWM 327 | , mkPWM 328 | , pwm 329 | , setDuty 330 | ) where 331 | 332 | import Clash.Prelude 333 | import Control.Lens 334 | import Control.Monad.RWS 335 | import Veldt.Counter 336 | 337 | --------- 338 | -- PWM -- 339 | --------- 340 | data PWM a = PWM 341 | { _ctr :: a 342 | , _duty :: a 343 | } deriving (NFDataX, Generic) 344 | makeLenses ''PWM 345 | 346 | mkPWM :: Bounded a => a -> PWM a 347 | mkPWM = PWM minBound 348 | 349 | setDuty :: (Monoid w, Monad m, Bounded a) => a -> RWST r w (PWM a) m () 350 | setDuty d = do 351 | duty .= d 352 | ctr .= minBound 353 | 354 | pwm :: (Monoid w, Monad m, Ord a, Bounded a, Enum a) => RWST r w (PWM a) m Bit 355 | pwm = do 356 | d <- use duty 357 | c <- ctr <<%= increment 358 | return $ boolToBit $ c < d 359 | ``` 360 | To end this part, we rebuild the library. You should not see any errors. 361 | ```console 362 | foo@bar:~/VELDT-getting-started/veldt$ cabal build 363 | ... 364 | [1 of 2] Compiling Veldt.Counter ... 365 | [2 of 2] Compiling Veldt.PWM ... 366 | ``` 367 | You can find the full PWM source code [here](veldt/Veldt/PWM.hs). In the next part, we use a Clash primitive to infer Lattice RGB Driver IP. 368 | 369 | ### [Drive: RGB Primitive](#table-of-contents) 370 | We need one more component before starting our demo, a RGB (Red, Green, Blue) LED Driver. It takes 3 PWM signals (R, G, B) to drive the LED. We use the Verilog template from the Lattice documentation [iCE40 LED Driver Usage Guide](https://github.com/standardsemiconductor/VELDT-info/blob/main/ICE40LEDDriverUsageGuide.pdf). Because the RGB Driver is a Lattice IP block, we need our compiled Haskell code to take a certain form in Verilog. When we synthesize the demo, Yosys will infer the Lattice Ice40 RGB Driver IP (SB_RGBA_DRV) from the Verilog code. In order to have Clash use a certain Verilog (or VHDL) code, we write a primitive. This primitive tells the Clash compiler to insert Verilog (or VHDL) instead of compiling our function. Let's begin by creating a directory `Ice40` for our Lattice primitives. This will be within the `Veldt` directory. Then we create a `Rgb.hs` file which will be our RGB Driver primitive. 371 | ```console 372 | foo@bar:~/VELDT-getting-started/veldt$ mkdir Veldt/Ice40 && touch Veldt/Ice40/Rgb.hs 373 | ``` 374 | Next add the `Veldt.Ice40.Rgb` to our `veldt.cabal` `exposed-modules` list. 375 | ``` 376 | ... 377 | exposed-modules: Veldt.Counter, 378 | Veldt.PWM, 379 | Veldt.Ice40.Rgb 380 | ... 381 | ``` 382 | Now edit `Rgb.hs`. We inline the Verilog primitive (meaning we have Verilog and Haskell in the same module), and then wrap it with a function to ease usage. Let's start by naming the module, its exports, and its imports. 383 | ```haskell 384 | module Veldt.Ice40.Rgb 385 | ( Rgb 386 | , rgbDriver 387 | ) where 388 | 389 | import Clash.Prelude 390 | import Clash.Annotations.Primitive 391 | import Data.String.Interpolate (i) 392 | import Data.String.Interpolate.Util (unindent) 393 | ``` 394 | We export the `Rgb` type which is the input/output type of our primitive and a wrapper function `rgbDriver` for the primitive. Additionally we import `Clash.Annotations.Primitive` which supplies code for writing primitives. Since the primitive will be inlined we use the [interpolate](https://hackage.haskell.org/package/interpolate) package for string interpolation. 395 | 396 | Now we create the primitive. 397 | ```haskell 398 | {-# ANN rgbPrim (InlinePrimitive [Verilog] $ unindent [i| 399 | [ { "BlackBox" : 400 | { "name" : "Veldt.Ice40.Rgb.rgbPrim" 401 | , "kind" : "Declaration" 402 | , "type" : 403 | "rgbPrim 404 | :: String -- current_mode ARG[0] 405 | -> String -- rgb0_current ARG[1] 406 | -> String -- rgb1_current ARG[2] 407 | -> String -- rgb2_current ARG[3] 408 | -> Signal dom Bit -- pwm_r ARG[4] 409 | -> Signal dom Bit -- pwm_g ARG[5] 410 | -> Signal dom Bit -- pwm_b ARG[6] 411 | -> Signal dom (Bit, Bit, Bit)" 412 | , "template" : 413 | "//SB_RGBA_DRV begin 414 | wire ~GENSYM[RED][0]; 415 | wire ~GENSYM[GREEN][1]; 416 | wire ~GENSYM[BLUE][2]; 417 | 418 | SB_RGBA_DRV #( 419 | .CURRENT_MODE(~ARG[0]), 420 | .RGB0_CURRENT(~ARG[1]), 421 | .RGB1_CURRENT(~ARG[2]), 422 | .RGB2_CURRENT(~ARG[3]) 423 | ) RGBA_DRIVER ( 424 | .CURREN(1'b1), 425 | .RGBLEDEN(1'b1), 426 | .RGB0PWM(~ARG[4]), 427 | .RGB1PWM(~ARG[5]), 428 | .RGB2PWM(~ARG[6]), 429 | .RGB0(~SYM[0]), 430 | .RGB1(~SYM[1]), 431 | .RGB2(~SYM[2]) 432 | ); 433 | 434 | assign ~RESULT = {~SYM[0], ~SYM[1], ~SYM[2]}; 435 | //SB_RGBA_DRV end" 436 | } 437 | } 438 | ] 439 | |]) #-} 440 | ``` 441 | When writing primitives be sure the function name, module name, and black box name all match. The template is Verilog from the Lattice documentation [iCE40 LED Driver Usage Guide](https://github.com/standardsemiconductor/VELDT-info/blob/main/ICE40LEDDriverUsageGuide.pdf). The documentation for writing primitives is on the [clash-prelude](https://hackage.haskell.org/package/clash-prelude) hackage page in the `Clash.Annotations.Primitive` module. Basically, the `SB_RGBA_DRV` module takes 3 PWM input signals and outputs 3 LED driver signals. We adopt the style to prefix any primitive functions with `Prim`. Let's give a Haskell function stub for the primitive. 442 | ```haskell 443 | {-# NOINLINE rgbDriverPrim #-} 444 | rgbPrim 445 | :: String 446 | -> String 447 | -> String 448 | -> String 449 | -> Signal dom Bit 450 | -> Signal dom Bit 451 | -> Signal dom Bit 452 | -> Signal dom (Bit, Bit, Bit) 453 | rgbPrim !_ !_ !_ !_ !_ !_ !_ = pure (0, 0, 0) 454 | ``` 455 | Although we do not provide a real implementation for the the primitive in Haskell, it is good practice to do so and helps when testing and modeling. We use [bang patterns](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/exts.html#bang-patterns-informal) on the arguments to ensure our primitive is strictly evaluated. Also, note the type of `rgbPrim` matches exactly to the inlined primitive type and has a `NOINLINE` annotation. 456 | 457 | Instead of constantly writing `(Bit, Bit, Bit)` for our RGB tuple, let's define a type synonym with some tags which are useful when constraining pins. 458 | ```haskell 459 | type Rgb = ("red" ::: Bit, "green" ::: Bit, "blue" ::: Bit) 460 | ``` 461 | Finally, using our `Rgb` type, we wrap the primitive and give it some default parameters. 462 | ```haskell 463 | rgb :: Signal dom Rgb -> Signal dom Rgb 464 | rgb rgbPWM = let (r, g, b) = unbundle rgbPWM 465 | in rgbPrim "0b0" "0b111111" "0b111111" "0b111111" r g b 466 | ``` 467 | `unbundle` is part of a `Signal` isomorphism, the other part being `bundle`. In this case, `unbundle` maps the type `Signal dom (Bit, Bit, Bit)` to `(Signal dom Bit, Signal dom Bit, Signal dom Bit)`. The `String` parameters we give to `rgbPrim` define the current and mode outputs for the driver. It may be prudent to adjust these parameters depending on the power requirements of your application. It is a good exercise to define a custom current/mode data type and use that in the wrapper `rgb` for easy usage. 468 | 469 | Here is the complete `Rgb.hs` source code: 470 | ```haskell 471 | module Veldt.Ice40.Rgb 472 | ( Rgb 473 | , rgb 474 | ) where 475 | 476 | import Clash.Prelude 477 | import Clash.Annotations.Primitive 478 | import Data.String.Interpolate (i) 479 | import Data.String.Interpolate.Util (unindent) 480 | 481 | {-# ANN rgbPrim (InlinePrimitive [Verilog] $ unindent [i| 482 | [ { "BlackBox" : 483 | { "name" : "Veldt.Ice40.Rgb.rgbPrim" 484 | , "kind" : "Declaration" 485 | , "type" : 486 | "rgbPrim 487 | :: String -- current_mode ARG[0] 488 | -> String -- rgb0_current ARG[1] 489 | -> String -- rgb1_current ARG[2] 490 | -> String -- rgb2_current ARG[3] 491 | -> Signal dom Bit -- pwm_r ARG[4] 492 | -> Signal dom Bit -- pwm_g ARG[5] 493 | -> Signal dom Bit -- pwm_b ARG[6] 494 | -> Signal dom (Bit, Bit, Bit)" 495 | , "template" : 496 | "//SB_RGBA_DRV begin 497 | wire ~GENSYM[RED][0]; 498 | wire ~GENSYM[GREEN][1]; 499 | wire ~GENSYM[BLUE][2]; 500 | 501 | SB_RGBA_DRV #( 502 | .CURRENT_MODE(~ARG[0]), 503 | .RGB0_CURRENT(~ARG[1]), 504 | .RGB1_CURRENT(~ARG[2]), 505 | .RGB2_CURRENT(~ARG[3]) 506 | ) RGBA_DRIVER ( 507 | .CURREN(1'b1), 508 | .RGBLEDEN(1'b1), 509 | .RGB0PWM(~ARG[4]), 510 | .RGB1PWM(~ARG[5]), 511 | .RGB2PWM(~ARG[6]), 512 | .RGB0(~SYM[0]), 513 | .RGB1(~SYM[1]), 514 | .RGB2(~SYM[2]) 515 | ); 516 | 517 | assign ~RESULT = {~SYM[0], ~SYM[1], ~SYM[2]}; 518 | //SB_RGBA_DRV end" 519 | } 520 | } 521 | ] 522 | |]) #-} 523 | 524 | {-# NOINLINE rgbPrim #-} 525 | rgbPrim 526 | :: String 527 | -> String 528 | -> String 529 | -> String 530 | -> Signal dom Bit 531 | -> Signal dom Bit 532 | -> Signal dom Bit 533 | -> Signal dom (Bit, Bit, Bit) 534 | rgbPrim !_ !_ !_ !_ !_ !_ !_ = pure (0, 0, 0) 535 | 536 | type Rgb = ("red" ::: Bit, "green" ::: Bit, "blue" ::: Bit) 537 | 538 | rgb :: Signal dom Rgb -> Signal dom Rgb 539 | rgb rgbPWM = let (r, g, b) = unbundle rgbPWM 540 | in rgbPrim "0b0" "0b111111" "0b111111" "0b111111" r g b 541 | ``` 542 | 543 | To end this part, we rebuild the library. You should not see any errors. 544 | ```console 545 | foo@bar:~/VELDT-getting-started/veldt$ cabal build 546 | Building library for veldt-0.1.0.0.. 547 | [1 of 3] Compiling Veldt.Counter ... 548 | [2 of 3] Compiling Veldt.Ice40.Rgb ... 549 | [3 of 3] Compiling Veldt.PWM ... 550 | ``` 551 | You can find the full RGB Driver source code [here](veldt/Veldt/Ice40/Rgb.hs). We should mention that Standard Semiconductor also maintains [ice40-prim](https://github.com/standardsemiconductor/ice40-prim), a library of iCE40 FPGA primitives [available on Hackage](https://hackage.haskell.org/package/ice40-prim). It contains the RGB driver along with other primitives for you to use in your own projects. However, this guide is meant to be self-contained so we will continue to use the driver developed in this section. We now move onto creating a blinker. 552 | 553 | ### [Fiat Lux: Blinker](#table-of-contents) 554 | This is our first demo, we will use our PWM to blink an LED; it will light up red, green, blue, then cycle back to red. Let's begin by setting up a directory for our demos, then setup a blinker demo with cabal: 555 | ```console 556 | foo@bar:~/VELDT-getting-started$ mkdir -p demo/blinker && cd demo/blinker 557 | ``` 558 | Once again, we use the [clash-starters simple](https://github.com/clash-lang/clash-starters/blob/main/simple) project as our starting template. Copy the `/bin` directory, `cabal.project`, and `simple.cabal`. Be sure to update the project name and dependencies. 559 | 560 | Your `cabal.project` file should look similar, note we also include the `veldt.cabal` file from our library; you may need to change the filepath to `veldt.cabal` depending on your file locations: 561 | ``` 562 | packages: 563 | blinker.cabal, 564 | ../../veldt/veldt.cabal 565 | 566 | package clash-prelude 567 | -- 'large-tuples' generates tuple instances for various classes up to the 568 | -- GHC imposed maximum of 62 elements. This severely slows down compiling 569 | -- Clash, and triggers Template Haskell bugs on Windows. Hence, we disable 570 | -- it by default. This will be the default for Clash >=1.4. 571 | flags: -large-tuples 572 | ``` 573 | Your `blinker.cabal` file should look similar: 574 | ``` 575 | cabal-version: 2.4 576 | name: blinker 577 | version: 0.1.0.0 578 | license-file: LICENSE 579 | author: Standard Semiconductor 580 | maintainer: standard.semiconductor@gmail.com 581 | extra-source-files: CHANGELOG.md 582 | 583 | common common-options 584 | default-extensions: 585 | BangPatterns 586 | BinaryLiterals 587 | ConstraintKinds 588 | DataKinds 589 | DefaultSignatures 590 | DeriveAnyClass 591 | DeriveDataTypeable 592 | DeriveFoldable 593 | DeriveFunctor 594 | DeriveGeneric 595 | DeriveLift 596 | DeriveTraversable 597 | DerivingStrategies 598 | InstanceSigs 599 | KindSignatures 600 | LambdaCase 601 | NoStarIsType 602 | PolyKinds 603 | RankNTypes 604 | ScopedTypeVariables 605 | StandaloneDeriving 606 | TupleSections 607 | TypeApplications 608 | TypeFamilies 609 | TypeOperators 610 | ViewPatterns 611 | 612 | -- TemplateHaskell is used to support convenience functions such as 613 | -- 'listToVecTH' and 'bLit'. 614 | TemplateHaskell 615 | QuasiQuotes 616 | 617 | -- Prelude isn't imported by default as Clash offers Clash.Prelude 618 | NoImplicitPrelude 619 | ghc-options: 620 | -Wall -Wcompat 621 | -haddock 622 | 623 | -- Plugins to support type-level constraint solving on naturals 624 | -fplugin GHC.TypeLits.Extra.Solver 625 | -fplugin GHC.TypeLits.Normalise 626 | -fplugin GHC.TypeLits.KnownNat.Solver 627 | 628 | -- Clash needs access to the source code in compiled modules 629 | -fexpose-all-unfoldings 630 | 631 | -- Worker wrappers introduce unstable names for functions that might have 632 | -- blackboxes attached for them. You can disable this, but be sure to add 633 | -- a no-specialize pragma to every function with a blackbox. 634 | -fno-worker-wrapper 635 | default-language: Haskell2010 636 | build-depends: 637 | base, 638 | Cabal, 639 | mtl, 640 | lens, 641 | interpolate, 642 | veldt, 643 | 644 | -- clash-prelude will set suitable version bounds for the plugins 645 | clash-prelude >= 1.4 && < 1.5, 646 | ghc-typelits-natnormalise, 647 | ghc-typelits-extra, 648 | ghc-typelits-knownnat 649 | 650 | library 651 | import: common-options 652 | exposed-modules: Blinker 653 | default-language: Haskell2010 654 | 655 | -- Builds the executable 'clash', with blinker in scope 656 | executable clash 657 | main-is: bin/Clash.hs 658 | default-language: Haskell2010 659 | Build-Depends: base, clash-ghc, blinker 660 | if !os(Windows) 661 | ghc-options: -dynamic 662 | 663 | -- Builds the executable 'clashi', with blinker in scope 664 | executable clashi 665 | main-is: bin/Clashi.hs 666 | default-language: Haskell2010 667 | if !os(Windows) 668 | ghc-options: -dynamic 669 | build-depends: base, clash-ghc, blinker 670 | ``` 671 | 672 | With that out of the way, let's create a [`Blinker.hs`](demo/blinker/Blinker.hs) file and open the file with a text editor. 673 | ```console 674 | foo@bar:~/VELDT-getting-started/demo/blinker$ touch Blinker.hs 675 | ``` 676 | 677 | We start by naming our module and importing dependencies. 678 | ```haskell 679 | module Blinker where 680 | 681 | import Clash.Prelude 682 | import Clash.Annotations.TH 683 | import Control.Monad.RWS 684 | import Control.Lens hiding (Index) 685 | import qualified Veldt.Counter as C 686 | import qualified Veldt.PWM as P 687 | import qualified Veldt.Ice40.Rgb as R 688 | ``` 689 | Using qualified imports can help to reduce ambiguity and expedite the process of looking up type signatures. `Clash.Annotations.TH` includes functions to name the top entity module which is used for synthesis. Both `Clash.Prelude` and `Control.Lens` export an `Index` type. In order to use the prelude `Index`, we skip importing it from `Control.Lens` with the `hiding` keyword. The [Haskell wiki](https://wiki.haskell.org/Import) has more information concerning imports. 690 | 691 | Let's define some types to get a feel for the state space. 692 | ```haskell 693 | type Byte = BitVector 8 694 | 695 | data Color = Red | Green | Blue 696 | deriving (NFDataX, Generic, Show, Eq, Enum, Bounded) 697 | 698 | data Blinker = Blinker 699 | { _color :: Color 700 | , _redPWM :: P.PWM Byte 701 | , _greenPWM :: P.PWM Byte 702 | , _bluePWM :: P.PWM Byte 703 | , _timer :: Index 24000000 704 | } deriving (NFDataX, Generic) 705 | makeLenses ''Blinker 706 | 707 | mkBlinker :: Blinker 708 | mkBlinker = Blinker 709 | { _color = Red 710 | , _redPWM = P.mkPWM 0xFF 711 | , _greenPWM = P.mkPWM 0 712 | , _bluePWM = P.mkPWM 0 713 | , _timer = 0 714 | } 715 | ``` 716 | The blinker needs a color counter, three PWMs (one to drive each RGB signal), and a timer which will indicate when the color should change. We also create the `mkBlinker` smart constructor which initializes the color to `Red` and sets the red PWM duty cycle to `0xFF` with the other PWM duty cycles to `0` and the timer to `0`. We derive `Eq`, `Bounded` and `Enum` (along with the usual `NFDataX` and `Generic`) for `Color` so we can use functions from `Veldt.Counter`. For example, if we want to change the color from Red to Green, we can use `increment`. Remember `increment` also respects bounds, so incrementing the color `Blue` just wraps back around to `Red`. 717 | 718 | Next, we create a `toPWM` function to convert a `Color` into its RGB triple which we use to set the PWM duty cycles. 719 | ```haskell 720 | toPWM :: Color -> (Byte, Byte, Byte) 721 | toPWM Red = (0xFF, 0, 0 ) 722 | toPWM Green = (0, 0xFF, 0 ) 723 | toPWM Blue = (0, 0, 0xFF) 724 | ``` 725 | The next function `blinkerM` is the core of our demo. Here is the implementation. 726 | ```haskell 727 | blinkerM :: RWS r () Blinker R.Rgb 728 | blinkerM = do 729 | r <- zoom redPWM P.pwm 730 | g <- zoom greenPWM P.pwm 731 | b <- zoom bluePWM P.pwm 732 | t <- timer <<%= C.increment 733 | when (t == maxBound) $ do 734 | c' <- color <%= C.increment 735 | let (redDuty', greenDuty', blueDuty') = toPWM c' 736 | zoom redPWM $ P.setDuty redDuty' 737 | zoom greenPWM $ P.setDuty greenDuty' 738 | zoom bluePWM $ P.setDuty blueDuty' 739 | return (r, g, b) 740 | ``` 741 | First we run each PWM with `pwm` and bind the output `Bit` to `r`, `g`, and `b`. [`zoom`](https://hackage.haskell.org/package/lens-5.0.1/docs/Control-Lens-Combinators.html#v:zoom) allows us to run a monadic action within larger state. 742 | 743 | Next, we `increment` the timer while binding the **old** value to `t` using the [`<<%=`](https://hackage.haskell.org/package/lens-5.0.1/docs/Control-Lens-Operators.html#v:-60--60--37--61-) operator. 744 | 745 | The clock has a frequency of 12Mhz and the timer increments every cycle therefore counting from 0 to 23,999,999 takes two seconds. When `t` is equal to `maxBound` (in this case 23,999,999), we `increment` the `color` and bind the **new** color to `c'` with [`<%=`](https://hackage.haskell.org/package/lens-5.0.1/docs/Control-Lens-Lens.html#v:-60--37--61-). Next we apply `toPWM` and bind the updated duty cycles. Then, we update each PWM duty cycle using `setDuty`. Finally, we `return` the PWM outputs `r`, `g`, and `b` which were bound at the start of `blinkerM`. 746 | 747 | Now we need to run `blinkerM` as a mealy machine. This requires the use of [`mealy`](http://hackage.haskell.org/package/clash-prelude-1.8.1/docs/Clash-Prelude.html#v:mealy) from the Clash Prelude. [`mealy`](http://hackage.haskell.org/package/clash-prelude-1.8.1/docs/Clash-Prelude.html#v:mealy) takes a transfer function of type `s -> i -> (s, o)` and an initial state then produces a function of type `HiddenClockResetEnable dom => Signal dom i -> Signal dom o`. 748 | ```haskell 749 | blinker :: HiddenClockResetEnable dom => Signal dom R.Rgb 750 | blinker = R.rgb $ mealy blinkerMealy mkBlinker $ pure () 751 | where 752 | blinkerMealy s i = let (a, s', ()) = runRWS blinkerM i s 753 | in (s', a) 754 | ``` 755 | First, we transform our `blinkerM :: RWS r () Blinker R.Rgb` into a transfer function `blinkerMealy` with type `Blinker -> () -> (Blinker, R.Rgb)` using `runRWS`. We use the unit `()` to describe no input. Then we use `mkBlinker` to construct the initial state. Finally, we apply a unit signal as input and apply the mealy output directly to the RGB Driver IP. 756 | 757 | Finally, we define the `topEntity` function which takes a clock as input and outputs a `Signal` of RGB LED driver. 758 | ```haskell 759 | {-# NOINLINE topEntity #-} 760 | topEntity 761 | :: "clk" ::: Clock XilinxSystem 762 | -> "led" ::: Signal XilinxSystem R.Rgb 763 | topEntity clk = withClockResetEnable clk rst enableGen blinker 764 | where 765 | rst = unsafeFromHighPolarity $ pure False 766 | makeTopEntityWithName 'topEntity "Blinker" 767 | ``` 768 | Note, every top entity function has the `NOINLINE` annotation. Although this is a Lattice FPGA, it just so happens that the `XilinxSystem` domain also works. Domains describe things such as reset polarity and clock period and active edge. More information about domains is found in the `Clash.Signal` module. `XilinxSystem` specifies active-high resets, therefore we define a `rst` signal, which is always inactive, by inputting `False` to [`unsafeFromHighPolarity`](http://hackage.haskell.org/package/clash-prelude-1.8.1/docs/Clash-Signal.html#v:withClockResetEnable). 769 | 770 | `blinker` has a `HiddenClockResetEnable` constraint so we use [`withClockResetEnable`](http://hackage.haskell.org/package/clash-prelude-1.8.1/docs/Clash-Signal.html#v:withClockResetEnable) to expose the clock, reset, and enable signals. 771 | 772 | We use the template haskell function [`makeTopEntityWithName`](http://hackage.haskell.org/package/clash-prelude-1.8.1/docs/Clash-Annotations-TH.html#v:makeTopEntityWithName) which will generate synthesis boilerplate and name the top module and its ports in Verilog. The inputs and outputs of the `topEntity` function will be constrained by the `Blinker.pcf`, or pin constraint file. 773 | 774 | Here is the complete `Blinker.hs` source code: 775 | ```haskell 776 | module Blinker where 777 | 778 | import Clash.Prelude 779 | import Clash.Annotations.TH 780 | import Control.Monad.RWS 781 | import Control.Lens hiding (Index) 782 | import qualified Veldt.Counter as C 783 | import qualified Veldt.PWM as P 784 | import qualified Veldt.Ice40.Rgb as R 785 | 786 | type Byte = BitVector 8 787 | 788 | data Color = Red | Green | Blue 789 | deriving (NFDataX, Generic, Show, Eq, Enum, Bounded) 790 | 791 | data Blinker = Blinker 792 | { _color :: Color 793 | , _redPWM :: P.PWM Byte 794 | , _greenPWM :: P.PWM Byte 795 | , _bluePWM :: P.PWM Byte 796 | , _timer :: Index 24000000 797 | } deriving (NFDataX, Generic) 798 | makeLenses ''Blinker 799 | 800 | mkBlinker :: Blinker 801 | mkBlinker = Blinker 802 | { _color = Red 803 | , _redPWM = P.mkPWM 0xFF 804 | , _greenPWM = P.mkPWM 0 805 | , _bluePWM = P.mkPWM 0 806 | , _timer = 0 807 | } 808 | 809 | toPWM :: Color -> (Byte, Byte, Byte) 810 | toPWM Red = (0xFF, 0, 0 ) 811 | toPWM Green = (0, 0xFF, 0 ) 812 | toPWM Blue = (0, 0, 0xFF) 813 | 814 | blinkerM :: RWS r () Blinker R.Rgb 815 | blinkerM = do 816 | r <- zoom redPWM P.pwm 817 | g <- zoom greenPWM P.pwm 818 | b <- zoom bluePWM P.pwm 819 | t <- timer <<%= C.increment 820 | when (t == maxBound) $ do 821 | c' <- color <%= C.increment 822 | let (redDuty', greenDuty', blueDuty') = toPWM c' 823 | zoom redPWM $ P.setDuty redDuty' 824 | zoom greenPWM $ P.setDuty greenDuty' 825 | zoom bluePWM $ P.setDuty blueDuty' 826 | return (r, g, b) 827 | 828 | blinker :: HiddenClockResetEnable dom => Signal dom R.Rgb 829 | blinker = R.rgb $ mealy blinkerMealy mkBlinker $ pure () 830 | where 831 | blinkerMealy s i = let (a, s', ()) = runRWS blinkerM i s 832 | in (s', a) 833 | 834 | {-# NOINLINE topEntity #-} 835 | topEntity 836 | :: "clk" ::: Clock XilinxSystem 837 | -> "led" ::: Signal XilinxSystem R.Rgb 838 | topEntity clk = withClockResetEnable clk rst enableGen blinker 839 | where 840 | rst = unsafeFromHighPolarity $ pure False 841 | makeTopEntityWithName 'topEntity "Blinker" 842 | ``` 843 | 844 | We need a `.pcf` file to connect the FPGA ports to our design ports. Keep in mind that `Rgb` is annotated with `red`, `green`, and `blue`. Thus, our only input is `clk`, and our three outputs are `led_red`, `led_green`, `led_blue`. Here is the [Blinker.pcf](demo/blinker/Blinker.pcf). 845 | ``` 846 | set_io clk 35 # iot_46b_g0 12Mhz Xtal 847 | 848 | set_io led_blue 41 # rgb2 blue 849 | set_io led_green 40 # rgb1 green 850 | set_io led_red 39 # rgb0 red 851 | ``` 852 | The `#` indicates anything after it is a comment. We provide a [default pin constraint file](demo/pcf_generic.pcf) with helpful comments in the [demo](demo/) directory; just remove the first `#` and change the pin name to suit your design. 853 | 854 | Finally, we provide a [Makefile](demo/blinker/Makefile) along with a [generic version](demo/Makefile_generic) in the [demo](demo/) directory. This automates building the Haskell code with cabal, compiling with Clash, synthesizing with Yosys, place-and-route with NextPNR, bitstream packing with icepack, and bitstream programming with iceprog. Specifically, `make build` just calls `cabal build`, `make` will build with cabal, synthesize, and place-and-route. `make prog` will program the bitstream to VELDT. `make clean` cleans synthesis files while `make clean-all` will also clean the cabal build cache. Information about automatic variables such as `$<` and `$@` can be found [here](https://www.gnu.org/software/make/manual/html_node/Automatic-Variables.html). Be sure `TOP` is assigned the same value as provided to `makeTopEntityWithName`. 855 | ```make 856 | TOP := Blinker 857 | 858 | all: $(TOP).bin 859 | 860 | $(TOP).bin: $(TOP).asc 861 | icepack $< $@ 862 | 863 | $(TOP).asc: $(TOP).json $(TOP).pcf 864 | nextpnr-ice40 --up5k --package sg48 --pcf $(TOP).pcf --asc $@ --json $< 865 | 866 | $(TOP).json: $(TOP).hs 867 | cabal run clash --write-ghc-environment-files=always -- $(TOP) --verilog 868 | yosys -q -p "synth_ice40 -top $(TOP) -json $@ -abc2" verilog/$(TOP).topEntity/*.v 869 | 870 | prog: $(TOP).bin 871 | iceprog $< 872 | 873 | build: $(TOP).hs 874 | cabal build $< 875 | 876 | clean: 877 | rm -rf verilog/ 878 | rm -f $(TOP).json 879 | rm -f $(TOP).asc 880 | rm -f $(TOP).bin 881 | rm -f *~ 882 | rm -f *.hi 883 | rm -f *.o 884 | rm -f *.dyn_hi 885 | rm -f *.dyn_o 886 | 887 | clean-all: 888 | $(MAKE) clean 889 | cabal clean 890 | 891 | .PHONY: all clean clean-all prog build 892 | ``` 893 | 894 | To end this section, we build, synthesize, place-and-route, pack, and program VELDT. There should be no build errors. Verify your device utilisation looks similar, including usage of SB_RGBA_DRV. 895 | 896 | Before programming, make sure VELDT is connected to your computer, the power switch is ON, and the mode switch is set to FLASH. After programming, make sure the LED blinks with the correct color order with the intended 2 second period. If the CDONE LED is not illuminated blue, try pressing the reset button and/or toggling the power switch. If you have any issues, questions, or suggestions please open a public issue in this repository or contact us privately at standard.semiconductor@gmail.com. 897 | ```console 898 | foo@bar:~/VELDT-getting-started/demo/blinker$ make clean-all && make prog 899 | ..... 900 | Info: Device utilisation: 901 | Info: ICESTORM_LC: 161/ 5280 3% 902 | Info: ICESTORM_RAM: 0/ 30 0% 903 | Info: SB_IO: 1/ 96 1% 904 | Info: SB_GB: 3/ 8 37% 905 | Info: ICESTORM_PLL: 0/ 1 0% 906 | Info: SB_WARMBOOT: 0/ 1 0% 907 | Info: ICESTORM_DSP: 0/ 8 0% 908 | Info: ICESTORM_HFOSC: 0/ 1 0% 909 | Info: ICESTORM_LFOSC: 0/ 1 0% 910 | Info: SB_I2C: 0/ 2 0% 911 | Info: SB_SPI: 0/ 2 0% 912 | Info: IO_I3C: 0/ 2 0% 913 | Info: SB_LEDDA_IP: 0/ 1 0% 914 | Info: SB_RGBA_DRV: 1/ 1 100% 915 | Info: ICESTORM_SPRAM: 0/ 4 0% 916 | ..... 917 | ``` 918 | You can find the blinker demo [here](demo/blinker). Here is a demo video: 919 | 920 | ![](demo/blinker/blinker.gif) 921 | ## [Section 3: Roar](#table-of-contents) 922 | 923 | > Remarkable how the nursery caught the telepathic emanations of the children’s minds and created life to fill their every desire. The children thought lions, and there were lions. The children thought zebras, and there were zebras. Sun—sun. Giraffes—giraffes. 924 | 925 | > *The Veldt* by Ray Bradbury 926 | 927 | In this section we start by building a serializer and deserializer. Then, with a serializer and deserializer along with a counter we construct a UART (Universal Asynchronous Receiver Transmitter). Equipped with our UART, we create a demo which echoes its input. 928 | ### [Serial for Breakfast](#table-of-contents) 929 | Let's begin by creating a file `Serial.hs` in the `Veldt` directory. 930 | ```console 931 | foo@bar:~/VELDT-getting-started/veldt$ touch Veldt/Serial.hs 932 | ``` 933 | Now expose the module with `veldt.cabal`. Your `exposed-modules` section should look similar. 934 | ``` 935 | ..... 936 | exposed-modules: Veldt.Counter, 937 | Veldt.PWM, 938 | Veldt.Serial, 939 | Veldt.Ice40.Rgb 940 | ..... 941 | ``` 942 | Let's begin editing the `Serial.hs` file. Fundamentally, we represent serializers and deserializers with a counter and a `Vec` from [Clash.Sized.Vector](http://hackage.haskell.org/package/clash-prelude-1.8.1/docs/Clash-Sized-Vector.html). This means we will be able to serialize or deserialize in two directions say left or right e.g. for a deserializer we could add elements at the beginning (left) or end (right) of the `Vec`. Additionally, we use a flag to indicate whether a deserializer is full or a serializer is empty. 943 | ```haskell 944 | module Veldt.Serial 945 | ( Direction(..) 946 | -- Deserializer 947 | , Deserializer 948 | , mkDeserializer 949 | , full 950 | , deserialize 951 | , get 952 | , clear 953 | -- Serializer 954 | , Serializer 955 | , mkSerializer 956 | , empty 957 | , serialize 958 | , peek 959 | , give 960 | ) where 961 | 962 | import Clash.Prelude hiding (empty) 963 | import Control.Monad.RWS (RWST) 964 | import Control.Lens hiding (Index) 965 | import qualified Veldt.Counter as C 966 | ``` 967 | With a deserializer we are able to: 968 | 1. construct it with `mkDeserializer` 969 | 2. check if it is full 970 | 3. `deserialize` data, shifting it into the vector and incrementing the counter. 971 | 4. `get` the `Vec` of elements of the deserializer 972 | 5. `clear` the full flag and reset the counter 973 | 974 | Similarly with a serializer we are able to: 975 | 1. construct it with `mkSerializer` 976 | 2. check if it is empty 977 | 3. `serialize` data, shifting either left or right depending on the direction and incrementing the counter 978 | 4. `peek` at the element to serialize 979 | 5. `give` new data to the serializer and reset the counter 980 | 981 | Before we dive into the serializer and deserializer, let's first define a `Direction` type with two inhabitants `L` and `R`, representing left and right respectively. 982 | ```haskell 983 | data Direction = L | R 984 | deriving (NFDataX, Generic) 985 | ``` 986 | 987 | We start with defining a deserializer state parameterized by its size and the type it can "buffer" along with a smart constructor. 988 | ```haskell 989 | data Deserializer n a = Deserializer 990 | { _dBuf :: Vec n a 991 | , _dFull :: Bool 992 | , _dCtr :: Index n 993 | , _dDir :: Direction 994 | } deriving (NFDataX, Generic) 995 | makeLenses ''Deserializer 996 | 997 | mkDeserializer :: KnownNat n => a -> Direction -> Deserializer n a 998 | mkDeserializer a = Deserializer (repeat a) False 0 999 | ``` 1000 | The `Deserializer` has four components: 1001 | 1. a buffer `_dBuf` which is a `Vec` to hold the data as it is deserialized 1002 | 2. a full flag `_dFull` which will be set when the deserializer is full 1003 | 3. a counter `_dCtr` with the same "size" as `_dBuf`, which keeps track of how much data has been deserialized; when the counter is `maxBound` the deserializer is flagged as full. 1004 | 4. a `Direction` `_dDir` which indicates whether data is shifted-in to the front or back of `_dBuf`. 1005 | 1006 | To construct a deserializer we need to specify a default value to initially populate `_dBuf` and a `Direction`. Initially, the full flag is set to `False` and the counter is `0`. 1007 | 1008 | Let's implement the deserializer interface. 1009 | ```haskell 1010 | full :: (Monoid w, Monad m) => RWST r w (Deserializer n a) m Bool 1011 | full = use dFull 1012 | 1013 | deserialize :: (Monoid w, Monad m, KnownNat n) => a -> RWST r w (Deserializer n a) m () 1014 | deserialize d = do 1015 | use dDir >>= \case 1016 | R -> dBuf %= (<<+ d) 1017 | L -> dBuf %= (d +>>) 1018 | dFull <~ uses dCtr (== maxBound) 1019 | dCtr %= C.increment 1020 | 1021 | get :: (Monoid w, Monad m) => RWST r w (Deserializer n a) m (Vec n a) 1022 | get = use dBuf 1023 | 1024 | clear :: (Monoid w, Monad m, KnownNat n) => RWST r w (Deserializer n a) m () 1025 | clear = do 1026 | dFull .= False 1027 | dCtr .= 0 1028 | ``` 1029 | The `full` function simply returns the `dFull` value of the current state; `True` if the deserializer is full or `False` otherwise. Likewise, the `get` function returns the `dBuf` vector of the current state and the `clear` function sets `dFull` to `False` (meaning empty) and resets the `dCtr` counter to 0. 1030 | 1031 | The most important function `deserialize` takes a value, then adds it to either the head or tail of the `dBuf` vector. If the value of `dCtr` is equal to its maximum bound then set `dFull` to `True`, otherwise `False`. Finally, increment `dCtr`; remember `dCtr` will roll over to `0` if equal to max bound. Note [`<~`](https://hackage.haskell.org/package/lens-4.19.2/docs/Control-Lens-Operators.html#v:-60--126-) sets the target of the lens to the result of a monadic action. 1032 | 1033 | Next, we implement a serializer. Let's start with the state type and constructor. 1034 | ```haskell 1035 | data Serializer n a = Serializer 1036 | { _sBuf :: Vec n a 1037 | , _sEmpty :: Bool 1038 | , _sCtr :: Index n 1039 | , _sDir :: Direction 1040 | } deriving (NFDataX, Generic) 1041 | makeLenses ''Serializer 1042 | 1043 | mkSerializer :: KnownNat n => a -> Direction -> Serializer n a 1044 | mkSerializer a = Serializer (repeat a) True 0 1045 | ``` 1046 | The serializer state type is similar to the deserializer except the `Bool` flag tracks when the serializer is empty (as opposed to full in the deserializer). 1047 | 1048 | Let's implement the serializer interface `serialize`, `peek`, `give`, and `empty`: 1049 | ```haskell 1050 | serialize :: (Monoid w, Monad m, KnownNat n) => RWST r w (Serializer n a) m () 1051 | serialize = do 1052 | use sDir >>= \case 1053 | R -> sBuf %= (`rotateRightS` d1) 1054 | L -> sBuf %= (`rotateLeftS` d1) 1055 | sEmpty <~ uses sCtr (== maxBound) 1056 | sCtr %= C.increment 1057 | 1058 | peek :: (Monoid w, Monad m, KnownNat n) => RWST r w (Serializer (n + 1) a) m a 1059 | peek = use sDir >>= \case 1060 | R -> uses sBuf last 1061 | L -> uses sBuf head 1062 | 1063 | give :: (Monoid w, Monad m, KnownNat n) => Vec n a -> RWST r w (Serializer n a) m () 1064 | give v = do 1065 | sBuf .= v 1066 | sEmpty .= False 1067 | sCtr .= 0 1068 | 1069 | empty :: (Monoid w, Monad m) => RWST r w (Serializer n a) m Bool 1070 | empty = use sEmpty 1071 | ``` 1072 | `empty` is similar to `full`, in that we just return the flag. `give` first sets the buffer to the function input `v`, then sets the empty flag to false (meaning the serializer is full) and finally we reset the counter to 0. `peek` returns either the `head` or `last` element of the buffer, depending on the serializer direction. This is useful because sometimes we just want to know what value to serialize without actually changing the underlying buffer. If we do want to update the underlying buffer, use `serialize` which rotates the buffer depending on the direction, then updates the empty flag, and finally increments the counter. 1073 | 1074 | Here is the complete [Serial.hs](veldt/Veldt/Serial.hs) source code: 1075 | ```haskell 1076 | module Veldt.Serial 1077 | ( Direction(..) 1078 | -- Deserializer 1079 | , Deserializer 1080 | , mkDeserializer 1081 | , full 1082 | , deserialize 1083 | , get 1084 | , clear 1085 | -- Serializer 1086 | , Serializer 1087 | , mkSerializer 1088 | , empty 1089 | , serialize 1090 | , peek 1091 | , give 1092 | ) where 1093 | 1094 | import Clash.Prelude hiding (empty) 1095 | import Control.Monad.RWS (RWST) 1096 | import Control.Lens hiding (Index) 1097 | import qualified Veldt.Counter as C 1098 | 1099 | data Direction = L | R 1100 | deriving (NFDataX, Generic) 1101 | 1102 | ------------------ 1103 | -- Deserializer -- 1104 | ------------------ 1105 | data Deserializer n a = Deserializer 1106 | { _dBuf :: Vec n a 1107 | , _dFull :: Bool 1108 | , _dCtr :: Index n 1109 | , _dDir :: Direction 1110 | } deriving (NFDataX, Generic) 1111 | makeLenses ''Deserializer 1112 | 1113 | mkDeserializer :: KnownNat n => a -> Direction -> Deserializer n a 1114 | mkDeserializer a = Deserializer (repeat a) False 0 1115 | 1116 | full :: (Monoid w, Monad m) => RWST r w (Deserializer n a) m Bool 1117 | full = use dFull 1118 | 1119 | deserialize :: (Monoid w, Monad m, KnownNat n) => a -> RWST r w (Deserializer n a) m () 1120 | deserialize d = do 1121 | use dDir >>= \case 1122 | R -> dBuf %= (<<+ d) 1123 | L -> dBuf %= (d +>>) 1124 | dFull <~ uses dCtr (== maxBound) 1125 | dCtr %= C.increment 1126 | 1127 | get :: (Monoid w, Monad m) => RWST r w (Deserializer n a) m (Vec n a) 1128 | get = use dBuf 1129 | 1130 | clear :: (Monoid w, Monad m, KnownNat n) => RWST r w (Deserializer n a) m () 1131 | clear = do 1132 | dFull .= False 1133 | dCtr .= 0 1134 | 1135 | ---------------- 1136 | -- Serializer -- 1137 | ---------------- 1138 | data Serializer n a = Serializer 1139 | { _sBuf :: Vec n a 1140 | , _sEmpty :: Bool 1141 | , _sCtr :: Index n 1142 | , _sDir :: Direction 1143 | } deriving (NFDataX, Generic) 1144 | makeLenses ''Serializer 1145 | 1146 | mkSerializer :: KnownNat n => a -> Direction -> Serializer n a 1147 | mkSerializer a = Serializer (repeat a) True 0 1148 | 1149 | serialize :: (Monoid w, Monad m, KnownNat n) => RWST r w (Serializer n a) m () 1150 | serialize = do 1151 | use sDir >>= \case 1152 | R -> sBuf %= (`rotateRightS` d1) 1153 | L -> sBuf %= (`rotateLeftS` d1) 1154 | sEmpty <~ uses sCtr (== maxBound) 1155 | sCtr %= C.increment 1156 | 1157 | peek :: (Monoid w, Monad m, KnownNat n) => RWST r w (Serializer (n + 1) a) m a 1158 | peek = use sDir >>= \case 1159 | R -> uses sBuf last 1160 | L -> uses sBuf head 1161 | 1162 | give :: (Monoid w, Monad m, KnownNat n) => Vec n a -> RWST r w (Serializer n a) m () 1163 | give v = do 1164 | sBuf .= v 1165 | sEmpty .= False 1166 | sCtr .= 0 1167 | 1168 | empty :: (Monoid w, Monad m) => RWST r w (Serializer n a) m Bool 1169 | empty = use sEmpty 1170 | ``` 1171 | To end this part, we rebuild the library. There should not be any errors. 1172 | ```console 1173 | foo@bar:~/VELDT-getting-started/veldt$ cabal build 1174 | ... 1175 | Building library for veldt-0.1.0.0.. 1176 | [1 of 4] Compiling Veldt.Counter ... 1177 | [2 of 4] Compiling Veldt.Ice40.Rgb ... 1178 | [3 of 4] Compiling Veldt.PWM ... 1179 | [4 of 4] Compiling Veldt.Serial ... 1180 | ``` 1181 | In the next part we develop a UART. 1182 | 1183 | ### [UART My Art](#table-of-contents) 1184 | Before diving into this section, it may be helpful to familiarize yourself with UART by browsing the [Wikipedia page](https://en.wikipedia.org/wiki/Universal_asynchronous_receiver-transmitter). Let's create a `Uart.hs` file. 1185 | ```console 1186 | foo@bar:~/VELDT-getting-started/veldt$ touch Veldt/Uart.hs 1187 | ``` 1188 | Next add the `Veldt.Uart` module to our `veldt.cabal` `exposed-modules` list: 1189 | ``` 1190 | ... 1191 | exposed-modules: Veldt.Counter, 1192 | Veldt.PWM, 1193 | Veldt.Serial, 1194 | Veldt.Uart, 1195 | Veldt.Ice40.Rgb 1196 | ... 1197 | ``` 1198 | Now open `Uart.hs` with a text editor. We begin by naming the module, specifying the API, and importing dependencies. 1199 | ```haskell 1200 | module Veldt.Uart 1201 | ( Rx(Rx) 1202 | , unRx 1203 | , Tx(Tx) 1204 | , unTx 1205 | , Byte 1206 | , Uart 1207 | , mkUart 1208 | -- API 1209 | , read 1210 | , write 1211 | ) where 1212 | 1213 | import Clash.Prelude hiding (read) 1214 | import Control.Monad.RWS 1215 | import Control.Lens hiding ((:>)) 1216 | import qualified Veldt.Counter as C 1217 | import qualified Veldt.Serial as S 1218 | ``` 1219 | The API consists of `read` and `write` which will receive and transmit `Byte`s over the `Tx` and `Rx` wires. We also export the `Uart` type and its smart constructor `mkUart`. In order to implement the API we will need a `Counter` for the baud rate and a serializer and deserializer for receiving and transmitting bits, so we import the `Veldt.Counter` and `Veldt.Serial` modules. Let's define some types: 1220 | ```haskell 1221 | type Byte = BitVector 8 1222 | 1223 | newtype Rx = Rx { unRx :: Bit } 1224 | newtype Tx = Tx { unTx :: Bit } 1225 | 1226 | instance Semigroup Tx where 1227 | Tx tx <> Tx tx' = Tx $ tx .&. tx' 1228 | 1229 | instance Monoid Tx where 1230 | mempty = Tx 1 1231 | ``` 1232 | We want to be able to `read` and `write` bytes over UART so first we define a `Byte` type synonym for `BitVector 8` to save some keystrokes. Next we define the `Rx` and `Tx` newtypes which wrap `Bit`. Defining `Tx` as a newtype over `Bit` is important because we want to use it with the writer monad of `RWS`. The writer monad has a `Monoid` constraint so we make `Tx` an instance of `Semigroup` and `Monoid`. The `Tx` semigroup uses `.&.` (bitwise AND) as its product and `1` as its unit. We use `1` as the unit because when the UART is idle, it should drive the tx line high, indicating there is nothing to send. We now move onto creating a transmitter. Let's start by defining its types. 1233 | ```haskell 1234 | data TxFsm = TxStart | TxSend 1235 | deriving (NFDataX, Generic) 1236 | 1237 | data Transmitter = Transmitter 1238 | { _txSer :: S.Serializer 10 Bit 1239 | , _txBaud :: Unsigned 16 1240 | , _txCtr :: Unsigned 16 1241 | , _txFsm :: TxFsm 1242 | } 1243 | deriving (NFDataX, Generic) 1244 | makeLenses ''Transmitter 1245 | 1246 | mkTransmitter :: Unsigned 16 -> Transmitter 1247 | mkTransmitter b = Transmitter 1248 | { _txSer = S.mkSerializer 0 S.R 1249 | , _txBaud = b 1250 | , _txCtr = 0 1251 | , _txFsm = TxStart 1252 | } 1253 | ``` 1254 | The transmission of a byte occurs over two states. We represent the states `TxStart` and `TxSend` as the `TxFsm` type. The `TxStart` state will setup the transmission then the `TxSend` state will serialize a frame. Finite state machines are very easy and expressive with Haskell and we use the pattern for both transmitting and receiving bytes. Now that we have our machine states, we can define the `Transmitter` state. It has four components: 1255 | 1. a serializer `_txSer` which we use to transmit a frame one bit at a time 1256 | 2. a baud rate `_txBaud` which determines how many clock cycles each bit requires for transmission. 1257 | 3. a counter `_txCtr` which acts as the timer to count clock cycles for each bit. 1258 | 4. a finite state machine `_txFsm` which indicates the state the transmitter is in currently; either `TxStart` or `TxSend`. 1259 | 1260 | Let's also define a `Transmitter` smart constructor `mkTransmitter`. It will take a baud rate as input. Note, `_txSer` is a right serializer, `_txCtr` starts at zero, and the initial `_txFsm` state is `TxStart`. 1261 | 1262 | We now implement the `transmit` function: 1263 | ```haskell 1264 | transmit :: Byte -> RWS r Tx Transmitter Bool 1265 | transmit byte = use txFsm >>= \case 1266 | TxStart -> do 1267 | zoom txSer $ S.give $ bv2v $ frame byte 1268 | txCtr .= 0 1269 | txFsm .= TxSend 1270 | return False 1271 | TxSend -> do 1272 | zoom txSer S.peek >>= tell . Tx 1273 | baud <- use txBaud 1274 | ctrDone <- uses txCtr (== baud) 1275 | txCtr %= C.incrementUnless (== baud) 1276 | if ctrDone 1277 | then do 1278 | zoom txSer S.serialize 1279 | serEmpty <- zoom txSer S.empty 1280 | when serEmpty $ txFsm .= TxStart 1281 | return serEmpty 1282 | else return False 1283 | 1284 | frame :: Byte -> BitVector 10 1285 | frame b = (1 :: BitVector 1) ++# b ++# (0 :: BitVector 1) 1286 | ``` 1287 | We do case analysis on `txFsm`: 1288 | 1. If `txFsm` is `TxStart` we `frame` the input byte, transform it into a `Vec` of `Bit`s (note this reverses the bits), then `give` it to the serializer `_txSer`. We also set the counter `_txCtr` to zero, update `txFsm` to the `TxSend` state, and return `False` which indicates the transmit is in progress. 1289 | 2. If `txFsm` is `TxSend`, first we `peek` at the current bit to serialize, wrap it in a `Tx` type, then pass it to `tell` which transmits the bit via the writer monad. Then we update the baud counter `txCtr`. If the baud counter is done then we `serialize`. Then if `txSer` is empty, set `txFsm` back to `TxStart`, and return the empty flag. When the serializer is empty, `transmit` returns `True` (indicating the transmission is finished). If the baud counter is not done, return False (indicating transmission is busy). 1290 | 1291 | Note, we have to `frame` a byte before sending it, this means adding a start bit and an end bit. The start bit is `0` and the end bit is `1`. Our frame function takes into account that `bv2v` reverses the bits, thus the start bit in `frame` is added to the end of the byte and the stop bit is added to the beginning. 1292 | 1293 | Next we tackle the receiver, beginning with the types: 1294 | ```haskell 1295 | data RxFsm = RxIdle | RxStart | RxRecv | RxStop 1296 | deriving (NFDataX, Generic) 1297 | 1298 | data Receiver = Receiver 1299 | { _rxDes :: S.Deserializer 8 Bit 1300 | , _rxBaud :: Unsigned 16 1301 | , _rxCtr :: Unsigned 16 1302 | , _rxFsm :: RxFsm 1303 | } 1304 | deriving (NFDataX, Generic) 1305 | makeLenses ''Receiver 1306 | 1307 | mkReceiver :: Unsigned 16 -> Receiver 1308 | mkReceiver b = Receiver 1309 | { _rxDes = S.mkDeserializer 0 S.L 1310 | , _rxBaud = b 1311 | , _rxCtr = 0 1312 | , _rxFsm = RxIdle 1313 | } 1314 | ``` 1315 | The receiver is a four-state finite-state machine (FSM). The receiver state has four parts, each of which are made into lenses with `makeLenses`: 1316 | 1. an 8-bit deserializer `_rxDes` to buffer incoming bits from the RX wire. 1317 | 2. a baud rate `_rxBaud` 1318 | 3. a baud counter `_rxCtr` 1319 | 4. a fsm `_rxFsm` 1320 | 1321 | We define a smart constructor `mkReceiver` which only takes a baud rate. It intializes the deserializer with direction left `L`, and all bits are zero. It sets the baud rate to the input. The baud counter `_rxCtr` starts at zero and the `_rxFsm` FSM starts in the `RxIdle` state. 1322 | 1323 | Now we define and implement the receiver: 1324 | ```haskell 1325 | receive :: Monoid w => RWS Rx w Receiver (Maybe Byte) 1326 | receive = use rxFsm >>= \case 1327 | RxIdle -> do 1328 | rxLow <- asks $ (== low) . unRx 1329 | when rxLow $ do 1330 | rxCtr %= C.increment 1331 | rxFsm .= RxStart 1332 | return Nothing 1333 | RxStart -> do 1334 | rxLow <- asks $ (== low) . unRx 1335 | baudHalf <- uses rxBaud (`shiftR` 1) 1336 | ctrDone <- uses rxCtr (== baudHalf) 1337 | rxCtr %= C.incrementUnless (== baudHalf) 1338 | when ctrDone $ if rxLow 1339 | then rxFsm .= RxRecv 1340 | else rxFsm .= RxIdle 1341 | return Nothing 1342 | RxRecv -> do 1343 | ctrDone <- countBaud 1344 | when ctrDone $ do 1345 | i <- asks unRx 1346 | zoom rxDes $ S.deserialize i 1347 | full <- zoom rxDes S.full 1348 | when full $ rxFsm .= RxStop 1349 | return Nothing 1350 | RxStop -> do 1351 | ctrDone <- countBaud 1352 | if ctrDone 1353 | then do 1354 | byte <- v2bv <$> zoom rxDes S.get 1355 | zoom rxDes S.clear 1356 | rxFsm .= RxIdle 1357 | return $ Just byte 1358 | else return Nothing 1359 | where 1360 | countBaud = do 1361 | baud <- use rxBaud 1362 | ctrDone <- uses rxCtr (== baud) 1363 | rxCtr %= C.incrementUnless (== baud) 1364 | return ctrDone 1365 | ``` 1366 | Note the `countBaud` function, it gets the baud rate `_rxBaud` and checks if it is equal to `_rxCtr`, binding the result to `ctrDone`. If the counter is not equal to the baud rate, we increment. Finally, the function returns `ctrDone`. This function is used in each of the receiver states to indicate when to sample the RX wire. 1367 | 1368 | The receiver starts with case analysis on `_rxFsm`: 1369 | 1. `RxIdle` is the initial state. We simply wait until the RX wire goes low. When this happens, the receiver increments it's baud counter and sets `_rxFsm` to `RxStart`. This state always returns `Nothing` because there is no byte received yet. 1370 | 2. `RxStart` verifies the start bit. It waits until the `_rxCtr` is half the baud rate then checks if the RX wire is still low. If the RX wire is still low, we set `_rxFsm` to the next state `RxRecv`, otherwise the receiver should go back to idling due to an inconsistent start bit. Note when the counter reaches half the baud rate, using `incrementUnless (== baudHalf)` will reset the `_rxCtr` to zero. This state always returns `Nothing` because there is no byte received yet. 1371 | 3. `RxRecv` counts up to the baud rate with `countBaud`. When `ctrDone` is true, we sample the RX wire and `deserialize` it. If the deserializer is full, then we set `_rxFsm` to `RxStop`, otherwise we will stay in the `RxRecv` state to sample another bit. This state always returns `Nothing` because we have not yet counted the stop bit. 1372 | 4. `RxStop` counts up to the baud rate with `countBaud`. When `ctrDone` is false, we return `Nothing` because the stop bit has not yet been verified. When `ctrDone` is true, we retrieve the byte from the deserializer, `clear` the deserializer for further use, set `_rxFsm` back to `RxIdle`, and return `Just` the byte. 1373 | 1374 | ``` 1375 | RX Start Bit 0 Bit1 Bit2 Bit3 Bit4 Bit5 Bit6 Bit7 Stop 1376 | --------------- --------- -------- ------- ------- -------- ----------------- 1377 | |_______| |_______ _______| |_______| 1378 | <^RxIdle ^RxRecv ^RxRecv ^RxRecv ^RxRecv ^RxStop > RxIdle 1379 | ^RxStart ^RxRecv ^RxRecv ^RxRecv ^RxRecv 1380 | 1381 | ``` 1382 | Note that we sample in the "middle" of each bit. This helps to guarantee that our UART doesn't jumble the bits. Each `^RxRecv` will be `baudRate` clock cycles apart. We will see in the next section how to calculate a working baud rate for our UART given the 12Mhz crystal provided by VELDT. 1383 | 1384 | The last part of the UART module combines both receiver and transmitter and defines a clear API: 1385 | ```haskell 1386 | data Uart = Uart 1387 | { _receiver :: Receiver 1388 | , _transmitter :: Transmitter 1389 | } 1390 | deriving (NFDataX, Generic) 1391 | makeLenses ''Uart 1392 | 1393 | mkUart :: Unsigned 16 -> Uart 1394 | mkUart baud = Uart 1395 | { _receiver = mkReceiver baud 1396 | , _transmitter = mkTransmitter baud 1397 | } 1398 | 1399 | read :: Monoid w => RWS Rx w Uart (Maybe Byte) 1400 | read = zoom receiver receive 1401 | 1402 | write :: Byte -> RWS r Tx Uart Bool 1403 | write = zoom transmitter . transmit 1404 | ``` 1405 | The `Uart` state type consists of a receiver and a transmitter. We define a smart constructor `mkUart` which takes a baud rate and constructs both the receiver and transmitter with the same baud rate. Next we define a `read` function which just `zoom`s into the receiver. When the `read` function is busy it returns `Nothing`, when it has a byte it returns `Just` that byte. Finally, the `write` function `zoom`s into the transmitter. It returns `False` when busy sending and `True` when it is done. 1406 | 1407 | Here is the full [`Uart.hs`](veldt/Veldt/Uart.hs) source code: 1408 | ```haskell 1409 | module Veldt.Uart 1410 | ( Rx(Rx) 1411 | , unRx 1412 | , Tx(Tx) 1413 | , unTx 1414 | , Byte 1415 | , Uart 1416 | , mkUart 1417 | , read 1418 | , write 1419 | ) where 1420 | 1421 | import Clash.Prelude hiding (read) 1422 | import Control.Monad.RWS 1423 | import Control.Lens hiding ((:>)) 1424 | import qualified Veldt.Counter as C 1425 | import qualified Veldt.Serial as S 1426 | 1427 | type Byte = BitVector 8 1428 | 1429 | newtype Rx = Rx { unRx :: Bit } 1430 | newtype Tx = Tx { unTx :: Bit } 1431 | 1432 | instance Semigroup Tx where 1433 | Tx tx <> Tx tx' = Tx $ tx .&. tx' 1434 | 1435 | instance Monoid Tx where 1436 | mempty = Tx 1 1437 | 1438 | ----------------- 1439 | -- Transmitter -- 1440 | ----------------- 1441 | data TxFsm = TxStart | TxSend 1442 | deriving (NFDataX, Generic) 1443 | 1444 | data Transmitter = Transmitter 1445 | { _txSer :: S.Serializer 10 Bit 1446 | , _txBaud :: Unsigned 16 1447 | , _txCtr :: Unsigned 16 1448 | , _txFsm :: TxFsm 1449 | } 1450 | deriving (NFDataX, Generic) 1451 | makeLenses ''Transmitter 1452 | 1453 | mkTransmitter :: Unsigned 16 -> Transmitter 1454 | mkTransmitter b = Transmitter 1455 | { _txSer = S.mkSerializer 0 S.R 1456 | , _txBaud = b 1457 | , _txCtr = 0 1458 | , _txFsm = TxStart 1459 | } 1460 | 1461 | transmit :: Byte -> RWS r Tx Transmitter Bool 1462 | transmit byte = use txFsm >>= \case 1463 | TxStart -> do 1464 | zoom txSer $ S.give $ bv2v $ frame byte 1465 | txCtr .= 0 1466 | txFsm .= TxSend 1467 | return False 1468 | TxSend -> do 1469 | zoom txSer S.peek >>= tell . Tx 1470 | baud <- use txBaud 1471 | ctrDone <- uses txCtr (== baud) 1472 | txCtr %= C.incrementUnless (== baud) 1473 | if ctrDone 1474 | then do 1475 | zoom txSer S.serialize 1476 | serEmpty <- zoom txSer S.empty 1477 | when serEmpty $ txFsm .= TxStart 1478 | return serEmpty 1479 | else return False 1480 | 1481 | frame :: Byte -> BitVector 10 1482 | frame b = (1 :: BitVector 1) ++# b ++# (0 :: BitVector 1) 1483 | 1484 | -------------- 1485 | -- Receiver -- 1486 | -------------- 1487 | data RxFsm = RxIdle | RxStart | RxRecv | RxStop 1488 | deriving (NFDataX, Generic) 1489 | 1490 | data Receiver = Receiver 1491 | { _rxDes :: S.Deserializer 8 Bit 1492 | , _rxBaud :: Unsigned 16 1493 | , _rxCtr :: Unsigned 16 1494 | , _rxFsm :: RxFsm 1495 | } 1496 | deriving (NFDataX, Generic) 1497 | makeLenses ''Receiver 1498 | 1499 | mkReceiver :: Unsigned 16 -> Receiver 1500 | mkReceiver b = Receiver 1501 | { _rxDes = S.mkDeserializer 0 S.L 1502 | , _rxBaud = b 1503 | , _rxCtr = 0 1504 | , _rxFsm = RxIdle 1505 | } 1506 | 1507 | receive :: Monoid w => RWS Rx w Receiver (Maybe Byte) 1508 | receive = use rxFsm >>= \case 1509 | RxIdle -> do 1510 | rxLow <- asks $ (== low) . unRx 1511 | when rxLow $ do 1512 | rxCtr %= C.increment 1513 | rxFsm .= RxStart 1514 | return Nothing 1515 | RxStart -> do 1516 | rxLow <- asks $ (== low) . unRx 1517 | baudHalf <- uses rxBaud (`shiftR` 1) 1518 | ctrDone <- uses rxCtr (== baudHalf) 1519 | rxCtr %= C.incrementUnless (== baudHalf) 1520 | when ctrDone $ if rxLow 1521 | then rxFsm .= RxRecv 1522 | else rxFsm .= RxIdle 1523 | return Nothing 1524 | RxRecv -> do 1525 | ctrDone <- countBaud 1526 | when ctrDone $ do 1527 | i <- asks unRx 1528 | zoom rxDes $ S.deserialize i 1529 | full <- zoom rxDes S.full 1530 | when full $ rxFsm .= RxStop 1531 | return Nothing 1532 | RxStop -> do 1533 | ctrDone <- countBaud 1534 | if ctrDone 1535 | then do 1536 | byte <- v2bv <$> zoom rxDes S.get 1537 | zoom rxDes S.clear 1538 | rxFsm .= RxIdle 1539 | return $ Just byte 1540 | else return Nothing 1541 | where 1542 | countBaud = do 1543 | baud <- use rxBaud 1544 | ctrDone <- uses rxCtr (== baud) 1545 | rxCtr %= C.incrementUnless (== baud) 1546 | return ctrDone 1547 | 1548 | ---------- 1549 | -- Uart -- 1550 | ---------- 1551 | data Uart = Uart 1552 | { _receiver :: Receiver 1553 | , _transmitter :: Transmitter 1554 | } 1555 | deriving (NFDataX, Generic) 1556 | makeLenses ''Uart 1557 | 1558 | mkUart :: Unsigned 16 -> Uart 1559 | mkUart baud = Uart 1560 | { _receiver = mkReceiver baud 1561 | , _transmitter = mkTransmitter baud 1562 | } 1563 | 1564 | read :: Monoid w => RWS Rx w Uart (Maybe Byte) 1565 | read = zoom receiver receive 1566 | 1567 | write :: Byte -> RWS r Tx Uart Bool 1568 | write = zoom transmitter . transmit 1569 | ``` 1570 | To end this part, we rebuild the library. There should not be any errors. 1571 | ```console 1572 | foo@bar:~/VELDT-getting-started/veldt$ cabal build 1573 | ... 1574 | Building library for veldt-0.1.0.0.. 1575 | [1 of 4] Compiling Veldt.Counter ... 1576 | [2 of 4] Compiling Veldt.Ice40.Rgb ... 1577 | [3 of 4] Compiling Veldt.PWM ... 1578 | [4 of 4] Compiling Veldt.Serial ... 1579 | [5 of 5] Compiling Veldt.UART ... 1580 | ``` 1581 | In the next part we demo our UART! 1582 | 1583 | ### [Roar: Echo](#table-of-contents) 1584 | It's time to demonstrate usage of our UART! We will have it echo our input. First setup the `echo` project directory, we use `blinker` as our template. We need to copy `bin/`, `cabal.project`, and `blinker.cabal`, along with `Makefile_generic` and `pcf_generic` and rename the package to `echo`. 1585 | ```console 1586 | foo@bar:~/VELDT-getting-started/demo$ mkdir echo && cd echo 1587 | foo@bar:~/VELDT-getting-started/demo/echo$ cp -r ../blinker/bin/ . 1588 | foo@bar:~/VELDT-getting-started/demo/echo$ cp ../blinker/cabal.project . 1589 | foo@bar:~/VELDT-getting-started/demo/echo$ cp ../blinker/blinker.cabal echo.cabal 1590 | foo@bar:~/VELDT-getting-started/demo/echo$ cp ../Makefile_generic Makefile 1591 | foo@bar:~/VELDT-getting-started/demo/echo# cp ../pcf_generic Echo.pcf 1592 | ``` 1593 | Update the `cabal.project` file to use our `echo.cabal` file. Your `cabal.project` file should look similar: 1594 | ``` 1595 | packages: 1596 | echo.cabal, 1597 | ../../veldt/veldt.cabal 1598 | 1599 | package clash-prelude 1600 | -- 'large-tuples' generates tuple instances for various classes up to the 1601 | -- GHC imposed maximum of 62 elements. This severely slows down compiling 1602 | -- Clash, and triggers Template Haskell bugs on Windows. Hence, we disable 1603 | -- it by default. This will be the default for Clash >=1.4. 1604 | flags: -large-tuples 1605 | ``` 1606 | 1607 | Update the `echo.cabal` file and replace the blinker package name with echo, be sure to update the exposed module to `Echo` as well. Your `echo.cabal` file should look similar: 1608 | ``` 1609 | cabal-version: 2.4 1610 | name: echo 1611 | version: 0.1.0.0 1612 | license-file: LICENSE 1613 | author: Standard Semiconductor 1614 | maintainer: standard.semiconductor@gmail.com 1615 | extra-source-files: CHANGELOG.md 1616 | 1617 | common common-options 1618 | default-extensions: 1619 | BangPatterns 1620 | BinaryLiterals 1621 | ConstraintKinds 1622 | DataKinds 1623 | DefaultSignatures 1624 | DeriveAnyClass 1625 | DeriveDataTypeable 1626 | DeriveFoldable 1627 | DeriveFunctor 1628 | DeriveGeneric 1629 | DeriveLift 1630 | DeriveTraversable 1631 | DerivingStrategies 1632 | InstanceSigs 1633 | KindSignatures 1634 | LambdaCase 1635 | NoStarIsType 1636 | PolyKinds 1637 | RankNTypes 1638 | ScopedTypeVariables 1639 | StandaloneDeriving 1640 | TupleSections 1641 | TypeApplications 1642 | TypeFamilies 1643 | TypeOperators 1644 | ViewPatterns 1645 | 1646 | -- TemplateHaskell is used to support convenience functions such as 1647 | -- 'listToVecTH' and 'bLit'. 1648 | TemplateHaskell 1649 | QuasiQuotes 1650 | 1651 | -- Prelude isn't imported by default as Clash offers Clash.Prelude 1652 | NoImplicitPrelude 1653 | ghc-options: 1654 | -Wall -Wcompat 1655 | -haddock 1656 | 1657 | -- Plugins to support type-level constraint solving on naturals 1658 | -fplugin GHC.TypeLits.Extra.Solver 1659 | -fplugin GHC.TypeLits.Normalise 1660 | -fplugin GHC.TypeLits.KnownNat.Solver 1661 | 1662 | -- Clash needs access to the source code in compiled modules 1663 | -fexpose-all-unfoldings 1664 | 1665 | -- Worker wrappers introduce unstable names for functions that might have 1666 | -- blackboxes attached for them. You can disable this, but be sure to add 1667 | -- a no-specialize pragma to every function with a blackbox. 1668 | -fno-worker-wrapper 1669 | default-language: Haskell2010 1670 | build-depends: 1671 | base, 1672 | Cabal, 1673 | mtl, 1674 | lens, 1675 | interpolate, 1676 | veldt, 1677 | 1678 | -- clash-prelude will set suitable version bounds for the plugins 1679 | clash-prelude >= 1.4 && < 1.5, 1680 | ghc-typelits-natnormalise, 1681 | ghc-typelits-extra, 1682 | ghc-typelits-knownnat 1683 | 1684 | library 1685 | import: common-options 1686 | exposed-modules: Echo 1687 | default-language: Haskell2010 1688 | 1689 | -- Builds the executable 'clash', with echo in scope 1690 | executable clash 1691 | main-is: bin/Clash.hs 1692 | default-language: Haskell2010 1693 | Build-Depends: base, clash-ghc, echo 1694 | if !os(Windows) 1695 | ghc-options: -dynamic 1696 | 1697 | -- Builds the executable 'clashi', with echo in scope 1698 | executable clashi 1699 | main-is: bin/Clashi.hs 1700 | default-language: Haskell2010 1701 | if !os(Windows) 1702 | ghc-options: -dynamic 1703 | build-depends: base, clash-ghc, echo 1704 | ``` 1705 | Finally, update `Makefile`, we will call our toplevel module `Echo`. Your `Makefile` should look similar: 1706 | ```make 1707 | TOP := Echo 1708 | 1709 | all: $(TOP).bin 1710 | 1711 | $(TOP).bin: $(TOP).asc 1712 | icepack $< $@ 1713 | 1714 | $(TOP).asc: $(TOP).json $(TOP).pcf 1715 | nextpnr-ice40 --up5k --package sg48 --pcf $(TOP).pcf --asc $@ --json $< 1716 | 1717 | $(TOP).json: $(TOP).hs 1718 | cabal run clash --write-ghc-environment-files=always -- $(TOP) --verilog 1719 | yosys -q -p "synth_ice40 -top $(TOP) -json $@ -abc2" verilog/$(TOP).topEntity/*.v 1720 | 1721 | prog: $(TOP).bin 1722 | iceprog $< 1723 | 1724 | build: $(TOP).hs 1725 | cabal build $< 1726 | 1727 | clean: 1728 | rm -rf verilog/ 1729 | rm -f $(TOP).json 1730 | rm -f $(TOP).asc 1731 | rm -f $(TOP).bin 1732 | rm -f *~ 1733 | rm -f *.hi 1734 | rm -f *.o 1735 | rm -f *.dyn_hi 1736 | rm -f *.dyn_o 1737 | 1738 | clean-all: 1739 | $(MAKE) clean 1740 | cabal clean 1741 | 1742 | .PHONY: all clean clean-all prog build 1743 | ``` 1744 | Create the `Echo.hs` source file and then open it with your favorite text editor. 1745 | Let's begin with declaring the module, imports and a language extension: 1746 | ```haskell 1747 | {-# LANGUAGE LambdaCase #-} 1748 | module Echo where 1749 | 1750 | import Clash.Prelude 1751 | import Clash.Annotations.TH 1752 | import Control.Monad.RWS 1753 | import Control.Lens 1754 | import qualified Veldt.Uart as U 1755 | ``` 1756 | First, we use [`LambdaCase`](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-LambdaCase) which saves a few keystrokes when doing case analysis on the finite-state machine. Next, we define the module and declare imports. We have used most of these imports before so I will not go into detail but note we import `Veldt.Uart` as `qualified`, so anytime we want to use something from our Uart module we need to prefix it with `U.`. This is a stylistic choice, though it can help organize imports and avoid any overlapping function or type names. 1757 | 1758 | Our echo demo reads a byte, then writes that same byte. We will need three stateful elements: 1759 | 1. The FSM which indicates whether we are currently reading a byte or writing a byte. 1760 | 2. The UART state. 1761 | 3. A byte to save between reads and writes. 1762 | 1763 | Let's define our state space: 1764 | ```haskell 1765 | data Fsm = Read | Write 1766 | deriving (Generic, NFDataX) 1767 | 1768 | data Echo = Echo 1769 | { _byte :: BitVector 8 1770 | , _uart :: U.Uart 1771 | , _fsm :: Fsm 1772 | } deriving (Generic, NFDataX) 1773 | makeLenses ''Echo 1774 | 1775 | mkEcho :: Echo 1776 | mkEcho = Echo 1777 | { _byte = 0 1778 | , _uart = U.mkUart 624 1779 | , _fsm = Read 1780 | } 1781 | ``` 1782 | We also declare a smart constructor `mkEcho` which initializes our state. The byte is filled with a dummy value `0` and the `_fsm` is set to `Read` because the echo starts in the reading state. Most important is how we chose `624` when constructing the UART; it is integral to the correct functioning and timing of the UART. We will be running the demo with a clock frequency of 12Mhz and the desired baud rate is 19200. 12 000 000 / 19 200 = 625, so we count from 0 - 624 inclusive between bit samples. The key is to select a baud rate which is compatible with the clock frequency. 12Mhz and 19 200 are compatible because 19 200 divides 12 000 000 without remainder. In reality UART can handle a slight mismatch, but it must remain under a certain threshold. 1783 | 1784 | Now that we have our types, let's implement the echo: 1785 | ```haskell 1786 | echoM :: RWS U.Rx U.Tx Echo () 1787 | echoM = use fsm >>= \case 1788 | Read -> do 1789 | rM <- zoom uart U.read 1790 | forM_ rM $ \r -> do 1791 | byte .= r 1792 | fsm .= Write 1793 | Write -> do 1794 | w <- use byte 1795 | done <- zoom uart $ U.write w 1796 | when done $ fsm .= Read 1797 | ``` 1798 | First we do case analysis on the `fsm` value. 1799 | 1. `Read`: `U.read` returns a `Maybe (BitVector 8)`. When it is a `Just r` value (meaning the read is complete), we save `r` in `byte` and update the `fsm` to `Write`. 1800 | 2. `Write`: First get the `byte` then write it. `U.write` returns a `Bool` which indicates the status of the write. When `done` is `True`, we know the UART write has completed and we set the `fsm` to `Read`. 1801 | 1802 | Now we run `echoM` and lift it into the `Signal` domain: 1803 | ```haskell 1804 | echo 1805 | :: HiddenClockResetEnable dom 1806 | => Signal dom Bit 1807 | -> Signal dom Bit 1808 | echo = echoMealy <^> mkEcho 1809 | where 1810 | echoMealy s i = let ((), s', tx) = runRWS echoM (U.Rx i) s 1811 | in (s', U.unTx tx) 1812 | ``` 1813 | [`<^>`](http://hackage.haskell.org/package/clash-prelude-1.8.1/docs/Clash-Prelude.html#v:-60--94--62-) is the infix version of `mealy`; it takes two arguments 1814 | 1. the transfer function `s -> i -> (s, o)` 1815 | 2. the initial state 1816 | 1817 | `<^>` returns a function `Signal dom i -> Signal dom o`. The initial state is just `mkEcho`. The transfer function is `echoMealy` which runs `echoM` with [`runRWS :: RWS r w s a -> r -> s -> (a, s, w)`](https://hackage.haskell.org/package/mtl-2.2.2/docs/Control-Monad-RWS-Lazy.html#v:runRWS) then reformats the output to fit the transfer function type. Note we also wrap rx and tx with their respective newtypes. 1818 | 1819 | Finally we define the `topEntity`: 1820 | ```haskell 1821 | {-# NOINLINE topEntity #-} 1822 | topEntity 1823 | :: "clk" ::: Clock XilinxSystem 1824 | -> "rx" ::: Signal XilinxSystem Bit 1825 | -> "tx" ::: Signal XilinxSystem Bit 1826 | topEntity clk = withClockResetEnable clk rst enableGen echo 1827 | where 1828 | rst = unsafeFromHighPolarity $ pure False 1829 | makeTopEntityWithName 'topEntity "Echo" 1830 | ``` 1831 | We annotate the inputs and outputs for easy usage with our pin constraint file. Additionally, [`makeTopEntityWithName`](http://hackage.haskell.org/package/clash-prelude-1.8.1/docs/Clash-Annotations-TH.html#v:makeTopEntityWithName) from [`Clash.Annotations.TH`](http://hackage.haskell.org/package/clash-prelude-1.8.1/docs/Clash-Annotations-TH.html) automatically annotates our function with specified input, output, and module names. 1832 | 1833 | Next, edit the `Echo.pcf` file to match our `topEntity` declaration. We only need three pins so we remove the ones we don't need. The `generic_pcf.pcf` which we copied from has all the pins and helpful comments to discern their function. We need pin 35 `12Mhz Xtal` (12Mhz crystal oscillator) for `clk`. We need pin 17 for `tx` and pin 15 for `rx`. Note `#` starts a comment. 1834 | Your `Echo.pcf` file should look similar: 1835 | ``` 1836 | set_io tx 17 # iob_33b_spi_wi ice_bowi uart_tx 1837 | set_io rx 15 # iob_34a_spi_wck ice_wck uart_rx 1838 | 1839 | set_io clk 35 # iot_46b_g0 12Mhz Xtal 1840 | ``` 1841 | You can view the [Functional Diagram](functional-diagram.pdf) of the VELDT board to understand how these pins connect to the rest of the board. 1842 | 1843 | Before we test out our demo, we need a way to communicate with the VELDT from our computer via UART. For this demo we use [Minicom](https://help.ubuntu.com/community/Minicom), a text-based serial port communications program though any serial communcations program should work; just make sure it is configured with the correct port, protocol and baud rate! 1844 | 1845 | First install minicom: 1846 | ```console 1847 | foo@bar:~$ sudo apt install -y minicom 1848 | ``` 1849 | Now we need to discover the name of the serial port. Plug in the VELDT to your computer via USB port. 1850 | ```console 1851 | foo@bar:~$ dmesg | grep tty 1852 | ... 1853 | ... FTDI USB Serial Device converter now attached to ttyUSB0 1854 | ``` 1855 | Locate the name of the port; on my computer it is ttyUSB0. 1856 | 1857 | Now we can setup minicom: 1858 | ```console 1859 | foo@bar:~$ sudo minicom -s 1860 | ``` 1861 | This should bring you into the minicom setup. Use the arrow keys to select `Serial port setup`. Press Enter. Make sure `Serial Device` matches the device we just found, if not press a then type `/dev/YOURDEVICEHERE` followed by Enter, on my computer it is `/dev/ttyUSB0`. Next make sure `Bps/Par/Bits` is set to `19200 8N1`. If not, press e, then use a or b to set the `Speed` to `19200`. Then press q to set the parity and data to `8N1`. Press Enter when finished. Then press Enter again to finish serial port setup. Use the arrow keys to select `Screen and Keyboard`. To make things easier, we want to set `Local Echo` to `Yes` by toggling q, and set `Line Wrap` to `Yes` by toggling r. Press enter to finish. Finally use the arrow keys to select `Save setup as dfl`, which saves this setup as the default setup. Now `Exit from Minicom`. 1862 | 1863 | It's time to run our demo! Make sure the VELDT is plugged in via USB. The power switch (white) should be `ON`, the program switch (black) should be `FLASH`. The power indicator LED should be illuminated red. 1864 | ```console 1865 | foo@bar:~/VELDT-getting-started/demo/echo$ make prog 1866 | ``` 1867 | You should see a similar device utilisation: 1868 | ``` 1869 | Info: Device utilisation: 1870 | Info: ICESTORM_LC: 178/ 5280 3% 1871 | Info: ICESTORM_RAM: 0/ 30 0% 1872 | Info: SB_IO: 3/ 96 3% 1873 | Info: SB_GB: 4/ 8 50% 1874 | ... 1875 | ``` 1876 | Likewise with max clock frequency; most importantly it should say `PASS at 12.00 MHz`: 1877 | ``` 1878 | Info: Max frequency for clock 'clk$SB_IO_IN_$glb_clk': 65.82 MHz (PASS at 12.00 MHz) 1879 | ``` 1880 | When the programming is finished (indicated by CDONE LED illuminated blue), cycle the power switch (white), then flip the configuration switch (black) to FPGA. 1881 | Next start minicom: 1882 | ```console 1883 | foo@bar:~/VELDT-getting-started/demo/echo$ minicom 1884 | ``` 1885 | It should say "Welcome to minicom" along with some information about options, port and instructions for help. Press any key character and you should see two copies appear in the minicom console. The first character is minicom's local echo, the second character will be from the FPGA, the echo! Ctrl-a x will exit minicom when you are finished testing out the echo. 1886 | 1887 | Here is a demo video using minicom: 1888 | 1889 | ![](demo/echo/echo.gif) 1890 | 1891 | An alternative to minicom is using [serialport](https://github.com/standardsemiconductor/serialport), a Haskell library for serial port communication which is maintained by Standard Semiconductor and [available on Hackage](https://hackage.haskell.org/package/serialport). 1892 | 1893 | We create a client program [Main.hs](demo/echo/Main.hs) which echoes bytes through the serial port: 1894 | ```haskell 1895 | import System.Hardware.Serialport 1896 | import System.IO 1897 | import Control.Monad (forever) 1898 | import qualified Data.ByteString.Char8 as B 1899 | 1900 | main :: IO () 1901 | main = withSerial "/dev/ttyUSB0" settings $ \port -> do 1902 | hSetBuffering stdin NoBuffering 1903 | hSetBuffering stdout NoBuffering 1904 | forever $ echo port 1905 | where 1906 | echo port = do 1907 | send port . B.singleton =<< getChar 1908 | putChar . B.head =<< recv port 1 1909 | settings = defaultSerialSettings { commSpeed = CS19200 } 1910 | ``` 1911 | 1912 | Now we add an executable to our [echo.cabal](demo/echo/echo.cabal) file. 1913 | ``` 1914 | executable echo 1915 | main-is: Main.hs 1916 | default-language: Haskell2010 1917 | build-depends: base, 1918 | serialport >= 0.5 && < 0.6, 1919 | bytestring 1920 | ``` 1921 | 1922 | Make sure the VELDT FPGA board is connected to your computer and running the echo demo. Run the executable and type some input to see it echo: 1923 | ```console 1924 | foo@bar:~/VELDT-getting-started/demo/echo$ cabal run echo 1925 | ``` 1926 | When you are finished, press Ctrl-c to stop the program. 1927 | 1928 | This concludes the demo. You can find the project directory [here](demo/echo). 1929 | 1930 | ## [Section 4: Happylife](#table-of-contents) 1931 | > They walked down the hall of their soundproofed Happylife Home... this house which clothed and fed and rocked them to sleep and played and sang and was good to them. Their approach sensitized a switch somewhere and the nursery light flicked on when they came within ten feet of it. Similarly, behind them, in the halls, lights went on and off as they left them behind, with a soft automaticity. 1932 | 1933 | > *The Veldt* by Ray Bradbury 1934 | 1935 | In this section we [DRY](https://en.wikipedia.org/wiki/Don%27t_repeat_yourself) up the Veldt library by factoring out a common operation: using PWMs to drive RGB (red, green, blue) signals. Then we implement the [UART LED](https://github.com/standardsemiconductor/VELDT-getting-started/tree/master/demo/uart-led) demo: a system which controls the LED via a UART. 1936 | 1937 | ### [DRY PWM](https://github.com/standardsemiconductor/VELDT-getting-started#table-of-contents) 1938 | 1939 | In the [blinker demo](demo/blinker/Blinker.hs) we used three PWMs to drive the RGB LED. This is a common pattern, and one we will use in the upcoming UART LED demo. To avoid repeating code, we factor this pattern into a separate module `Veldt.PWM.Rgb`. Let's create the directory `PWM` with the file `Rgb.hs` then open it with a text editor. 1940 | ```console 1941 | foo@bar:~/VELDT-getting-started$ mkdir veldt/Veldt/PWM && touch veldt/Veldt/PWM/Rgb.hs 1942 | ``` 1943 | Define the module, API, and imports: 1944 | ```haskell 1945 | module Veldt.PWM.Rgb 1946 | ( PWMRgb 1947 | , mkPWMRgb 1948 | , pwmRgb 1949 | , setRgb 1950 | ) where 1951 | 1952 | import Clash.Prelude 1953 | import Control.Lens 1954 | import Control.Monad.RWS 1955 | import Veldt.PWM 1956 | import Veldt.Ice40.Rgb (Rgb) 1957 | ``` 1958 | The module exports five things 1959 | 1. `PWMRgb`: the state type which consists of three PWMs 1960 | 2. `mkPWMRgb`: the smart constructor for `PWMRgb` 1961 | 3. `pwmRgb`: run each pwm then return a RGB (red, green, blue) triple with type `Rgb` 1962 | 4. `setRgb`: set the duty cycle for each PWM 1963 | 1964 | Now define the state type along with a smart constructor: 1965 | ```haskell 1966 | data PWMRgb a = PWMRgb 1967 | { _redPWM :: PWM a 1968 | , _greenPWM :: PWM a 1969 | , _bluePWM :: PWM a 1970 | } deriving (NFDataX, Generic) 1971 | makeLenses ''PWMRgb 1972 | 1973 | mkPWMRgb :: Bounded a => (a, a, a) -> PWMRgb a 1974 | mkPWMRgb (r, g, b) = PWMRgb 1975 | { _redPWM = mkPWM r 1976 | , _greenPWM = mkPWM g 1977 | , _bluePWM = mkPWM b 1978 | } 1979 | ``` 1980 | `PWMRgb` is just three PWMs each corresponding to a color: red, green, and blue. To construct `PWMRgb` with `mkPWMRgb` we first need an initial duty cycle for each color (represented as a triple). Then, we construct each individual color PWM with the `mkPWM` smart constructor from the [`Veldt.PWM`](veldt/Veldt/PWM.hs) module. Our `mkPWMRgb` function has a `Bounded` constraint because `mkPWM` requires it (remember `mkPWM` sets `ctr` to `minBound`). 1981 | 1982 | Now we implement the API: 1983 | ```haskell 1984 | pwmRgb :: (Monoid w, Monad m, Ord a, Bounded a, Enum a) => RWST r w (PWMRgb a) m Rgb 1985 | pwmRgb = do 1986 | r <- zoom redPWM pwm 1987 | g <- zoom greenPWM pwm 1988 | b <- zoom bluePWM pwm 1989 | return (r, g, b) 1990 | 1991 | setRgb :: (Monoid w, Monad m, Bounded a) => (a, a, a) -> RWST r w (PWMRgb a) m () 1992 | setRgb (r, g, b) = do 1993 | zoom redPWM $ setDuty r 1994 | zoom greenPWM $ setDuty g 1995 | zoom bluePWM $ setDuty b 1996 | ``` 1997 | 1998 | The first function `pwmRgb` uses [`zoom`](https://hackage.haskell.org/package/lens-5.0.1/docs/Control-Lens-Combinators.html#v:zoom) to get at each `PWM` sub-state then runs `pwm`. We collect the outputs (each having type `Bit`) and return the triple as type `Rgb`. Remeber `Rgb` is a triple-tuple of `Bit`s annotated "red", "green", and "blue". We could have used `(Bit, Bit, Bit)` instead of `Rgb` but there is no need when `Rgb` is more descriptive and already defined in `Veldt.Ice40.Rgb`. 1999 | 2000 | The second function `setRgb` takes a triple of duty cycles (parameterized by `a`) and updates each individual PWM's duty cycle. We use `zoom` to get at each PWM sub-state, then use `setDuty` for each color's PWM. 2001 | 2002 | Make sure to add this module (`Veldt.PWM.Rgb`) to the `exposed-modules` list in the [`veldt.cabal`](veldt/veldt.cabal) file. 2003 | ``` 2004 | ... 2005 | exposed-modules: Veldt.Counter, 2006 | Veldt.PWM, 2007 | Veldt.PWM.Rgb, 2008 | Veldt.Serial, 2009 | ... 2010 | ... 2011 | ``` 2012 | Rebuild the library; there should be no errors. 2013 | ```console 2014 | foo@bar:~/VELDT-getting-started/veldt$ cabal build 2015 | ``` 2016 | In the next part we will use `PWMRgb` and build a system which controls the LED via UART. We leave it as an exercise to the reader to use `PWMRgb` to DRY up the [blinker demo](demo/blinker). 2017 | 2018 | ### [Happylife: UART LED](#table-of-contents) 2019 | In this section we build a system which allows the user to control an LED via UART. Specifically, the user can change the LED color and the speed at which the LED blinks. The user sends ascii characters via UART to the system: 2020 | * s adjusts the blinking speed, there are three speeds: low, medium, and high 2021 | * r sets the LED color to red 2022 | * g sets the LED color to green 2023 | * b sets the LED color to blue 2024 | 2025 | You can find all the demo files (cabal, pin-constraint, Makefile etc.) in the [uart-led](demo/uart-led) directory. We will dive directly into the demo source code [UartLed.hs](demo/uart-led/UartLed.hs) so as not to get bogged down by setup (it's very similar to the first two demos). 2026 | 2027 | Let's declare our module, langauge extensions, and imports: 2028 | ```haskell 2029 | {-# LANGUAGE LambdaCase #-} 2030 | module UartLed where 2031 | 2032 | import Clash.Prelude 2033 | import Clash.Annotations.TH 2034 | import Control.Monad.RWS 2035 | import Control.Lens hiding (Index) 2036 | import Data.Maybe (fromMaybe) 2037 | import Veldt.Counter 2038 | import qualified Veldt.PWM.Rgb as P 2039 | import qualified Veldt.Ice40.Rgb as R 2040 | import qualified Veldt.Uart as U 2041 | ``` 2042 | Using [LambdaCase](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-LambdaCase) is just an opinion. I like the way it cleans up syntax, but it is not necessary. We name the module `UartLed` which will match-up with our top entity name and Makefile's TOP variable. Note we import `Veldt.Counter` unqualified along with `Veldt.PWM.Rgb`, `Veldt.Ice40.Rgb`, and `Veldt.Uart` as qualified. 2043 | 2044 | Next we define some type synonyms: 2045 | ```haskell 2046 | type Byte = BitVector 8 2047 | type Timer = Index 36000000 2048 | ``` 2049 | `Byte` is straight forward, just saving keystrokes. `Timer` is used to indicate when the LED should toggle on and off. We are running this demo with a 12Mhz clock and blink speeds range from slow (3 second period or 36,000,000 clock cycles) to fast (0.25 second period or 3,000,000 clock cycles) so `Index 36000000` will be large enough to count for all three speeds. 2050 | 2051 | In order to make working with speeds a bit easier, we define a custom data type `Speed` along with a helper function `toPeriod` which converts a `Speed` into a `Timer`. 2052 | ```haskell 2053 | data Speed = Low | Mid | Hi 2054 | deriving (NFDataX, Generic, Eq, Bounded, Enum) 2055 | 2056 | toPeriod :: Speed -> Timer 2057 | toPeriod = \case 2058 | Low -> 35999999 2059 | Mid -> 11999999 2060 | Hi -> 2999999 2061 | ``` 2062 | Note that we derive `Eq`, `Bounded`, and `Enum` for `Speed`. This allows us to treat `Speed` as a counter. When the user enters s, we simply use `increment` from `Veldt.Counter`. Remember, `increment` respects bounds, so incrementing the speed when it is already `Hi` will just wrap around back to `Low`. Also note that `toPeriod` outputs the desired period minus one because the timer always starts at zero. In other words, counting from `0` to `2999999` takes three million clock cycles. 2063 | 2064 | Next we define our colors (red, green, and blue) as a custom data type `Color`. We also define a function `fromColor` which converts a `Color` into it's RGB representation; a byte triple. `fromColor` is used to get the appropriate PWM duty cycles for each color. 2065 | ```haskell 2066 | data Color = Red | Green | Blue 2067 | deriving (NFDataX, Generic) 2068 | 2069 | fromColor :: Color -> (Byte, Byte, Byte) 2070 | fromColor = \case 2071 | Red -> (0xFF, 0x00, 0x00) 2072 | Green -> (0x00, 0xFF, 0x00) 2073 | Blue -> (0x00, 0x00, 0xFF) 2074 | ``` 2075 | 2076 | In addition to the LED having a color, it can also be toggled on and off. We define a type `Led` with two inhabitants, `On` and `Off`, along with a `toggle`. `toggle` simply maps `On` to `Off` and `Off` to `On`. 2077 | ```haskell 2078 | data Led = On | Off 2079 | deriving (NFDataX, Generic, Eq) 2080 | 2081 | toggle :: Led -> Led 2082 | toggle On = Off 2083 | toggle Off = On 2084 | ``` 2085 | 2086 | Let's model the system instructions in types along with a way to encode them from ascii characters: 2087 | ```haskell 2088 | data Instr = Speed | Color Color 2089 | deriving (NFDataX, Generic) 2090 | 2091 | encodeInstrM :: Byte -> Maybe Instr 2092 | encodeInstrM = \case 2093 | 0x73 -> Just Speed -- 's' 2094 | 0x72 -> Just $ Color Red -- 'r' 2095 | 0x67 -> Just $ Color Green -- 'g' 2096 | 0x62 -> Just $ Color Blue -- 'b' 2097 | _ -> Nothing 2098 | ``` 2099 | There are two "sorts" of instructions: 2100 | 1. `Speed` instruction which will increase the blinking speed 2101 | 2. `Color` instruction which has a single field with type `Color` (we pun the constructor `Color` and the type `Color`). 2102 | 2103 | We encode an instruction by pattern matching on an ascii byte. We used this [ascii table](http://www.asciitable.com/) to determine which bytes correspond to s, r, g, b. If the input byte does not correspond to one of those characters `encodeInstrM` returns `Nothing` indicating an invalid instruction, otherwise we return `Just` the expected instruction. 2104 | 2105 | We now have the necessary types to define the state space of the UART LED system: 2106 | ```haskell 2107 | data UartLed = UartLed 2108 | { _uart :: U.Uart 2109 | , _pwmRgb :: P.PWMRgb Byte 2110 | , _speed :: Speed 2111 | , _led :: Led 2112 | , _timer :: Timer 2113 | } deriving (NFDataX, Generic) 2114 | makeLenses ''UartLed 2115 | 2116 | mkUartLed :: UartLed 2117 | mkUartLed = UartLed 2118 | { _uart = U.mkUart 624 2119 | , _pwmRgb = P.mkPWMRgb $ fromColor Red 2120 | , _speed = Low 2121 | , _led = On 2122 | , _timer = 0 2123 | } 2124 | ``` 2125 | 2126 | There are five components: 2127 | 1. `_uart` is the UART which we use to read bytes sent by the user. Initialized with a baud rate of 19200. 2128 | 2. `_pwmRgb` is used to drive the RGB LED. Initialized to drive the color `Red`. 2129 | 3. `_speed`: the current blinking speed. Initialized as `Low`. 2130 | 4. `_led`: indicates whether the LED is currently on or off. Initialized as `On`. 2131 | 5. `_timer`: counter used to indicate when to toggle the LED. Initialized as zero. 2132 | 2133 | Now we can tackle the transfer function `uartLed`: 2134 | ```haskell 2135 | uartLed :: RWS U.Rx (First R.Rgb) UartLed () 2136 | uartLed = do 2137 | -- Output pwm rgb when Led on 2138 | isOn <- uses led (== On) 2139 | when isOn $ tell . First . Just =<< zoom pwmRgb P.pwmRgb 2140 | 2141 | -- Check toggle led 2142 | period <- uses speed toPeriod 2143 | t <- timer <<%= incrementUnless (== period) 2144 | when (t == period) $ led %= toggle 2145 | 2146 | -- Update color/speed from uart 2147 | bM <- zoom uart U.read 2148 | forM_ (bM >>= encodeInstrM) $ \case 2149 | Speed -> do 2150 | speed %= increment 2151 | timer .= 0 2152 | Color c -> zoom pwmRgb $ P.setRgb $ fromColor c 2153 | ``` 2154 | Conceptually, we break the transfer function `uartLed` into three major parts. In the first part we check if the LED is currently `On`. When it is on, we output the result of `P.pwmRgb` with [`tell`](https://hackage.haskell.org/package/mtl-2.2.2/docs/Control-Monad-Writer-Lazy.html#v:tell). Note, `tell` requires a monoid as an argument. That is why we wrap `R.Rgb` with the [`First`](https://hackage.haskell.org/package/base-4.16.0.0/docs/Data-Monoid.html#t:First) monoid. 2155 | 2156 | In the second part, we check if the LED needs to be toggled. We get the speed and project it to it's period using `toPeriod`. Then, when the `timer` is equal to the period we `toggle` the `led` and reset the counter. Remember, `incrementUnless` takes care of resetting the timer if it is equal to the period. We use [`<<%=`](https://hackage.haskell.org/package/lens-5.0.1/docs/Control-Lens-Lens.html#v:-60--60--37--61-) to modify the timer and bind `t` to it's old value. 2157 | 2158 | In the third part, we read a byte from the UART, encode it into an instruction, then execute the instruction. If it is a `Speed` instruction, we increment speed and reset the timer to zero. If it is a `Color` instruction, we update the PWM RGB duty cycle with `setRgb`. 2159 | 2160 | We now run the `uartLed` transfer function: 2161 | ```haskell 2162 | uartLedS 2163 | :: HiddenClockResetEnable dom 2164 | => Signal dom Bit 2165 | -> Signal dom R.Rgb 2166 | uartLedS = R.rgb . fmap (fromMaybe (0, 0, 0) . getFirst) . mealy uartLedMealy mkUartLed 2167 | where 2168 | uartLedMealy s i = let ((), s', o) = runRWS uartLed (U.Rx i) s 2169 | in (s', o) 2170 | ``` 2171 | 2172 | We "run" the `uartLed` transfer function using [`runRWS`](https://hackage.haskell.org/package/mtl-2.2.2/docs/Control-Monad-RWS-Lazy.html#v:runRWS) and rearrange our types for [`mealy`](http://hackage.haskell.org/package/clash-prelude-1.8.1/docs/Clash-Prelude.html#v:mealy). We also unwrap the output signal, a RGB-tuple of PWM outputs, with [`getFirst`](https://hackage.haskell.org/package/base-4.16.0.0/docs/Data-Monoid.html#v:getFirst) then `fromMaybe (0, 0, 0)`. If the LED is off then the output signal is `mempty` or `First Nothing`. After unwrapping, we end up feeding `(0, 0, 0)` into `R.rgb` which turns the LED off. If the LED is on then the output signal is `First (Just (pwmR, pwmG, pwmB))`. After unwrapping, we end up feeding `(pwmR, pwmG, pwmB)` into `R.rgb`, driving the LED! 2173 | 2174 | Last, we define the top entity: 2175 | ```haskell 2176 | {-# NOINLINE topEntity #-} 2177 | topEntity 2178 | :: "clk" ::: Clock XilinxSystem 2179 | -> "rx" ::: Signal XilinxSystem Bit 2180 | -> "led" ::: Signal XilinxSystem R.Rgb 2181 | topEntity clk = withClockResetEnable clk rst enableGen uartLedS 2182 | where 2183 | rst = unsafeFromHighPolarity $ pure False 2184 | makeTopEntityWithName 'topEntity "UartLed" 2185 | ``` 2186 | We label the inputs "clk" and "rx" along with the output "led". We also make sure `makeTopEntityWithName` uses "UartLed" which matches `TOP` in our [Makefile](demo/uart-led/Makefile). 2187 | 2188 | Be sure the cabal files, bin directory, pcf file, and Makefile are setup correctly. Plug the VELDT FPGA board into your computer. Set the power switch (white) to ON and the configuration switch (black) to FLASH. Ensure the PWR LED is illuminated RED. Then execute `make prog` from the command line. The demo should build, synthesize, and program with no errors. You should see a similar device utilisation: 2189 | ``` 2190 | Info: Device utilisation: 2191 | Info: ICESTORM_LC: 340/ 5280 6% 2192 | Info: ICESTORM_RAM: 0/ 30 0% 2193 | Info: SB_IO: 2/ 96 2% 2194 | Info: SB_GB: 2/ 8 25% 2195 | ... 2196 | Info: SB_RGBA_DRV: 1/ 1 100% 2197 | ... 2198 | ``` 2199 | When the programming is finished (indicated by CDONE LED illuminated blue), cycle the power switch (white) and flip the configuration switch (black) to FPGA. The RGB LED should be RED and blinking with three second period. This is our initial state! Start minicom using the same setup as used in the echo demo. Within minicom we control the LED color and blink speed with the s, r, g, and b keyboard characters. 2200 | 2201 | This concludes the demo. You can find the project directory [here](demo/uart-led). Special thanks to @kejace for suggesting this demo. 2202 | 2203 | [Jump to Table of Contents](#table-of-contents) 2204 | -------------------------------------------------------------------------------- /demo/Makefile_generic: -------------------------------------------------------------------------------- 1 | TOP := #TopEntity 2 | 3 | all: $(TOP).bin 4 | 5 | $(TOP).bin: $(TOP).asc 6 | icepack $< $@ 7 | 8 | $(TOP).asc: $(TOP).json $(TOP).pcf 9 | nextpnr-ice40 --up5k --package sg48 --pcf $(TOP).pcf --asc $@ --json $< 10 | 11 | $(TOP).json: $(TOP).hs 12 | cabal run clash --write-ghc-environment-files=always -- $(TOP) --verilog 13 | yosys -q -p "synth_ice40 -top $(TOP) -json $@ -abc2" verilog/$(TOP).topEntity/*.v 14 | 15 | prog: $(TOP).bin 16 | iceprog $< 17 | 18 | build: $(TOP).hs 19 | cabal build $< 20 | 21 | clean: 22 | rm -rf verilog/ 23 | rm -f $(TOP).json 24 | rm -f $(TOP).asc 25 | rm -f $(TOP).bin 26 | rm -f *~ 27 | rm -f *.hi 28 | rm -f *.o 29 | rm -f *.dyn_hi 30 | rm -f *.dyn_o 31 | 32 | clean-all: 33 | $(MAKE) clean 34 | cabal clean 35 | 36 | .PHONY: all clean clean-all prog build 37 | -------------------------------------------------------------------------------- /demo/blinker/Blinker.hs: -------------------------------------------------------------------------------- 1 | module Blinker where 2 | 3 | import Clash.Prelude 4 | import Clash.Annotations.TH 5 | import Control.Monad 6 | import Control.Monad.RWS 7 | import Control.Lens hiding (Index) 8 | import qualified Veldt.Counter as C 9 | import qualified Veldt.PWM as P 10 | import qualified Veldt.Ice40.Rgb as R 11 | 12 | type Byte = BitVector 8 13 | 14 | data Color = Red | Green | Blue 15 | deriving (NFDataX, Generic, Show, Eq, Enum, Bounded) 16 | 17 | data Blinker = Blinker 18 | { _color :: Color 19 | , _redPWM :: P.PWM Byte 20 | , _greenPWM :: P.PWM Byte 21 | , _bluePWM :: P.PWM Byte 22 | , _timer :: Index 24000000 23 | } deriving (NFDataX, Generic) 24 | makeLenses ''Blinker 25 | 26 | mkBlinker :: Blinker 27 | mkBlinker = Blinker 28 | { _color = Red 29 | , _redPWM = P.mkPWM 0xFF 30 | , _greenPWM = P.mkPWM 0 31 | , _bluePWM = P.mkPWM 0 32 | , _timer = 0 33 | } 34 | 35 | toPWM :: Color -> (Byte, Byte, Byte) 36 | toPWM Red = (0xFF, 0, 0 ) 37 | toPWM Green = (0, 0xFF, 0 ) 38 | toPWM Blue = (0, 0, 0xFF) 39 | 40 | blinkerM :: RWS r () Blinker R.Rgb 41 | blinkerM = do 42 | r <- zoom redPWM P.pwm 43 | g <- zoom greenPWM P.pwm 44 | b <- zoom bluePWM P.pwm 45 | t <- timer <<%= C.increment 46 | when (t == maxBound) $ do 47 | c' <- color <%= C.increment 48 | let (redDuty', greenDuty', blueDuty') = toPWM c' 49 | zoom redPWM $ P.setDuty redDuty' 50 | zoom greenPWM $ P.setDuty greenDuty' 51 | zoom bluePWM $ P.setDuty blueDuty' 52 | return (r, g, b) 53 | 54 | blinker :: HiddenClockResetEnable dom => Signal dom R.Rgb 55 | blinker = R.rgb $ mealy blinkerMealy mkBlinker $ pure () 56 | where 57 | blinkerMealy s i = let (a, s', ()) = runRWS blinkerM i s 58 | in (s', a) 59 | 60 | {-# NOINLINE topEntity #-} 61 | topEntity 62 | :: "clk" ::: Clock XilinxSystem 63 | -> "led" ::: Signal XilinxSystem R.Rgb 64 | topEntity clk = withClockResetEnable clk rst enableGen blinker 65 | where 66 | rst = unsafeFromHighPolarity $ pure False 67 | makeTopEntityWithName 'topEntity "Blinker" 68 | 69 | -------------------------------------------------------------------------------- /demo/blinker/Blinker.pcf: -------------------------------------------------------------------------------- 1 | set_io clk 35 # iot_46b_g0 12Mhz Xtal 2 | 3 | set_io led_blue 41 # rgb2 blue 4 | set_io led_green 40 # rgb1 green 5 | set_io led_red 39 # rgb0 red 6 | -------------------------------------------------------------------------------- /demo/blinker/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for blinker 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /demo/blinker/Makefile: -------------------------------------------------------------------------------- 1 | TOP := Blinker 2 | 3 | all: $(TOP).bin 4 | 5 | $(TOP).bin: $(TOP).asc 6 | icepack $< $@ 7 | 8 | $(TOP).asc: $(TOP).json $(TOP).pcf 9 | nextpnr-ice40 --up5k --package sg48 --pcf $(TOP).pcf --asc $@ --json $< 10 | 11 | $(TOP).json: $(TOP).hs 12 | cabal run clash --write-ghc-environment-files=always -- $(TOP) --verilog 13 | yosys -q -p "synth_ice40 -top $(TOP) -json $@ -abc2" verilog/$(TOP).topEntity/*.v 14 | 15 | prog: $(TOP).bin 16 | iceprog $< 17 | 18 | build: $(TOP).hs 19 | cabal build $< 20 | 21 | clean: 22 | rm -rf verilog/ 23 | rm -f $(TOP).json 24 | rm -f $(TOP).asc 25 | rm -f $(TOP).bin 26 | rm -f *~ 27 | rm -f *.hi 28 | rm -f *.o 29 | rm -f *.dyn_hi 30 | rm -f *.dyn_o 31 | 32 | clean-all: 33 | $(MAKE) clean 34 | cabal clean 35 | 36 | .PHONY: all clean clean-all prog build 37 | -------------------------------------------------------------------------------- /demo/blinker/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /demo/blinker/bin/Clash.hs: -------------------------------------------------------------------------------- 1 | import Prelude 2 | import System.Environment (getArgs) 3 | import Clash.Main (defaultMain) 4 | 5 | main :: IO () 6 | main = getArgs >>= defaultMain 7 | -------------------------------------------------------------------------------- /demo/blinker/bin/Clashi.hs: -------------------------------------------------------------------------------- 1 | import Prelude 2 | import System.Environment (getArgs) 3 | import Clash.Main (defaultMain) 4 | 5 | main :: IO () 6 | main = getArgs >>= defaultMain . ("--interactive":) 7 | -------------------------------------------------------------------------------- /demo/blinker/blinker.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | name: blinker 3 | version: 0.1.0.0 4 | license-file: LICENSE 5 | author: Standard Semiconductor 6 | maintainer: standard.semiconductor@gmail.com 7 | extra-source-files: CHANGELOG.md 8 | 9 | common common-options 10 | default-extensions: 11 | BangPatterns 12 | BinaryLiterals 13 | ConstraintKinds 14 | DataKinds 15 | DefaultSignatures 16 | DeriveAnyClass 17 | DeriveDataTypeable 18 | DeriveFoldable 19 | DeriveFunctor 20 | DeriveGeneric 21 | DeriveLift 22 | DeriveTraversable 23 | DerivingStrategies 24 | InstanceSigs 25 | KindSignatures 26 | LambdaCase 27 | NoStarIsType 28 | PolyKinds 29 | RankNTypes 30 | ScopedTypeVariables 31 | StandaloneDeriving 32 | TupleSections 33 | TypeApplications 34 | TypeFamilies 35 | TypeOperators 36 | ViewPatterns 37 | 38 | -- TemplateHaskell is used to support convenience functions such as 39 | -- 'listToVecTH' and 'bLit'. 40 | TemplateHaskell 41 | QuasiQuotes 42 | 43 | -- Prelude isn't imported by default as Clash offers Clash.Prelude 44 | NoImplicitPrelude 45 | ghc-options: 46 | -Wall -Wcompat 47 | -haddock 48 | 49 | -- Plugins to support type-level constraint solving on naturals 50 | -fplugin GHC.TypeLits.Extra.Solver 51 | -fplugin GHC.TypeLits.Normalise 52 | -fplugin GHC.TypeLits.KnownNat.Solver 53 | 54 | -- Clash needs access to the source code in compiled modules 55 | -fexpose-all-unfoldings 56 | 57 | -- Worker wrappers introduce unstable names for functions that might have 58 | -- blackboxes attached for them. You can disable this, but be sure to add 59 | -- a no-specialize pragma to every function with a blackbox. 60 | -fno-worker-wrapper 61 | default-language: Haskell2010 62 | build-depends: 63 | base, 64 | Cabal, 65 | mtl, 66 | lens, 67 | interpolate, 68 | veldt, 69 | 70 | -- clash-prelude will set suitable version bounds for the plugins 71 | clash-prelude >= 1.4 && < 1.9, 72 | ghc-typelits-natnormalise, 73 | ghc-typelits-extra, 74 | ghc-typelits-knownnat 75 | 76 | library 77 | import: common-options 78 | exposed-modules: Blinker 79 | default-language: Haskell2010 80 | 81 | -- Builds the executable 'clash', with blinker in scope 82 | executable clash 83 | main-is: bin/Clash.hs 84 | default-language: Haskell2010 85 | Build-Depends: base, clash-ghc, blinker 86 | if !os(Windows) 87 | ghc-options: -dynamic 88 | 89 | -- Builds the executable 'clashi', with blinker in scope 90 | executable clashi 91 | main-is: bin/Clashi.hs 92 | default-language: Haskell2010 93 | if !os(Windows) 94 | ghc-options: -dynamic 95 | build-depends: base, clash-ghc, blinker 96 | -------------------------------------------------------------------------------- /demo/blinker/blinker.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/standardsemiconductor/VELDT-getting-started/d5a70f6478fb615b808fdb7e14504ee19ebd5d0a/demo/blinker/blinker.gif -------------------------------------------------------------------------------- /demo/blinker/cabal.project: -------------------------------------------------------------------------------- 1 | packages: 2 | blinker.cabal, 3 | ../../veldt/veldt.cabal 4 | 5 | package clash-prelude 6 | -- 'large-tuples' generates tuple instances for various classes up to the 7 | -- GHC imposed maximum of 62 elements. This severely slows down compiling 8 | -- Clash, and triggers Template Haskell bugs on Windows. Hence, we disable 9 | -- it by default. This will be the default for Clash >=1.4. 10 | flags: -large-tuples 11 | -------------------------------------------------------------------------------- /demo/echo/Echo.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | module Echo where 3 | 4 | import Clash.Prelude 5 | import Clash.Annotations.TH 6 | import Control.Monad 7 | import Control.Monad.RWS 8 | import Control.Lens 9 | import qualified Veldt.Uart as U 10 | 11 | data Fsm = Read | Write 12 | deriving (Generic, NFDataX) 13 | 14 | data Echo = Echo 15 | { _byte :: BitVector 8 16 | , _uart :: U.Uart 17 | , _fsm :: Fsm 18 | } deriving (Generic, NFDataX) 19 | makeLenses ''Echo 20 | 21 | mkEcho :: Echo 22 | mkEcho = Echo 23 | { _byte = 0 24 | , _uart = U.mkUart 624 25 | , _fsm = Read 26 | } 27 | 28 | echoM :: RWS U.Rx U.Tx Echo () 29 | echoM = use fsm >>= \case 30 | Read -> do 31 | rM <- zoom uart U.read 32 | forM_ rM $ \r -> do 33 | byte .= r 34 | fsm .= Write 35 | Write -> do 36 | w <- use byte 37 | done <- zoom uart $ U.write w 38 | when done $ fsm .= Read 39 | 40 | echo 41 | :: HiddenClockResetEnable dom 42 | => Signal dom Bit 43 | -> Signal dom Bit 44 | echo = echoMealy <^> mkEcho 45 | where 46 | echoMealy s i = let ((), s', tx) = runRWS echoM (U.Rx i) s 47 | in (s', U.unTx tx) 48 | 49 | {-# NOINLINE topEntity #-} 50 | topEntity 51 | :: "clk" ::: Clock XilinxSystem 52 | -> "rx" ::: Signal XilinxSystem Bit 53 | -> "tx" ::: Signal XilinxSystem Bit 54 | topEntity clk = withClockResetEnable clk rst enableGen echo 55 | where 56 | rst = unsafeFromHighPolarity $ pure False 57 | makeTopEntityWithName 'topEntity "Echo" 58 | -------------------------------------------------------------------------------- /demo/echo/Echo.pcf: -------------------------------------------------------------------------------- 1 | set_io tx 17 # iob_33b_spi_wi ice_bowi uart_tx 2 | set_io rx 15 # iob_34a_spi_wck ice_wck uart_rx 3 | 4 | set_io clk 35 # iot_46b_g0 12Mhz Xtal 5 | -------------------------------------------------------------------------------- /demo/echo/Main.hs: -------------------------------------------------------------------------------- 1 | import System.Hardware.Serialport 2 | import System.IO 3 | import Control.Monad (forever) 4 | import qualified Data.ByteString.Char8 as B 5 | 6 | main :: IO () 7 | main = withSerial "/dev/ttyUSB0" settings $ \port -> do 8 | hSetBuffering stdin NoBuffering 9 | hSetBuffering stdout NoBuffering 10 | forever $ echo port 11 | where 12 | echo port = do 13 | send port . B.singleton =<< getChar 14 | putChar . B.head =<< recv port 1 15 | settings = defaultSerialSettings{ commSpeed = CS19200 } 16 | -------------------------------------------------------------------------------- /demo/echo/Makefile: -------------------------------------------------------------------------------- 1 | TOP := Echo 2 | 3 | all: $(TOP).bin 4 | 5 | $(TOP).bin: $(TOP).asc 6 | icepack $< $@ 7 | 8 | $(TOP).asc: $(TOP).json $(TOP).pcf 9 | nextpnr-ice40 --up5k --package sg48 --pcf $(TOP).pcf --asc $@ --json $< 10 | 11 | $(TOP).json: $(TOP).hs 12 | cabal run clash --write-ghc-environment-files=always -- $(TOP) --verilog 13 | yosys -q -p "synth_ice40 -top $(TOP) -json $@ -abc2" verilog/$(TOP).topEntity/*.v 14 | 15 | prog: $(TOP).bin 16 | iceprog $< 17 | 18 | build: $(TOP).hs 19 | cabal build $< 20 | 21 | clean: 22 | rm -rf verilog/ 23 | rm -f $(TOP).json 24 | rm -f $(TOP).asc 25 | rm -f $(TOP).bin 26 | rm -f *~ 27 | rm -f *.hi 28 | rm -f *.o 29 | rm -f *.dyn_hi 30 | rm -f *.dyn_o 31 | 32 | clean-all: 33 | $(MAKE) clean 34 | cabal clean 35 | 36 | .PHONY: all clean clean-all prog build 37 | -------------------------------------------------------------------------------- /demo/echo/bin/Clash.hs: -------------------------------------------------------------------------------- 1 | import Prelude 2 | import System.Environment (getArgs) 3 | import Clash.Main (defaultMain) 4 | 5 | main :: IO () 6 | main = getArgs >>= defaultMain 7 | -------------------------------------------------------------------------------- /demo/echo/bin/Clashi.hs: -------------------------------------------------------------------------------- 1 | import Prelude 2 | import System.Environment (getArgs) 3 | import Clash.Main (defaultMain) 4 | 5 | main :: IO () 6 | main = getArgs >>= defaultMain . ("--interactive":) 7 | -------------------------------------------------------------------------------- /demo/echo/cabal.project: -------------------------------------------------------------------------------- 1 | packages: 2 | echo.cabal, 3 | ../../veldt/veldt.cabal 4 | 5 | package clash-prelude 6 | -- 'large-tuples' generates tuple instances for various classes up to the 7 | -- GHC imposed maximum of 62 elements. This severely slows down compiling 8 | -- Clash, and triggers Template Haskell bugs on Windows. Hence, we disable 9 | -- it by default. This will be the default for Clash >=1.4. 10 | flags: -large-tuples 11 | -------------------------------------------------------------------------------- /demo/echo/echo.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | name: echo 3 | version: 0.1.0.0 4 | license-file: LICENSE 5 | author: Standard Semiconductor 6 | maintainer: standard.semiconductor@gmail.com 7 | extra-source-files: CHANGELOG.md 8 | 9 | common common-options 10 | default-extensions: 11 | BangPatterns 12 | BinaryLiterals 13 | ConstraintKinds 14 | DataKinds 15 | DefaultSignatures 16 | DeriveAnyClass 17 | DeriveDataTypeable 18 | DeriveFoldable 19 | DeriveFunctor 20 | DeriveGeneric 21 | DeriveLift 22 | DeriveTraversable 23 | DerivingStrategies 24 | InstanceSigs 25 | KindSignatures 26 | LambdaCase 27 | NoStarIsType 28 | PolyKinds 29 | RankNTypes 30 | ScopedTypeVariables 31 | StandaloneDeriving 32 | TupleSections 33 | TypeApplications 34 | TypeFamilies 35 | TypeOperators 36 | ViewPatterns 37 | 38 | -- TemplateHaskell is used to support convenience functions such as 39 | -- 'listToVecTH' and 'bLit'. 40 | TemplateHaskell 41 | QuasiQuotes 42 | 43 | -- Prelude isn't imported by default as Clash offers Clash.Prelude 44 | NoImplicitPrelude 45 | ghc-options: 46 | -Wall -Wcompat 47 | -haddock 48 | 49 | -- Plugins to support type-level constraint solving on naturals 50 | -fplugin GHC.TypeLits.Extra.Solver 51 | -fplugin GHC.TypeLits.Normalise 52 | -fplugin GHC.TypeLits.KnownNat.Solver 53 | 54 | -- Clash needs access to the source code in compiled modules 55 | -fexpose-all-unfoldings 56 | 57 | -- Worker wrappers introduce unstable names for functions that might have 58 | -- blackboxes attached for them. You can disable this, but be sure to add 59 | -- a no-specialize pragma to every function with a blackbox. 60 | -fno-worker-wrapper 61 | default-language: Haskell2010 62 | build-depends: 63 | base, 64 | Cabal, 65 | mtl, 66 | lens, 67 | interpolate, 68 | veldt, 69 | 70 | -- clash-prelude will set suitable version bounds for the plugins 71 | clash-prelude >= 1.4 && < 1.9, 72 | ghc-typelits-natnormalise, 73 | ghc-typelits-extra, 74 | ghc-typelits-knownnat 75 | 76 | library 77 | import: common-options 78 | exposed-modules: Echo 79 | default-language: Haskell2010 80 | 81 | -- Builds the executable 'clash', with echo in scope 82 | executable clash 83 | main-is: bin/Clash.hs 84 | default-language: Haskell2010 85 | Build-Depends: base, clash-ghc, echo 86 | if !os(Windows) 87 | ghc-options: -dynamic 88 | 89 | -- Builds the executable 'clashi', with echo in scope 90 | executable clashi 91 | main-is: bin/Clashi.hs 92 | default-language: Haskell2010 93 | if !os(Windows) 94 | ghc-options: -dynamic 95 | build-depends: base, clash-ghc, echo 96 | 97 | executable echo 98 | main-is: Main.hs 99 | default-language: Haskell2010 100 | build-depends: base, 101 | serialport >= 0.5 && < 0.6, 102 | bytestring 103 | -------------------------------------------------------------------------------- /demo/echo/echo.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/standardsemiconductor/VELDT-getting-started/d5a70f6478fb615b808fdb7e14504ee19ebd5d0a/demo/echo/echo.gif -------------------------------------------------------------------------------- /demo/pcf_generic.pcf: -------------------------------------------------------------------------------- 1 | # set_io iob_0a 46 # iob_0a 2 | # set_io iob_2a 47 # iob_2a 3 | 4 | # set_io iob_3b_g6 44 # iob_3b_g6 5 | 6 | # set_io iob_4a 48 # iob_4a 7 | # set_io iob_5b 45 # iob_5b 8 | # set_io iob_6a 2 # iob_6a 9 | # set_io iob_8a 4 # iob_8a 10 | # set_io iob_9b 3 # iob_9b 11 | 12 | # set_io creset_b 8 # creset_b 13 | 14 | # set_io iob_13b 6 # iob_13b 15 | 16 | # set_io cdone 7 # cdone 17 | 18 | # set_io iob_16a 9 # iob_16a mem_biwo 19 | # set_io iob_18a 10 # iob_18a mem_wck 20 | # set_io iob_20a 11 # iob_20a mem_bowi 21 | # set_io iob_22b 12 # iob_22b mem_wp 22 | # set_io iob_23b 21 # iob_23b mem_hold 23 | # set_io iob_24a 13 # iob_24a mem_cs 24 | 25 | # set_io iob_25b_g3 20 # iob_25b_g3 26 | 27 | # set_io iob_29b 19 # iob_29b 28 | # set_io iob_31b 18 # iob_31b 29 | 30 | # set_io iob_32a_spi_wo 14 # iob_32a_spi_wo ice_biwo 31 | # set_io iob_33b_spi_wi 17 # iob_33b_spi_wi ice_bowi uart_tx 32 | # set_io iob_34a_spi_wck 15 # iob_34a_spi_wck ice_wck uart_rx 33 | # set_io iob_35b_spi_csn 16 # iob_35b_spi_csn ice_cs 34 | 35 | # set_io iot_36b 25 # iot_36b 36 | # set_io iot_37a 23 # iot_37a 37 | # set_io iot_38b 27 # iot_38b 38 | # set_io iot_39a 26 # iot_39a 39 | # set_io iot_41a 28 # iot_41a 40 | # set_io iot_42b 31 # iot_42b 41 | # set_io iot_43a 32 # iot_43a 42 | # set_io iot_44b 34 # iot_44b 43 | 44 | # set_io iot_45a_g1 37 # iot_45a_g1 45 | # set_io iot_46b_g0 35 # iot_46b_g0 12Mhz Xtal 46 | 47 | # set_io iot_48b 36 # iot_48b 48 | # set_io iot_49a 43 # iot_49a 49 | # set_io iot_50b 38 # iot_50b 50 | # set_io iot_51a 42 # iot_51a 51 | 52 | # set_io rgb2 41 # rgb2 blue 53 | # set_io rgb1 40 # rgb1 green 54 | # set_io rgb0 39 # rgb0 red 55 | 56 | # set_io vcc_0 5 # vcc 57 | # set_io vcc_1 30 # vcc 58 | # set_io vccio_0 33 # vccio_0 59 | # set_io vccio_2 1 # vccio_2 60 | # set_io spi_vccio1 22 # spi_vccio1 61 | # set_io vccpll 29 # vccpll 62 | # set_io vpp_2v5 24 # vpp_2v5 -------------------------------------------------------------------------------- /demo/uart-led/Makefile: -------------------------------------------------------------------------------- 1 | TOP := UartLed 2 | 3 | all: $(TOP).bin 4 | 5 | $(TOP).bin: $(TOP).asc 6 | icepack $< $@ 7 | 8 | $(TOP).asc: $(TOP).json $(TOP).pcf 9 | nextpnr-ice40 --up5k --package sg48 --pcf $(TOP).pcf --asc $@ --json $< 10 | 11 | $(TOP).json: $(TOP).hs 12 | cabal run clash --write-ghc-environment-files=always -- $(TOP) --verilog 13 | yosys -q -p "synth_ice40 -top $(TOP) -json $@ -abc2" verilog/$(TOP).topEntity/*.v 14 | 15 | prog: $(TOP).bin 16 | iceprog $< 17 | 18 | build: $(TOP).hs 19 | cabal build $< 20 | 21 | clean: 22 | rm -rf verilog/ 23 | rm -f $(TOP).json 24 | rm -f $(TOP).asc 25 | rm -f $(TOP).bin 26 | rm -f *~ 27 | rm -f *.hi 28 | rm -f *.o 29 | rm -f *.dyn_hi 30 | rm -f *.dyn_o 31 | 32 | clean-all: 33 | $(MAKE) clean 34 | cabal clean 35 | 36 | .PHONY: all clean clean-all prog build 37 | -------------------------------------------------------------------------------- /demo/uart-led/UartLed.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | module UartLed where 3 | 4 | import Clash.Prelude 5 | import Clash.Annotations.TH 6 | import Control.Monad 7 | import Control.Monad.RWS 8 | import Control.Lens hiding (Index) 9 | import Data.Maybe (fromMaybe) 10 | import Data.Monoid 11 | import Veldt.Counter 12 | import qualified Veldt.PWM.Rgb as P 13 | import qualified Veldt.Ice40.Rgb as R 14 | import qualified Veldt.Uart as U 15 | 16 | type Byte = BitVector 8 17 | type Timer = Index 36000000 18 | 19 | data Speed = Low | Mid | Hi 20 | deriving (NFDataX, Generic, Eq, Bounded, Enum) 21 | 22 | toPeriod :: Speed -> Timer 23 | toPeriod = \case 24 | Low -> 35999999 25 | Mid -> 11999999 26 | Hi -> 2999999 27 | 28 | data Color = Red | Green | Blue 29 | deriving (NFDataX, Generic) 30 | 31 | fromColor :: Color -> (Byte, Byte, Byte) 32 | fromColor = \case 33 | Red -> (0xFF, 0x00, 0x00) 34 | Green -> (0x00, 0xFF, 0x00) 35 | Blue -> (0x00, 0x00, 0xFF) 36 | 37 | data Led = On | Off 38 | deriving (NFDataX, Generic, Eq) 39 | 40 | toggle :: Led -> Led 41 | toggle On = Off 42 | toggle Off = On 43 | 44 | data Instr = Speed | Color Color 45 | deriving (NFDataX, Generic) 46 | 47 | encodeInstrM :: Byte -> Maybe Instr 48 | encodeInstrM = \case 49 | 0x73 -> Just Speed -- 's' 50 | 0x72 -> Just $ Color Red -- 'r' 51 | 0x67 -> Just $ Color Green -- 'g' 52 | 0x62 -> Just $ Color Blue -- 'b' 53 | _ -> Nothing 54 | 55 | data UartLed = UartLed 56 | { _uart :: U.Uart 57 | , _pwmRgb :: P.PWMRgb Byte 58 | , _speed :: Speed 59 | , _led :: Led 60 | , _timer :: Timer 61 | } deriving (NFDataX, Generic) 62 | makeLenses ''UartLed 63 | 64 | mkUartLed :: UartLed 65 | mkUartLed = UartLed 66 | { _uart = U.mkUart 624 67 | , _pwmRgb = P.mkPWMRgb $ fromColor Red 68 | , _speed = Low 69 | , _led = On 70 | , _timer = 0 71 | } 72 | 73 | uartLed :: RWS U.Rx (First R.Rgb) UartLed () 74 | uartLed = do 75 | -- Output pwm rgb when Led on 76 | isOn <- uses led (== On) 77 | when isOn $ tell . First . Just =<< zoom pwmRgb P.pwmRgb 78 | 79 | -- Check toggle led 80 | period <- uses speed toPeriod 81 | t <- timer <<%= incrementUnless (== period) 82 | when (t == period) $ led %= toggle 83 | 84 | -- Update color/speed from uart 85 | bM <- zoom uart U.read 86 | forM_ (bM >>= encodeInstrM) $ \case 87 | Speed -> do 88 | speed %= increment 89 | timer .= 0 90 | Color c -> zoom pwmRgb $ P.setRgb $ fromColor c 91 | 92 | uartLedS 93 | :: HiddenClockResetEnable dom 94 | => Signal dom Bit 95 | -> Signal dom R.Rgb 96 | uartLedS = R.rgb . fmap (fromMaybe (0, 0, 0) . getFirst) . mealy uartLedMealy mkUartLed 97 | where 98 | uartLedMealy s i = let ((), s', o) = runRWS uartLed (U.Rx i) s 99 | in (s', o) 100 | 101 | {-# NOINLINE topEntity #-} 102 | topEntity 103 | :: "clk" ::: Clock XilinxSystem 104 | -> "rx" ::: Signal XilinxSystem Bit 105 | -> "led" ::: Signal XilinxSystem R.Rgb 106 | topEntity clk = withClockResetEnable clk rst enableGen uartLedS 107 | where 108 | rst = unsafeFromHighPolarity $ pure False 109 | makeTopEntityWithName 'topEntity "UartLed" 110 | -------------------------------------------------------------------------------- /demo/uart-led/UartLed.pcf: -------------------------------------------------------------------------------- 1 | set_io rx 15 # iob_34a_spi_wck ice_wck uart_rx 2 | 3 | set_io clk 35 # iot_46b_g0 12Mhz Xtal 4 | 5 | set_io led_blue 41 # rgb2 blue 6 | set_io led_green 40 # rgb1 green 7 | set_io led_red 39 # rgb0 red 8 | -------------------------------------------------------------------------------- /demo/uart-led/bin/Clash.hs: -------------------------------------------------------------------------------- 1 | import Prelude 2 | import System.Environment (getArgs) 3 | import Clash.Main (defaultMain) 4 | 5 | main :: IO () 6 | main = getArgs >>= defaultMain 7 | -------------------------------------------------------------------------------- /demo/uart-led/bin/Clashi.hs: -------------------------------------------------------------------------------- 1 | import Prelude 2 | import System.Environment (getArgs) 3 | import Clash.Main (defaultMain) 4 | 5 | main :: IO () 6 | main = getArgs >>= defaultMain . ("--interactive":) 7 | -------------------------------------------------------------------------------- /demo/uart-led/cabal.project: -------------------------------------------------------------------------------- 1 | packages: 2 | uart-led.cabal, 3 | ../../veldt/veldt.cabal 4 | 5 | package clash-prelude 6 | -- 'large-tuples' generates tuple instances for various classes up to the 7 | -- GHC imposed maximum of 62 elements. This severely slows down compiling 8 | -- Clash, and triggers Template Haskell bugs on Windows. Hence, we disable 9 | -- it by default. This will be the default for Clash >=1.4. 10 | flags: -large-tuples 11 | -------------------------------------------------------------------------------- /demo/uart-led/uart-led.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | name: uart-led 3 | version: 0.1 4 | license-file: LICENSE 5 | author: Standard semiconductor 6 | maintainer: standard.semiconductor@gmail.com 7 | 8 | common common-options 9 | default-extensions: 10 | BangPatterns 11 | BinaryLiterals 12 | ConstraintKinds 13 | DataKinds 14 | DefaultSignatures 15 | DeriveAnyClass 16 | DeriveDataTypeable 17 | DeriveFoldable 18 | DeriveFunctor 19 | DeriveGeneric 20 | DeriveLift 21 | DeriveTraversable 22 | DerivingStrategies 23 | DerivingVia 24 | GeneralizedNewtypeDeriving 25 | InstanceSigs 26 | KindSignatures 27 | LambdaCase 28 | MagicHash 29 | NoStarIsType 30 | PolyKinds 31 | RankNTypes 32 | ScopedTypeVariables 33 | StandaloneDeriving 34 | TupleSections 35 | TypeApplications 36 | TypeFamilies 37 | TypeOperators 38 | ViewPatterns 39 | 40 | -- TemplateHaskell is used to support convenience functions such as 41 | -- 'listToVecTH' and 'bLit'. 42 | TemplateHaskell 43 | QuasiQuotes 44 | 45 | -- Prelude isn't imported by default as Clash offers Clash.Prelude 46 | NoImplicitPrelude 47 | ghc-options: 48 | -Wall -Wcompat 49 | -haddock 50 | 51 | -- Plugins to support type-level constraint solving on naturals 52 | -fplugin GHC.TypeLits.Extra.Solver 53 | -fplugin GHC.TypeLits.Normalise 54 | -fplugin GHC.TypeLits.KnownNat.Solver 55 | 56 | -- Clash needs access to the source code in compiled modules 57 | -fexpose-all-unfoldings 58 | 59 | -- Worker wrappers introduce unstable names for functions that might have 60 | -- blackboxes attached for them. You can disable this, but be sure to add 61 | -- a no-specialize pragma to every function with a blackbox. 62 | -fno-worker-wrapper 63 | default-language: Haskell2010 64 | build-depends: 65 | base, 66 | Cabal, 67 | mtl, 68 | lens, 69 | veldt, 70 | -- clash-prelude will set suitable version bounds for the plugins 71 | clash-prelude >= 1.4 && < 1.9, 72 | ghc-typelits-natnormalise, 73 | ghc-typelits-extra, 74 | ghc-typelits-knownnat 75 | 76 | library 77 | import: common-options 78 | exposed-modules: 79 | UartLed 80 | default-language: Haskell2010 81 | 82 | -- Builds the executable 'clash', with uart-led in scope 83 | executable clash 84 | main-is: bin/Clash.hs 85 | default-language: Haskell2010 86 | Build-Depends: base, clash-ghc, uart-led 87 | if !os(Windows) 88 | ghc-options: -dynamic 89 | 90 | -- Builds the executable 'clashi', with uart-led in scope 91 | executable clashi 92 | main-is: bin/Clashi.hs 93 | default-language: Haskell2010 94 | if !os(Windows) 95 | ghc-options: -dynamic 96 | build-depends: base, clash-ghc, uart-led 97 | -------------------------------------------------------------------------------- /veldt/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for veldt 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /veldt/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /veldt/Veldt/Counter.hs: -------------------------------------------------------------------------------- 1 | module Veldt.Counter 2 | ( increment 3 | , incrementWhen 4 | , incrementUnless 5 | , decrement 6 | ) where 7 | 8 | import Clash.Prelude 9 | 10 | ------------- 11 | -- Counter -- 12 | ------------- 13 | increment :: (Bounded a, Enum a, Eq a) => a -> a 14 | increment a 15 | | a == maxBound = minBound 16 | | otherwise = succ a 17 | 18 | decrement :: (Bounded a, Enum a, Eq a) => a -> a 19 | decrement a 20 | | a == minBound = maxBound 21 | | otherwise = pred a 22 | 23 | incrementWhen :: (Bounded a, Enum a, Eq a) => (a -> Bool) -> a -> a 24 | incrementWhen p a 25 | | p a = increment a 26 | | otherwise = minBound 27 | 28 | incrementUnless :: (Bounded a, Enum a, Eq a) => (a -> Bool) -> a -> a 29 | incrementUnless p = incrementWhen (not . p) 30 | -------------------------------------------------------------------------------- /veldt/Veldt/Ice40/Rgb.hs: -------------------------------------------------------------------------------- 1 | module Veldt.Ice40.Rgb 2 | ( Rgb 3 | , rgb 4 | ) where 5 | 6 | import Clash.Prelude 7 | import Clash.Annotations.Primitive 8 | import Data.String.Interpolate (i) 9 | import Data.String.Interpolate.Util (unindent) 10 | 11 | {-# ANN rgbPrim (InlinePrimitive [Verilog] $ unindent [i| 12 | [ { "BlackBox" : 13 | { "name" : "Veldt.Ice40.Rgb.rgbPrim" 14 | , "kind" : "Declaration" 15 | , "type" : 16 | "rgbPrim 17 | :: String -- current_mode ARG[0] 18 | -> String -- rgb0_current ARG[1] 19 | -> String -- rgb1_current ARG[2] 20 | -> String -- rgb2_current ARG[3] 21 | -> Signal dom Bit -- pwm_r ARG[4] 22 | -> Signal dom Bit -- pwm_g ARG[5] 23 | -> Signal dom Bit -- pwm_b ARG[6] 24 | -> Signal dom (Bit, Bit, Bit)" 25 | , "template" : 26 | "//SB_RGBA_DRV begin 27 | wire ~GENSYM[RED][0]; 28 | wire ~GENSYM[GREEN][1]; 29 | wire ~GENSYM[BLUE][2]; 30 | 31 | SB_RGBA_DRV #( 32 | .CURRENT_MODE(~ARG[0]), 33 | .RGB0_CURRENT(~ARG[1]), 34 | .RGB1_CURRENT(~ARG[2]), 35 | .RGB2_CURRENT(~ARG[3]) 36 | ) RGBA_DRIVER ( 37 | .CURREN(1'b1), 38 | .RGBLEDEN(1'b1), 39 | .RGB0PWM(~ARG[4]), 40 | .RGB1PWM(~ARG[5]), 41 | .RGB2PWM(~ARG[6]), 42 | .RGB0(~SYM[0]), 43 | .RGB1(~SYM[1]), 44 | .RGB2(~SYM[2]) 45 | ); 46 | 47 | assign ~RESULT = {~SYM[0], ~SYM[1], ~SYM[2]}; 48 | //SB_RGBA_DRV end" 49 | } 50 | } 51 | ] 52 | |]) #-} 53 | 54 | {-# NOINLINE rgbPrim #-} 55 | rgbPrim 56 | :: String 57 | -> String 58 | -> String 59 | -> String 60 | -> Signal dom Bit 61 | -> Signal dom Bit 62 | -> Signal dom Bit 63 | -> Signal dom (Bit, Bit, Bit) 64 | rgbPrim !_ !_ !_ !_ !_ !_ !_ = pure (0, 0, 0) 65 | 66 | type Rgb = ("red" ::: Bit, "green" ::: Bit, "blue" ::: Bit) 67 | 68 | rgb :: Signal dom Rgb -> Signal dom Rgb 69 | rgb rgbPWM = let (r, g, b) = unbundle rgbPWM 70 | in rgbPrim "0b0" "0b111111" "0b111111" "0b111111" r g b 71 | -------------------------------------------------------------------------------- /veldt/Veldt/PWM.hs: -------------------------------------------------------------------------------- 1 | module Veldt.PWM 2 | ( PWM 3 | , mkPWM 4 | , pwm 5 | , setDuty 6 | ) where 7 | 8 | import Clash.Prelude 9 | import Control.Lens 10 | import Control.Monad.RWS 11 | import Veldt.Counter 12 | 13 | --------- 14 | -- PWM -- 15 | --------- 16 | data PWM a = PWM 17 | { _ctr :: a 18 | , _duty :: a 19 | } deriving (NFDataX, Generic) 20 | makeLenses ''PWM 21 | 22 | mkPWM :: Bounded a => a -> PWM a 23 | mkPWM = PWM minBound 24 | 25 | setDuty :: (Monoid w, Monad m, Bounded a) => a -> RWST r w (PWM a) m () 26 | setDuty d = do 27 | duty .= d 28 | ctr .= minBound 29 | 30 | pwm :: (Monoid w, Monad m, Ord a, Bounded a, Enum a) => RWST r w (PWM a) m Bit 31 | pwm = do 32 | d <- use duty 33 | c <- ctr <<%= increment 34 | return $ boolToBit $ c < d 35 | 36 | 37 | -------------------------------------------------------------------------------- /veldt/Veldt/PWM/Rgb.hs: -------------------------------------------------------------------------------- 1 | module Veldt.PWM.Rgb where 2 | 3 | import Clash.Prelude 4 | import Control.Lens 5 | import Control.Monad.RWS 6 | import Veldt.PWM 7 | import Veldt.Ice40.Rgb (Rgb) 8 | 9 | ----------- 10 | -- Types -- 11 | ----------- 12 | data PWMRgb a = PWMRgb 13 | { _redPWM :: PWM a 14 | , _greenPWM :: PWM a 15 | , _bluePWM :: PWM a 16 | } deriving (NFDataX, Generic) 17 | makeLenses ''PWMRgb 18 | 19 | mkPWMRgb :: Bounded a => (a, a, a) -> PWMRgb a 20 | mkPWMRgb (r, g, b) = PWMRgb 21 | { _redPWM = mkPWM r 22 | , _greenPWM = mkPWM g 23 | , _bluePWM = mkPWM b 24 | } 25 | 26 | --------- 27 | -- API -- 28 | --------- 29 | pwmRgb :: (Monoid w, Monad m, Ord a, Bounded a, Enum a) => RWST r w (PWMRgb a) m Rgb 30 | pwmRgb = do 31 | r <- zoom redPWM pwm 32 | g <- zoom greenPWM pwm 33 | b <- zoom bluePWM pwm 34 | return (r, g, b) 35 | 36 | setRgb :: (Monoid w, Monad m, Bounded a) => (a, a, a) -> RWST r w (PWMRgb a) m () 37 | setRgb (r, g, b) = do 38 | zoom redPWM $ setDuty r 39 | zoom greenPWM $ setDuty g 40 | zoom bluePWM $ setDuty b 41 | -------------------------------------------------------------------------------- /veldt/Veldt/Serial.hs: -------------------------------------------------------------------------------- 1 | module Veldt.Serial 2 | ( Direction(..) 3 | -- Deserializer 4 | , Deserializer 5 | , mkDeserializer 6 | , full 7 | , deserialize 8 | , get 9 | , clear 10 | -- Serializer 11 | , Serializer 12 | , mkSerializer 13 | , empty 14 | , serialize 15 | , peek 16 | , give 17 | ) where 18 | 19 | import Clash.Prelude hiding (empty) 20 | import Control.Monad.RWS (RWST) 21 | import Control.Lens hiding (Index) 22 | import qualified Veldt.Counter as C 23 | 24 | data Direction = L | R 25 | deriving (NFDataX, Generic) 26 | 27 | ------------------ 28 | -- Deserializer -- 29 | ------------------ 30 | data Deserializer n a = Deserializer 31 | { _dBuf :: Vec n a 32 | , _dFull :: Bool 33 | , _dCtr :: Index n 34 | , _dDir :: Direction 35 | } deriving (NFDataX, Generic) 36 | makeLenses ''Deserializer 37 | 38 | mkDeserializer :: KnownNat n => a -> Direction -> Deserializer n a 39 | mkDeserializer a = Deserializer (repeat a) False 0 40 | 41 | full :: (Monoid w, Monad m) => RWST r w (Deserializer n a) m Bool 42 | full = use dFull 43 | 44 | deserialize :: (Monoid w, Monad m, KnownNat n) => a -> RWST r w (Deserializer n a) m () 45 | deserialize d = do 46 | use dDir >>= \case 47 | R -> dBuf %= (<<+ d) 48 | L -> dBuf %= (d +>>) 49 | dFull <~ uses dCtr (== maxBound) 50 | dCtr %= C.increment 51 | 52 | get :: (Monoid w, Monad m) => RWST r w (Deserializer n a) m (Vec n a) 53 | get = use dBuf 54 | 55 | clear :: (Monoid w, Monad m, KnownNat n) => RWST r w (Deserializer n a) m () 56 | clear = do 57 | dFull .= False 58 | dCtr .= 0 59 | 60 | ---------------- 61 | -- Serializer -- 62 | ---------------- 63 | data Serializer n a = Serializer 64 | { _sBuf :: Vec n a 65 | , _sEmpty :: Bool 66 | , _sCtr :: Index n 67 | , _sDir :: Direction 68 | } deriving (NFDataX, Generic) 69 | makeLenses ''Serializer 70 | 71 | mkSerializer :: KnownNat n => a -> Direction -> Serializer n a 72 | mkSerializer a = Serializer (repeat a) True 0 73 | 74 | serialize :: (Monoid w, Monad m, KnownNat n) => RWST r w (Serializer n a) m () 75 | serialize = do 76 | use sDir >>= \case 77 | R -> sBuf %= (`rotateRightS` d1) 78 | L -> sBuf %= (`rotateLeftS` d1) 79 | sEmpty <~ uses sCtr (== maxBound) 80 | sCtr %= C.increment 81 | 82 | peek :: (Monoid w, Monad m, KnownNat n) => RWST r w (Serializer (n + 1) a) m a 83 | peek = use sDir >>= \case 84 | R -> uses sBuf last 85 | L -> uses sBuf head 86 | 87 | give :: (Monoid w, Monad m, KnownNat n) => Vec n a -> RWST r w (Serializer n a) m () 88 | give v = do 89 | sBuf .= v 90 | sEmpty .= False 91 | sCtr .= 0 92 | 93 | empty :: (Monoid w, Monad m) => RWST r w (Serializer n a) m Bool 94 | empty = use sEmpty 95 | -------------------------------------------------------------------------------- /veldt/Veldt/Uart.hs: -------------------------------------------------------------------------------- 1 | module Veldt.Uart 2 | ( Rx(Rx) 3 | , unRx 4 | , Tx(Tx) 5 | , unTx 6 | , Byte 7 | , Uart 8 | , mkUart 9 | , read 10 | , write 11 | ) where 12 | 13 | import Clash.Prelude hiding (read) 14 | import Control.Monad 15 | import Control.Monad.RWS 16 | import Control.Lens hiding ((:>)) 17 | import qualified Veldt.Counter as C 18 | import qualified Veldt.Serial as S 19 | 20 | type Byte = BitVector 8 21 | 22 | newtype Rx = Rx { unRx :: Bit } 23 | newtype Tx = Tx { unTx :: Bit } 24 | 25 | instance Semigroup Tx where 26 | Tx tx <> Tx tx' = Tx $ tx .&. tx' 27 | 28 | instance Monoid Tx where 29 | mempty = Tx 1 30 | 31 | ----------------- 32 | -- Transmitter -- 33 | ----------------- 34 | data TxFsm = TxStart | TxSend 35 | deriving (NFDataX, Generic) 36 | 37 | data Transmitter = Transmitter 38 | { _txSer :: S.Serializer 10 Bit 39 | , _txBaud :: Unsigned 16 40 | , _txCtr :: Unsigned 16 41 | , _txFsm :: TxFsm 42 | } 43 | deriving (NFDataX, Generic) 44 | makeLenses ''Transmitter 45 | 46 | mkTransmitter :: Unsigned 16 -> Transmitter 47 | mkTransmitter b = Transmitter 48 | { _txSer = S.mkSerializer 0 S.R 49 | , _txBaud = b 50 | , _txCtr = 0 51 | , _txFsm = TxStart 52 | } 53 | 54 | transmit :: Byte -> RWS r Tx Transmitter Bool 55 | transmit byte = use txFsm >>= \case 56 | TxStart -> do 57 | zoom txSer $ S.give $ bv2v $ frame byte 58 | txCtr .= 0 59 | txFsm .= TxSend 60 | return False 61 | TxSend -> do 62 | zoom txSer S.peek >>= tell . Tx 63 | baud <- use txBaud 64 | ctrDone <- uses txCtr (== baud) 65 | txCtr %= C.incrementUnless (== baud) 66 | if ctrDone 67 | then do 68 | zoom txSer S.serialize 69 | serEmpty <- zoom txSer S.empty 70 | when serEmpty $ txFsm .= TxStart 71 | return serEmpty 72 | else return False 73 | 74 | frame :: Byte -> BitVector 10 75 | frame b = (1 :: BitVector 1) ++# b ++# (0 :: BitVector 1) 76 | 77 | -------------- 78 | -- Receiver -- 79 | -------------- 80 | data RxFsm = RxIdle | RxStart | RxRecv | RxStop 81 | deriving (NFDataX, Generic) 82 | 83 | data Receiver = Receiver 84 | { _rxDes :: S.Deserializer 8 Bit 85 | , _rxBaud :: Unsigned 16 86 | , _rxCtr :: Unsigned 16 87 | , _rxFsm :: RxFsm 88 | } 89 | deriving (NFDataX, Generic) 90 | makeLenses ''Receiver 91 | 92 | mkReceiver :: Unsigned 16 -> Receiver 93 | mkReceiver b = Receiver 94 | { _rxDes = S.mkDeserializer 0 S.L 95 | , _rxBaud = b 96 | , _rxCtr = 0 97 | , _rxFsm = RxIdle 98 | } 99 | 100 | receive :: Monoid w => RWS Rx w Receiver (Maybe Byte) 101 | receive = use rxFsm >>= \case 102 | RxIdle -> do 103 | rxLow <- asks $ (== low) . unRx 104 | when rxLow $ do 105 | rxCtr %= C.increment 106 | rxFsm .= RxStart 107 | return Nothing 108 | RxStart -> do 109 | rxLow <- asks $ (== low) . unRx 110 | baudHalf <- uses rxBaud (`shiftR` 1) 111 | ctrDone <- uses rxCtr (== baudHalf) 112 | rxCtr %= C.incrementUnless (== baudHalf) 113 | when ctrDone $ if rxLow 114 | then rxFsm .= RxRecv 115 | else rxFsm .= RxIdle 116 | return Nothing 117 | RxRecv -> do 118 | ctrDone <- countBaud 119 | when ctrDone $ do 120 | i <- asks unRx 121 | zoom rxDes $ S.deserialize i 122 | full <- zoom rxDes S.full 123 | when full $ rxFsm .= RxStop 124 | return Nothing 125 | RxStop -> do 126 | ctrDone <- countBaud 127 | if ctrDone 128 | then do 129 | byte <- v2bv <$> zoom rxDes S.get 130 | zoom rxDes S.clear 131 | rxFsm .= RxIdle 132 | return $ Just byte 133 | else return Nothing 134 | where 135 | countBaud = do 136 | baud <- use rxBaud 137 | ctrDone <- uses rxCtr (== baud) 138 | rxCtr %= C.incrementUnless (== baud) 139 | return ctrDone 140 | 141 | ---------- 142 | -- Uart -- 143 | ---------- 144 | data Uart = Uart 145 | { _receiver :: Receiver 146 | , _transmitter :: Transmitter 147 | } 148 | deriving (NFDataX, Generic) 149 | makeLenses ''Uart 150 | 151 | mkUart :: Unsigned 16 -> Uart 152 | mkUart baud = Uart 153 | { _receiver = mkReceiver baud 154 | , _transmitter = mkTransmitter baud 155 | } 156 | 157 | read :: Monoid w => RWS Rx w Uart (Maybe Byte) 158 | read = zoom receiver receive 159 | 160 | write :: Byte -> RWS r Tx Uart Bool 161 | write = zoom transmitter . transmit 162 | -------------------------------------------------------------------------------- /veldt/bin/Clash.hs: -------------------------------------------------------------------------------- 1 | import Prelude 2 | import System.Environment (getArgs) 3 | import Clash.Main (defaultMain) 4 | 5 | main :: IO () 6 | main = getArgs >>= defaultMain 7 | -------------------------------------------------------------------------------- /veldt/bin/Clashi.hs: -------------------------------------------------------------------------------- 1 | import Prelude 2 | import System.Environment (getArgs) 3 | import Clash.Main (defaultMain) 4 | 5 | main :: IO () 6 | main = getArgs >>= defaultMain . ("--interactive":) 7 | -------------------------------------------------------------------------------- /veldt/cabal.project: -------------------------------------------------------------------------------- 1 | packages: 2 | veldt.cabal 3 | 4 | package clash-prelude 5 | -- 'large-tuples' generates tuple instances for various classes up to the 6 | -- GHC imposed maximum of 62 elements. This severely slows down compiling 7 | -- Clash, and triggers Template Haskell bugs on Windows. Hence, we disable 8 | -- it by default. This will be the default for Clash >=1.4. 9 | flags: -large-tuples 10 | -------------------------------------------------------------------------------- /veldt/veldt.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | name: veldt 3 | version: 0.1.0.0 4 | license-file: LICENSE 5 | author: Standard Semiconductor 6 | maintainer: standard.semiconductor@gmail.com 7 | extra-source-files: CHANGELOG.md 8 | 9 | common common-options 10 | default-extensions: 11 | BangPatterns 12 | BinaryLiterals 13 | ConstraintKinds 14 | DataKinds 15 | DefaultSignatures 16 | DeriveAnyClass 17 | DeriveDataTypeable 18 | DeriveFoldable 19 | DeriveFunctor 20 | DeriveGeneric 21 | DeriveLift 22 | DeriveTraversable 23 | DerivingStrategies 24 | InstanceSigs 25 | KindSignatures 26 | LambdaCase 27 | NoStarIsType 28 | PolyKinds 29 | RankNTypes 30 | ScopedTypeVariables 31 | StandaloneDeriving 32 | TupleSections 33 | TypeApplications 34 | TypeFamilies 35 | TypeOperators 36 | ViewPatterns 37 | 38 | -- TemplateHaskell is used to support convenience functions such as 39 | -- 'listToVecTH' and 'bLit'. 40 | TemplateHaskell 41 | QuasiQuotes 42 | 43 | -- Prelude isn't imported by default as Clash offers Clash.Prelude 44 | NoImplicitPrelude 45 | ghc-options: 46 | -Wall -Wcompat 47 | -haddock 48 | 49 | -- Plugins to support type-level constraint solving on naturals 50 | -fplugin GHC.TypeLits.Extra.Solver 51 | -fplugin GHC.TypeLits.Normalise 52 | -fplugin GHC.TypeLits.KnownNat.Solver 53 | 54 | -- Clash needs access to the source code in compiled modules 55 | -fexpose-all-unfoldings 56 | 57 | -- Worker wrappers introduce unstable names for functions that might have 58 | -- blackboxes attached for them. You can disable this, but be sure to add 59 | -- a no-specialize pragma to every function with a blackbox. 60 | -fno-worker-wrapper 61 | default-language: Haskell2010 62 | build-depends: 63 | base, 64 | Cabal, 65 | mtl, 66 | lens, 67 | interpolate, 68 | 69 | -- clash-prelude will set suitable version bounds for the plugins 70 | clash-prelude >= 1.2.5 && < 1.9, 71 | ghc-typelits-natnormalise, 72 | ghc-typelits-extra, 73 | ghc-typelits-knownnat 74 | 75 | library 76 | import: common-options 77 | exposed-modules: Veldt.Counter, 78 | Veldt.PWM, 79 | Veldt.PWM.Rgb, 80 | Veldt.Serial, 81 | Veldt.Uart, 82 | Veldt.Ice40.Rgb 83 | default-language: Haskell2010 84 | 85 | -- Builds the executable 'clash', with veldt in scope 86 | executable clash 87 | main-is: bin/Clash.hs 88 | default-language: Haskell2010 89 | Build-Depends: base, clash-ghc, veldt 90 | if !os(Windows) 91 | ghc-options: -dynamic 92 | 93 | -- Builds the executable 'clashi', with veldt in scope 94 | executable clashi 95 | main-is: bin/Clashi.hs 96 | default-language: Haskell2010 97 | if !os(Windows) 98 | ghc-options: -dynamic 99 | build-depends: base, clash-ghc, veldt 100 | --------------------------------------------------------------------------------