fix struct member accesses within field select bounds (#330)

bufif0, bufif1, notif0, notif1, cmos, rcmos, nmos, pmos, rnmos, rpmos

Co-authored-by: Zachary Snow <zach@zachjs.com>

.gitattributes

@@ -0,0 +1 @@
+*.v linguist-language=Verilog

.github/workflows/main.yaml

@@ -0,0 +1,128 @@
+name: Main
+on:
+  push:
+    branches:
+      - '*'
+    tags-ignore:
+      - v*
+  pull_request:
+  release:
+    types:
+      - created
+  schedule:
+    - cron: '0 0 * * 0'
+jobs:
+
+  build:
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        os:
+          - ubuntu-24.04
+          - macOS-15
+          - windows-2025
+    steps:
+      - uses: actions/checkout@v6
+        with:
+          fetch-depth: 0
+          fetch-tags: true
+      - name: Install Dependencies (macOS)
+        if: runner.os == 'macOS'
+        run: brew install haskell-stack
+      - name: Build
+        run: make
+      - name: Prepare Artifact
+        shell: bash
+        run: cp LICENSE NOTICE README.md CHANGELOG.md bin
+      - name: Upload Artifact
+        uses: actions/upload-artifact@v7
+        with:
+          name: ${{ runner.os }}
+          path: bin
+
+  test:
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        os:
+          - ubuntu-24.04
+          - macOS-15
+    needs: build
+    env:
+      IVERILOG_REF: f20865a5ea4ea7f5cdcbb6d19b0751a9390a8978
+    steps:
+      - uses: actions/checkout@v6
+        with:
+          fetch-depth: 0
+          fetch-tags: true
+      - name: Install Dependencies (macOS)
+        if: runner.os == 'macOS'
+        run: |
+          brew install bison autoconf automake gperf
+          echo "$(brew --prefix bison)/bin" >> $GITHUB_PATH
+      - name: Install Dependencies (Linux)
+        if: runner.os == 'Linux'
+        run: sudo apt-get install -y flex bison autoconf gperf
+      - name: Cache iverilog
+        uses: actions/cache@v5
+        with:
+          path: ~/.local
+          key: ${{ runner.os }}-${{ env.IVERILOG_REF }}
+          restore-keys: ${{ runner.os }}-${{ env.IVERILOG_REF }}
+      - name: Install iverilog
+        run: |
+          if [ ! -e "$HOME/.local/bin/iverilog" ]; then
+            git clone https://github.com/steveicarus/iverilog.git
+            cd iverilog
+            git checkout $IVERILOG_REF
+            autoconf
+            ./configure --prefix=$HOME/.local
+            make -j2
+            make install
+            cd ..
+          fi
+          curl -L https://raw.githubusercontent.com/kward/shunit2/v2.1.8/shunit2 > ~/.local/bin/shunit2
+          chmod +x ~/.local/bin/shunit2
+          echo "$HOME/.local/bin" >> $GITHUB_PATH
+      - name: Download Artifact
+        uses: actions/download-artifact@v8
+        with:
+          name: ${{ runner.os }}
+          path: bin
+      - name: Test
+        run: |
+          chmod +x bin/sv2v
+          # rebuild and upload a code coverage report on scheduled linux runs
+          make ${{ github.event_name == 'schedule' && runner.os == 'Linux' && 'coverage' || 'test' }}
+      - name: Upload Coverage
+        uses: actions/upload-artifact@v7
+        if: github.event_name == 'schedule' && runner.os == 'Linux'
+        with:
+          name: coverage
+          path: .hpc
+          include-hidden-files: true
+
+  release:
+    permissions:
+      contents: write
+    runs-on: ubuntu-24.04
+    strategy:
+      matrix:
+        name: [macOS, Linux, Windows]
+    needs: build
+    if: github.event_name == 'release'
+    steps:
+      - name: Download Artifact
+        uses: actions/download-artifact@v8
+        with:
+          name: ${{ matrix.name }}
+          path: sv2v-${{ matrix.name }}
+      - name: Mark Binary Executable
+        run: chmod +x */sv2v*
+      - name: Create ZIP
+        run: zip -r sv2v-${{ matrix.name }} ./sv2v-${{ matrix.name }}
+      - name: Upload Release Asset
+        env:
+          GH_TOKEN: ${{ github.token }}
+          GH_REPO: ${{ github.repository }}
+        run: gh release upload ${{ github.event.release.tag_name }} sv2v-${{ matrix.name }}.zip

.github/workflows/notice.yaml

@@ -1,6 +1,8 @@
 name: Notice
 on:
   push:
+    branches:
+      - master
     paths:
       - stack.yaml
       - stack.yaml.lock
@@ -9,11 +11,9 @@ on:
       - NOTICE
 jobs:
   notice:
-    runs-on: macOS-latest
+    runs-on: ubuntu-24.04
     steps:
-      - uses: actions/checkout@v1
+      - uses: actions/checkout@v6
-      - name: Install Haskell Stack
-        run: brew install haskell-stack
       - name: Regenerate NOTICE
         run: ./notice.sh > NOTICE
       - name: Validate NOTICE

.github/workflows/resolver.yaml

@@ -0,0 +1,33 @@
+name: Resolver
+on:
+  push:
+    branches:
+      - '*'
+  pull_request:
+  schedule:
+    - cron: '0 0 * * 0'
+jobs:
+  build:
+    runs-on: ubuntu-24.04
+    strategy:
+      fail-fast: false
+      matrix:
+        resolver:
+          - nightly
+          - lts-24
+          - lts-23
+          - lts-22
+          - lts-21
+          - lts-20
+          - lts-19
+          - lts-18
+          - lts-17
+          - lts-16
+          - lts-15
+          - lts-14
+          - lts-13
+    steps:
+      - uses: actions/checkout@v6
+      - run: stack build --resolver ${{ matrix.resolver }}
+      - run: stack exec sv2v --resolver ${{ matrix.resolver }} -- --help
+      - run: stack exec sv2v --resolver ${{ matrix.resolver }} -- test/basic/*.sv

.github/workflows/test.yaml

@@ -1,92 +0,0 @@
-name: Build and Test
-on:
-  push:
-  release:
-    types:
-      - created
-jobs:
-
-  test:
-    runs-on: ${{ matrix.os }}
-    strategy:
-      matrix:
-        os: [ubuntu-18.04, macOS-latest]
-    steps:
-      - uses: actions/checkout@v1
-      - name: Install Dependencies
-        run: |
-          brew install haskell-stack shunit2 icarus-verilog || ls
-          sudo apt-get install -y haskell-stack shunit2 flex bison autoconf gperf || ls
-      - name: Cache iverilog
-        uses: actions/cache@v1
-        with:
-          path: ~/.local
-          key: ${{ runner.OS }}-iverilog-10-3
-          restore-keys: ${{ runner.OS }}-iverilog-10-3
-      - name: Install iverilog
-        run: |
-          if [ "${{ runner.OS }}" = "Linux" ] && [ ! -e "$HOME/.local/bin/iverilog" ]; then
-            curl -L https://github.com/steveicarus/iverilog/archive/v10_3.tar.gz > iverilog-10_3.tar.gz
-            tar -xzf iverilog-10_3.tar.gz
-            cd iverilog-10_3
-            autoconf
-            ./configure --prefix=$HOME/.local
-            make
-            make install
-            cd ..
-          fi
-      - name: Build
-        run: make
-      - name: Test
-        run: |
-          export PATH="$PATH:$HOME/.local/bin"
-          make test
-      - name: Prepare Artifact
-        if: github.event_name == 'release'
-        run: cp LICENSE NOTICE README.md bin
-      - name: Upload Artifact
-        if: github.event_name == 'release'
-        uses: actions/upload-artifact@v1
-        with:
-          name: ${{ runner.os }}
-          path: bin
-
-  release:
-    runs-on: ubuntu-latest
-    needs: test
-    if: github.event_name == 'release'
-    steps:
-      - run: sudo apt-get install -y tree
-      - name: Download Linux Artifact
-        uses: actions/download-artifact@v1
-        with:
-          name: Linux
-          path: sv2v-Linux
-      - name: Download MacOS Artifact
-        uses: actions/download-artifact@v1
-        with:
-          name: macOS
-          path: sv2v-macOS
-      - name: Create ZIPs
-        run: |
-          chmod +x */sv2v
-          zip -r sv2v-Linux ./sv2v-Linux
-          zip -r sv2v-macOS ./sv2v-macOS
-      - name: Upload Linux Release Asset
-        uses: actions/upload-release-asset@v1.0.1
-        env:
-          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
-        with:
-          upload_url: ${{ github.event.release.upload_url }}
-          asset_path: ./sv2v-Linux.zip
-          asset_name: sv2v-Linux.zip
-          asset_content_type: application/zip
-      - name: Upload MacOS Release Asset
-        uses: actions/upload-release-asset@v1.0.1
-        env:
-          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
-        with:
-          upload_url: ${{ github.event.release.upload_url }}
-          asset_path: ./sv2v-macOS.zip
-          asset_name: sv2v-macOS.zip
-          asset_content_type: application/zip

.gitignore

@@ -2,3 +2,5 @@
 dist/
 bin/
 .stack-work/
+.hpc/
+*.tix

CHANGELOG.md

@@ -0,0 +1,241 @@
+## Unreleased
+
+### New Features
+
+* Added support for `typdef` in the top level of tasks and functions.
+* Added support for `bufif0`, `bufif1`, `notif0`, `notif1`, `cmos`, `rcmos`,
+  `nmos`, `pmos`, `rnmos`, and `rpmos`.
+
+### Bug Fixes
+
+* Fixed conversion of struct field accesses when the struct's field widths
+  depend on a member of a struct-typed parameter
+
+### Other Enhancements
+
+* `always_comb` blocks with sensitivities inherited from called functions or
+  tasks are no longer converted with duplicate expressions
+
+## v0.0.13
+
+### New Features
+
+* Added support for module and interface input ports with default values
+* Added conversion of severity system tasks and elaboration system tasks (e.g.,
+  `$info`) into `$display` tasks that include source file and scope information;
+  pass `-E SeverityTask` to disable this new conversion
+* Added support for gate arrays and conversion for multidimensional gate arrays
+* Added parsing support for `not`, `strong`, `weak`, `nexttime`, and
+  `s_nexttime` in assertion property expressions
+* Added `--bugpoint` utility for minimizing test cases for issue submission
+
+### Bug Fixes
+
+* Fixed `--write path/to/dir/` with directives like `` `default_nettype ``
+* Fixed `logic` incorrectly converted to `wire` even when provided to a task or
+  function output port
+* Fixed conversion of fields accessed from explicitly-cast structs
+* Fixed generated parameter name collisions when inlining interfaces and
+  interfaced-bound modules
+* Fixed conversion of enum item names and typenames nested deeply within the
+  left-hand side of an assignment
+* Fixed `input signed` ports of interface-using modules producing invalid
+  declarations after inlining
+* Fixed inlining of interfaces and interface-bound modules containing port
+  declarations tagged with an attribute
+* Fixed stray attributes producing invalid nested output when attached to
+  inlined interfaces and interface-bounds modules
+* Fixed conversion of struct variables that shadow their module's name
+* Fixed `` `resetall `` not resetting the `` `default_nettype ``
+
+### Other Enhancements
+
+* Improved error messages for invalid port or parameter bindings
+* Added warning for modules or interfaces defined more than once
+* `--write path/to/dir/` can now also be used with `--pass-through`
+
+## v0.0.12
+
+### Breaking Changes
+
+* Removed deprecated CLI flags `-d`/`-e`/`-i`, which have been aliased to
+  `-D`/`-E`/`-I` with a warning since late 2019
+
+### New Features
+
+* `unique`, `unique0`, and `priority` case statements now produce corresponding
+  `parallel_case` and `full_case` statement attributes
+* Added support for attributes in unary, binary, and ternary expressions
+* Added support for streaming concatenations within ternary expressions
+* Added support for shadowing interface names with local typenames
+* Added support for passing through `wait` statements
+
+### Bug Fixes
+
+* Fixed signed unsized literals with a leading 1 bit (e.g., `'sb1`, `'sh8f`)
+  incorrectly sign-extending in size and type casts
+* Fixed conflicting genvar names when inlining interfaces and modules that use
+  them; all genvars are now given a design-wide unique name
+* Fixed unconverted structs within explicit type casts
+* Fixed byte order of strings in size casts
+* Fixed unconverted multidimensional struct fields within dimension queries
+* Fixed non-typenames (e.g., from packages or subsequent declarations)
+  improperly shadowing the names of `struct` pattern fields
+* Fixed shadowing of interface array indices passed to port connections
+* Fixed failure to resolve typenames suffixed with dimensions in contexts
+  permitting both types and expressions, e.g., `$bits(T[W-1:0])`
+* Fixed an issue that prevented parsing tasks and functions with `inout` ports
+* Fixed errant constant folding of shadowed non-trivial localparams
+* Fixed conversion of function calls with no arguments passed to other functions
+* Fixed certain non-ANSI style port declarations being incorrectly reported as
+  incompatible
+
+### Other Enhancements
+
+* `always_comb` and `always_latch` now reliably execute at time zero
+* Added error checking for unresolved typenames
+* Added constant folding for `||` and `&&`
+* `input reg` module ports are now converted to `input wire`
+* `x | |y` and `x & &y` are now output as `x | (|y)` and `x & (&y)`
+
+## v0.0.11
+
+### New Features
+
+* Added `-y`/`--libdir` for specifying library directories from which to
+  automatically load modules and interfaces used in the design that are not
+  found in the provided input files
+* Added `--top` for pruning unneeded modules during conversion
+* Added `--write path/to/dir/` for creating an output `.v` in the specified
+  preexisting directory for each module in the converted result
+* The `string` data type is now dropped from parameters and localparams
+* Added support for passing through `sequence` and `property` declarations
+
+### Bug Fixes
+
+* Fixed crash when converting multi-dimensional arrays or arrays of structs or
+  unions used in certain expressions involving unbased unsized literals
+* Fixed module-level localparams being needlessly inlined when forming longest
+  static prefixes, which could cause deep recursion and run out of memory on
+  some designs
+* Fixed overzealous removal of explicitly unconnected ports (e.g., `.a()`)
+* Fixed an issue that left `always_comb`, `always_latch`, and `always_ff`
+  unconverted when tagged with an attribute
+* Fixed unneeded scoping of constant function calls used in type lookups
+* `/*/` is no longer interpreted as a self-closing block comment, e.g.,
+  `$display("a"/*/,"b"/* */);` previously printed "ab", but now prints "a"
+* Fixed missing `begin`/`end` when disambiguating procedural branches tagged
+  with an attribute
+* Fixed keywords included in the "1364-2001" and "1364-2001-noconfig"
+  `begin_keywords` version specifiers
+
+### Other Enhancements
+
+* Added elaboration for accesses to fields of struct constants, which can
+  substantially improve conversion speed on some designs
+* Added constant folding for comparisons involving string literals
+* Port connection attributes (e.g., [pulp_soc.sv]) are now ignored with a
+  warning rather than failing to parse
+* Improved error message when specifying an extraneous named port connection
+* Improved error message for an unfinished conditional directive, e.g., an
+  `ifdef` with no `endif`
+* Added checks for accidental usage of interface or module names as type names
+
+[pulp_soc.sv]: https://github.com/pulp-platform/pulp_soc/blob/0573a85c/rtl/pulp_soc/pulp_soc.sv#L733
+
+## v0.0.10
+
+### Breaking Changes
+
+* `--write adjacent` no longer forbids overwriting existing generated files
+
+### New Features
+
+* Added support for assignments within expressions (e.g., `x = ++y;`)
+* Added support for excluding the conversion of unbased unsized literals (e.g.,
+  `'1`, `'x`) via `--exclude UnbasedUniszed`
+* Added support for enumerated type ranges (e.g., `enum { X[3:5] }`)
+* Added support for complex event expressions (e.g., `@(x ^ y)`)
+* Added support for the SystemVerilog `edge` event
+* Added support for cycle delay ranges in assertion sequence expressions
+* Added support for procedural continuous assignments (`assign`/`deassign` and
+  `force`/`release`)
+* Added conversion for `do` `while` loops
+* Added support for hierarchical calls to functions with no inputs
+* Added support for passing through DPI imports and exports
+* Added support for passing through functions with output ports
+* Extended applicability of simplified Yosys-compatible `for` loop elaboration
+
+### Other Enhancements
+
+* Certain errors raised during conversion now also provide hierarchical and
+  approximate source location information to help locate the error
+
+### Bug Fixes
+
+* Fixed inadvertent design behavior changes caused by constant folding removing
+  intentional width-extending operations such as `+ 0` and `* 1`
+* Fixed forced conversion to `reg` of data sensed in an edge-controlled
+  procedural assignment
+* `always_comb` and `always_latch` now generate explicit sensitivity lists where
+  necessary because of calls to functions which reference non-local data
+* Fixed signed `struct` fields being converted to unsigned expressions when
+  accessed directly
+* Fixed conversion of casts using structs containing multi-dimensional fields
+* Fixed incorrect name resolution conflicts raised during interface inlining
+* Fixed handling of interface instances which shadow other declarations
+* Fixed names like `<pkg>_<name>` being shadowed by elaborated packages
+
+## v0.0.9
+
+### Breaking Changes
+
+* Unsized number literals exceeding the maximum width of 32 bits (e.g.,
+  `'h1_ffff_ffff`, `4294967296`) are now truncated and produce a warning, rather
+  than being silently extended
+  * Support for unsized number literals exceeding the standard-imposed 32-bit
+    limit can be re-enabled with `--oversized-numbers`
+* Input source files are now decoded as UTF-8 on all platforms, with transcoding
+  failures tolerated, enabling reading files encoded using other ASCII supersets
+  (e.g., Latin-1)
+
+### New Features
+
+* Added support for non-ANSI style port declarations where the port declaration
+  is separate from the corresponding net or variable declaration
+* Added support for typed value parameters declared in parameter port lists
+  without explicitly providing a leading `parameter` or `localparam` marker
+* Added support for tasks and functions with implicit port directions
+* Added support for parameters which use a type-of as the data type
+* Added support for bare delay controls with real number delays
+* Added support for deferred immediate assertions
+
+### Other Enhancements
+
+* Explicitly-sized number literals with non-zero bits exceeding the given width
+  (e.g., `1'b11`, `3'sd8`, `2'o7`) are now truncated and produce a warning,
+  rather than yielding a cryptic error
+* Number literals with leading zeroes which extend beyond the width of the
+  literal (e.g., `1'b01`, `'h0_FFFF_FFFF`) now produce a warning
+* Non-positive integer size casts are now detected and forbidden
+* Negative indices in struct pattern literals are now detected and forbidden
+* Escaped vendor block comments in macro bodies are now tolerated
+* Illegal bit-selects and part-selects of scalar struct fields are now detected
+  and forbidden, rather than yielding an internal assertion failure
+
+### Bug Fixes
+
+* Fixed parsing of sized ports with implicit directions
+* Fixed flattening of arrays used in nested ternary expressions
+* Fixed preprocessing of line comments which are neither preceded nor followed
+  by whitespace except for the newline which terminates the comment
+* Fixed parsing of alternate spacings of `@(*)`
+* Fixed conversion of interface-based typedefs when used with explicit modports,
+  unpacked arrays, or in designs with multi-dimensional instances
+* Fixed conversion of module-scoped references to modports
+* Fixed conversion of references to modports nested within types in expressions
+* Fixed assertion removal in verbose mode causing orphaned statements
+
+## v0.0.8
+
+Future releases will have complete change logs.

LICENSE

@@ -1,8 +1,7 @@
 BSD 3-Clause License
 
-Copyright for portions of sv2v are held by Tom Hawkins, 2011-2015, as part of
+Copyright 2019-2024 Zachary Snow
-tomahawkins/verilog. Copyright for all other portions of sv2v are held by
+Copyright 2011-2015 Tom Hawkins
-Zachary Snow, 2019.
 
 All rights reserved.
 
@@ -16,17 +15,17 @@ are permitted provided that the following conditions are met:
    this list of conditions and the following disclaimer in the documentation
    and/or other materials provided with the distribution.
 
-3. Neither the name of the author nor the names of his contributors may be used
+3. Neither the name of the copyright holder nor the names of its contributors
-   to endorse or promote products derived from this software without specific
+   may be used to endorse or promote products derived from this software without
-   prior written permission.
+   specific prior written permission.
 
-THIS SOFTWARE IS PROVIDED BY THE AUTHORS "AS IS" AND ANY EXPRESS OR IMPLIED
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
-INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
-LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Makefile

@@ -12,3 +12,10 @@ clean:
 
 test:
 	(cd test && ./run-all.sh)
+
+coverage:
+	stack install --local-bin-path bin --ghc-options=-fhpc
+	rm -f test/*/sv2v.tix
+	make test
+	stack exec hpc -- sum test/*/sv2v.tix --union --output=.hpc/combined.tix
+	stack exec hpc -- markup .hpc/combined.tix --destdir=.hpc

README.md

@@ -12,11 +12,20 @@ conversion already exist, they generally either rely on commercial tools, or are
 limited in scope.
 
 This project was originally developed to target [Yosys], and so allows for
-disabling the conversion of (passing through) those [SystemVerilog features
+disabling the conversion of (passing through) those [SystemVerilog features that
-which Yosys supports].
+Yosys supports].
 
-[Yosys]: http://www.clifford.at/yosys/
+[Yosys]: https://yosyshq.net/yosys/
-[SystemVerilog features which Yosys supports]: https://github.com/YosysHQ/yosys#supported-features-from-systemverilog
+[SystemVerilog features that Yosys supports]: https://github.com/YosysHQ/yosys#supported-features-from-systemverilog
+
+The idea for this project was shared with me while I was an undergraduate at
+Carnegie Mellon University as part of a joint Computer Science and Electrical
+and Computer Engineering research project on open hardware under Professors [Ken
+Mai] and [Dave Eckhardt]. I have greatly enjoyed collaborating with the team at
+CMU since January 2019, even after my graduation the following May.
+
+[Ken Mai]: https://engineering.cmu.edu/directory/bios/mai-kenneth.html
+[Dave Eckhardt]: https://www.cs.cmu.edu/~davide/
 
 
 ## Dependencies
@@ -27,15 +36,21 @@ All of sv2v's dependencies are free and open-source.
     * [Haskell Stack](https://www.haskellstack.org/) - Haskell build system
     * Haskell dependencies are managed in `sv2v.cabal`
 * Test Dependencies
-    * [Icarus Verilog](http://iverilog.icarus.com) - for Verilog simulation
+    * [Icarus Verilog](https://steveicarus.github.io/iverilog/) - for Verilog
+      simulation
     * [shUnit2](https://github.com/kward/shunit2) - test framework
+    * Python 3.x - for evaluating certain test cases
 
 
 ## Installation
 
 ### Pre-built binaries
 
-We plan on releasing pre-built binaries in the future.
+Binaries for Ubuntu, macOS, and Windows are available on the [releases page]. If
+your system is not covered, or you would like to build the latest commit, simple
+instructions for building from source are below.
+
+[releases page]: https://github.com/zachjs/sv2v/releases
 
 ### Building from source
 
@@ -58,27 +73,53 @@ running `stack install`, or copy over the executable manually.
 
 ## Usage
 
-sv2v takes in a list of files and prints the converted Verilog to `stdout`.
+sv2v takes in a list of files and prints the converted Verilog to `stdout` by
+default. Users should typically pass all of their SystemVerilog source files to
+sv2v at once so it can properly resolve packages, interfaces, type parameters,
+etc., across files. Using `--write=adjacent` will create a converted `.v` for
+every `.sv` input file rather than printing to `stdout`. `--write`/`-w` can also
+be used to specify a path to a `.v` output file. Undefined modules and
+interfaces can be automatically loaded from library directories using
+`--libdir`/`-y`.
+
 Users may specify `include` search paths, define macros during preprocessing,
 and exclude some of the conversions. Specifying `-` as an input file will read
 from `stdin`.
 
-Below is the current usage printout. This interface is subject to change.
+Below is the current usage printout.
 
 ```
 sv2v [OPTIONS] [FILES]
 
 Preprocessing:
-  -I --incdir=DIR           Add directory to include search path
+  -I --incdir=DIR           Add a directory to the include search path
+  -y --libdir=DIR           Add a directory to the library search path used
+                            when looking for undefined modules and interfaces
   -D --define=NAME[=VALUE]  Define a macro for preprocessing
      --siloed               Lex input files separately, so macros from
                             earlier files are not defined in later files
+     --skip-preprocessor    Disable preprocessing of macros, comments, etc.
 Conversion:
-  -E --exclude=CONV         Exclude a particular conversion (always,
+     --pass-through         Dump input without converting
-                            interface, or logic)
+  -E --exclude=CONV         Exclude a particular conversion (Always, Assert,
+                            Interface, Logic, SeverityTask, or UnbasedUnsized)
   -v --verbose              Retain certain conversion artifacts
+  -w --write=MODE/FILE/DIR  How to write output; default is 'stdout'; use
+                            'adjacent' to create a .v file next to each input;
+                            use a path ending in .v to write to a file; use a
+                            path to an existing directory to create a .v within
+                            for each converted module
+     --top=NAME             Remove uninstantiated modules except the given
+                            top module; can be used multiple times
 Other:
-     --help                 Display help message
+     --oversized-numbers    Disable standard-imposed 32-bit limit on unsized
+                            number literals (e.g., 'h1_ffff_ffff, 4294967296)
+     --dump-prefix=PATH     Create intermediate output files with the given
+                            path prefix; used for internal debugging
+     --bugpoint=SUBSTR      Reduce the input by pruning modules, wires, etc.,
+                            that aren't needed to produce the given output or
+                            error substring when converted
+     --help                 Display this help message
      --version              Print version information
      --numeric-version      Print just the version number
 ```
@@ -87,16 +128,19 @@ Other:
 ## Supported Features
 
 sv2v supports most synthesizable SystemVerilog features. Current notable
-exceptions include `export` and complex (non-identifier) `modport` expressions.
+exceptions include `defparam` on interface instances, certain synthesizable
-Assertions are also supported, but are simply dropped during conversion.
+usages of parameterized classes, and the `bind` keyword. Assertions are also
+supported, but are simply dropped during conversion.
 
-If you find a bug or have a feature request, please create an issue. Preference
+If you find a bug or have a feature request, please [create an issue].
-will be given to issues which include examples or test cases.
+Preference will be given to issues that include examples or test cases.
+
+[create an issue]: https://github.com/zachjs/sv2v/issues/new
 
 
 ## SystemVerilog Front End
 
-This project contains a preprocessor and lexer, a parser, and an abstract syntax
+This project contains a preprocessor, lexer, and parser, and an abstract syntax
 tree representation for a subset of the SystemVerilog specification. The parser
 is not very strict. The AST allows for the representation of syntactically (and
 semantically) invalid Verilog. The goal is to be more general in the
@@ -107,14 +151,19 @@ front end if there is significant interest.
 
 ## Testing
 
-Once the [test dependencies](#dependencies) are installed, tests can be run with
+Once the [test dependencies] are installed, tests can be run with `make test`.
-`make test`. Travis CI is used to automatically test commits on GitHub.
+GitHub Actions is used to [automatically test] commits. Please review the [test
+documentation] for guidance on adding, debugging, and interpreting tests.
 
-There is also a [SystemVerilog compliance suite] being created to test
+[test dependencies]: #dependencies
-open-source tools' SystemVerilog support. Although not every test in the suite
+[test documentation]: test/README.md
-is applicable, it has been a valuable asset in finding edge cases.
+[automatically test]: https://github.com/zachjs/sv2v/actions
 
-[SystemVerilog compliance suite]: https://github.com/SymbiFlow/sv-tests
+There is also a [SystemVerilog compliance suite] that tests open-source tools'
+SystemVerilog support. Although not every test in the suite is applicable, it
+has been a valuable asset in finding edge cases.
+
+[SystemVerilog compliance suite]: https://github.com/chipsalliance/sv-tests
 
 
 ## Acknowledgements
@@ -126,17 +175,11 @@ standard, his project was a great starting point.
 [Tom Hawkin's Verilog parser]: https://github.com/tomahawkins/verilog
 
 Reid Long was invaluable in developing this tool, providing significant tests
-and advice, and isolating many bugs. His projects can be found
+and advice, and isolating many bugs.
-[here](https://bitbucket.org/ReidLong/).
 
 Edric Kusuma helped me with the ins and outs of SystemVerilog, with which I had
 no prior experience, and has also helped with test cases.
 
-Since sv2v's public release, several people have taken the time to file detailed
+Since sv2v's public release, many people have taken the time to file detailed
 bug reports and feature requests. I greatly appreciate their help in furthering
 the project.
-
-
-## License
-
-See the [LICENSE file](LICENSE) for copyright and licensing information.

notice.sh

@@ -3,7 +3,8 @@
 dependencies=`stack ls dependencies \
     | sed -e 's/ /-/' \
     | grep -v "^sv2v-[0-9\.]\+\$" \
-    | grep -v "^rts-1\.0\$" \
+    | grep -v "^rts-[0-9\.]\+\$" \
+    | grep -v "^ghc-boot-th" \
     `
 
 for dependency in `echo "$dependencies"`; do
@@ -13,6 +14,6 @@ for dependency in `echo "$dependencies"`; do
     echo "Dependency: $dependency"
     echo "================================================================================"
     echo ""
-    curl "$license_url" 2> /dev/null | sed -e "s/^/  /"
+    curl "$license_url" 2> /dev/null | sed -e "s/\r$//" -e "s/^/  /" -e "s/ *$//"
     echo ""
 done

release.sh

@@ -0,0 +1,41 @@
+#!/bin/bash
+
+set -e
+set -x
+
+version=$1
+
+# ensure there are no uncommitted changes
+[ "" == "$(git status --porcelain)" ]
+
+# update the version in sv2v.cabal
+sed -i.bak -e "s/^version.*/version: $version/" sv2v.cabal
+diff sv2v.cabal{,.bak} && echo not changed && exit 1 || true
+rm sv2v.cabal.bak
+
+# update the version in CHANGELOG.md
+sed -i.bak -e "s/^## Unreleased$/## v$version/" CHANGELOG.md
+diff CHANGELOG.md{,.bak} && echo not changed && exit 1 || true
+rm CHANGELOG.md.bak
+
+# create the release commit and tag
+git commit -a -m "release v$version"
+git tag -a v$version HEAD -m "Release v$version"
+
+# build and test
+make
+make test
+[ $version == `bin/sv2v --numeric-version` ]
+
+# push the release commit and tag
+git push
+git push origin v$version
+
+# create the GitHub release
+notes=`pandoc --from markdown --to markdown --wrap none CHANGELOG.md | \
+    sed '3,/^## /!d' | \
+    tac | tail -n +3 | tac`
+gh release create v$version --title v$version --notes "$notes"
+
+# create the Hackage release candidate
+stack upload --test-tarball --candidate .

src/Bugpoint.hs

@@ -0,0 +1,150 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Utility for reducing test cases that cause conversion errors or otherwise
+ - produce unexpected output.
+ -}
+
+module Bugpoint (runBugpoint) where
+
+import System.Exit (exitFailure)
+import System.IO (hPutStrLn, stderr)
+
+import Control.Exception (catches, ErrorCall(..), Handler(..), PatternMatchFail(..))
+import Control.Monad (when, (>=>))
+import Data.Functor ((<&>))
+import Data.List (isInfixOf)
+
+import qualified Convert.RemoveComments
+import Language.SystemVerilog.AST
+
+runBugpoint :: [String] -> ([AST] -> IO [AST]) -> [AST] -> IO [AST]
+runBugpoint expected converter =
+    fmap pure . runBugpoint' expected converter' . concat
+    where
+        converter' :: AST -> IO AST
+        converter' = fmap concat . converter . pure
+
+runBugpoint' :: [String] -> (AST -> IO AST) -> AST -> IO AST
+runBugpoint' expected converter ast = do
+    ast' <- runBugpointPass expected converter ast
+    if ast == ast'
+        then out "done minimizing" >> return ast
+        else runBugpoint' expected converter ast'
+
+out :: String -> IO ()
+out = hPutStrLn stderr . ("bugpoint: " ++)
+
+-- run the given converter and return the conversion failure if any or the
+-- converted output otherwise
+extractConversionResult :: (AST -> IO AST) -> AST -> IO String
+extractConversionResult converter asts =
+    catches runner
+        [ Handler handleErrorCall
+        , Handler handlePatternMatchFail
+        ]
+    where
+        runner = converter asts <&> show
+        handleErrorCall (ErrorCall str) = return str
+        handlePatternMatchFail (PatternMatchFail str) = return str
+
+runBugpointPass :: [String] -> (AST -> IO AST) -> AST -> IO AST
+runBugpointPass expected converter ast = do
+    out $ "beginning pass with " ++ (show $ length $ show ast) ++ " characters"
+    matches <- oracle ast
+    when (not matches) $
+        out ("doesn't match expected strings: " ++ show expected) >> exitFailure
+    let ast' = concat $ Convert.RemoveComments.convert [ast]
+    matches' <- oracle ast'
+    minimizeContainer oracle minimizeDescription "<design>" id $
+        if matches' then ast' else ast
+    where
+        oracle :: AST -> IO Bool
+        oracle = fmap check . extractConversionResult converter
+        check :: String -> Bool
+        check = flip all expected . flip isInfixOf
+
+type Oracle t = t -> IO Bool
+type Minimizer t = Oracle t -> t -> IO t
+
+-- given a subsequence-verifying oracle, a strategy for minimizing within
+-- elements of the sequence, a name for debugging, a constructor for the
+-- container, and the elements within the container, produce a minimized version
+-- of the container
+minimizeContainer :: forall a b. (Show a, Show b)
+    => Oracle a -> Minimizer b -> String -> ([b] -> a) -> [b] -> IO a
+minimizeContainer oracle minimizer name constructor =
+    stepFilter 0 [] >=>
+    stepRecurse [] >=>
+    return . constructor
+    where
+        oracle' :: Oracle [b]
+        oracle' = oracle . constructor
+
+        stepFilter :: Int -> [b] -> [b] -> IO [b]
+        stepFilter 0 [] pending = stepFilter (length pending) [] pending
+        stepFilter 1 need [] = return need
+        stepFilter width need [] =
+            stepFilter (max 1 $ width `div` 4) [] need
+        stepFilter width need pending = do
+            matches <- oracle' $ need ++ rest
+            if matches
+                then out msg >> stepFilter width need rest
+                else stepFilter width (need ++ curr) rest
+            where
+                (curr, rest) = splitAt width pending
+                msg = "removed " ++ show (length curr) ++ " items from " ++ name
+
+        stepRecurse :: [b] -> [b] -> IO [b]
+        stepRecurse before [] = return before
+        stepRecurse before (isolated : after) = do
+            isolated' <- minimizer oracleRecurse isolated
+            stepRecurse (before ++ [isolated']) after
+            where oracleRecurse = (oracle' $) . (before ++) . (: after)
+
+minimizeDescription :: Minimizer Description
+minimizeDescription oracle (Package lifetime name items) =
+    minimizeContainer oracle (const return) name constructor items
+    where constructor = Package lifetime name
+minimizeDescription oracle (Part att ext kw lif name ports items) =
+    minimizeContainer oracle minimizeModuleItem name constructor items
+    where constructor = Part att ext kw lif name ports
+minimizeDescription _ other = return other
+
+minimizeModuleItem :: Minimizer ModuleItem
+minimizeModuleItem oracle (Generate items) =
+    minimizeContainer oracle minimizeGenItem "<generate>" Generate items
+minimizeModuleItem _ item = return item
+
+minimizeGenItem :: Minimizer GenItem
+minimizeGenItem _ GenNull = return GenNull
+minimizeGenItem oracle item = do
+    matches <- oracle GenNull
+    if matches
+        then out "removed generate item" >> return GenNull
+        else minimizeGenItem' oracle item
+
+minimizeGenItem' :: Minimizer GenItem
+minimizeGenItem' oracle (GenModuleItem item) =
+    minimizeModuleItem (oracle . GenModuleItem) item <&> GenModuleItem
+minimizeGenItem' oracle (GenIf c t f) = do
+    t' <- minimizeGenItem (oracle . flip (GenIf c) f) t
+    f' <- minimizeGenItem (oracle . GenIf c t') f
+    return $ GenIf c t' f'
+minimizeGenItem' _ (GenBlock _ []) = return GenNull
+minimizeGenItem' oracle (GenBlock name items) =
+    minimizeContainer oracle minimizeGenItem' name constructor items
+    where constructor = GenBlock name
+minimizeGenItem' oracle (GenFor a b c item) =
+    minimizeGenItem (oracle . constructor) item <&> constructor
+    where constructor = GenFor a b c
+minimizeGenItem' oracle (GenCase expr cases) =
+    minimizeContainer oracle minimizeGenCase "<case>" constructor cases
+    where constructor = GenCase expr
+minimizeGenItem' _ GenNull = return GenNull
+
+minimizeGenCase :: Minimizer GenCase
+minimizeGenCase oracle (exprs, item) =
+    minimizeGenItem' (oracle . constructor) item <&> constructor
+    where constructor = (exprs,)

src/Convert.hs

@@ -6,6 +6,8 @@
 
 module Convert (convert) where
 
+import Control.Monad ((>=>))
+
 import Language.SystemVerilog.AST
 import qualified Job (Exclude(..))
 
@@ -13,13 +15,21 @@ import qualified Convert.AlwaysKW
 import qualified Convert.AsgnOp
 import qualified Convert.Assertion
 import qualified Convert.BlockDecl
+import qualified Convert.Cast
 import qualified Convert.DimensionQuery
+import qualified Convert.DoWhile
+import qualified Convert.DuplicateGenvar
 import qualified Convert.EmptyArgs
 import qualified Convert.Enum
-import qualified Convert.ForDecl
+import qualified Convert.EventEdge
+import qualified Convert.ExprAsgn
+import qualified Convert.ForAsgn
 import qualified Convert.Foreach
 import qualified Convert.FuncRet
 import qualified Convert.FuncRoutine
+import qualified Convert.GenvarName
+import qualified Convert.HierConst
+import qualified Convert.ImplicitNet
 import qualified Convert.Inside
 import qualified Convert.Interface
 import qualified Convert.IntTypes
@@ -29,84 +39,140 @@ import qualified Convert.Logic
 import qualified Convert.LogOp
 import qualified Convert.MultiplePacked
 import qualified Convert.NamedBlock
-import qualified Convert.NestPI
 import qualified Convert.Package
+import qualified Convert.ParamNoDefault
 import qualified Convert.ParamType
+import qualified Convert.PortDecl
+import qualified Convert.PortDefault
 import qualified Convert.RemoveComments
-import qualified Convert.SignCast
+import qualified Convert.ResolveBindings
+import qualified Convert.SeverityTask
 import qualified Convert.Simplify
-import qualified Convert.SizeCast
-import qualified Convert.StarPort
-import qualified Convert.StmtBlock
 import qualified Convert.Stream
+import qualified Convert.StringParam
+import qualified Convert.StringType
 import qualified Convert.Struct
+import qualified Convert.StructConst
+import qualified Convert.TFBlock
 import qualified Convert.Typedef
 import qualified Convert.TypeOf
 import qualified Convert.UnbasedUnsized
 import qualified Convert.Unique
+import qualified Convert.UnnamedGenBlock
 import qualified Convert.UnpackedArray
 import qualified Convert.Unsigned
 import qualified Convert.Wildcard
 
 type Phase = [AST] -> [AST]
+type IOPhase = [AST] -> IO [AST]
+type Selector = Job.Exclude -> Phase -> Phase
 
-phases :: [Job.Exclude] -> [Phase]
+finalPhases :: Selector -> [Phase]
-phases excludes =
+finalPhases _ =
-    [ Convert.AsgnOp.convert
+    [ Convert.NamedBlock.convert
-    , Convert.NamedBlock.convert
+    , Convert.DuplicateGenvar.convert
-    , Convert.Assertion.convert
+    , Convert.AsgnOp.convert
-    , Convert.BlockDecl.convert
-    , selectExclude (Job.Logic    , Convert.Logic.convert)
-    , Convert.ForDecl.convert
-    , Convert.FuncRet.convert
-    , Convert.FuncRoutine.convert
     , Convert.EmptyArgs.convert
+    , Convert.FuncRet.convert
+    , Convert.TFBlock.convert
+    , Convert.Unsigned.convert
+    , Convert.PortDefault.convert
+    , Convert.StringType.convert
+    ]
+
+mainPhases :: [String] -> Selector -> [Phase]
+mainPhases tops selectExclude =
+    [ Convert.BlockDecl.convert
+    , selectExclude Job.Logic Convert.Logic.convert
+    , Convert.ImplicitNet.convert
     , Convert.Inside.convert
     , Convert.IntTypes.convert
-    , Convert.KWArgs.convert
-    , Convert.LogOp.convert
     , Convert.MultiplePacked.convert
+    , selectExclude Job.UnbasedUnsized Convert.UnbasedUnsized.convert
+    , Convert.Cast.convert
+    , Convert.ParamType.convert tops
+    , Convert.HierConst.convert
     , Convert.TypeOf.convert
     , Convert.DimensionQuery.convert
-    , Convert.ParamType.convert
-    , Convert.SizeCast.convert
     , Convert.Simplify.convert
-    , Convert.StarPort.convert
-    , Convert.StmtBlock.convert
     , Convert.Stream.convert
     , Convert.Struct.convert
     , Convert.Typedef.convert
-    , Convert.UnbasedUnsized.convert
-    , Convert.Unique.convert
     , Convert.UnpackedArray.convert
-    , Convert.Unsigned.convert
-    , Convert.SignCast.convert
     , Convert.Wildcard.convert
-    , Convert.Package.convert
     , Convert.Enum.convert
-    , Convert.NestPI.convert
+    , Convert.StringParam.convert
-    , Convert.Jump.convert
+    , selectExclude Job.Interface $ Convert.Interface.convert tops
-    , Convert.Foreach.convert
+    , selectExclude Job.Succinct Convert.RemoveComments.convert
-    , selectExclude (Job.Interface, Convert.Interface.convert)
-    , selectExclude (Job.Always   , Convert.AlwaysKW.convert)
-    , selectExclude (Job.Succinct , Convert.RemoveComments.convert)
     ]
+
+initialPhases :: [String] -> Selector -> [Phase]
+initialPhases tops selectExclude =
+    [ Convert.ForAsgn.convert
+    , Convert.Jump.convert
+    , Convert.ExprAsgn.convert
+    , Convert.KWArgs.convert
+    , Convert.Unique.convert
+    , Convert.EventEdge.convert
+    , Convert.LogOp.convert
+    , Convert.DoWhile.convert
+    , Convert.Foreach.convert
+    , Convert.FuncRoutine.convert
+    , Convert.GenvarName.convert
+    , selectExclude Job.Assert Convert.Assertion.convert
+    , selectExclude Job.Always Convert.AlwaysKW.convert
+    , Convert.Interface.disambiguate
+    , selectExclude Job.SeverityTask Convert.SeverityTask.convert
+    , Convert.Package.convert
+    , Convert.StructConst.convert
+    , Convert.PortDecl.convert
+    , Convert.ParamNoDefault.convert tops
+    , Convert.ResolveBindings.convert
+    , Convert.UnnamedGenBlock.convert
+    ]
+
+convert :: [String] -> FilePath -> [Job.Exclude] -> IOPhase
+convert tops dumpPrefix excludes =
+    step "parse"   id      >=>
+    step "initial" initial >=>
+    loop 1 "main"  main    >=>
+    step "final"   final
     where
-        selectExclude :: (Job.Exclude, Phase) -> Phase
+        final = combine $ finalPhases selectExclude
-        selectExclude (exclude, phase) =
+        main = combine $ mainPhases tops selectExclude
+        initial = combine $ initialPhases tops selectExclude
+        combine = foldr1 (.)
+
+        selectExclude :: Selector
+        selectExclude exclude phase =
             if elem exclude excludes
                 then id
                 else phase
 
-run :: [Job.Exclude] -> Phase
+        dumper :: String -> IOPhase
-run excludes = foldr (.) id $ phases excludes
+        dumper =
+            if null dumpPrefix
+                then const return
+                else fileDumper dumpPrefix
 
-convert :: [Job.Exclude] -> Phase
+        -- add debug dumping to a phase
-convert excludes = convert'
+        step :: String -> Phase -> IOPhase
+        step key = (dumper key .)
+
+        -- add convergence and debug dumping to a phase
+        loop :: Int -> String -> Phase -> IOPhase
+        loop idx key phase files =
+            if files == files'
+                then return files
+                else dumper key' files' >>= loop (idx + 1) key phase
             where
-        convert' :: Phase
+                files' = phase files
-        convert' descriptions =
+                key' = key ++ "_" ++ show idx
-            if descriptions == descriptions'
+
-                then descriptions
+-- pass through dumper which writes ASTs to a file
-                else convert' descriptions'
+fileDumper :: String -> String -> IOPhase
-            where descriptions' = run excludes descriptions
+fileDumper prefix key files = do
+    let path = prefix ++ key ++ ".sv"
+    let output = show $ concat files
+    writeFile path output
+    return files

src/Convert/AlwaysKW.hs

@@ -3,24 +3,255 @@
  -
  - Conversion for `always_latch`, `always_comb`, and `always_ff`
  -
- - `always_latch` -> `always @*`
+ - `always_comb` and `always_latch` become `always @*`, or produce an explicit
- - `always_comb` -> `always @*`
+ - sensitivity list if they need to pick up sensitivities from the functions
- - `always_ff` -> `always`
+ - they call. These blocks are triggered at time zero by adding a no-op
+ - statement reading from `_sv2v_0`, which is injected and updated in an
+ - `initial` block. `always_ff` simply becomes `always`.
  -}
 
 module Convert.AlwaysKW (convert) where
 
+import Control.Monad (when, zipWithM, (>=>))
+import Control.Monad.State.Strict
+import Control.Monad.Writer.Strict
+import Data.List (nub)
+import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Monoid (Any(Any), getAny)
+
+import Convert.Scoper
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
 convert :: [AST] -> [AST]
-convert = map $ traverseDescriptions $ traverseModuleItems replaceAlwaysKW
+convert = map $ traverseDescriptions traverseDescription
 
-replaceAlwaysKW :: ModuleItem -> ModuleItem
+traverseDescription :: Description -> Description
-replaceAlwaysKW (AlwaysC AlwaysLatch stmt) =
+traverseDescription (Part att ext kw lif name pts items) =
-    AlwaysC Always $ Timing (Event SenseStar) stmt
+    Part att ext kw lif name pts $
-replaceAlwaysKW (AlwaysC AlwaysComb stmt) =
+    if getAny anys && not (elem triggerDecl items')
-    AlwaysC Always $ Timing (Event SenseStar) stmt
+        then triggerDecl : items' ++ [triggerFire]
-replaceAlwaysKW (AlwaysC AlwaysFF stmt) =
+        else items'
-    AlwaysC Always stmt
+    where
-replaceAlwaysKW other = other
+        op = traverseModuleItem >=> scoper
+        (items', (anys, _)) = flip runState mempty $ evalScoperT $
+            insertElem triggerIdent Var >> scopeModuleItems op name items
+traverseDescription description = description
+
+type SC = ScoperT Kind (State (Any, [Expr]))
+
+type PortDir = (Identifier, Direction)
+
+data Kind
+    = Const Expr
+    | Var
+    | Proc [Expr] [PortDir]
+
+scoper :: ModuleItem -> SC ModuleItem
+scoper = scopeModuleItem traverseDecl return traverseGenItem traverseStmt
+
+-- track declarations and visit expressions they contain
+traverseDecl :: Decl -> SC Decl
+traverseDecl decl = do
+    case decl of
+        Param    s _ x e   -> do
+            -- handle references to local constants
+            e' <- if s == Localparam
+                    then scopeExpr e
+                    else return Nil
+            insertElem x $ Const e'
+        ParamType  _ x _   -> insertElem x $ Const Nil
+        Variable _ _ x _ _ -> do
+            -- don't let the second visit of a function or task overwrite the
+            -- Proc entry that was just generated
+            details <- lookupLocalIdentM x
+            case details of
+                Just (_, _, Proc{}) -> return ()
+                _ -> insertElem x Var
+        Net  _ _ _ _ x _ _ -> insertElem x Var
+        CommentDecl{} -> return ()
+    traverseDeclExprsM traverseExpr decl
+
+-- track expressions and subroutines in a statement
+traverseStmt :: Stmt -> SC Stmt
+traverseStmt (Subroutine expr args) =
+    traverseCall Subroutine expr args
+traverseStmt stmt = traverseStmtExprsM traverseExpr stmt
+
+-- visit tasks, functions, and always blocks in generate scopes
+traverseGenItem :: GenItem -> SC GenItem
+traverseGenItem (GenModuleItem item) =
+    traverseModuleItem item >>= return . GenModuleItem
+traverseGenItem other = return other
+
+-- identify variables referenced within an expression
+traverseExpr :: Expr -> SC Expr
+traverseExpr (Call expr args) =
+    traverseCall Call expr args
+traverseExpr expr = do
+    prefix <- embedScopes longestStaticPrefix expr
+    case prefix of
+        Just expr' -> push (Any False, [expr']) >> return expr
+        _ -> traverseSinglyNestedExprsM traverseExpr expr
+
+-- turn a reference to a variable into a canonicalized longest static prefix, if
+-- possible, per IEEE 1800-2017 Section 11.5.3
+longestStaticPrefix :: Scopes Kind -> Expr -> Maybe Expr
+longestStaticPrefix scopes expr@Ident{} =
+    asVar scopes expr
+longestStaticPrefix scopes (Range expr mode (l, r)) = do
+    expr' <- longestStaticPrefix scopes expr
+    l' <- asConst scopes l
+    r' <- asConst scopes r
+    Just $ Range expr' mode (l', r')
+longestStaticPrefix scopes (Bit expr idx) = do
+    expr' <- longestStaticPrefix scopes expr
+    idx' <- asConst scopes idx
+    Just $ Bit expr' idx'
+longestStaticPrefix scopes orig@(Dot expr field) =
+    case asVar scopes orig of
+        Just orig' -> Just orig'
+        _ -> do
+            expr' <- longestStaticPrefix scopes expr
+            Just $ Dot expr' field
+longestStaticPrefix _ _ =
+    Nothing
+
+-- lookup an expression as an outwardly-visible variable
+asVar :: Scopes Kind -> Expr -> Maybe Expr
+asVar scopes expr = do
+    (accesses, _, Var) <- lookupElem scopes expr
+    if visible accesses
+        then Just $ accessesToExpr accesses
+        else Nothing
+
+visible :: [Access] -> Bool
+visible = not . elem (Access "" Nil)
+
+-- lookup an expression as a hoist-able constant
+asConst :: Scopes Kind -> Expr -> Maybe Expr
+asConst scopes expr =
+    case runWriter $ asConstRaw scopes expr of
+        (expr', Any False) -> Just expr'
+        _ -> Nothing
+
+asConstRaw :: Scopes Kind -> Expr -> Writer Any Expr
+asConstRaw scopes expr =
+    case lookupElem scopes expr of
+        Just (accesses@[_, _], _, Const{}) -> return $ accessesToExpr accesses
+        Just (_, _, Const Nil) -> recurse
+        Just (_, _, Const expr') -> asConstRaw scopes expr'
+        Just{} -> tell (Any True) >> return Nil
+        Nothing -> recurse
+    where
+        recurse = traverseSinglyNestedExprsM (asConstRaw scopes) expr
+
+-- special handling for subroutine invocations and function calls
+traverseCall :: (Expr -> Args -> a) -> Expr -> Args -> SC a
+traverseCall constructor expr args = do
+    details <- lookupElemM expr
+    expr' <- traverseExpr expr
+    args' <- case details of
+        Just (_, _, Proc exprs ps) -> do
+            when (not $ null exprs) $
+                push (Any True, exprs)
+            traverseArgs ps args
+        _ -> traverseArgs [] args
+    return $ constructor expr' args'
+
+-- treats output ports as assignment-like contexts
+traverseArgs :: [PortDir] -> Args -> SC Args
+traverseArgs ps (Args pnArgs kwArgs) = do
+    pnArgs' <- zipWithM usingPN [0..] pnArgs
+    kwArgs' <- mapM usingKW kwArgs
+    return (Args pnArgs' kwArgs')
+    where
+
+        usingPN :: Int -> Expr -> SC Expr
+        usingPN key val = do
+            if dir == Output
+                then return val
+                else traverseExpr val
+            where dir = if key < length ps
+                            then snd $ ps !! key
+                            else Input
+
+        usingKW :: (Identifier, Expr) -> SC (Identifier, Expr)
+        usingKW (key, val) = do
+            val' <- if dir == Output
+                        then return val
+                        else traverseExpr val
+            return (key, val')
+            where dir = fromMaybe Input $ lookup key ps
+
+-- append to the non-local expression state
+push :: (Any, [Expr]) -> SC ()
+push x = lift $ modify' (x <>)
+
+-- custom traversal which converts SystemVerilog `always` keywords and tracks
+-- information about task and functions
+traverseModuleItem :: ModuleItem -> SC ModuleItem
+traverseModuleItem (AlwaysC AlwaysLatch stmt) =
+    traverseModuleItem $ AlwaysC AlwaysComb stmt
+traverseModuleItem (AlwaysC AlwaysComb stmt) = do
+    push (Any True, [])
+    e <- fmap toEvent $ findNonLocals $ Initial stmt'
+    return $ AlwaysC Always $ Timing (Event e) stmt'
+    where stmt' = addTriggerStmt stmt
+traverseModuleItem (AlwaysC AlwaysFF stmt) =
+    return $ AlwaysC Always stmt
+traverseModuleItem item@(MIPackageItem (Function _ _ x decls _)) = do
+    (_, s) <- findNonLocals item
+    insertElem x $ Proc s (ports decls)
+    return item
+traverseModuleItem item@(MIPackageItem (Task _ x decls _)) = do
+    insertElem x $ Proc [] (ports decls)
+    return item
+traverseModuleItem (MIAttr attr item) =
+    MIAttr attr <$> traverseModuleItem item
+traverseModuleItem other = return other
+
+toEvent :: (Bool, [Expr]) -> Event
+toEvent (False, _) = EventStar
+toEvent (True, exprs) =
+    EventExpr $ foldl1 EventExprOr $ map (EventExprEdge NoEdge) exprs
+
+-- turn a list of port declarations into a port direction map
+ports :: [Decl] -> [PortDir]
+ports = filter ((/= Local) . snd) . map port
+
+port :: Decl -> PortDir
+port (Variable d _ x _ _) = (x, d)
+port _ = ("", Local)
+
+-- get a list of non-local variables referenced within a module item, and
+-- whether or not this module item references any functions which themselves
+-- reference non-local variables
+findNonLocals :: ModuleItem -> SC (Bool, [Expr])
+findNonLocals item = do
+    scopes <- get
+    prev <- lift get
+    lift $ put mempty
+    _ <- scoper item
+    (anys, exprs) <- lift get
+    lift $ put prev
+    let nonLocals = mapMaybe (longestStaticPrefix scopes) $ nub exprs
+    return (getAny anys, nonLocals)
+
+triggerIdent :: Identifier
+triggerIdent = "_sv2v_0"
+
+triggerDecl :: ModuleItem
+triggerDecl = MIPackageItem $ Decl $ Variable Local t triggerIdent [] Nil
+    where t = IntegerVector TReg Unspecified []
+
+triggerFire :: ModuleItem
+triggerFire = Initial $ Asgn AsgnOpEq Nothing (LHSIdent triggerIdent) (RawNum 0)
+
+triggerStmt :: Stmt
+triggerStmt = If NoCheck (Ident triggerIdent) Null Null
+
+addTriggerStmt :: Stmt -> Stmt
+addTriggerStmt (Block Seq name decls stmts) =
+    Block Seq name decls $ triggerStmt : stmts
+addTriggerStmt stmt = Block Seq "" [] [triggerStmt, stmt]

src/Convert/AsgnOp.hs

@@ -14,13 +14,13 @@ import Language.SystemVerilog.AST
 convert :: [AST] -> [AST]
 convert =
     map $ traverseDescriptions $ traverseModuleItems $
-    ( traverseStmts    convertStmt
+    ( traverseStmts (traverseNestedStmts convertStmt)
-    . traverseGenItems convertGenItem
+    . traverseGenItems (traverseNestedGenItems convertGenItem)
     )
 
 convertGenItem :: GenItem -> GenItem
 convertGenItem (GenFor a b (ident, AsgnOp op, expr) c) =
-    GenFor a b (ident, AsgnOpEq, BinOp op (Ident ident) expr) c
+    GenFor a b (ident, AsgnOpEq, elabBinOp op (Ident ident) expr) c
 convertGenItem other = other
 
 convertStmt :: Stmt -> Stmt
@@ -30,8 +30,13 @@ convertStmt (For inits cc asgns stmt) =
         asgns' = map convertAsgn asgns
         convertAsgn :: (LHS, AsgnOp, Expr) -> (LHS, AsgnOp, Expr)
         convertAsgn (lhs, AsgnOp op, expr) =
-            (lhs, AsgnOpEq, BinOp op (lhsToExpr lhs) expr)
+            (lhs, AsgnOpEq, elabBinOp op (lhsToExpr lhs) expr)
         convertAsgn other = other
-convertStmt (AsgnBlk (AsgnOp op) lhs expr) =
+convertStmt (Asgn (AsgnOp op) mt lhs expr) =
-    AsgnBlk AsgnOpEq lhs (BinOp op (lhsToExpr lhs) expr)
+    Asgn AsgnOpEq mt lhs (elabBinOp op (lhsToExpr lhs) expr)
 convertStmt other = other
+
+elabBinOp :: BinOp -> Expr -> Expr -> Expr
+elabBinOp Add e1 (UniOp UniSub e2) = BinOp Sub e1 e2
+elabBinOp Sub e1 (UniOp UniSub e2) = BinOp Add e1 e2
+elabBinOp op e1 e2 = BinOp op e1 e2

src/Convert/Assertion.hs

@@ -13,12 +13,13 @@ convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem
 
 convertModuleItem :: ModuleItem -> ModuleItem
-convertModuleItem (AssertionItem item) =
+convertModuleItem item@AssertionItem{} =
-    Generate $
+    Generate $ map toItem comments
-    map (GenModuleItem . MIPackageItem . Comment) $
+    where
-        "removed an assertion item" :
+        toItem = GenModuleItem . MIPackageItem . Decl . CommentDecl
-        (lines $ show $ AssertionItem item)
+        comments = "removed an assertion item" : (lines $ show item)
-convertModuleItem other = traverseStmts convertStmt other
+convertModuleItem other =
+    traverseStmts (traverseNestedStmts convertStmt) other
 
 convertStmt :: Stmt -> Stmt
 convertStmt (Assertion _) = Null

src/Convert/BlockDecl.hs

@@ -16,7 +16,7 @@ import Language.SystemVerilog.AST
 convert :: [AST] -> [AST]
 convert =
     map $ traverseDescriptions $ traverseModuleItems
-    (convertModuleItem . traverseStmts convertStmt)
+    (convertModuleItem . traverseStmts (traverseNestedStmts convertStmt))
 
 convertModuleItem :: ModuleItem -> ModuleItem
 convertModuleItem (MIPackageItem (Function ml t f decls stmts)) =
@@ -42,9 +42,11 @@ convertStmt (Block Seq name decls stmts) =
 convertStmt other = other
 
 splitDecl :: Decl -> (Decl, Maybe (LHS, Expr))
-splitDecl (Variable d t ident a (Just e)) =
+splitDecl decl@(Variable _ _ _ _ Nil) =
-    (Variable d t ident a Nothing, Just (LHSIdent ident, e))
+    (decl, Nothing)
-splitDecl other = (other, Nothing)
+splitDecl (Variable d t ident a e) =
+    (Variable d t ident a Nil, Just (LHSIdent ident, e))
+splitDecl decl = (decl, Nothing)
 
 asgnStmt :: (LHS, Expr) -> Stmt
-asgnStmt = uncurry $ AsgnBlk AsgnOpEq
+asgnStmt = uncurry $ Asgn AsgnOpEq Nothing

src/Convert/Cast.hs

@@ -0,0 +1,223 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion of elaborated type casts
+ -
+ - Much of the work of elaborating various casts into explicit integer vector
+ - type casts happens in the TypeOf conversion, which contains the primary logic
+ - for resolving the type and signedness of expressions. It also removes
+ - redundant explicit casts to produce cleaner output.
+ -
+ - Type casts are defined as producing the result of the expression assigned to
+ - a variable of the given type. In the general case, this conversion generates
+ - a pass-through function which performs this assignment-based casting. This
+ - allows for casts to be used anywhere expressions are used, including within
+ - constant expressions.
+ -
+ - It is possible for the type in a cast to refer to localparams within a
+ - procedure. Without evaluating the localparam itself, a function outside of
+ - the procedure cannot refer to the size of the type in the cast. In these
+ - scenarios, the cast is instead performed by adding a temporary parameter or
+ - data declaration within the procedure and assigning the expression to that
+ - declaration to perform the cast.
+ -
+ - A few common cases of casts on number literals are fully elaborated into
+ - their corresponding resulting number literals to avoid excessive noise.
+ -}
+
+module Convert.Cast (convert) where
+
+import Control.Monad (when)
+import Control.Monad.Writer.Strict
+import Data.List (isPrefixOf)
+import Data.Maybe (isJust)
+import Data.Monoid (Any(Any), getAny)
+
+import Convert.ExprUtils
+import Convert.Scoper
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+convert :: [AST] -> [AST]
+convert = map $ traverseDescriptions convertDescription
+
+convertDescription :: Description -> Description
+convertDescription =
+    traverseModuleItems dropDuplicateCaster . evalScoper . scopePart scoper
+    where scoper = scopeModuleItem
+            traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
+
+type SC = Scoper ()
+
+traverseDeclM :: Decl -> SC Decl
+traverseDeclM decl = do
+    decl' <- case decl of
+        Variable d t x a e -> do
+            enterStmt
+            e' <- traverseExprM e
+            exitStmt
+            details <- lookupLocalIdentM x
+            if isPrefixOf "sv2v_cast_" x && details /= Nothing
+                then return $ Variable Local t DuplicateTag [] Nil
+                else do
+                    insertElem x ()
+                    return $ Variable d t x a e'
+        Net d n s t x a e -> do
+            enterStmt
+            e' <- traverseExprM e
+            exitStmt
+            insertElem x ()
+            return $ Net d n s t x a e'
+        Param _ _ x _ ->
+            insertElem x () >> return decl
+        ParamType    _ _ _ -> return decl
+        CommentDecl      _ -> return decl
+    traverseDeclExprsM traverseExprM decl'
+
+pattern DuplicateTag :: Identifier
+pattern DuplicateTag = ":duplicate_cast_to_be_removed:"
+
+dropDuplicateCaster :: ModuleItem -> ModuleItem
+dropDuplicateCaster (MIPackageItem (Function _ _ DuplicateTag _ _)) =
+    Generate []
+dropDuplicateCaster other = other
+
+traverseModuleItemM :: ModuleItem -> SC ModuleItem
+traverseModuleItemM (Genvar x) =
+    insertElem x () >> return (Genvar x)
+traverseModuleItemM item =
+    traverseExprsM traverseExprM item
+
+traverseGenItemM :: GenItem -> SC GenItem
+traverseGenItemM = traverseGenItemExprsM traverseExprM
+
+traverseStmtM :: Stmt -> SC Stmt
+traverseStmtM stmt = do
+    enterStmt
+    stmt' <- traverseStmtExprsM traverseExprM stmt
+    exitStmt
+    return stmt'
+
+traverseExprM :: Expr -> SC Expr
+traverseExprM (Cast (Left (IntegerVector kw sg rs)) value) | kw /= TBit = do
+    value' <- fmap simplify $ traverseExprM value
+    size' <- traverseExprM size
+    convertCastM size' value' signed
+    where
+        signed = sg == Signed
+        size = dimensionsSize rs
+traverseExprM other =
+    traverseSinglyNestedExprsM traverseExprM other
+
+convertCastM :: Expr -> Expr -> Bool -> SC Expr
+convertCastM (Number size) _ _
+    | maybeInt == Nothing = illegal "an integer"
+    | int <= 0            = illegal "a positive integer"
+    where
+        maybeInt = numberToInteger size
+        Just int = maybeInt
+        illegal = scopedErrorM . msg
+        msg s = "size cast width " ++ show size ++ " is not " ++ s
+convertCastM (Number size) (Number value) signed =
+    return $ Number $
+        numberCast signed (fromIntegral size') value
+    where Just size' = numberToInteger size
+convertCastM size@Number{} (String str) signed =
+    convertCastM size (stringToNumber str) signed
+convertCastM size value signed = do
+    sizeUsesLocalVars <- embedScopes usesLocalVars size
+    inProcedure <- withinProcedureM
+    if not sizeUsesLocalVars || not inProcedure then do
+        let name = castFnName size signed
+        let item = castFn name size signed
+        if sizeUsesLocalVars
+            then do
+                details <- lookupLocalIdentM name
+                when (details == Nothing) (injectItem item)
+            else do
+                details <- lookupElemM name
+                when (details == Nothing) (injectTopItem item)
+        return $ Call (Ident name) (Args [value] [])
+    else do
+        name <- castDeclName 0
+        insertElem name ()
+        useVar <- withinStmt
+        injectDecl $ castDecl useVar name value size signed
+        return $ Ident name
+
+-- checks if a cast size references any vars not defined at the top level scope
+usesLocalVars :: Scopes a -> Expr -> Bool
+usesLocalVars scopes =
+    getAny . execWriter . collectNestedExprsM collectLocalVarsM
+    where
+        collectLocalVarsM :: Expr -> Writer Any ()
+        collectLocalVarsM expr@(Ident x) =
+            if isLoopVar scopes x
+                then tell $ Any True
+                else resolve expr
+        collectLocalVarsM expr = resolve expr
+        resolve :: Expr -> Writer Any ()
+        resolve expr =
+            case lookupElem scopes expr of
+                Nothing -> return ()
+                Just ([_, _], _, _) -> return ()
+                Just (_, _, _) -> tell $ Any True
+
+castType :: Expr -> Bool -> Type
+castType size signed =
+    IntegerVector TLogic sg [r]
+    where
+        r = (simplify $ BinOp Sub size (RawNum 1), RawNum 0)
+        sg = if signed then Signed else Unspecified
+
+castFn :: Identifier -> Expr -> Bool -> ModuleItem
+castFn name size signed =
+    MIPackageItem $ Function Automatic t name [decl] [stmt]
+    where
+        inp = "inp"
+        t = castType size signed
+        decl = Variable Input t inp [] Nil
+        stmt = Asgn AsgnOpEq Nothing (LHSIdent name) (Ident inp)
+
+castFnName :: Expr -> Bool -> String
+castFnName size signed =
+    "sv2v_cast_" ++ sizeStr ++ suffix
+    where
+        sizeStr = case size of
+            Number n -> show v
+                where Just v = numberToInteger n
+            _ -> shortHash size
+        suffix = if signed then "_signed" else ""
+
+castDecl :: Bool -> Identifier -> Expr -> Expr -> Bool -> Decl
+castDecl useVar name value size signed =
+    if useVar
+        then Variable Local t name [] value
+        else Param Localparam t name value
+    where t = castType size signed
+
+castDeclName :: Int -> SC String
+castDeclName counter = do
+    details <- lookupElemM name
+    if details == Nothing
+        then return name
+        else castDeclName (counter + 1)
+    where
+        name = if counter == 0
+            then prefix
+            else prefix ++ '_' : show counter
+        prefix = "sv2v_tmp_cast"
+
+-- track whether procedural casts should use variables
+withinStmtKey :: Identifier
+withinStmtKey = ":within_stmt:"
+withinStmt :: SC Bool
+withinStmt = fmap isJust $ lookupElemM withinStmtKey
+enterStmt :: SC ()
+enterStmt = do
+    inProcedure <- withinProcedureM
+    when inProcedure $ insertElem withinStmtKey ()
+exitStmt :: SC ()
+exitStmt = do
+    inProcedure <- withinProcedureM
+    when inProcedure $ removeElem withinStmtKey

src/Convert/DimensionQuery.hs

@@ -19,17 +19,12 @@
 
 module Convert.DimensionQuery (convert) where
 
-import Data.List (elemIndex)
+import Convert.ExprUtils
-
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
 convert :: [AST] -> [AST]
-convert files =
+convert = map $ traverseDescriptions convertDescription
-    if files == files'
-        then files
-        else convert files'
-    where files' = map (traverseDescriptions convertDescription) files
 
 convertDescription :: Description -> Description
 convertDescription =
@@ -41,9 +36,9 @@ elaborateType (IntegerAtom t sg) =
     IntegerVector TLogic sg [(hi, lo)]
     where
         size = atomSize t
-        hi = Number $ show (size - 1)
+        hi = RawNum $ size - 1
-        lo = Number "0"
+        lo = RawNum 0
-        atomSize :: IntegerAtomType -> Int
+        atomSize :: IntegerAtomType -> Integer
         atomSize TByte = 8
         atomSize TShortint = 16
         atomSize TInt = 32
@@ -61,32 +56,34 @@ convertExpr (DimsFn fn (Right e)) =
     DimsFn fn $ Left $ TypeOf e
 convertExpr (DimFn fn (Right e) d) =
     DimFn fn (Left $ TypeOf e) d
-convertExpr (orig @ (DimsFn FnUnpackedDimensions (Left t))) =
+convertExpr orig@(DimsFn FnUnpackedDimensions (Left t)) =
     case t of
-        UnpackedType _ rs -> Number $ show $ length rs
+        UnpackedType _ rs -> RawNum $ fromIntegral $ length rs
         TypeOf{} -> orig
-        _ -> Number "0"
+        _ -> RawNum 0
-convertExpr (orig @ (DimsFn FnDimensions (Left t))) =
+convertExpr orig@(DimsFn FnDimensions (Left t)) =
     case t of
-        IntegerAtom{} -> Number "1"
+        IntegerAtom{} -> RawNum 1
         Alias{} -> orig
+        PSAlias{} -> orig
+        CSAlias{} -> orig
         TypeOf{} -> orig
         UnpackedType t' rs ->
             BinOp Add
-                (Number $ show $ length rs)
+                (RawNum $ fromIntegral $ length rs)
                 (DimsFn FnDimensions $ Left t')
-        _ -> Number $ show $ length $ snd $ typeRanges t
+        _ -> RawNum $ fromIntegral $ length $ snd $ typeRanges t
 
 -- conversion for array dimension functions on types
-convertExpr (DimFn f (Left t) (Number str)) =
+convertExpr (DimFn f (Left t) (Number n)) =
-    if dm == Nothing || isUnresolved t then
+    if isUnresolved t then
-        DimFn f (Left t) (Number str)
+        DimFn f (Left t) (Number n)
     else if d <= 0 || d > length rs then
-        Number "'x"
+        Number $ UnbasedUnsized BitX
     else case f of
         FnLeft -> fst r
         FnRight -> snd r
-        FnIncrement -> endianCondExpr r (Number "1") (Number "-1")
+        FnIncrement -> endianCondExpr r (RawNum 1) (UniOp UniSub $ RawNum 1)
         FnLow -> endianCondExpr r (snd r) (fst r)
         FnHigh -> endianCondExpr r (fst r) (snd r)
         FnSize -> rangeSize r
@@ -95,12 +92,15 @@ convertExpr (DimFn f (Left t) (Number str)) =
             UnpackedType tInner rsOuter ->
                 rsOuter ++ (snd $ typeRanges $ elaborateType tInner)
             _ -> snd $ typeRanges $ elaborateType t
-        dm = readNumber str
+        d = case numberToInteger n of
-        Just d = dm
+            Just value -> fromIntegral value
+            Nothing -> 0
         r = rs !! (d - 1)
         isUnresolved :: Type -> Bool
-        isUnresolved (Alias{}) = True
+        isUnresolved Alias{} = True
-        isUnresolved (TypeOf{}) = True
+        isUnresolved PSAlias{} = True
+        isUnresolved CSAlias{} = True
+        isUnresolved TypeOf{} = True
         isUnresolved _ = False
 convertExpr (DimFn f (Left t) d) =
     DimFn f (Left t) d
@@ -113,7 +113,11 @@ convertBits (Left t) =
     case elaborateType t of
         IntegerVector _ _ rs -> dimensionsSize rs
         Implicit        _ rs -> dimensionsSize rs
-        Net           _ _ rs -> dimensionsSize rs
+        Struct   _ fields rs ->
+            BinOp Mul
+                (dimensionsSize rs)
+                (foldl (BinOp Add) (RawNum 0) fieldSizes)
+            where fieldSizes = map (DimsFn FnBits . Left . fst) fields
         UnpackedType  t'  rs ->
             BinOp Mul
                 (dimensionsSize rs)
@@ -122,12 +126,16 @@ convertBits (Left t) =
 convertBits (Right e) =
     case e of
         Concat exprs ->
-            foldl (BinOp Add) (Number "0") $
+            foldl (BinOp Add) (RawNum 0) $
             map (convertBits . Right) $
             exprs
         Stream _ _ exprs -> convertBits $ Right $ Concat exprs
-        Number n ->
+        Number n -> RawNum $ numberBitLength n
-            case elemIndex '\'' n of
+        Range expr mode range ->
-                Nothing -> Number "32"
+            BinOp Mul size $ convertBits $ Right $ Bit expr (RawNum 0)
-                Just idx -> Number $ take idx n
+            where
+                size = case mode of
+                    NonIndexed   -> rangeSize range
+                    IndexedPlus  -> snd range
+                    IndexedMinus -> snd range
         _ -> DimsFn FnBits $ Left $ TypeOf e

src/Convert/DoWhile.hs

@@ -0,0 +1,31 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for `do` `while` loops.
+ -
+ - These are converted into while loops with an extra condition which is
+ - initially true and immediately set to false in the body. This strategy is
+ - preferrable to simply duplicating the loop body as it could contain jumps.
+ -}
+
+module Convert.DoWhile (convert) where
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+convert :: [AST] -> [AST]
+convert =
+    map $ traverseDescriptions $ traverseModuleItems $
+    traverseStmts $ traverseNestedStmts convertStmt
+
+convertStmt :: Stmt -> Stmt
+convertStmt (DoWhile cond body) =
+    Block Seq "" [decl] [While cond' body']
+    where
+        ident = "sv2v_do_while"
+        typ = IntegerVector TLogic Unspecified []
+        decl = Variable Local typ ident [] (RawNum 1)
+        cond' = BinOp LogOr (Ident ident) cond
+        asgn = Asgn AsgnOpEq Nothing (LHSIdent ident) (RawNum 0)
+        body' = Block Seq "" [] [asgn, body]
+convertStmt other = other

src/Convert/DuplicateGenvar.hs

@@ -0,0 +1,25 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion to remove duplicate genvar declarations
+ -}
+
+module Convert.DuplicateGenvar (convert) where
+
+import Convert.Scoper
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+convert :: [AST] -> [AST]
+convert = map $ traverseDescriptions traverseDescription
+
+traverseDescription :: Description -> Description
+traverseDescription = partScoper return traverseModuleItemM return return
+
+traverseModuleItemM :: ModuleItem -> Scoper () ModuleItem
+traverseModuleItemM (Genvar x) = do
+    details <- lookupLocalIdentM x
+    if details == Nothing
+        then insertElem x () >> return (Genvar x)
+        else return $ Generate []
+traverseModuleItemM item = return item

src/Convert/EmptyArgs.hs

@@ -8,47 +8,78 @@
 
 module Convert.EmptyArgs (convert) where
 
-import Control.Monad.Writer
+import Convert.Scoper
-import qualified Data.Set as Set
-
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type Idents = Set.Set Identifier
+type SC = Scoper ()
 
 convert :: [AST] -> [AST]
-convert = map $ traverseDescriptions convertDescription
+convert = map $ traverseDescriptions traverseDescription
 
-convertDescription :: Description -> Description
+traverseDescription :: Description -> Description
-convertDescription (description @ Part{}) =
+traverseDescription =
-    traverseModuleItems
+    evalScoper . scopePart scoper .
-        (traverseExprs $ traverseNestedExprs $ convertExpr functions)
+    traverseModuleItems addDummyArg
-        description'
+    where scoper = scopeModuleItem
-    where
+            traverseDecl traverseModuleItem traverseGenItem traverseStmt
-        (description', functions) =
+
-            runWriter $ traverseModuleItemsM traverseFunctionsM description
+-- add a dummy argument to functions with no input ports
-convertDescription other = other
+addDummyArg :: ModuleItem -> ModuleItem
+addDummyArg (MIPackageItem (Function l t f decls stmts))
+    | all (not . isInput) decls =
+        MIPackageItem $ Function l t f (dummyDecl : decls) stmts
+addDummyArg other = other
 
-traverseFunctionsM :: ModuleItem -> Writer Idents ModuleItem
-traverseFunctionsM (MIPackageItem (Function ml t f decls stmts)) = do
-    let dummyDecl = Variable Input (Implicit Unspecified []) "_sv2v_unused" [] Nothing
-    decls' <- do
-        if any isInput decls
-            then return decls
-            else do
-                tell $ Set.singleton f
-                return $ dummyDecl : decls
-    return $ MIPackageItem $ Function ml t f decls' stmts
-    where
 isInput :: Decl -> Bool
 isInput (Variable Input _ _ _ _) = True
 isInput _ = False
-traverseFunctionsM other = return other
 
-convertExpr :: Idents -> Expr -> Expr
+-- write down all declarations so we can look up the dummy arg
-convertExpr functions (Call (Ident func) (Args [] [])) =
+traverseDecl :: Decl -> SC Decl
-    Call (Ident func) (Args args [])
+traverseDecl decl = do
-    where args = if Set.member func functions
+    decl' <- case decl of
-            then [Just $ Number "0"]
+        Param    _ _ x _   -> insertElem x () >> return decl
-            else []
+        ParamType  _ x _   -> insertElem x () >> return decl
-convertExpr _ other = other
+        Variable d t x a e -> do
+            insertElem x ()
+            -- new dummy args have a special name for idempotence
+            return $ if x == dummyIdent
+                then Variable d t dummyIdentFinal a e
+                else decl
+        Net  _ _ _ _ x _ _ -> insertElem x () >> return decl
+        CommentDecl{} -> return decl
+    traverseDeclExprsM traverseExpr decl'
+
+traverseModuleItem :: ModuleItem -> SC ModuleItem
+traverseModuleItem = traverseExprsM traverseExpr
+
+traverseGenItem :: GenItem -> SC GenItem
+traverseGenItem = traverseGenItemExprsM traverseExpr
+
+traverseStmt :: Stmt -> SC Stmt
+traverseStmt = traverseStmtExprsM traverseExpr
+
+-- pass a dummy value to functions which had no inputs
+traverseExpr :: Expr -> SC Expr
+traverseExpr (Call func (Args args [])) = do
+    details <- lookupElemM $ Dot func dummyIdent
+    args' <- mapM traverseExpr $
+                if details /= Nothing
+                    then RawNum 0 : args
+                    else args
+    return $ Call func (Args args' [])
+traverseExpr expr =
+    traverseSinglyNestedExprsM traverseExpr expr
+
+dummyIdent :: Identifier
+dummyIdent = '?' : dummyIdentFinal
+
+dummyIdentFinal :: Identifier
+dummyIdentFinal = "_sv2v_unused"
+
+dummyType :: Type
+dummyType = IntegerVector TReg Unspecified []
+
+dummyDecl :: Decl
+dummyDecl = Variable Input dummyType dummyIdent [] Nil

src/Convert/Enum.hs

@@ -3,16 +3,12 @@
  -
  - Conversion for `enum`
  -
- - This conversion replaces the enum items with localparams declared within any
+ - This conversion replaces references to enum items with their values. The
- - modules in which that enum type appears. This is not necessarily foolproof,
+ - values are explicitly cast to the enum's base type.
- - as some tools do allow the use of an enum item even if the actual enum type
- - does not appear in that description. The localparams are explicitly sized to
- - match the size of the converted enum type. This conversion includes only enum
- - items which are actually used within a given description.
  -
  - SystemVerilog allows for enums to have any number of the items' values
  - specified or unspecified. If the first one is unspecified, it is 0. All other
- - values take on the value of the previous item, plus 1.
+ - unspecified values take on the value of the previous item, plus 1.
  -
  - It is an error for multiple items of the same enum to take on the same value,
  - whether implicitly or explicitly. We catch try to catch "obvious" instances
@@ -21,130 +17,91 @@
 
 module Convert.Enum (convert) where
 
-import Control.Monad.Writer
+import Control.Monad (zipWithM_, (>=>))
-import Data.List (elemIndices, partition, sortOn)
+import Data.List (elemIndices)
-import qualified Data.Set as Set
 
+import Convert.ExprUtils
+import Convert.Scoper
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type EnumInfo = (Maybe Range, [(Identifier, Maybe Expr)])
+type SC = Scoper Expr
-type Enums = Set.Set EnumInfo
-type Idents = Set.Set Identifier
-type EnumItem = ((Maybe Range, Identifier), Expr)
 
 convert :: [AST] -> [AST]
-convert = map $ traverseDescriptions convertDescription
+convert = map $ traverseDescriptions $ partScoper
+    traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
 
-defaultType :: Type
+traverseDeclM :: Decl -> SC Decl
-defaultType = IntegerVector TLogic Unspecified [(Number "31", Number "0")]
+traverseDeclM decl = do
+    case decl of
+        Variable _ _ x _ _ -> insertElem x Nil
+        Net  _ _ _ _ x _ _ -> insertElem x Nil
+        Param    _ _ x   _ -> insertElem x Nil
+        ParamType  _ x   _ -> insertElem x Nil
+        CommentDecl{} -> return ()
+    traverseDeclTypesM traverseTypeM decl >>=
+        traverseDeclExprsM traverseExprM
 
-convertDescription :: Description -> Description
+traverseModuleItemM :: ModuleItem -> SC ModuleItem
-convertDescription (description @ Part{}) =
+traverseModuleItemM (Genvar x) =
-    Part attrs extern kw lifetime name ports (enumItems ++ items)
+    insertElem x Nil >> return (Genvar x)
+traverseModuleItemM item =
+    traverseNodesM traverseExprM return traverseTypeM traverseLHSM return item
+    where traverseLHSM = traverseNestedLHSsM $ traverseLHSExprsM traverseExprM
+
+traverseGenItemM :: GenItem -> SC GenItem
+traverseGenItemM = traverseGenItemExprsM traverseExprM
+
+traverseStmtM :: Stmt -> SC Stmt
+traverseStmtM = traverseStmtExprsM traverseExprM
+
+traverseTypeM :: Type -> SC Type
+traverseTypeM =
+    traverseSinglyNestedTypesM traverseTypeM >=>
+    traverseTypeExprsM traverseExprM >=>
+    replaceEnum
+
+traverseExprM :: Expr -> SC Expr
+traverseExprM (Ident x) = do
+    details <- lookupElemM x
+    return $ case details of
+        Just (_, _, Nil) -> Ident x
+        Just (_, _, e) -> e
+        Nothing -> Ident x
+traverseExprM expr =
+    traverseSinglyNestedExprsM traverseExprM expr
+        >>= traverseExprTypesM traverseTypeM
+
+-- replace enum types and insert enum items
+replaceEnum :: Type -> SC Type
+replaceEnum t@(Enum Alias{} v _) = -- not ready
+    mapM_ (flip insertElem Nil . fst) v >> return t
+replaceEnum (Enum (Implicit sg rl) v rs) =
+    replaceEnum $ Enum t' v rs
     where
-        -- replace and collect the enum types in this description
+        -- default to a 32 bit logic
-        (Part attrs extern kw lifetime name ports items, enumPairs) =
+        t' = IntegerVector TLogic sg rl'
-            convertDescription' description
+        rl' = if null rl
-        -- convert the collected enums into their corresponding localparams
+            then [(RawNum 31, RawNum 0)]
-        enumItems = map MIPackageItem $ map toItem $ sortOn snd $ convergeUsage items enumPairs
+            else rl
-convertDescription (description @ (Package _ _ _)) =
+replaceEnum (Enum t v rs) =
-    Package ml name (items ++ enumItems)
+    insertEnumItems t v >> return (tf $ rl ++ rs)
-    where
+    where (tf, rl) = typeRanges t
-        -- replace and collect the enum types in this description
+replaceEnum other = return other
-        (Package ml name items, enumPairs) =
-            convertDescription' description
-        -- convert the collected enums into their corresponding localparams
-        enumItems = map toItem $ sortOn snd $ enumPairs
-convertDescription other = other
 
--- replace and collect the enum types in a description
+insertEnumItems :: Type -> [(Identifier, Expr)] -> SC ()
-convertDescription' :: Description -> (Description, [EnumItem])
+insertEnumItems itemType items =
-convertDescription' description =
-    (description', enumPairs)
-    where
-        -- replace and collect the enum types in this description
-        (description', enums) =
-            runWriter $
-            traverseModuleItemsM (traverseTypesM traverseType) $
-            traverseModuleItems (traverseExprs $ traverseNestedExprs traverseExpr) $
-            description
-        -- convert the collected enums into their corresponding localparams
-        enumPairs = concatMap enumVals $ Set.toList enums
-
--- add only the enums actually used in the given items
-convergeUsage :: [ModuleItem] -> [EnumItem] -> [EnumItem]
-convergeUsage items enums =
-    if null usedEnums
-        then []
-        else usedEnums ++ convergeUsage (enumItems ++ items) unusedEnums
-    where
-        -- determine which of the enum items are actually used here
-        (usedEnums, unusedEnums) = partition isUsed enums
-        enumItems = map MIPackageItem $ map toItem usedEnums
-        isUsed ((_, x), _) = Set.member x usedIdents
-        usedIdents = execWriter $
-            mapM (collectExprsM $ collectNestedExprsM collectIdent) $ items
-        collectIdent :: Expr -> Writer Idents ()
-        collectIdent (Ident x) = tell $ Set.singleton x
-        collectIdent _ = return ()
-
-toItem :: EnumItem -> PackageItem
-toItem ((mr, x), v) =
-    Decl $ Param Localparam itemType x v'
-    where
-        v' = simplify v
-        rs = maybe [] (\a -> [a]) mr
-        itemType = Implicit Unspecified rs
-
-toBaseType :: Maybe Type -> Type
-toBaseType Nothing = defaultType
-toBaseType (Just (Implicit _ rs)) =
-    fst (typeRanges defaultType) rs
-toBaseType (Just t @ (Alias _ _ _)) = t
-toBaseType (Just t) =
-    if null rs
-        then tf [(Number "0", Number "0")]
-        else t
-    where (tf, rs) = typeRanges t
-
--- replace, but write down, enum types
-traverseType :: Type -> Writer Enums Type
-traverseType (Enum t v rs) = do
-    let baseType = toBaseType t
-    let (tf, rl) = typeRanges baseType
-    mr <- return $ case rl of
-        [] -> Nothing
-        [r] -> Just r
-        _ -> error $ "unexpected multi-dim enum type: "
-                    ++ show (Enum t v rs)
-    () <- tell $ Set.singleton (fmap simplifyRange mr, v)
-    return $ tf (rl ++ rs)
-traverseType other = return other
-
-simplifyRange :: Range -> Range
-simplifyRange (a, b) = (simplify a, simplify b)
-
--- drop any enum type casts in favor of implicit conversion from the
--- converted type
-traverseExpr :: Expr -> Expr
-traverseExpr (Cast (Left (IntegerVector _ _ _)) e) = e
-traverseExpr (Cast (Left (Enum _ _ _)) e) = e
-traverseExpr other = other
-
-enumVals :: EnumInfo -> [EnumItem]
-enumVals (mr, l) =
     -- check for obviously duplicate values
     if noDuplicates
-        then res
+        then zipWithM_ insertEnumItem keys vals
-        else error $ "enum conversion has duplicate vals: "
+        else scopedErrorM $ "enum conversion has duplicate vals: "
                 ++ show (zip keys vals)
     where
-        keys = map fst l
+        insertEnumItem :: Identifier -> Expr -> SC ()
-        vals = tail $ scanl step (Number "-1") (map snd l)
+        insertEnumItem x = scopeExpr . Cast (Left itemType) >=> insertElem x
-        res = zip (zip (repeat mr) keys) vals
+        (keys, valsRaw) = unzip items
+        vals = tail $ scanl step (UniOp UniSub $ RawNum 1) valsRaw
         noDuplicates = all (null . tail . flip elemIndices vals) vals
-        step :: Expr -> Maybe Expr -> Expr
+        step :: Expr -> Expr -> Expr
-        step _ (Just expr) = expr
+        step expr Nil = simplify $ BinOp Add expr (RawNum 1)
-        step expr Nothing =
+        step _ expr = expr
-            simplify $ BinOp Add expr (Number "1")

src/Convert/EventEdge.hs

@@ -0,0 +1,41 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for `edge` sensitivity
+ -
+ - IEEE 1800-2017 Section 9.4.2 defines `edge` as either `posedge` or `negedge`.
+ - This does not convert senses in assertions as they are likely either removed
+ - or fully supported downstream.
+ -}
+
+module Convert.EventEdge (convert) where
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+convert :: [AST] -> [AST]
+convert =
+    map $ traverseDescriptions $ traverseModuleItems $ traverseStmts $
+        traverseNestedStmts convertStmt
+
+convertStmt :: Stmt -> Stmt
+convertStmt (Asgn op (Just timing) lhs expr) =
+    Asgn op (Just $ convertTiming timing) lhs expr
+convertStmt (Timing timing stmt) =
+    Timing (convertTiming timing) stmt
+convertStmt other = other
+
+convertTiming :: Timing -> Timing
+convertTiming (Event event) = Event $ convertEvent event
+convertTiming other = other
+
+convertEvent :: Event -> Event
+convertEvent EventStar = EventStar
+convertEvent (EventExpr e) = EventExpr $ convertEventExpr e
+
+convertEventExpr :: EventExpr -> EventExpr
+convertEventExpr (EventExprOr v1 v2) =
+    EventExprOr (convertEventExpr v1) (convertEventExpr v2)
+convertEventExpr (EventExprEdge Edge lhs) =
+    EventExprOr (EventExprEdge Posedge lhs) (EventExprEdge Negedge lhs)
+convertEventExpr other@EventExprEdge{} = other

src/Convert/ExprAsgn.hs

@@ -0,0 +1,112 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for assignments within expressions
+ -
+ - IEEE 1800-2017 Section 11.3.6 states that assignments within expressions can
+ - only appear in procedural statements, though some tools support them in other
+ - contexts. We do not currently raise an error for assignments within
+ - expressions in unsupported contexts.
+ -
+ - Assignment expressions are replaced with the LHS, with the LHS being updated
+ - in a preceding statement. For post-increment operations, a pre-increment is
+ - performed and then the increment is reversed in the expression.
+ -
+ - This conversion occurs after the elaboration of `do` `while` loops and
+ - `foreach` loops, but before the elaboration of jumps and extra `for` loop
+ - initializations.
+ -}
+
+module Convert.ExprAsgn (convert) where
+
+import Control.Monad.Writer.Strict
+import Data.Bitraversable (bimapM)
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+convert :: [AST] -> [AST]
+convert = map $ traverseDescriptions $ traverseModuleItems $
+    traverseStmts convertStmt
+
+convertStmt :: Stmt -> Stmt
+
+-- assignment expressions in a loop guard
+convertStmt (While cond stmt) =
+    if null add
+        then While cond stmt'
+        else block $ add ++ [While cond' $ injectLoopIter add stmt']
+    where
+        (cond', add) = runWriter $ convertExpr cond
+        stmt' = convertStmt stmt
+
+-- assignment expressions can appear in any part of the for loop
+convertStmt (For inits cond incrs stmt) =
+    if null initsAdd && null condAdd && null incrsAdd
+        then For inits cond incrs stmt'
+        else For initsCombined cond' incrs' $
+            injectLoopIter (incrsAdd ++ condAdd) stmt'
+    where
+        (inits', initsAdd) = runWriter $ mapM convertInit inits
+        (cond', condAdd) = runWriter $ convertExpr cond
+        (incrs', incrsAdd) = runWriter $ mapM convertIncr incrs
+        stmt' = convertStmt stmt
+        initsCombined = map toInit initsAdd ++ inits' ++ map toInit condAdd
+
+-- assignment expressions in other statements are added in front
+convertStmt stmt =
+    traverseSinglyNestedStmts convertStmt $
+        if null add
+            then stmt
+            else block $ add ++ [stmt']
+    where (stmt', add) = runWriter $ traverseStmtExprsM convertExpr stmt
+
+-- helper for creating simple blocks
+block :: [Stmt] -> Stmt
+block = Block Seq "" []
+
+-- add statements before the loop guard is checked
+injectLoopIter :: [Stmt] -> Stmt -> Stmt
+injectLoopIter add stmt = block $ beforeContinue add stmt : add
+
+-- add statements before every `continue` in the loop
+beforeContinue :: [Stmt] -> Stmt -> Stmt
+beforeContinue _ stmt@While{} = stmt
+beforeContinue _ stmt@For{} = stmt
+beforeContinue add Continue =
+    block $ add ++ [Continue]
+beforeContinue add stmt =
+    traverseSinglyNestedStmts (beforeContinue add) stmt
+
+-- reversible pattern to unwrap in for loops
+pattern AsgnStmt :: LHS -> Expr -> Stmt
+pattern AsgnStmt lhs expr = Asgn AsgnOpEq Nothing lhs expr
+
+toInit :: Stmt -> (LHS, Expr)
+toInit stmt = (lhs, expr)
+    where AsgnStmt lhs expr = stmt
+
+-- functions which convert and collect assignment expressions
+type Converter t = t -> Writer [Stmt] t
+
+convertExpr :: Converter Expr
+convertExpr (ExprAsgn l r) = do
+    l' <- convertExpr l
+    r' <- convertExpr r
+    let Just lhs = exprToLHS l' -- checked by parser
+    tell [AsgnStmt lhs r']
+    return l'
+convertExpr expr =
+    traverseSinglyNestedExprsM convertExpr expr
+
+convertLHS :: Converter LHS
+convertLHS = traverseNestedLHSsM $ traverseLHSExprsM convertExpr
+
+convertInit :: Converter (LHS, Expr)
+convertInit = bimapM convertLHS convertExpr
+
+convertIncr :: Converter (LHS, AsgnOp, Expr)
+convertIncr (lhs, op, expr) = do
+    lhs' <- convertLHS lhs
+    expr' <- convertExpr expr
+    return (lhs', op, expr')

src/Convert/ExprUtils.hs

@@ -0,0 +1,348 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Utilities for expressions and ranges
+ -}
+
+module Convert.ExprUtils
+    ( simplify
+    , simplifyStep
+    , rangeSize
+    , rangeSizeHiLo
+    , endianCondExpr
+    , endianCondRange
+    , dimensionsSize
+    , stringToNumber
+    , simplifyRange
+    , simplifyDimensions
+    ) where
+
+import Data.Bits ((.&.), (.|.), shiftL, shiftR)
+import Data.Char (ord)
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+simplify :: Expr -> Expr
+simplify = simplifyStep . traverseSinglyNestedExprs simplify . simplifyStep
+
+simplifyStep :: Expr -> Expr
+
+simplifyStep (UniOpA LogNot a (Number n)) =
+    case numberToInteger n of
+        Just 0 -> bool True
+        Just _ -> bool False
+        Nothing -> UniOpA LogNot a $ Number n
+simplifyStep (UniOp LogNot (BinOp Eq a b)) = BinOp Ne a b
+simplifyStep (UniOp LogNot (BinOp Ne a b)) = BinOp Eq a b
+
+simplifyStep (UniOpA UniSub _ (UniOpA UniSub _ e)) = e
+simplifyStep (UniOp UniSub (BinOp Sub e1 e2)) = BinOp Sub e2 e1
+
+simplifyStep (Concat [Number (Decimal size _ value)]) =
+    Number $ Decimal size False value
+simplifyStep (Concat [Number (Based size _ base value kinds)]) =
+    Number $ Based size False base value kinds
+simplifyStep (Concat [e@Stream{}]) = e
+simplifyStep (Concat [e@Repeat{}]) = e
+simplifyStep (Concat es) = Concat $ flattenConcat es
+simplifyStep (Repeat (Dec 0) _) = Concat []
+simplifyStep (Repeat (Dec 1) es) = Concat es
+simplifyStep (MuxA a (Number n) e1 e2) =
+    case numberToInteger n of
+        Just 0 -> e2
+        Just _ -> e1
+        Nothing -> MuxA a (Number n) e1 e2
+
+simplifyStep (Call (Ident "$clog2") (Args [SizDec k] [])) =
+    simplifyStep $ Call (Ident "$clog2") (Args [RawNum k] [])
+simplifyStep (Call (Ident "$clog2") (Args [Dec k] [])) =
+    toDec $ clog2 k
+    where
+        clog2Help :: Integer -> Integer -> Integer
+        clog2Help p n = if p >= n then 0 else 1 + clog2Help (p*2) n
+        clog2 :: Integer -> Integer
+        clog2 n = if n < 2 then 0 else clog2Help 1 n
+
+-- TODO: add full constant evaluation for all number literals to avoid the
+-- anti-loop hack below
+simplifyStep e@(BinOp _ (BinOp _ Number{} Number{}) Number{}) = e
+
+simplifyStep (BinOp op e1 e2) = simplifyBinOp op e1 e2
+simplifyStep other = other
+
+-- flatten and coalesce concatenations
+flattenConcat :: [Expr] -> [Expr]
+flattenConcat (Number n1 : Number n2 : es) =
+    flattenConcat $ Number (n1 <> n2) : es
+flattenConcat (Concat es1 : es2) =
+    flattenConcat $ es1 ++ es2
+flattenConcat (e : es) =
+    e : flattenConcat es
+flattenConcat [] = []
+
+
+simplifyBinOp :: BinOp -> Expr -> Expr -> Expr
+
+simplifyBinOp Sub e (Dec 0) = e
+simplifyBinOp Sub (Dec 0) e = UniOp UniSub e
+simplifyBinOp Mul (Dec 0) _ = toDec 0
+simplifyBinOp Mul _ (Dec 0) = toDec 0
+simplifyBinOp Mod _ (Dec 1) = toDec 0
+
+simplifyBinOp Add e1 (UniOp UniSub e2) = BinOp Sub e1 e2
+simplifyBinOp Add (UniOp UniSub e1) e2 = BinOp Sub e2 e1
+simplifyBinOp Sub e1 (UniOp UniSub e2) = BinOp Add e1 e2
+simplifyBinOp Sub (UniOp UniSub e1) e2 = UniOp UniSub $ BinOp Add e1 e2
+
+simplifyBinOp Add (BinOp Add e n1@Number{}) n2@Number{} =
+    BinOp Add e (BinOp Add n1 n2)
+simplifyBinOp Sub n1@Number{} (BinOp Sub n2@Number{} e) =
+    BinOp Add (BinOp Sub n1 n2) e
+simplifyBinOp Sub n1@Number{} (BinOp Sub e n2@Number{}) =
+    BinOp Sub (BinOp Add n1 n2) e
+simplifyBinOp Sub (BinOp Add e n1@Number{}) n2@Number{} =
+    BinOp Add e (BinOp Sub n1 n2)
+simplifyBinOp Add n1@Number{} (BinOp Add n2@Number{} e) =
+    BinOp Add (BinOp Add n1 n2) e
+simplifyBinOp Add n1@Number{} (BinOp Sub e n2@Number{}) =
+    BinOp Add e (BinOp Sub n1 n2)
+simplifyBinOp Sub (BinOp Sub e n1@Number{}) n2@Number{} =
+    BinOp Sub e (BinOp Add n1 n2)
+simplifyBinOp Add (BinOp Sub e n1@Number{}) n2@Number{} =
+    BinOp Sub e (BinOp Sub n1 n2)
+simplifyBinOp Add (BinOp Sub n1@Number{} e) n2@Number{} =
+    BinOp Sub (BinOp Add n1 n2) e
+simplifyBinOp Ge (BinOp Sub e (Dec 1)) (Dec 0) = BinOp Ge e (toDec 1)
+
+-- simplify bit shifts of decimal literals
+simplifyBinOp op (Dec x) (Number yRaw)
+    | ShiftAL <- op = decShift shiftL
+    | ShiftAR <- op = decShift shiftR
+    | ShiftL  <- op = decShift shiftL
+    | ShiftR  <- op = decShift shiftR
+    where
+        decShift shifter =
+            case numberToInteger yRaw of
+                Just y -> toDec $ shifter x (fromIntegral y)
+                Nothing -> constantFold undefined Div undefined 0
+
+-- simply comparisons with string literals
+simplifyBinOp op (Number n) (String s) | isCmpOp op =
+    simplifyBinOp op (Number n) (sizeStringAs s n)
+simplifyBinOp op (String s) (Number n) | isCmpOp op =
+    simplifyBinOp op (sizeStringAs s n) (Number n)
+simplifyBinOp op (String s1) (String s2) | isCmpOp op =
+    simplifyBinOp op (stringToNumber s1) (stringToNumber s2)
+
+-- simply basic arithmetic comparisons
+simplifyBinOp op (Number n1) (Number n2)
+    | Eq <- op = cmp (==)
+    | Ne <- op = cmp (/=)
+    | Lt <- op = cmp (<)
+    | Le <- op = cmp (<=)
+    | Gt <- op = cmp (>)
+    | Ge <- op = cmp (>=)
+    where
+        cmp :: (Integer -> Integer -> Bool) -> Expr
+        cmp folder =
+            case (numberToInteger n1', numberToInteger n2') of
+                (Just i1, Just i2) -> bool $ folder i1 i2
+                _ -> BinOp op (Number n1') (Number n2')
+        sg = numberIsSigned n1 && numberIsSigned n2
+        sz = fromIntegral $ max (numberBitLength n1) (numberBitLength n2)
+        n1' = numberCast sg sz n1
+        n2' = numberCast sg sz n2
+
+-- simply comparisons with unbased unsized literals
+simplifyBinOp op (Number n) (ConvertedUU sz v k) | isCmpOp op =
+    simplifyBinOp op (Number n) (uuExtend sz v k)
+simplifyBinOp op (ConvertedUU sz v k) (Number n) | isCmpOp op =
+    simplifyBinOp op (uuExtend sz v k) (Number n)
+
+simplifyBinOp op (Number n) e | op == LogAnd || op == LogOr =
+    simplifyLogAndOr op n e
+
+simplifyBinOp op e1 e2 =
+    case (e1, e2) of
+        (Dec    x, Dec    y) -> constantFold orig op   x    y
+        (SizDec x, Dec    y) -> constantFold orig op   x    y
+        (Dec    x, SizDec y) -> constantFold orig op   x    y
+        (Bas    x, Dec    y) -> constantFold orig op   x    y
+        (Dec    x, Bas    y) -> constantFold orig op   x    y
+        (NegDec x, Dec    y) -> constantFold orig op (-x)   y
+        (Dec    x, NegDec y) -> constantFold orig op   x  (-y)
+        (NegDec x, NegDec y) -> constantFold orig op (-x) (-y)
+        _ -> orig
+    where orig = BinOp op e1 e2
+
+
+-- attempt to constant fold a binary operation on integers
+constantFold :: Expr -> BinOp -> Integer -> Integer -> Expr
+constantFold _ Add x y = toDec (x + y)
+constantFold _ Sub x y = toDec (x - y)
+constantFold _ Mul x y = toDec (x * y)
+constantFold _ Div _ 0 = Number $ Based (-32) True Hex 0 bits
+    where bits = 2 ^ (32 :: Integer) - 1
+constantFold _ Div x y = toDec (x `quot` y)
+constantFold _ Mod x y = toDec (x `rem` y)
+constantFold _ Pow x y = toDec (x ^ y)
+constantFold _ Eq  x y = bool $ x == y
+constantFold _ Ne  x y = bool $ x /= y
+constantFold _ Gt  x y = bool $ x >  y
+constantFold _ Ge  x y = bool $ x >= y
+constantFold _ Lt  x y = bool $ x <  y
+constantFold _ Le  x y = bool $ x <= y
+constantFold _ BitAnd x y = toDec $ x .&. y
+constantFold _ BitOr  x y = toDec $ x .|. y
+constantFold fallback _ _ _ = fallback
+
+
+bool :: Bool -> Expr
+bool True = Number $ Decimal 1 False 1
+bool False = Number $ Decimal 1 False 0
+
+toDec :: Integer -> Expr
+toDec n =
+    if n < 0 then
+        UniOp UniSub $ toDec (-n)
+    else if n >= 4294967296 `div` 2 then
+        let size = fromIntegral $ bits $ n * 2
+        in Number $ Decimal size True n
+    else
+        RawNum n
+    where
+        bits :: Integer -> Integer
+        bits 0 = 0
+        bits v = 1 + bits (quot v 2)
+
+pattern Dec :: Integer -> Expr
+pattern Dec n <- Number (Decimal (-32) _ n)
+
+pattern SizDec :: Integer -> Expr
+pattern SizDec n <- Number (Decimal 32 _ n)
+
+pattern NegDec :: Integer -> Expr
+pattern NegDec n <- UniOp UniSub (Dec n)
+
+pattern Bas :: Integer -> Expr
+pattern Bas n <- Number (Based _ False _ n 0)
+
+
+-- returns the size of a range
+rangeSize :: Range -> Expr
+rangeSize (s, e) =
+    endianCondExpr (s, e) a b
+    where
+        a = rangeSizeHiLo (s, e)
+        b = rangeSizeHiLo (e, s)
+
+-- returns the size of a range known to be ordered
+rangeSizeHiLo :: Range -> Expr
+rangeSizeHiLo (SizedRange size) = size
+rangeSizeHiLo (hi, lo) =
+    simplify $ BinOp Add (BinOp Sub hi lo) (RawNum 1)
+
+-- chooses one or the other expression based on the endianness of the given
+-- range; [hi:lo] chooses the first expression
+endianCondExpr :: Range -> Expr -> Expr -> Expr
+endianCondExpr SizedRange{} e _ = e
+endianCondExpr RevSzRange{} _ e = e
+endianCondExpr r e1 e2 = simplify $ Mux (uncurry (BinOp Ge) r) e1 e2
+
+-- chooses one or the other range based on the endianness of the given range,
+-- but in such a way that the result is itself also usable as a range even if
+-- the endianness cannot be resolved during conversion, i.e. if it's dependent
+-- on a parameter value; [hi:lo] chooses the first range
+endianCondRange :: Range -> Range -> Range -> Range
+endianCondRange r r1 r2 =
+    ( endianCondExpr r (fst r1) (fst r2)
+    , endianCondExpr r (snd r1) (snd r2)
+    )
+
+-- returns the total size of a set of dimensions
+dimensionsSize :: [Range] -> Expr
+dimensionsSize [] = RawNum 1
+dimensionsSize ranges =
+    simplify $
+    foldl1 (BinOp Mul) $
+    map rangeSize $
+    ranges
+
+-- "sized ranges" are of the form [E-1:0], where E is any expression; in most
+-- designs, we can safely assume that E >= 1, allowing for more succinct output
+pattern SizedRange :: Expr -> Range
+pattern SizedRange expr = (BinOp Sub expr (RawNum 1), RawNum 0)
+
+-- similar to the above pattern, we assume E >= 1 for any range like [0:E-1]
+pattern RevSzRange :: Expr -> Range
+pattern RevSzRange expr = (RawNum 0, BinOp Sub expr (RawNum 1))
+
+-- convert a string to decimal number
+stringToNumber :: String -> Expr
+stringToNumber str =
+    Number $ Decimal size False value
+    where
+        size = 8 * length str
+        value = stringToInteger str
+
+-- convert a string to big integer
+stringToInteger :: String -> Integer
+stringToInteger = foldl ((+) . (256 *)) 0 . map (fromIntegral . ord)
+
+-- cast string to number at least as big as the width of the given number
+sizeStringAs :: String -> Number -> Expr
+sizeStringAs str num =
+    Cast (Left typ) (stringToNumber str)
+    where
+        typ = IntegerVector TReg Unspecified [(RawNum size, RawNum 1)]
+        size = max strSize numSize
+        strSize = fromIntegral $ 8 * length str
+        numSize = numberBitLength num
+
+-- excludes wildcard and strict comparison operators
+isCmpOp :: BinOp -> Bool
+isCmpOp Eq = True
+isCmpOp Ne = True
+isCmpOp Lt = True
+isCmpOp Le = True
+isCmpOp Gt = True
+isCmpOp Ge = True
+isCmpOp _ = False
+
+-- sign extend a converted unbased unsized literal into a based number
+uuExtend :: Integer -> Integer -> Integer -> Expr
+uuExtend sz v k =
+    Number $
+    numberCast False (fromIntegral sz) $
+    Based 1 True Hex v k
+
+pattern ConvertedUU :: Integer -> Integer -> Integer -> Expr
+pattern ConvertedUU sz v k <- Repeat
+    (RawNum sz)
+    [Number (Based 1 True Binary v k)]
+
+simplifyRange :: Range -> Range
+simplifyRange (e1, e2) = (simplify e1, simplify e2)
+
+simplifyDimensions :: [Range] -> [Range]
+simplifyDimensions = map simplifyRange
+
+-- TODO: extend this to other logical binary operators
+simplifyLogAndOr :: BinOp -> Number -> Expr -> Expr
+simplifyLogAndOr op n1 (Number n2) =
+    case (numberToInteger n1, numberToInteger n2) of
+        (Just v, _) | (v /= 0) == isOr -> bool isOr
+        (_, Just v) | (v /= 0) == isOr -> bool isOr
+        (Nothing, _) -> boolUnknown
+        (_, Nothing) -> boolUnknown
+        _ -> bool $ not isOr
+    where
+        isOr = op == LogOr
+        boolUnknown = Number $ Based 1 False Binary 0 1
+simplifyLogAndOr op n e =
+    case numberToInteger n of
+        Just v | (v /= 0) == isOr -> bool isOr
+        Just _ -> UniOp LogNot $ UniOp LogNot e
+        Nothing -> BinOp op (Number n) e
+    where isOr = op == LogOr

src/Convert/ForAsgn.hs

@@ -0,0 +1,65 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Verilog-2005 requires that for loops have have one initialization and one
+ - incrementation. If there are excess initializations, they are turned into
+ - preceding statements. If there is no loop variable, a dummy loop variable is
+ - created. If there are multiple incrementations, they are all safely combined
+ - into a single concatenation. If there is no incrementation, a no-op
+ - assignment is added.
+ -}
+
+module Convert.ForAsgn (convert) where
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+convert :: [AST] -> [AST]
+convert =
+    map $ traverseDescriptions $ traverseModuleItems $
+    traverseStmts $ traverseNestedStmts convertStmt
+
+convertStmt :: Stmt -> Stmt
+
+-- for loop with multiple incrementations
+convertStmt (For inits cond incrs@(_ : _ : _) stmt) =
+    convertStmt $ For inits cond incrs' stmt
+    where
+        incrs' = [(LHSConcat lhss, AsgnOpEq, Concat exprs)]
+        lhss = map (\(lhs, _, _) -> lhs) incrs
+        exprs = map toRHS incrs
+        toRHS :: (LHS, AsgnOp, Expr) -> Expr
+        toRHS (lhs, AsgnOpEq, expr) =
+            Cast (Left $ TypeOf $ lhsToExpr lhs) expr
+        toRHS (lhs, asgnop, expr) =
+            toRHS (lhs, AsgnOpEq, BinOp binop (lhsToExpr lhs) expr)
+            where AsgnOp binop = asgnop
+
+-- for loop with no initializations
+convertStmt (For [] cond incrs stmt) =
+    Block Seq "" [dummyDecl Nil] $ pure $
+    For [(LHSIdent dummyIdent, RawNum 0)] cond incrs stmt
+
+-- for loop with no incrementations
+convertStmt (For inits cond [] stmt) =
+    convertStmt $ For inits cond incrs stmt
+    where
+        (lhs, _) : _ = inits
+        incrs = [(lhs, AsgnOpEq, lhsToExpr lhs)]
+
+-- for loop with multiple initializations
+convertStmt (For inits@(_ : _ : _) cond incrs@[_] stmt) =
+    Block Seq "" [] $
+        (map asgnStmt $ init inits) ++
+        [For [last inits] cond incrs stmt]
+
+convertStmt other = other
+
+asgnStmt :: (LHS, Expr) -> Stmt
+asgnStmt = uncurry $ Asgn AsgnOpEq Nothing
+
+dummyIdent :: Identifier
+dummyIdent = "_sv2v_dummy"
+
+dummyDecl :: Expr -> Decl
+dummyDecl = Variable Local (IntegerAtom TInteger Unspecified) dummyIdent []

src/Convert/ForDecl.hs

@@ -1,86 +0,0 @@
-{- sv2v
- - Author: Zachary Snow <zach@zachjs.com>
- -
- - Verilog-2005 requires that for loops have have exactly one assignment in the
- - initialization section. For generate for loops, we move any genvar
- - declarations to a wrapping generate block. For procedural for loops, we pull
- - the declarations out to a wrapping block, and convert all but one assignment
- - to a preceding statement. If a for loop has no assignments or declarations, a
- - dummy declaration is generated.
- -}
-
-module Convert.ForDecl (convert) where
-
-import Convert.Traverse
-import Language.SystemVerilog.AST
-
-convert :: [AST] -> [AST]
-convert =
-    map $ traverseDescriptions $ traverseModuleItems $
-    ( traverseStmts    convertStmt
-    . traverseGenItems convertGenItem
-    )
-
-convertGenItem :: GenItem -> GenItem
-convertGenItem (GenFor (True, x, e) a b c) =
-    GenBlock "" genItems
-    where
-        bx = case c of
-            GenBlock name _ -> name
-            _ -> ""
-        x' = if null bx then x else bx ++ "_" ++ x
-        Generate genItems =
-            traverseNestedModuleItems converter $ Generate $
-            [ GenModuleItem $ Genvar x'
-            , GenFor (False, x, e) a b c
-            ]
-        converter =
-            (traverseExprs $ traverseNestedExprs convertExpr) .
-            (traverseLHSs  $ traverseNestedLHSs  convertLHS )
-        prefix :: String -> String
-        prefix ident = if ident == x then x' else ident
-        convertExpr (Ident ident) = Ident $ prefix ident
-        convertExpr other = other
-        convertLHS (LHSIdent ident) = LHSIdent $ prefix ident
-        convertLHS other = other
-convertGenItem other = other
-
-convertStmt :: Stmt -> Stmt
-convertStmt (For (Left []) cc asgns stmt) =
-    convertStmt $ For (Right []) cc asgns stmt
-convertStmt (For (Right []) cc asgns stmt) =
-    convertStmt $ For inits cc asgns stmt
-    where inits = Left [dummyDecl (Just $ Number "0")]
-convertStmt (orig @ (For (Right [_]) _ _ _)) = orig
-
-convertStmt (For (Left inits) cc asgns stmt) =
-    Block Seq "" decls $
-        initAsgns ++
-        [For (Right [(lhs, expr)]) cc asgns stmt]
-    where
-        splitDecls = map splitDecl inits
-        decls = map fst splitDecls
-        initAsgns = map asgnStmt $ init $ map snd splitDecls
-        (lhs, expr) = snd $ last splitDecls
-
-convertStmt (For (Right origPairs) cc asgns stmt) =
-    Block Seq "" [] $
-        initAsgns ++
-        [For (Right [(lhs, expr)]) cc asgns stmt]
-    where
-        (lhs, expr) = last origPairs
-        initAsgns = map asgnStmt $ init origPairs
-
-convertStmt other = other
-
-splitDecl :: Decl -> (Decl, (LHS, Expr))
-splitDecl (Variable d t ident a (Just e)) =
-    (Variable d t ident a Nothing, (LHSIdent ident, e))
-splitDecl other =
-    error $ "invalid for loop decl: " ++ show other
-
-asgnStmt :: (LHS, Expr) -> Stmt
-asgnStmt = uncurry $ AsgnBlk AsgnOpEq
-
-dummyDecl :: Maybe Expr -> Decl
-dummyDecl = Variable Local (IntegerAtom TInteger Unspecified) "_sv2v_dummy" []

src/Convert/Foreach.hs

@@ -16,22 +16,23 @@ import Language.SystemVerilog.AST
 convert :: [AST] -> [AST]
 convert =
     map $ traverseDescriptions $ traverseModuleItems $
-    traverseStmts convertStmt
+    traverseStmts $ traverseNestedStmts convertStmt
 
 convertStmt :: Stmt -> Stmt
 convertStmt (Foreach x idxs stmt) =
     (foldl (.) id $ map toLoop $ zip [1..] idxs) stmt
     where
-        toLoop :: (Int, Maybe Identifier) -> (Stmt -> Stmt)
+        toLoop :: (Integer, Identifier) -> (Stmt -> Stmt)
-        toLoop (_, Nothing) = id
+        toLoop (_, "") = id
-        toLoop (d, Just i) =
+        toLoop (d, i) =
-            For (Left [idxDecl]) cmp [incr]
+            Block Seq "" [idxDecl] . pure .
+                For [(LHSIdent i, queryFn FnLeft)] cmp [incr]
             where
-                queryFn f = DimFn f (Right $ Ident x) (Number $ show d)
+                queryFn f = DimFn f (Right $ Ident x) (RawNum d)
-                idxDecl = Variable Local (IntegerAtom TInteger Unspecified) i []
+                idxType = IntegerAtom TInteger Unspecified
-                    $ Just $ queryFn FnLeft
+                idxDecl = Variable Local idxType i [] Nil
                 cmp =
-                    Mux (BinOp Eq (queryFn FnIncrement) (Number "1"))
+                    Mux (BinOp Eq (queryFn FnIncrement) (RawNum 1))
                         (BinOp Ge (Ident i) (queryFn FnRight))
                         (BinOp Le (Ident i) (queryFn FnRight))
                 incr = (LHSIdent i, AsgnOp Sub, queryFn FnIncrement)

src/Convert/FuncRet.hs

@@ -1,7 +1,8 @@
 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  -
- - Conversion which makes function `logic` and `reg` return types implicit
+ - Conversion which makes function `logic` and `reg` return types implicit and
+ - converts `void` functions to tasks
  -
  - Verilog-2005 restricts function return types to `integer`, `real`,
  - `realtime`, `time`, and implicit signed/dimensioned types.
@@ -16,11 +17,12 @@ convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions $ traverseModuleItems convertFunction
 
 convertFunction :: ModuleItem -> ModuleItem
+convertFunction (MIPackageItem (Function ml Void f decls stmts)) =
+    MIPackageItem $ Task ml f decls stmts
 convertFunction (MIPackageItem (Function ml t f decls stmts)) =
     MIPackageItem $ Function ml t' f decls stmts
     where
         t' = case t of
             IntegerVector TReg   sg rs -> Implicit sg rs
-            IntegerVector TLogic sg rs -> Implicit sg rs
             _ -> t
 convertFunction other = other

src/Convert/FuncRoutine.hs

@@ -10,7 +10,7 @@
 
 module Convert.FuncRoutine (convert) where
 
-import Control.Monad.Writer
+import Control.Monad.Writer.Strict
 import qualified Data.Set as Set
 
 import Convert.Traverse
@@ -22,13 +22,17 @@ convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
-convertDescription (description @ Part{}) =
+convertDescription description@Part{} =
-    traverseModuleItems (traverseStmts $ convertStmt functions) description
+    traverseModuleItems traverseModuleItem description
-    where functions = execWriter $
+    where
+        traverseModuleItem =
+            traverseStmts $ traverseNestedStmts $ convertStmt functions
+        functions = execWriter $
             collectModuleItemsM collectFunctionsM description
 convertDescription other = other
 
 collectFunctionsM :: ModuleItem -> Writer Idents ()
+collectFunctionsM (MIPackageItem (Function _ Void _ _ _)) = return ()
 collectFunctionsM (MIPackageItem (Function _ _ f _ _)) =
     tell $ Set.singleton f
 collectFunctionsM _ = return ()
@@ -41,5 +45,5 @@ convertStmt functions (Subroutine (Ident func) args) =
     where
         t = TypeOf e
         e = Call (Ident func) args
-        decl = Variable Local t "sv2v_void" [] (Just e)
+        decl = Variable Local t "sv2v_void" [] e
 convertStmt _ other = other

src/Convert/GenvarName.hs

@@ -0,0 +1,127 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Assign unique names to `genvar`s to avoid conflicts within explicitly-scoped
+ - variables when inlining interface arrays.
+ -}
+
+module Convert.GenvarName (convert) where
+
+import Control.Monad (when)
+import Control.Monad.State.Strict
+import Control.Monad.Writer.Strict
+import Data.Functor ((<&>))
+import Data.List (isPrefixOf)
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+
+import Convert.Scoper (replaceInExpr)
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+convert :: [AST] -> [AST]
+convert files = evalState
+    (mapM (traverseDescriptionsM traverseDescription) files)
+    (collectFiles files, mempty)
+
+type IdentSet = Set.Set Identifier
+type IdentMap = Map.Map Identifier Identifier
+type SC = State (IdentSet, IdentMap)
+
+-- get all of the seemingly sv2v-generated genvar names already present anywhere
+-- in the sources so we can avoid generating new ones that conflict with them
+collectFiles :: [AST] -> IdentSet
+collectFiles = execWriter . mapM (collectDescriptionsM collectDescription)
+
+collectDescription :: Description -> Writer IdentSet ()
+collectDescription = collectModuleItemsM collectModuleItem
+
+collectModuleItem :: ModuleItem -> Writer IdentSet ()
+collectModuleItem (Genvar ident) =
+    when (isGeneratedName ident) $ tell (Set.singleton ident)
+collectModuleItem _ = return ()
+
+traverseDescription :: Description -> SC Description
+traverseDescription (Part att ext kw lif name ports items) =
+    mapM traverseModuleItem items <&> Part att ext kw lif name ports
+traverseDescription description = return description
+
+traverseModuleItem :: ModuleItem -> SC ModuleItem
+traverseModuleItem (Genvar ident) =
+    renameGenvar ident <&> Genvar
+traverseModuleItem (Generate genItems) =
+    mapM traverseGenItem genItems <&> Generate
+traverseModuleItem (MIAttr attr item) =
+    traverseModuleItem item <&> MIAttr attr
+traverseModuleItem item = return item
+
+traverseGenItem :: GenItem -> SC GenItem
+traverseGenItem (GenFor start@(index, _) cond incr item)
+    | not (isGeneratedName index) = do
+    index' <- gets $ (Map.! index) . snd
+    item' <- traverseGenItem item
+    return $ if index == index'
+        then GenFor start cond incr item'
+        else renameInLoop start cond incr index' item'
+traverseGenItem (GenBlock blk items) = do
+    priorMapping <- gets snd
+    items' <- mapM traverseGenItem items
+    -- keep all assigned names, but prefer names from the outer scope
+    modify' $ (, priorMapping) . fst
+    return $ GenBlock blk items'
+traverseGenItem (GenModuleItem item) =
+    traverseModuleItem item <&> GenModuleItem
+traverseGenItem item =
+    traverseSinglyNestedGenItemsM traverseGenItem item
+
+-- rename all usages of the genvar in the initialization, guard, and
+-- incrementation of a generate for loop
+renameInLoop :: (Identifier, Expr) -> Expr -> (Identifier, AsgnOp, Expr)
+    -> Identifier -> GenItem -> GenItem
+renameInLoop (index, start) cond (dest, op, next) index' =
+    GenFor (index', start') cond' (dest', op, next') . prependGenItem decl
+    where
+        expr = Ident index'
+        replacements = Map.singleton index expr
+        start' = replaceInExpr replacements start
+        cond' = replaceInExpr replacements cond
+        next' = replaceInExpr replacements next
+        dest' = if dest == index then index' else dest
+        decl = GenModuleItem $ MIPackageItem $ Decl $
+                Param Localparam UnknownType index expr
+
+-- add an item to the beginning of the given generate block
+prependGenItem :: GenItem -> GenItem -> GenItem
+prependGenItem item block = GenBlock blk $ item : items
+    where GenBlock blk items = block
+
+prefixIntf :: Identifier
+prefixIntf = "_arr_"
+prefixUniq :: Identifier
+prefixUniq = "_gv_"
+
+isGeneratedName :: Identifier -> Bool
+isGeneratedName ident =
+    isPrefixOf prefixIntf ident ||
+    isPrefixOf prefixUniq ident
+
+-- generate and record a unique name for the given genvar
+renameGenvar :: Identifier -> SC Identifier
+renameGenvar ident | isGeneratedName ident = return ident
+renameGenvar ident = do
+    idents <- gets fst
+    let ident' = uniqueGenvarName idents prefix 1
+    modify' $ (<>) (Set.singleton ident', Map.singleton ident ident')
+    return ident'
+    where prefix = prefixUniq ++ ident ++ "_"
+
+-- increment the counter until it produces a unique identifier
+uniqueGenvarName :: IdentSet -> Identifier -> Int -> Identifier
+uniqueGenvarName idents prefix = step
+    where
+        step :: Int -> Identifier
+        step counter =
+            if Set.member candidate idents
+                then step $ counter + 1
+                else candidate
+            where candidate = prefix ++ show counter

src/Convert/HierConst.hs

@@ -0,0 +1,118 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Elaborate hierarchical references to constants
+ -
+ - [System]Verilog does not allow hierarchical identifiers as constant
+ - primaries. However, the resolution of type information across scopes can
+ - create such hierarchical references. This conversion performs substitution
+ - for any hierarchical references to parameters or localparams, regardless of
+ - whether or not they occur within what should be a constant expression.
+ -
+ - If an identifier refers to a parameter which has been shadowed locally, the
+ - conversion creates a localparam alias of the parameter at the top level scope
+ - and refers to the parameter using that alias instead.
+ -
+ - TODO: Support resolution of hierarchical references to constant functions
+ - TODO: Some other conversions still blindly substitute type information
+ -}
+
+module Convert.HierConst (convert) where
+
+import Control.Monad (when)
+import qualified Data.Map.Strict as Map
+
+import Convert.Scoper
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+convert :: [AST] -> [AST]
+convert = map $ traverseDescriptions convertDescription
+
+convertDescription :: Description -> Description
+convertDescription (Part attrs extern kw lifetime name ports items) =
+    Part attrs extern kw lifetime name ports $
+        if null shadowedParams
+            then items'
+            else map expand items'
+    where
+        (items', mapping) = runScoper $ scopeModuleItems scoper name items
+        scoper = scopeModuleItem
+            traverseDeclM
+            (traverseExprsM traverseExprM)
+            (traverseGenItemExprsM traverseExprM)
+            (traverseStmtExprsM traverseExprM)
+        shadowedParams = Map.keys $ Map.filter (== HierParam True) $
+            extractMapping mapping
+        expand = traverseNestedModuleItems $ expandParam shadowedParams
+convertDescription description = description
+
+expandParam :: [Identifier] -> ModuleItem -> ModuleItem
+expandParam shadowed (MIPackageItem (Decl param@(Param Parameter _ x _))) =
+    if elem x shadowed
+        then Generate $ map (GenModuleItem . wrap) [param, extra]
+        else wrap param
+    where
+        wrap = MIPackageItem . Decl
+        extra = Param Localparam UnknownType (prefix x) (Ident x)
+expandParam _ item = item
+
+prefix :: Identifier -> Identifier
+prefix = (++) "_sv2v_disambiguate_"
+
+data Hier
+    = HierParam Bool
+    | HierLocalparam Expr
+    | HierVar
+    deriving Eq
+
+type ST = Scoper Hier
+
+traverseDeclM :: Decl -> ST Decl
+traverseDeclM decl = do
+    case decl of
+        Param Parameter _ x _ ->
+            insertElem x (HierParam False)
+        Param Localparam UnknownType x e ->
+            scopeExpr e >>= insertElem x . HierLocalparam
+        Param Localparam (Implicit sg rs) x e ->
+            scopeExpr (Cast (Left t) e) >>= insertElem x . HierLocalparam
+            where t = IntegerVector TBit sg rs
+        Param Localparam (IntegerVector _ sg rs) x e ->
+            scopeExpr (Cast (Left t) e) >>= insertElem x . HierLocalparam
+            where t = IntegerVector TBit sg rs
+        Param Localparam t x e ->
+            scopeExpr (Cast (Left t) e) >>= insertElem x . HierLocalparam
+        Variable _ _ x [] _ -> insertElem x HierVar
+        Net  _ _ _ _ x [] _ -> insertElem x HierVar
+        _ -> return ()
+    traverseDeclExprsM traverseExprM decl
+
+-- substitute hierarchical references to constants
+traverseExprM :: Expr -> ST Expr
+traverseExprM expr@(Dot _ x) = do
+    expr' <- traverseSinglyNestedExprsM traverseExprM expr
+    detailsE <- lookupElemM expr'
+    detailsX <- lookupElemM x
+    case (detailsE, detailsX) of
+        (Just ([_, _], _, HierParam{}), Just ([_, _], _, HierParam{})) ->
+            return $ Ident x
+        (Just ([_, _], _, HierVar), Just ([_, _], _, HierVar)) ->
+            return $ Ident x
+        (Just (accesses@[Access _ Nil, _], _, HierParam False), _) -> do
+            details <- lookupElemM $ prefix x
+            when (details == Nothing) $
+                insertElem accesses (HierParam True)
+            return $ Ident $ prefix x
+        (Just ([Access _ Nil, _], _, HierParam True), _) ->
+            return $ Ident $ prefix x
+        (Just (aE, replacements, HierLocalparam value), Just (aX, _, _)) ->
+            if aE == aX && Map.null replacements
+                then return $ Ident x
+                else traverseSinglyNestedExprsM traverseExprM $
+                        replaceInExpr replacements value
+        (Just (_, replacements, HierLocalparam value), Nothing) ->
+            traverseSinglyNestedExprsM traverseExprM $
+                replaceInExpr replacements value
+        _ -> traverseSinglyNestedExprsM traverseExprM expr
+traverseExprM expr = traverseSinglyNestedExprsM traverseExprM expr

src/Convert/ImplicitNet.hs

@@ -0,0 +1,108 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Create declarations for implicit nets
+ -}
+
+module Convert.ImplicitNet (convert) where
+
+import Control.Monad (when)
+import Data.List (isPrefixOf, mapAccumL)
+
+import Convert.Scoper
+import Language.SystemVerilog.AST
+
+type DefaultNetType = Maybe NetType
+
+convert :: [AST] -> [AST]
+convert =
+    snd . mapAccumL
+        (mapAccumL traverseDescription)
+        (Just TWire)
+
+traverseDescription :: DefaultNetType -> Description
+    -> (DefaultNetType, Description)
+traverseDescription defaultNetType (PackageItem (Directive str)) =
+    (defaultNetType', PackageItem $ Directive str)
+    where
+        prefix = "`default_nettype "
+        defaultNetType' =
+            if isPrefixOf prefix str then
+                parseDefaultNetType $ drop (length prefix) str
+            else if str == "`resetall" then
+                Just TWire
+            else
+                defaultNetType
+traverseDescription defaultNetType description =
+    (defaultNetType, partScoper traverseDeclM
+        (traverseModuleItemM defaultNetType)
+        return return description)
+
+traverseDeclM :: Decl -> Scoper () Decl
+traverseDeclM decl = do
+    case decl of
+        Variable _ _ x _ _ -> insertElem x ()
+        Net  _ _ _ _ x _ _ -> insertElem x ()
+        Param _ _ x _ -> insertElem x ()
+        ParamType{} -> return ()
+        CommentDecl{} -> return ()
+    return decl
+
+traverseModuleItemM :: DefaultNetType -> ModuleItem -> Scoper () ModuleItem
+traverseModuleItemM _ (Genvar x) =
+    insertElem x () >> return (Genvar x)
+traverseModuleItemM defaultNetType orig@(Assign _ x _) = do
+    needsLHS defaultNetType x
+    return orig
+traverseModuleItemM defaultNetType orig@(NInputGate _ _ x _ lhs exprs) = do
+    insertElem x ()
+    needsLHS defaultNetType lhs
+    _ <- mapM (needsExpr defaultNetType) exprs
+    return orig
+traverseModuleItemM defaultNetType orig@(NOutputGate _ _ x _ lhss expr) = do
+    insertElem x ()
+    _ <- mapM (needsLHS defaultNetType) lhss
+    needsExpr defaultNetType expr
+    return orig
+traverseModuleItemM defaultNetType orig@(Instance _ _ x _ ports) = do
+    insertElem x ()
+    _ <- mapM (needsExpr defaultNetType . snd) ports
+    return orig
+traverseModuleItemM _ item = return item
+
+needsExpr :: DefaultNetType -> Expr -> Scoper () ()
+needsExpr defaultNetType (Ident x) = needsIdent defaultNetType x
+needsExpr _ _ = return ()
+
+needsLHS :: DefaultNetType -> LHS -> Scoper () ()
+needsLHS defaultNetType (LHSIdent x) = needsIdent defaultNetType x
+needsLHS _ _ = return ()
+
+needsIdent :: DefaultNetType -> Identifier -> Scoper () ()
+needsIdent defaultNetType x = do
+    details <- lookupElemM x
+    when (details == Nothing) $ do
+        insertElem x ()
+        injectItem decl
+    where decl = MIPackageItem $ Decl $ impliedNet x defaultNetType
+
+impliedNet :: Identifier -> DefaultNetType -> Decl
+impliedNet var Nothing =
+    error $ "implicit declaration of " ++
+        show var ++ " but default_nettype is none"
+impliedNet var (Just netType) =
+    Net Local netType DefaultStrength UnknownType var [] Nil
+
+parseDefaultNetType :: String -> DefaultNetType
+parseDefaultNetType "tri"    = Just TTri
+parseDefaultNetType "triand" = Just TTriand
+parseDefaultNetType "trior"  = Just TTrior
+parseDefaultNetType "trireg" = Just TTrireg
+parseDefaultNetType "tri0"   = Just TTri0
+parseDefaultNetType "tri1"   = Just TTri1
+parseDefaultNetType "uwire"  = Just TUwire
+parseDefaultNetType "wire"   = Just TWire
+parseDefaultNetType "wand"   = Just TWand
+parseDefaultNetType "wor"    = Just TWor
+parseDefaultNetType "none"   = Nothing
+parseDefaultNetType str      = error $ "bad default_nettype: " ++ show str

src/Convert/Inside.hs

@@ -3,10 +3,9 @@
  -
  - Conversion for `inside` expressions and cases
  -
- - The expressions are compared to each candidate using the wildcard comparison
+ - The expressions are compared to each candidate using `==?`, the wildcard
- - operator. Note that if expression has any Xs or Zs that are not wildcarded in
+ - comparison. As required by the specification, the result of each comparison
- - the candidate, the results is `1'bx`. As required by the specification, the
+ - is combined using an OR reduction.
- - result of each comparison is combined using an OR reduction.
  -
  - `case ... inside` statements are converted to an equivalent if-else cascade.
  -
@@ -20,7 +19,9 @@ module Convert.Inside (convert) where
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
+import Control.Monad.Writer
 import Data.Maybe (fromMaybe)
+import Data.Monoid (Any(Any), getAny)
 
 convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem
@@ -28,54 +29,49 @@ convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem
 convertModuleItem :: ModuleItem -> ModuleItem
 convertModuleItem item =
     traverseExprs (traverseNestedExprs convertExpr) $
-    traverseStmts convertStmt $
+    traverseStmts (traverseNestedStmts convertStmt) $
     item
 
 convertExpr :: Expr -> Expr
-convertExpr (Inside Nil valueRanges) =
-    Inside Nil valueRanges
 convertExpr (Inside expr valueRanges) =
     if length checks == 1
         then head checks
         else UniOp RedOr $ Concat checks
     where
         checks = map toCheck valueRanges
-        toCheck :: ExprOrRange -> Expr
+        toCheck :: Expr -> Expr
-        toCheck (Left e) =
+        toCheck (Range Nil NonIndexed (lo, hi)) =
-            Mux
-            (BinOp TNe rxr lxlxrxr)
-            (Number "1'bx")
-            (BinOp WEq expr e)
-            where
-                lxl = BinOp BitXor expr expr
-                rxr = BinOp BitXor e e
-                lxlxrxr = BinOp BitXor lxl rxr
-        toCheck (Right (lo, hi)) =
             BinOp LogAnd
                 (BinOp Le lo expr)
                 (BinOp Ge hi expr)
+        toCheck pat =
+            BinOp WEq expr pat
 convertExpr other = other
 
 convertStmt :: Stmt -> Stmt
-convertStmt (Case u kw expr items) =
+convertStmt (Case u CaseInside expr items) =
-    if not $ any isSpecialInside exprs then
+    if hasSideEffects expr then
-        Case u kw expr items
+        Block Seq "" [decl] [stmt]
-    else if kw /= CaseN then
-        error $ "cannot use inside with " ++ show kw
     else
         foldr ($) defaultStmt $
         map (uncurry $ If NoCheck) $
         zip comps stmts
     where
-        exprs = map fst items
+        -- evaluate expressions with side effects once
+        tmp = "sv2v_temp_" ++ shortHash expr
+        decl = Variable Local (TypeOf expr) tmp [] expr
+        stmt = convertStmt (Case u CaseInside (Ident tmp) items)
+        -- underlying inside case elaboration
         itemsNonDefault = filter (not . null . fst) items
-        isSpecialInside :: [Expr] -> Bool
+        comps = map (Inside expr . fst) itemsNonDefault
-        isSpecialInside [Inside Nil _] = True
-        isSpecialInside _ = False
-        makeComp :: [Expr] -> Expr
-        makeComp [Inside Nil ovr] = Inside expr ovr
-        makeComp _ = error "internal invariant violated"
-        comps = map (makeComp . fst) itemsNonDefault
         stmts = map snd itemsNonDefault
         defaultStmt = fromMaybe Null (lookup [] items)
 convertStmt other = other
+
+hasSideEffects :: Expr -> Bool
+hasSideEffects expr =
+    getAny $ execWriter $ collectNestedExprsM write expr
+    where
+        write :: Expr -> Writer Any ()
+        write Call{} = tell $ Any True
+        write _ = return ()

src/Convert/IntTypes.hs

@@ -10,13 +10,63 @@ import Convert.Traverse
 import Language.SystemVerilog.AST
 
 convert :: [AST] -> [AST]
-convert =
+convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem
-    map $
+
-    traverseDescriptions $
+convertModuleItem :: ModuleItem -> ModuleItem
-    traverseModuleItems $
+convertModuleItem = traverseNodes
-    traverseTypes convertType
+    traverseExpr traverseDecl traverseType traverseLHS traverseStmt
+    where
+        traverseLHS = traverseNestedLHSs $ traverseLHSExprs traverseExpr
+        traverseStmt = traverseNestedStmts $
+            traverseStmtDecls (traverseDeclNodes traverseType id) .
+            traverseStmtExprs traverseExpr
+
+traverseDecl :: Decl -> Decl
+traverseDecl (Net d n s t x a e) =
+    traverseDeclNodes traverseType traverseExpr $
+        Net d n s (convertTypeForce t) x a e
+traverseDecl decl =
+    traverseDeclNodes traverseType traverseExpr decl
+
+traverseType :: Type -> Type
+traverseType =
+    traverseSinglyNestedTypes traverseType .
+    traverseTypeExprs traverseExpr .
+    convertType
+
+traverseExpr :: Expr -> Expr
+traverseExpr =
+    traverseSinglyNestedExprs traverseExpr .
+    traverseExprTypes traverseType .
+    convertExpr
 
 convertType :: Type -> Type
+convertType (Struct pk fields rs) =
+    Struct pk fields' rs
+    where fields' = convertStructFields fields
+convertType (Union  pk fields rs) =
+    Union  pk fields' rs
+    where fields' = convertStructFields fields
 convertType (IntegerAtom kw sg) = elaborateIntegerAtom $ IntegerAtom kw sg
 convertType (IntegerVector TBit sg rs) = IntegerVector TLogic sg rs
 convertType other = other
+
+convertStructFields :: [(Type, Identifier)] -> [(Type, Identifier)]
+convertStructFields fields =
+    zip (map (convertTypeForce . fst) fields) (map snd fields)
+
+convertTypeForce :: Type -> Type
+convertTypeForce (IntegerAtom TInteger sg) = IntegerAtom TInt sg
+convertTypeForce t = t
+
+convertExpr :: Expr -> Expr
+convertExpr (Pattern items) =
+    Pattern $ zip names exprs
+    where
+        names = map (convertTypeOrExprForce . fst) items
+        exprs = map snd items
+convertExpr other = other
+
+convertTypeOrExprForce :: TypeOrExpr -> TypeOrExpr
+convertTypeOrExprForce (Left t) = Left $ convertTypeForce t
+convertTypeOrExprForce (Right e) = Right e

src/Convert/Jump.hs

@@ -9,8 +9,9 @@
 
 module Convert.Jump (convert) where
 
-import Control.Monad.State
+import Control.Monad.State.Strict
-import Control.Monad.Writer
+import Control.Monad.Writer.Strict
+import Data.Monoid (Any(Any), getAny)
 
 import Convert.Traverse
 import Language.SystemVerilog.AST
@@ -40,7 +41,9 @@ convertModuleItem :: ModuleItem -> ModuleItem
 convertModuleItem (MIPackageItem (Function ml t f decls stmtsOrig)) =
     MIPackageItem $ Function ml t f decls' stmts''
     where
-        stmts = map (traverseNestedStmts convertReturn) stmtsOrig
+        stmts = if t == Void
+                then stmtsOrig
+                else map (traverseNestedStmts convertReturn) stmtsOrig
         convertReturn :: Stmt -> Stmt
         convertReturn (Return Nil) = Return Nil
         convertReturn (Return e) =
@@ -62,6 +65,8 @@ convertModuleItem (AlwaysC kw stmt) = convertMIStmt (AlwaysC kw) stmt
 convertModuleItem other = other
 
 convertMIStmt :: (Stmt -> ModuleItem) -> Stmt -> ModuleItem
+convertMIStmt constructor (Timing c stmt) =
+    convertMIStmt (constructor . Timing c) stmt
 convertMIStmt constructor stmt =
     constructor stmt''
     where
@@ -75,18 +80,19 @@ addJumpStateDeclTF :: [Decl] -> [Stmt] -> ([Decl], [Stmt])
 addJumpStateDeclTF decls stmts =
     if uses && not declares then
         ( decls ++
-            [Variable Local jumpStateType jumpState [] (Just jsNone)]
+            [Variable Local jumpStateType jumpState [] jsNone]
         , stmts )
     else if uses then
         (decls, stmts)
     else
         (decls, map (traverseNestedStmts removeJumpState) stmts)
     where
-        dummyModuleItem = Initial $ Block Seq "" decls stmts
+        dummyStmt = Block Seq "" decls stmts
-        declares = elem jumpState $ execWriter $
+        writesJumpState f = elem jumpState $ execWriter $
-            collectDeclsM collectVarM dummyModuleItem
+            collectNestedStmtsM f dummyStmt
-        uses = elem jumpState $ execWriter $
+        declares = writesJumpState $ collectStmtDeclsM collectVarM
-            collectExprsM (collectNestedExprsM collectExprIdentM) dummyModuleItem
+        uses = writesJumpState $
+            collectStmtExprsM $ collectNestedExprsM collectExprIdentM
         collectVarM :: Decl -> Writer [String] ()
         collectVarM (Variable Local _ ident _ _) = tell [ident]
         collectVarM _ = return ()
@@ -101,7 +107,7 @@ addJumpStateDeclStmt stmt =
     where (decls, [stmt']) = addJumpStateDeclTF [] [stmt]
 
 removeJumpState :: Stmt -> Stmt
-removeJumpState (orig @ (AsgnBlk _ (LHSIdent ident) _)) =
+removeJumpState orig@(Asgn _ _ (LHSIdent ident) _) =
     if ident == jumpState
         then Null
         else orig
@@ -114,21 +120,50 @@ convertStmts stmts = do
     return stmts'
 
 
+pattern SimpleLoopInits :: Identifier -> [(LHS, Expr)]
+pattern SimpleLoopInits var <- [(LHSIdent var, _)]
+
+pattern SimpleLoopIncrs :: Identifier -> [(LHS, AsgnOp, Expr)]
+pattern SimpleLoopIncrs var <- [(LHSIdent var, _, _)]
+
+-- check if an expression contains a reference to the given identifier
+usesIdent :: Identifier -> Expr -> Writer Any ()
+usesIdent x (Ident y)
+    | x == y = tell $ Any True
+    | otherwise = return ()
+usesIdent x expr =
+    collectSinglyNestedExprsM (usesIdent x) expr
+
+-- identifies loops which could likely be statically unrolled, and so may
+-- benefit from avoiding complicating the loop guard with jump state, assuming
+-- the guard and incrementation do not have side effects
+simpleLoopVar :: [(LHS, Expr)] -> Expr -> [(LHS, AsgnOp, Expr)] -> Identifier
+simpleLoopVar (SimpleLoopInits var1) comp (SimpleLoopIncrs var3)
+    | var1 == var3, getAny $ execWriter $ usesIdent var1 comp = var1
+simpleLoopVar _ _ _ = ""
+
 -- rewrites the given statement, and returns the type of any unfinished jump
 convertStmt :: Stmt -> State Info Stmt
 
 convertStmt (Block Par x decls stmts) = do
     -- break, continue, and return disallowed in fork-join
     jumpAllowed <- gets sJumpAllowed
-    returnAllowed <- gets sReturnAllowed
+    modify $ \s -> s { sJumpAllowed = False }
-    modify $ \s -> s { sJumpAllowed = False, sReturnAllowed = False }
     stmts' <- mapM convertStmt stmts
-    modify $ \s -> s { sJumpAllowed = jumpAllowed, sReturnAllowed = returnAllowed }
+    modify $ \s -> s { sJumpAllowed = jumpAllowed }
     return $ Block Par x decls stmts'
 
-convertStmt (Block Seq x decls stmts) = do
+convertStmt (Block Seq ""
-    stmts' <- step stmts
+    decls@[CommentDecl{}, Variable Local _ var0 [] Nil]
-    return $ Block Seq x decls $ filter (/= Null) stmts'
+    [comment@CommentStmt{}, For inits comp incr stmt])
+    | var1@(_ : _) <- simpleLoopVar inits comp incr, var0 == var1 =
+    convertLoop (Just var1) loop comp incr stmt
+        >>= return . Block Seq "" decls . (comment :) . pure
+    where
+        loop c i s = For inits c i s
+
+convertStmt (Block Seq x decls stmts) =
+    step stmts >>= return . Block Seq x decls
     where
         step :: [Stmt] -> State Info [Stmt]
         step [] = return []
@@ -164,13 +199,17 @@ convertStmt (Case unique kw expr cases) = do
     modify $ \s -> s { sHasJump = hasJump }
     return $ Case unique kw expr cases'
 
+convertStmt (For inits comp incr stmt)
+    | var@(_ : _) <- simpleLoopVar inits comp incr =
+    convertLoop (Just var) loop comp incr stmt
+    where
+        loop c i s = For inits c i s
 convertStmt (For inits comp incr stmt) =
-    convertLoop loop comp stmt
+    convertLoop Nothing loop comp incr stmt
-    where loop c s = For inits c incr s
+    where loop c i s = For inits c i s
 convertStmt (While comp stmt) =
-    convertLoop While comp stmt
+    convertLoop Nothing loop comp [] stmt
-convertStmt (DoWhile comp stmt) =
+    where loop c _ s = While c s
-    convertLoop DoWhile comp stmt
 
 convertStmt (Continue) = do
     loopDepth <- gets sLoopDepth
@@ -186,11 +225,12 @@ convertStmt (Break) = do
     assertMsg jumpAllowed "encountered break inside fork-join"
     modify $ \s -> s { sHasJump = True }
     return $ asgn jumpState jsBreak
-convertStmt (Return Nil) = do
+convertStmt (Return e) = do
     jumpAllowed <- gets sJumpAllowed
     returnAllowed <- gets sReturnAllowed
     assertMsg jumpAllowed "encountered return inside fork-join"
     assertMsg returnAllowed "encountered return outside of task or function"
+    assertMsg (e == Nil) "non-void return inside task or void function"
     modify $ \s -> s { sHasJump = True }
     return $ asgn jumpState jsReturn
 
@@ -216,8 +256,6 @@ convertStmt (Timing timing stmt) =
 convertStmt (StmtAttr attr stmt) =
     convertStmt stmt >>= return . StmtAttr attr
 
-convertStmt (Return{}) = return $
-    error "non-void return should have been elaborated already"
 convertStmt (Foreach{}) = return $
     error "foreach should have been elaborated already"
 
@@ -234,8 +272,11 @@ convertSubStmt stmt = do
     put origState
     return (stmt', hasJump)
 
-convertLoop :: (Expr -> Stmt -> Stmt) -> Expr -> Stmt -> State Info Stmt
+type Incr = (LHS, AsgnOp, Expr)
-convertLoop loop comp stmt = do
+
+convertLoop :: Maybe Identifier -> (Expr -> [Incr] -> Stmt -> Stmt) -> Expr
+    -> [Incr] -> Stmt -> State Info Stmt
+convertLoop localInfo loop comp incr stmt = do
     -- save the loop state and increment loop depth
     Info { sLoopDepth = origLoopDepth, sHasJump = origHasJump } <- get
     assertMsg (not origHasJump) "has jump invariant failed"
@@ -247,50 +288,91 @@ convertLoop loop comp stmt = do
     assertMsg (origLoopDepth + 1 == afterLoopDepth) "loop depth invariant failed"
     modify $ \s -> s { sLoopDepth = origLoopDepth }
 
-    let comp' = BinOp LogAnd comp $ BinOp Lt (Ident jumpState) jsBreak
+    let useBreakVar = local && not (null localVar)
-    let body = Block Seq "" []
+    let breakVarDeclRaw = Variable Local (TypeOf $ Ident localVar) breakVar [] Nil
+    let breakVarDecl = if useBreakVar then breakVarDeclRaw else CommentDecl "no-op"
+    let updateBreakVar = if useBreakVar then asgn breakVar $ Ident localVar else Null
+
+    let keepRunning = BinOp Lt (Ident jumpState) jsBreak
+    let pushBreakVar = if useBreakVar
+                        then If NoCheck (UniOp LogNot keepRunning)
+                                (asgn localVar $ Ident breakVar) Null
+                        else Null
+    let comp' = if local then comp else BinOp LogAnd comp keepRunning
+    let incr' = if local then incr else map (stubIncr keepRunning) incr
+    let body = Block Seq "" [] $
                 [ asgn jumpState jsNone
                 , stmt'
                 ]
+    let body' = if local
+                    then If NoCheck keepRunning
+                            (Block Seq "" [] [body, updateBreakVar]) Null
+                    else body
     let jsStackIdent = jumpState ++ "_" ++ show origLoopDepth
     let jsStackDecl = Variable Local jumpStateType jsStackIdent []
-                        (Just $ Ident jumpState)
+                        (Ident jumpState)
     let jsStackRestore = If NoCheck
                 (BinOp Ne (Ident jumpState) jsReturn)
                 (asgn jumpState (Ident jsStackIdent))
                 Null
+    let jsCheckReturn = If NoCheck
+                (BinOp Ne (Ident jumpState) jsReturn)
+                (asgn jumpState jsNone)
+                Null
 
     return $
         if not afterHasJump then
-            loop comp stmt'
+            loop comp incr stmt'
         else if origLoopDepth == 0 then
-            Block Seq "" []
+            Block Seq "" [ breakVarDecl ]
-                [ loop comp' body ]
+                [ loop comp' incr' body'
+                , pushBreakVar
+                , jsCheckReturn
+                ]
         else
             Block Seq ""
-                [ jsStackDecl ]
+                [ breakVarDecl, jsStackDecl ]
-                [ loop comp' body
+                [ loop comp' incr' body'
+                , pushBreakVar
                 , jsStackRestore
                 ]
 
+    where
+        breakVar = "_sv2v_value_on_break"
+        local = localInfo /= Nothing
+        Just localVar = localInfo
+
+stubIncr :: Expr -> Incr -> Incr
+stubIncr keepRunning (lhs, AsgnOpEq, expr) =
+    (lhs, AsgnOpEq, expr')
+    where expr' = Mux keepRunning expr (lhsToExpr lhs)
+stubIncr keepRunning (lhs, op, expr) =
+    stubIncr keepRunning (lhs, AsgnOpEq, expr')
+    where
+        AsgnOp binop = op
+        expr' = BinOp binop (lhsToExpr lhs) expr
+
 jumpStateType :: Type
-jumpStateType = IntegerVector TBit Unspecified [(Number "0", Number "1")]
+jumpStateType = IntegerVector TBit Unspecified [(RawNum 1, RawNum 0)]
 
 jumpState :: String
 jumpState = "_sv2v_jump"
 
+jsVal :: Integer -> Expr
+jsVal n = Number $ Based 2 False Binary n 0
+
 -- keep running the loop/function normally
 jsNone :: Expr
-jsNone = Number "2'b00"
+jsNone = jsVal 0
 -- skip to the next iteration of the loop (continue)
 jsContinue :: Expr
-jsContinue = Number "2'b01"
+jsContinue = jsVal 1
 -- stop running the loop immediately (break)
 jsBreak :: Expr
-jsBreak = Number "2'b10"
+jsBreak = jsVal 2
 -- stop running the function immediately (return)
 jsReturn :: Expr
-jsReturn = Number "2'b11"
+jsReturn = jsVal 3
 
 
 assertMsg :: Bool -> String -> State Info ()
@@ -298,4 +380,4 @@ assertMsg True _ = return ()
 assertMsg False msg = error msg
 
 asgn :: Identifier -> Expr -> Stmt
-asgn x e = AsgnBlk AsgnOpEq (LHSIdent x) e
+asgn x e = Asgn AsgnOpEq Nothing (LHSIdent x) e

src/Convert/KWArgs.hs

@@ -10,8 +10,7 @@
 module Convert.KWArgs (convert) where
 
 import Data.List (elemIndex, sortOn)
-import Data.Maybe (mapMaybe)
+import Control.Monad.Writer.Strict
-import Control.Monad.Writer
 import qualified Data.Map.Strict as Map
 
 import Convert.Traverse
@@ -24,11 +23,13 @@ convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
 convertDescription description =
-    traverseModuleItems
+    traverseModuleItems (convertModuleItem tfs) description
-        (traverseExprs $ traverseNestedExprs $ convertExpr tfs)
+    where tfs = execWriter $ collectModuleItemsM collectTF description
-        description
+
-    where
+convertModuleItem :: TFs -> ModuleItem -> ModuleItem
-        tfs = execWriter $ collectModuleItemsM collectTF description
+convertModuleItem tfs =
+    (traverseExprs $ traverseNestedExprs $ convertExpr tfs) .
+    (traverseStmts $ traverseNestedStmts $ convertStmt tfs)
 
 collectTF :: ModuleItem -> Writer TFs ()
 collectTF (MIPackageItem (Function _ _ f decls _)) = collectTFDecls f decls
@@ -37,19 +38,29 @@ collectTF _ = return ()
 
 collectTFDecls :: Identifier -> [Decl] -> Writer TFs ()
 collectTFDecls name decls =
-    tell $ Map.singleton name $ mapMaybe getInput decls
+    tell $ Map.singleton name $ filter (not . null) $ map getInput decls
     where
-        getInput :: Decl -> Maybe Identifier
+        getInput :: Decl -> Identifier
-        getInput (Variable Input _ ident _ _) = Just ident
+        getInput (Variable Input _ ident _ _) = ident
-        getInput _ = Nothing
+        getInput _ = ""
 
 convertExpr :: TFs -> Expr -> Expr
-convertExpr _ (orig @ (Call _ (Args _ []))) = orig
+convertExpr tfs (Call expr args) =
-convertExpr tfs (Call (Ident func) (Args pnArgs kwArgs)) =
+    convertInvoke tfs Call expr args
+convertExpr _ other = other
+
+convertStmt :: TFs -> Stmt -> Stmt
+convertStmt tfs (Subroutine expr args) =
+    convertInvoke tfs Subroutine expr args
+convertStmt _ other = other
+
+convertInvoke :: TFs -> (Expr -> Args -> a) -> Expr -> Args -> a
+convertInvoke tfs constructor (Ident func) (Args pnArgs kwArgs@(_ : _)) =
     case tfs Map.!? func of
-        Nothing -> Call (Ident func) (Args pnArgs kwArgs)
+        Nothing -> constructor (Ident func) (Args pnArgs kwArgs)
-        Just ordered -> Call (Ident func) (Args args [])
+        Just ordered -> constructor (Ident func) (Args args [])
             where
                 args = pnArgs ++ (map snd $ sortOn position kwArgs)
                 position (x, _) = elemIndex x ordered
-convertExpr _ other = other
+convertInvoke _ constructor expr args =
+    constructor expr args

src/Convert/Logic.hs

@@ -25,15 +25,20 @@
 
 module Convert.Logic (convert) where
 
-import Control.Monad.Writer
+import Control.Monad (when, zipWithM)
+import Control.Monad.Writer.Strict
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 
+import Convert.Scoper
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type Idents = Set.Set Identifier
+type Ports = Map.Map Identifier [(Identifier, Direction)]
-type Ports = Map.Map (Identifier, Identifier) Direction
+type Location = [Identifier]
+type Locations = Set.Set Location
+type DT = (Direction, Type)
+type ST = ScoperT DT (Writer Locations)
 
 convert :: [AST] -> [AST]
 convert =
@@ -42,123 +47,197 @@ convert =
         (traverseDescriptions . convertDescription)
     where
         collectPortsM :: Description -> Writer Ports ()
-        collectPortsM (orig @ (Part _ _ _ _ name portNames _)) =
+        collectPortsM orig@(Part _ _ _ _ name portNames _) =
-            collectModuleItemsM collectPortDirsM orig
+            tell $ Map.singleton name ports
             where
-                collectPortDirsM :: ModuleItem -> Writer Ports ()
+                ports = zip portNames (map lookupDir portNames)
-                collectPortDirsM (MIPackageItem (Decl (Variable dir _ ident _ _))) =
+                dirs = execWriter $ collectModuleItemsM collectDeclDirsM orig
-                    if dir == Local then
+                lookupDir :: Identifier -> Direction
-                        return ()
+                lookupDir portName =
-                    else if elem ident portNames then
+                    case lookup portName dirs of
-                        tell $ Map.singleton (name, ident) dir
+                        Just dir -> dir
-                    else
+                        Nothing -> Inout
-                        error $ "encountered decl with a dir that isn't a port: "
-                            ++ show (dir, ident)
-                collectPortDirsM _ = return ()
         collectPortsM _ = return ()
+        collectDeclDirsM :: ModuleItem -> Writer [(Identifier, Direction)] ()
+        collectDeclDirsM (MIPackageItem (Decl (Variable dir _ ident _ _))) =
+            when (dir /= Local) $ tell [(ident, dir)]
+        collectDeclDirsM (MIPackageItem (Decl (Net dir _ _ _ ident _ _))) =
+            when (dir /= Local) $ tell [(ident, dir)]
+        collectDeclDirsM _ = return ()
 
 convertDescription :: Ports -> Description -> Description
-convertDescription ports orig =
+convertDescription ports description =
-    if shouldConvert
+    evalScoper $ scopeModule conScoper description
-        then converted
-        else orig
     where
-        shouldConvert = case orig of
+        locations = execWriter $ evalScoperT $ scopePart locScoper description
-            Part _ _ Interface _ _ _ _ -> False
+        -- write down which vars are procedurally assigned
-            Part _ _ Module _ _ _ _ -> True
+        locScoper = scopeModuleItem
-            PackageItem _ -> True
+            traverseDeclM traverseModuleItemM return traverseStmtM
-            Package _ _ _ -> False
+        -- rewrite reg continuous assignments and output port connections
+        conScoper = scopeModuleItem
+            (rewriteDeclM locations) (rewriteModuleItemM ports) return return
 
-        origIdents = execWriter (collectModuleItemsM regIdents orig)
+rewriteModuleItemM :: Ports -> ModuleItem -> Scoper DT ModuleItem
-        fixed = traverseModuleItems fixModuleItem orig
+rewriteModuleItemM ports = embedScopes $ rewriteModuleItem ports
-        fixedIdents = execWriter (collectModuleItemsM regIdents fixed)
+
-        conversion = traverseDecls convertDecl . convertModuleItem
+rewriteModuleItem :: Ports -> Scopes DT -> ModuleItem -> ModuleItem
-        converted = traverseModuleItems conversion fixed
+rewriteModuleItem ports scopes =
+    fixModuleItem
+    where
+        isReg :: LHS -> Bool
+        isReg =
+            or . execWriter . collectNestedLHSsM isReg'
+            where
+                isRegType :: Type -> Bool
+                isRegType (IntegerVector TReg _ _) = True
+                isRegType _ = False
+                isReg' :: LHS -> Writer [Bool] ()
+                isReg' lhs =
+                    case lookupElem scopes lhs of
+                        Just (_, _, (_, t)) -> tell [isRegType t]
+                        _ -> tell [False]
+
+        always_comb = AlwaysC Always . Timing (Event EventStar)
 
         fixModuleItem :: ModuleItem -> ModuleItem
         -- rewrite bad continuous assignments to use procedural assignments
-        fixModuleItem (Assign Nothing lhs expr) =
+        fixModuleItem (Assign AssignOptionNone lhs expr) =
-            if Set.disjoint usedIdents origIdents
+            if not (isReg lhs)
-                then Assign Nothing lhs expr
+                then Assign AssignOptionNone lhs expr
-                else AlwaysC AlwaysComb $ AsgnBlk AsgnOpEq lhs expr
+                else
+                    Generate $ map GenModuleItem
+                    [ MIPackageItem $ Decl decl
+                    , Assign AssignOptionNone (LHSIdent x) expr
+                    , always_comb $ Asgn AsgnOpEq Nothing lhs (Ident x)
+                    ]
             where
-                usedIdents = execWriter $ collectNestedLHSsM lhsIdents lhs
+                decl = Net Local TWire DefaultStrength t x [] Nil
+                t = Implicit Unspecified [r]
+                r = (DimsFn FnBits $ Right $ lhsToExpr lhs, RawNum 1)
+                x = "sv2v_tmp_" ++ shortHash (lhs, expr)
         -- rewrite port bindings to use temporary nets where necessary
         fixModuleItem (Instance moduleName params instanceName rs bindings) =
             if null newItems
                 then Instance moduleName params instanceName rs bindings
                 else Generate $ map GenModuleItem $
-                    (MIPackageItem $ Comment "rewrote reg-to-output bindings") :
+                    comment : newItems ++
-                    newItems ++
                     [Instance moduleName params instanceName rs bindings']
             where
+                comment = MIPackageItem $ Decl $ CommentDecl
+                    "rewrote reg-to-output bindings"
                 (bindings', newItemsList) = unzip $ map fixBinding bindings
                 newItems = concat newItemsList
                 fixBinding :: PortBinding -> (PortBinding, [ModuleItem])
-                fixBinding (portName, Just expr) =
+                fixBinding (portName, expr) =
-                    if portDir /= Just Output || Set.disjoint usedIdents origIdents
+                    if not outputBound || not usesReg
-                        then ((portName, Just expr), [])
+                        then ((portName, expr), [])
-                        else ((portName, Just tmpExpr), items)
+                        else ((portName, tmpExpr), items)
                     where
-                        portDir = Map.lookup (moduleName, portName) ports
+                        outputBound = portDir == Just Output
-                        usedIdents = execWriter $
+                        usesReg = Just True == fmap isReg (exprToLHS expr)
-                            collectNestedExprsM exprIdents expr
+                        portDir = maybeModulePorts >>= lookup portName
                         tmp = "sv2v_tmp_" ++ instanceName ++ "_" ++ portName
                         tmpExpr = Ident tmp
-                        t = Net TWire Unspecified [(DimsFn FnBits $ Right expr, Number "1")]
+                        decl = Net Local TWire DefaultStrength t tmp [] Nil
+                        t = Implicit Unspecified [r]
+                        r = (DimsFn FnBits $ Right expr, RawNum 1)
                         items =
-                            [ MIPackageItem $ Decl $ Variable Local t tmp [] Nothing
+                            [ MIPackageItem $ Decl decl
-                            , AlwaysC AlwaysComb $ AsgnBlk AsgnOpEq lhs tmpExpr]
+                            , always_comb $ Asgn AsgnOpEq Nothing lhs tmpExpr]
-                        lhs = case exprToLHS expr of
+                        Just lhs = exprToLHS expr
-                            Just l -> l
+                maybeModulePorts = Map.lookup moduleName ports
-                            Nothing ->
-                                error $ "bad non-lhs, non-net expr "
-                                    ++ show expr ++ " connected to output port "
-                                    ++ portName ++ " of " ++ instanceName
-                fixBinding other = (other, [])
         fixModuleItem other = other
 
-        -- rewrite variable declarations to have the correct type
+traverseModuleItemM :: ModuleItem -> ST ModuleItem
-        convertModuleItem (MIPackageItem (Decl (Variable dir (IntegerVector _ sg mr) ident a me))) =
+traverseModuleItemM = traverseNodesM traverseExprM return return return return
-            MIPackageItem $ Decl $ Variable dir (t mr) ident a me
-            where
-                t = if Set.member ident fixedIdents
-                    then IntegerVector TReg sg
-                    else Net TWire sg
-        convertModuleItem other = other
-        -- all other logics (i.e. inside of functions) become regs
-        convertDecl :: Decl -> Decl
-        convertDecl (Param s (IntegerVector _ sg rs) x e) =
-            Param s (Implicit sg rs) x e
-        convertDecl (Variable d (IntegerVector TLogic sg rs) x a me) =
-            Variable d (IntegerVector TReg sg rs) x a me
-        convertDecl other = other
 
-regIdents :: ModuleItem -> Writer Idents ()
+traverseDeclM :: Decl -> ST Decl
-regIdents (AlwaysC _ stmt) = do
+traverseDeclM decl = do
-    collectNestedStmtsM collectReadMemsM stmt
+    case decl of
-    collectNestedStmtsM (collectStmtLHSsM (collectNestedLHSsM lhsIdents)) $
+        Variable d t x _ _ -> insertElem x (d, t)
-        traverseNestedStmts removeTimings stmt
+        Net  d _ _ t x _ _ -> insertElem x (d, t)
-    where
+        _ -> return ()
-        removeTimings :: Stmt -> Stmt
+    traverseDeclNodesM return traverseExprM decl
-        removeTimings (Timing _ s) = s
-        removeTimings other = other
-        collectReadMemsM :: Stmt -> Writer Idents ()
-        collectReadMemsM (Subroutine (Ident f) (Args (_ : Just (Ident x) : _) [])) =
-            if f == "$readmemh" || f == "$readmemb"
-                then tell $ Set.singleton x
-                else return ()
-        collectReadMemsM _ = return ()
-regIdents (Initial stmt) =
-    regIdents $ AlwaysC Always stmt
-regIdents (Final stmt) =
-    regIdents $ AlwaysC Always stmt
-regIdents _ = return ()
 
-lhsIdents :: LHS -> Writer Idents ()
+rewriteDeclM :: Locations -> Decl -> Scoper DT Decl
-lhsIdents (LHSIdent x) = tell $ Set.singleton x
+rewriteDeclM locations (Variable d (IntegerVector TLogic sg rs) x a e) = do
-lhsIdents _ = return () -- the collector recurses for us
+    accesses <- localAccessesM x
+    let location = map accessName accesses
+    let usedAsReg = Set.member location locations
+    blockLogic <- withinProcedureM
+    if blockLogic || usedAsReg || e /= Nil
+        then do
+            let d' = if d == Inout then Output else d
+            let t' = IntegerVector TReg sg rs
+            insertElem accesses (d', t')
+            return $ Variable d' t' x a e
+        else do
+            let t' = Implicit sg rs
+            insertElem accesses (d, t')
+            return $ Net d TWire DefaultStrength t' x a e
+rewriteDeclM locations decl@(Variable d t x a e) = do
+    inProcedure <- withinProcedureM
+    case (d, t, inProcedure) of
+        -- Reinterpret `input reg` module ports as `input logic`. We still don't
+        -- treat `logic` and `reg` as the same keyword, as specifying `reg`
+        -- explicitly is typically expected to flow downstream.
+        (Input, IntegerVector TReg sg rs, False) ->
+            rewriteDeclM locations $ Variable Input t' x a e
+            where t' = IntegerVector TLogic sg rs
+        _ -> insertElem x (d, t) >> return decl
+rewriteDeclM _ (Net d n s (IntegerVector _ sg rs) x a e) =
+    insertElem x (d, t) >> return (Net d n s t x a e)
+    where t = Implicit sg rs
+rewriteDeclM _ decl@(Net d _ _ t x _ _) =
+    insertElem x (d, t) >> return decl
+rewriteDeclM _ (Param s (IntegerVector _ sg []) x e) =
+    return $ Param s (Implicit sg [(zero, zero)]) x e
+    where zero = RawNum 0
+rewriteDeclM _ (Param s (IntegerVector _ sg rs) x e) =
+    return $ Param s (Implicit sg rs) x e
+rewriteDeclM _ decl = return decl
 
-exprIdents :: Expr -> Writer Idents ()
+traverseStmtM :: Stmt -> ST Stmt
-exprIdents (Ident x) = tell $ Set.singleton x
+traverseStmtM (Asgn op Just{} lhs expr) =
-exprIdents _ = return () -- the collector recurses for us
+    -- ignore the timing LHSs
+    traverseStmtM $ Asgn op Nothing lhs expr
+traverseStmtM stmt@(Subroutine (Ident f) (Args (_ : Ident x : _) []))
+    | f == "$readmemh" || f == "$readmemb" =
+        collectLHSM (LHSIdent x) >> return stmt
+traverseStmtM (Subroutine fn (Args args [])) = do
+    fn' <- traverseExprM fn
+    args' <- traverseCall fn' args
+    return $ Subroutine fn' $ Args args' []
+traverseStmtM stmt =
+    collectStmtLHSsM (collectNestedLHSsM collectLHSM) stmt
+        >> traverseStmtExprsM traverseExprM stmt
+
+traverseExprM :: Expr -> ST Expr
+traverseExprM (Call fn (Args args [])) = do
+    fn' <- traverseExprM fn
+    args' <- traverseCall fn' args
+    return $ Call fn' $ Args args' []
+traverseExprM other =
+    traverseSinglyNestedExprsM traverseExprM other
+
+traverseCall :: Expr -> [Expr] -> ST [Expr]
+traverseCall fn = zipWithM (traverseCallArg fn) [0..]
+
+-- task and function ports might be outputs, thus requiring a given logic to be
+-- a reg rather than a wire
+traverseCallArg :: Expr -> Int -> Expr -> ST Expr
+traverseCallArg fn idx arg = do
+    details <- lookupElemM $ Dot fn (show idx)
+    case (details, exprToLHS arg) of
+        (Just (_, _, (Output, _)), Just lhs) -> collectLHSM lhs
+        _ -> return ()
+    return arg -- no rewriting
+
+collectLHSM :: LHS -> ST ()
+collectLHSM lhs = do
+    details <- lookupElemM lhs
+    case details of
+        Just (accesses, _, _) ->
+            lift $ tell $ Set.singleton location
+            where location = map accessName accesses
+        Nothing -> return ()

src/Convert/MultiplePacked.hs

@@ -4,7 +4,7 @@
  - Conversion for flattening variables with multiple packed dimensions
  -
  - This removes one packed dimension per identifier per pass. This works fine
- - because all conversions are repeatedly applied.
+ - because this conversion is repeatedly applied.
  -
  - We previously had a very complex conversion which used `generate` to make
  - flattened and unflattened versions of the array as necessary. This has now
@@ -25,58 +25,97 @@
 
 module Convert.MultiplePacked (convert) where
 
-import Control.Monad.State
+import Convert.ExprUtils
+import Control.Monad ((>=>))
+import Data.Bifunctor (first)
 import Data.Tuple (swap)
-import Data.Maybe (isJust, fromJust)
+import Data.Maybe (isJust)
 import qualified Data.Map.Strict as Map
 
+import Convert.Scoper
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
 type TypeInfo = (Type, [Range])
-type Info = Map.Map Identifier TypeInfo
 
 convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
-convertDescription =
+convertDescription description@(Part _ _ Module _ _ _ _) =
-    scopedConversion traverseDeclM traverseModuleItemM traverseStmtM Map.empty
+    partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
+    description
+convertDescription other = other
 
 -- collects and converts declarations with multiple packed dimensions
-traverseDeclM :: Decl -> State Info Decl
+traverseDeclM :: Decl -> Scoper TypeInfo Decl
-traverseDeclM (Variable dir t ident a me) = do
+traverseDeclM (Variable dir t ident a e) = do
-    t' <- traverseTypeM t a ident
+    recordTypeM t a ident
-    return $ Variable dir t' ident a me
+    traverseDeclExprsM traverseExprM $ Variable dir t' ident a e
+    where t' = flattenType t
+traverseDeclM net@Net{} =
+    traverseNetAsVarM traverseDeclM net
 traverseDeclM (Param s t ident e) = do
-    t' <- traverseTypeM t [] ident
+    recordTypeM t [] ident
-    return $ Param s t' ident e
+    traverseDeclExprsM traverseExprM $ Param s t' ident e
-traverseDeclM (ParamType s ident mt) =
+    where t' = flattenType t
-    return $ ParamType s ident mt
+traverseDeclM other = traverseDeclExprsM traverseExprM other
 
-traverseTypeM :: Type -> [Range] -> Identifier -> State Info Type
+-- write down the given declaration
-traverseTypeM t a ident = do
+recordTypeM :: Type -> [Range] -> Identifier -> Scoper TypeInfo ()
-    modify $ Map.insert ident (t, a)
+recordTypeM t a ident = do
-    t' <- case t of
+    tScoped <- scopeType t
-        Struct pk fields rs -> do
+    insertElem ident (tScoped, a)
-            fields' <- flattenFields fields
+
-            return $ Struct pk fields' rs
+-- flatten the innermost dimension of the given type, and any types it contains
-        Union  pk fields rs -> do
+flattenType :: Type -> Type
-            fields' <- flattenFields fields
+flattenType t =
-            return $ Union  pk fields' rs
+    tf $ if length ranges <= 1
-        _ -> return t
+        then ranges
-    let (tf, rs) = typeRanges t'
+        else rangesFlat
-    if length rs <= 1
-        then return t'
-        else do
-            let r1 : r2 : rest = rs
-            let rs' = (combineRanges r1 r2) : rest
-            return $ tf rs'
     where
-        flattenFields fields = do
+        (tf, ranges) = case t of
-            let (fieldTypes, fieldNames) = unzip fields
+            Struct pk fields rs ->
-            fieldTypes' <- mapM (\x -> traverseTypeM x [] "") fieldTypes
+                (Struct pk fields', rs)
-            return $ zip fieldTypes' fieldNames
+                where fields' = flattenFields fields
+            Union  pk fields rs ->
+                (Union  pk fields', rs)
+                where fields' = flattenFields fields
+            _ -> typeRanges t
+        r1 : r2 : rest = ranges
+        rangesFlat = combineRanges r1 r2 : rest
+
+-- flatten the types in a given list of struct/union fields
+flattenFields :: [Field] -> [Field]
+flattenFields = map $ first flattenType
+
+traverseInstanceRanges :: Identifier -> [Range] -> Scoper TypeInfo [Range]
+traverseInstanceRanges x rs
+    | length rs <= 1 = return rs
+    | otherwise = do
+        let t = Implicit Unspecified rs
+        tScoped <- scopeType t
+        insertElem x (tScoped, [])
+        let r1 : r2 : rest = rs
+        return $ (combineRanges r1 r2) : rest
+
+traverseModuleItemM :: ModuleItem -> Scoper TypeInfo ModuleItem
+traverseModuleItemM (Instance m p x rs l) = do
+    -- converts multi-dimensional instances
+    rs' <- traverseInstanceRanges x rs
+    traverseExprsM traverseExprM $ Instance m p x rs' l
+traverseModuleItemM (NInputGate kw d x rs lhs exprs) = do
+    rs' <- traverseInstanceRanges x rs
+    traverseModuleItemM' $ NInputGate kw d x rs' lhs exprs
+traverseModuleItemM (NOutputGate kw d x rs lhss expr) = do
+    rs' <- traverseInstanceRanges x rs
+    traverseModuleItemM' $ NOutputGate kw d x rs' lhss expr
+traverseModuleItemM item = traverseModuleItemM' item
+
+traverseModuleItemM' :: ModuleItem -> Scoper TypeInfo ModuleItem
+traverseModuleItemM' =
+    traverseLHSsM traverseLHSM >=>
+    traverseExprsM traverseExprM
 
 -- combines two ranges into one flattened range
 combineRanges :: Range -> Range -> Range
@@ -94,42 +133,59 @@ combineRanges r1 r2 = r
         combine (s1, e1) (s2, e2) =
             (simplify upper, simplify lower)
             where
-                size1 = rangeSize (s1, e1)
+                size1 = rangeSizeHiLo (s1, e1)
-                size2 = rangeSize (s2, e2)
+                size2 = rangeSizeHiLo (s2, e2)
-                lower = BinOp Add e2 (BinOp Mul e1 size2)
+                lower = binOp Add e2 (binOp Mul e1 size2)
-                upper = BinOp Add (BinOp Mul size1 size2)
+                upper = binOp Add (binOp Mul size1 size2)
-                            (BinOp Sub lower (Number "1"))
+                            (binOp Sub lower (RawNum 1))
 
-traverseModuleItemM :: ModuleItem -> State Info ModuleItem
+traverseStmtM :: Stmt -> Scoper TypeInfo Stmt
-traverseModuleItemM item =
+traverseStmtM =
-    traverseLHSsM  traverseLHSM  item >>=
+    traverseStmtLHSsM  traverseLHSM  >=>
-    traverseExprsM traverseExprM
-
-traverseStmtM :: Stmt -> State Info Stmt
-traverseStmtM stmt =
-    traverseStmtLHSsM  traverseLHSM  stmt >>=
     traverseStmtExprsM traverseExprM
 
-traverseExprM :: Expr -> State Info Expr
+traverseExprM :: Expr -> Scoper TypeInfo Expr
-traverseExprM = traverseNestedExprsM $ stately traverseExpr
+traverseExprM =
+    embedScopes convertExpr >=>
+    traverseExprTypesM traverseTypeM >=>
+    traverseSinglyNestedExprsM traverseExprM
+
+traverseTypeM :: Type -> Scoper TypeInfo Type
+traverseTypeM typ =
+    traverseTypeExprsM traverseExprM >=>
+    traverseSinglyNestedTypesM traverseTypeM $
+    case typ of
+        Struct{} -> typ'
+        Union {} -> typ'
+        _ -> typ
+    where typ' = traverseSinglyNestedTypes flattenType typ
+
+traverseGenItemM :: GenItem -> Scoper TypeInfo GenItem
+traverseGenItemM = traverseGenItemExprsM traverseExprM
 
 -- LHSs need to be converted too. Rather than duplicating the procedures, we
 -- turn LHSs into expressions temporarily and use the expression conversion.
-traverseLHSM :: LHS -> State Info LHS
+traverseLHSM :: LHS -> Scoper TypeInfo LHS
-traverseLHSM lhs = do
+traverseLHSM = traverseNestedLHSsM traverseLHSSingleM
+    where
+        -- We can't use traverseExprM directly because that would cause Exprs
+        -- inside of LHSs to be converted twice in a single cycle!
+        traverseLHSSingleM :: LHS -> Scoper TypeInfo LHS
+        traverseLHSSingleM lhs = do
             let expr = lhsToExpr lhs
-    expr' <- traverseExprM expr
+            expr' <- embedScopes convertExpr expr
-    return $ fromJust $ exprToLHS expr'
+            let Just lhs' = exprToLHS expr'
+            return lhs'
 
-traverseExpr :: Info -> Expr -> Expr
+convertExpr :: Scopes TypeInfo -> Expr -> Expr
-traverseExpr typeMap =
+convertExpr scopes =
     rewriteExpr
     where
         -- removes the innermost dimensions of the given type information, and
         -- applies the given transformation to the expression
-        dropLevel :: (Expr -> Expr) -> (TypeInfo, Expr) -> (TypeInfo, Expr)
+        dropLevel :: TypeInfo -> TypeInfo
-        dropLevel nest ((t, a), expr) =
+        dropLevel (t, a) =
-            ((tf rs', a'), nest expr)
+            (tf rs', a')
             where
                 (tf, rs) = typeRanges t
                 (rs', a') = case (rs, a) of
@@ -137,42 +193,46 @@ traverseExpr typeMap =
                     (packed, []) -> (tail packed, [])
                     (packed, unpacked) -> (packed, tail unpacked)
 
-        -- given an expression, returns its type information and a tagged
+        -- given an expression, returns its type information, if possible
-        -- version of the expression, if possible
+        levels :: Expr -> Maybe TypeInfo
-        levels :: Expr -> Maybe (TypeInfo, Expr)
-        levels (Ident x) =
-            case Map.lookup x typeMap of
-                Just a -> Just (a, Ident $ tag : x)
-                Nothing -> Nothing
         levels (Bit expr a) =
-            fmap (dropLevel $ \expr' -> Bit expr' a) (levels expr)
+            case levels expr of
-        levels (Range expr a b) =
+                Just info -> Just $ dropLevel info
-            fmap (dropLevel $ \expr' -> Range expr' a b) (levels expr)
+                Nothing -> fallbackLevels $ Bit expr a
+        levels (Range expr _ _) =
+            fmap dropLevel $ levels expr
         levels (Dot expr x) =
             case levels expr of
-                Just ((Struct _ fields [], []), expr') -> dropDot fields expr'
+                Just (Struct _ fields [], []) -> dropDot fields
-                Just ((Union  _ fields [], []), expr') -> dropDot fields expr'
+                Just (Union  _ fields [], []) -> dropDot fields
-                _ -> Nothing
+                _ -> fallbackLevels $ Dot expr x
             where
-                dropDot :: [Field] -> Expr -> Maybe (TypeInfo, Expr)
+                dropDot :: [Field] -> Maybe TypeInfo
-                dropDot fields expr' =
+                dropDot fields =
                     if Map.member x fieldMap
-                        then Just ((fieldType, []), Dot expr' x)
+                        then Just (fieldType, [])
                         else Nothing
                     where
                         fieldMap = Map.fromList $ map swap fields
                         fieldType = fieldMap Map.! x
-        levels _ = Nothing
+        levels expr = fallbackLevels expr
 
-        -- given an expression, returns the two innermost packed dimensions and a
+        fallbackLevels :: Expr -> Maybe TypeInfo
-        -- tagged version of the expression, if possible
+        fallbackLevels expr =
-        dims :: Expr -> Maybe (Range, Range, Expr)
+            fmap thd3 res
+            where
+                res = lookupElem scopes expr
+                thd3 (_, _, c) = c
+
+        -- given an expression, returns the two most significant (innermost,
+        -- leftmost) packed dimensions
+        dims :: Expr -> Maybe (Range, Range)
         dims expr =
             case levels expr of
-                Just ((t, []), expr') ->
+                Just (t, []) ->
                     case snd $ typeRanges t of
                         dimInner : dimOuter : _ ->
-                            Just (dimInner, dimOuter, expr')
+                            Just (dimInner, dimOuter)
                         _ -> Nothing
                 _ -> Nothing
 
@@ -182,85 +242,131 @@ traverseExpr typeMap =
         orientIdx r e =
             endianCondExpr r e eSwapped
             where
-                eSwapped = BinOp Sub (snd r) (BinOp Sub e (fst r))
+                eSwapped = binOp Sub (snd r) (binOp Sub e (fst r))
 
         -- Converted idents are prefixed with an invalid character to ensure
         -- that are not converted twice when the traversal steps downward. When
         -- the prefixed identifier is encountered at the lowest level, it is
         -- removed.
 
-        tag = ':'
-
         rewriteExpr :: Expr -> Expr
-        rewriteExpr (Ident x) =
+        rewriteExpr expr@Ident{} = expr
-            if head x == tag
+        rewriteExpr orig@(Bit (Bit expr idxInner) idxOuter) =
-                then Ident $ tail x
+            if isJust maybeDims && expr == rewriteExpr expr
-                else Ident x
+                then Bit expr idx'
-        rewriteExpr (orig @ (Bit (Bit expr idxInner) idxOuter)) =
+                else rewriteExprLowPrec orig
-            if isJust maybeDims
-                then Bit expr' idx'
-                else orig
             where
-                maybeDims = dims $ rewriteExpr expr
+                maybeDims = dims expr
-                Just (dimInner, dimOuter, expr') = maybeDims
+                Just (dimInner, dimOuter) = maybeDims
                 idxInner' = orientIdx dimInner idxInner
                 idxOuter' = orientIdx dimOuter idxOuter
-                base = BinOp Mul idxInner' (rangeSize dimOuter)
+                base = binOp Mul idxInner' (rangeSize dimOuter)
-                idx' = simplify $ BinOp Add base idxOuter'
+                idx' = simplify $ binOp Add base idxOuter'
-        rewriteExpr (orig @ (Bit expr idx)) =
+        rewriteExpr orig@(Range (Bit expr idxInner) NonIndexed rangeOuter) =
-            if isJust maybeDims
+            if isJust maybeDims && expr == rewriteExpr expr
-                then Range expr' mode' range'
+                then rewriteExpr $ Range exprOuter IndexedMinus range
+                else rewriteExprLowPrec orig
+            where
+                maybeDims = dims expr
+                exprOuter = Bit expr idxInner
+                baseDec = fst rangeOuter
+                baseInc = binOp Sub (binOp Add baseDec len) (RawNum 1)
+                base = endianCondExpr rangeOuter baseDec baseInc
+                len = rangeSize rangeOuter
+                range = (base, len)
+        rewriteExpr orig@(Range (Bit expr idxInner) modeOuter rangeOuter) =
+            if isJust maybeDims && expr == rewriteExpr expr
+                then Range expr modeOuter range'
+                else rewriteExprLowPrec orig
+            where
+                maybeDims = dims expr
+                Just (dimInner, dimOuter) = maybeDims
+                idxInner' = orientIdx dimInner idxInner
+                (baseOuter, lenOuter) = rangeOuter
+                baseOuter' = orientIdx dimOuter baseOuter
+                start = binOp Mul idxInner' (rangeSize dimOuter)
+                baseDec = binOp Add start baseOuter'
+                baseInc = if modeOuter == IndexedPlus
+                    then binOp Add (binOp Sub baseDec len) one
+                    else binOp Sub (binOp Add baseDec len) one
+                base = endianCondExpr dimOuter baseDec baseInc
+                len = lenOuter
+                range' = (base, len)
+                one = RawNum 1
+        rewriteExpr (Cast (Left t) expr) =
+            Cast (Left $ flattenType t) expr
+        rewriteExpr other =
+            rewriteExprLowPrec other
+
+        rewriteExprLowPrec :: Expr -> Expr
+        rewriteExprLowPrec orig@(Bit expr idx) =
+            if isJust maybeDims && expr == rewriteExpr expr
+                then Range expr mode' range'
                 else orig
             where
-                maybeDims = dims $ rewriteExpr expr
+                maybeDims = dims expr
-                Just (dimInner, dimOuter, expr') = maybeDims
+                Just (dimInner, dimOuter) = maybeDims
                 mode' = IndexedPlus
                 idx' = orientIdx dimInner idx
                 len = rangeSize dimOuter
-                base = BinOp Add (endianCondExpr dimOuter (snd dimOuter) (fst dimOuter)) (BinOp Mul idx' len)
+                base = binOp Add (endianCondExpr dimOuter (snd dimOuter) (fst dimOuter)) (binOp Mul idx' len)
                 range' = (simplify base, simplify len)
-        rewriteExpr (orig @ (Range (Bit expr idxInner) modeOuter rangeOuter)) =
+        rewriteExprLowPrec orig@(Range expr NonIndexed range) =
-            if isJust maybeDims
+            if isJust maybeDims && expr == rewriteExpr expr
-                then Range expr' mode' range'
+                then rewriteExpr $ Range expr IndexedMinus range'
                 else orig
             where
-                maybeDims = dims $ rewriteExpr expr
+                maybeDims = dims expr
-                Just (dimInner, dimOuter, expr') = maybeDims
+                baseDec = fst range
-                mode' = IndexedPlus
+                baseInc = binOp Sub (binOp Add baseDec len) (RawNum 1)
-                idxInner' = orientIdx dimInner idxInner
+                base = endianCondExpr range baseDec baseInc
-                rangeOuterReverseIndexed =
+                len = rangeSize range
-                    (BinOp Add (fst rangeOuter) (BinOp Sub (snd rangeOuter)
-                    (Number "1")), snd rangeOuter)
-                (baseOuter, lenOuter) =
-                    case modeOuter of
-                        IndexedPlus ->
-                            endianCondRange dimOuter rangeOuter rangeOuterReverseIndexed
-                        IndexedMinus ->
-                            endianCondRange dimOuter rangeOuterReverseIndexed rangeOuter
-                        NonIndexed ->
-                            (endianCondExpr dimOuter (snd rangeOuter) (fst rangeOuter), rangeSize rangeOuter)
-                idxOuter' = orientIdx dimOuter baseOuter
-                start = BinOp Mul idxInner' (rangeSize dimOuter)
-                base = simplify $ BinOp Add start idxOuter'
-                len = lenOuter
                 range' = (base, len)
-        rewriteExpr (orig @ (Range expr mode range)) =
+        rewriteExprLowPrec orig@(Range expr mode range) =
-            if isJust maybeDims
+            if isJust maybeDims && expr == rewriteExpr expr
-                then Range expr' mode' range'
+                then Range expr mode' range'
                 else orig
             where
-                maybeDims = dims $ rewriteExpr expr
+                maybeDims = dims expr
-                Just (_, dimOuter, expr') = maybeDims
+                Just (dimInner, dimOuter) = maybeDims
-                mode' = mode
+                sizeOuter = rangeSize dimOuter
-                size = rangeSize dimOuter
+                offsetOuter = uncurry (endianCondExpr dimOuter) $ swap dimOuter
-                base = endianCondExpr dimOuter (snd dimOuter) (fst dimOuter)
+                (baseOrig, lenOrig) = range
-                range' =
+                lenOrigMinusOne = binOp Sub lenOrig (RawNum 1)
-                    case mode of
+                baseSwapped =
-                        NonIndexed   ->
+                    orientIdx dimInner $
-                            (simplify hi, simplify lo)
+                    if mode == IndexedPlus
-                            where
+                        then
-                                lo = BinOp Mul size (snd range)
+                            endianCondExpr dimInner
-                                hi = BinOp Sub (BinOp Add lo (BinOp Mul (rangeSize range) size)) (Number "1")
+                            baseOrig
-                        IndexedPlus  -> (BinOp Add (BinOp Mul size (fst range)) base, BinOp Mul size (snd range))
+                            (binOp Add baseOrig lenOrigMinusOne)
-                        IndexedMinus -> (BinOp Add (BinOp Mul size (fst range)) base, BinOp Mul size (snd range))
+                        else
-        rewriteExpr other = other
+                            endianCondExpr dimInner
+                            (binOp Sub baseOrig lenOrigMinusOne)
+                            baseOrig
+                base = binOp Add offsetOuter (binOp Mul sizeOuter baseSwapped)
+                mode' = IndexedPlus
+                len = binOp Mul sizeOuter lenOrig
+                range' = (base, len)
+        rewriteExprLowPrec other = other
+
+-- Traditional identity operations like `+ 0` and `* 1` are not no-ops in
+-- SystemVerilog because they may implicitly extend the width of the other
+-- operand. Encouraged by the official language specifications (e.g., Section
+-- 11.6.2 of IEEE 1800-2017), these operations are used in real designs as
+-- workarounds for the standard expression evaluation semantics.
+--
+-- The process of flattening arrays in this conversion can naturally lead to
+-- unnecessary identity operations. Previously, `simplifyStep` was responsible
+-- for cleaning up the below unnecessary operations produced by this conversion,
+-- but it inadvertently changed the behavior of legitimate input designs.
+--
+-- Rather than applying these specific simplifications to all expressions, they
+-- are now only considered when constructing a new binary operation expression
+-- as part of array flattening.
+binOp :: BinOp -> Expr -> Expr -> Expr
+binOp Add (RawNum 0) e = e
+binOp Add e (RawNum 0) = e
+binOp Mul (RawNum 1) e = e
+binOp Mul e (RawNum 1) = e
+binOp op a b = BinOp op a b

src/Convert/NamedBlock.hs

@@ -10,47 +10,30 @@
 
 module Convert.NamedBlock (convert) where
 
-import Control.Monad.State
+import Control.Monad.State.Strict
-import qualified Data.Set as Set
 
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type Idents = Set.Set Identifier
-
 convert :: [AST] -> [AST]
-convert asts =
+convert = map $ traverseDescriptions convertDescription
-    -- we collect all the existing blocks in the first pass to make sure we
-    -- don't generate conflicting names on repeated passes of this conversion
-    evalState (runner collectStmtM asts >>= runner traverseStmtM) Set.empty
-    where runner = mapM . traverseDescriptionsM . traverseModuleItemsM . traverseStmtsM
 
-collectStmtM :: Stmt -> State Idents Stmt
+convertDescription :: Description -> Description
-collectStmtM (Block kw x decls stmts) = do
+convertDescription description =
-    modify $ Set.insert x
+    evalState (traverseModuleItemsM traverseModuleItem description) 1
-    return $ Block kw x decls stmts
+    where
-collectStmtM other = return other
+        traverseModuleItem = traverseStmtsM $ traverseNestedStmtsM traverseStmtM
 
-traverseStmtM :: Stmt -> State Idents Stmt
+traverseStmtM :: Stmt -> State Int Stmt
 traverseStmtM (Block kw "" [] stmts) =
     return $ Block kw "" [] stmts
 traverseStmtM (Block kw "" decls stmts) = do
-    names <- get
+    x <- uniqueBlockName
-    let x = uniqueBlockName names
-    modify $ Set.insert x
     return $ Block kw x decls stmts
 traverseStmtM other = return other
 
-uniqueBlockName :: Idents -> Identifier
+uniqueBlockName :: State Int String
-uniqueBlockName names =
+uniqueBlockName = do
-    step ("sv2v_autoblock_" ++ (show $ Set.size names)) 0
+    cnt <- get
-    where
+    put $ cnt + 1
-        step :: Identifier -> Int -> Identifier
+    return $ "sv2v_autoblock_" ++ show cnt
-        step base n =
-            if Set.member name names
-                then step base (n + 1)
-                else name
-            where
-                name = if n == 0
-                    then base
-                    else base ++ "_" ++ show n

src/Convert/NestPI.hs

@@ -1,110 +0,0 @@
-{- sv2v
- - Author: Zachary Snow <zach@zachjs.com>
- -
- - Conversion for moving top-level package items into modules
- -}
-
-module Convert.NestPI (convert) where
-
-import Control.Monad.Writer
-import Data.List (isPrefixOf)
-import Data.List.Unique (complex)
-import qualified Data.Set as Set
-
-import Convert.Traverse
-import Language.SystemVerilog.AST
-
-type PIs = [(Identifier, PackageItem)]
-type Idents = Set.Set Identifier
-
-convert :: [AST] -> [AST]
-convert =
-    map (filter (not . isPI)) . nest
-    where
-        nest :: [AST] -> [AST]
-        nest curr =
-            if next == curr
-                then curr
-                else nest next
-            where
-                next = traverseFiles
-                    (collectDescriptionsM collectDescriptionM)
-                    (traverseDescriptions . convertDescription)
-                    curr
-        isPI :: Description -> Bool
-        isPI (PackageItem item) = piName item /= Nothing
-        isPI _ = False
-
--- collects packages items missing
-collectDescriptionM :: Description -> Writer PIs ()
-collectDescriptionM (PackageItem item) = do
-    case piName item of
-        Nothing -> return ()
-        Just ident -> tell [(ident, item)]
-collectDescriptionM _ = return ()
-
--- nests packages items missing from modules
-convertDescription :: PIs -> Description -> Description
-convertDescription pis (orig @ Part{}) =
-    Part attrs extern kw lifetime name ports items'
-    where
-        Part attrs extern kw lifetime name ports items = orig
-        existingPIs = execWriter $ collectModuleItemsM collectPIsM orig
-        runner f = execWriter $ collectModuleItemsM f orig
-        usedPIs = Set.unions $ map runner $
-            [ collectStmtsM collectSubroutinesM
-            , collectTypesM $ collectNestedTypesM collectTypenamesM
-            , collectExprsM $ collectNestedExprsM collectIdentsM
-            ]
-        neededPIs = Set.difference
-            (Set.union usedPIs $
-                Set.filter (isPrefixOf "import ") $ Set.fromList $ map fst pis)
-            existingPIs
-        uniq l = l' where (l', _, _) = complex l
-        newItems = uniq $ map MIPackageItem $ map snd $
-            filter (\(x, _) -> Set.member x neededPIs) pis
-        -- place data declarations at the beginning to obey declaration
-        -- ordering; everything else can go at the end
-        newItemsBefore = filter isDecl newItems
-        newItemsAfter = filter (not . isDecl) newItems
-        items' = newItemsBefore ++ items ++ newItemsAfter
-        isDecl (MIPackageItem (Decl{})) = True
-        isDecl _ = False
-convertDescription _ other = other
-
--- writes down the names of package items
-collectPIsM :: ModuleItem -> Writer Idents ()
-collectPIsM (MIPackageItem item) =
-    case piName item of
-        Nothing -> return ()
-        Just ident -> tell $ Set.singleton ident
-collectPIsM _ = return ()
-
--- writes down the names of subroutine invocations
-collectSubroutinesM :: Stmt -> Writer Idents ()
-collectSubroutinesM (Subroutine (Ident f) _) = tell $ Set.singleton f
-collectSubroutinesM _ = return ()
-
--- writes down the names of function calls and identifiers
-collectIdentsM :: Expr -> Writer Idents ()
-collectIdentsM (Call (Ident x) _) = tell $ Set.singleton x
-collectIdentsM (Ident x)          = tell $ Set.singleton x
-collectIdentsM _ = return ()
-
--- writes down aliased typenames
-collectTypenamesM :: Type -> Writer Idents ()
-collectTypenamesM (Alias _ x _) = tell $ Set.singleton x
-collectTypenamesM _ = return ()
-
--- returns the "name" of a package item, if it has one
-piName :: PackageItem -> Maybe Identifier
-piName (Function _ _ ident _ _) = Just ident
-piName (Task     _   ident _ _) = Just ident
-piName (Typedef    _ ident    ) = Just ident
-piName (Decl (Variable _ _ ident _ _)) = Just ident
-piName (Decl (Param    _ _ ident   _)) = Just ident
-piName (Decl (ParamType  _ ident   _)) = Just ident
-piName (Import x y) = Just $ show $ Import x y
-piName (Export    _) = Nothing
-piName (Comment   _) = Nothing
-piName (Directive _) = Nothing

src/Convert/ParamNoDefault.hs

@@ -0,0 +1,99 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for parameters without default values
+ -
+ - This conversion ensures that any parameters which don't have a default value
+ - are always given an explicit value wherever that module or interface is used.
+ -
+ - Parameters are given a fake default value if they do not have one so that the
+ - given source for that module can be consumed by downstream tools. This is not
+ - done for type parameters, as those modules are rewritten by a separate
+ - conversion. Localparams without defaults are expressly caught and forbidden.
+ -}
+
+module Convert.ParamNoDefault (convert) where
+
+import Control.Monad (when)
+import Control.Monad.Writer.Strict
+import Data.List (intercalate)
+import qualified Data.Map.Strict as Map
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+type Parts = Map.Map Identifier [(Identifier, Bool)]
+
+convert :: [Identifier] -> [AST] -> [AST]
+convert tops files =
+    flip (foldr $ ensureTopExists parts) tops $
+    map convertFile files'
+    where
+        (files', parts) = runWriter $
+            mapM (traverseDescriptionsM $ traverseDescriptionM tops) files
+        convertFile = traverseDescriptions $ traverseModuleItems $
+            traverseModuleItem parts
+
+ensureTopExists :: Parts -> Identifier -> a -> a
+ensureTopExists parts top =
+    if Map.member top parts
+        then id
+        else error $ "Could not find top module " ++ top
+
+traverseDescriptionM :: [Identifier] -> Description -> Writer Parts Description
+traverseDescriptionM tops (Part attrs extern kw lifetime name ports items) = do
+    let (items', params) = runWriter $ mapM traverseModuleItemM items
+    tell $ Map.singleton name params
+    let missing = map fst $ filter snd params
+    when (not (null tops) && elem name tops && not (null missing)) $
+        error $ "Specified top module " ++ name ++ " is missing default "
+            ++ "parameter value(s) for " ++ intercalate ", " missing
+    return $ Part attrs extern kw lifetime name ports items'
+traverseDescriptionM _ other = return other
+
+traverseModuleItemM :: ModuleItem -> Writer [(Identifier, Bool)] ModuleItem
+traverseModuleItemM (MIAttr attr item) =
+    traverseModuleItemM item >>= return . MIAttr attr
+traverseModuleItemM (MIPackageItem (Decl decl)) =
+    traverseDeclM decl >>= return . MIPackageItem . Decl
+traverseModuleItemM other = return other
+
+-- writes down the parameters for a part
+traverseDeclM :: Decl -> Writer [(Identifier, Bool)] Decl
+traverseDeclM (Param Localparam _ x Nil) =
+    error $ "localparam " ++ show x ++ " has no default value"
+traverseDeclM (Param Parameter t x e) = do
+    tell [(x, e == Nil)]
+    return $ if e == Nil
+        then Param Parameter t x $ RawNum 0
+        else Param Parameter t x e
+traverseDeclM (ParamType Localparam x UnknownType) =
+    error $ "localparam type " ++ show x ++ " has no default value"
+traverseDeclM (ParamType Parameter x t) = do
+    -- parameter types are rewritten separately, so no fake default here
+    tell [(x, t == UnknownType)]
+    return $ ParamType Parameter x t
+traverseDeclM other = return other
+
+-- check for instances missing values for parameters without defaults
+traverseModuleItem :: Parts -> ModuleItem -> ModuleItem
+traverseModuleItem parts orig@(Instance part params name _ _) =
+    if maybePartInfo == Nothing || null missingParams
+        then orig
+        else error $ "instance " ++ show name ++ " of " ++ show part
+                ++ " is missing values for parameters without defaults: "
+                ++ (intercalate " " $ map show missingParams)
+    where
+        maybePartInfo = Map.lookup part parts
+        Just partInfo = maybePartInfo
+        paramsWithNoDefault = map fst $ filter snd partInfo
+        missingParams = filter (needsDefault params) paramsWithNoDefault
+traverseModuleItem _ other = other
+
+-- whether a given parameter is unspecified in the given parameter bindings
+needsDefault :: [(Identifier, TypeOrExpr)] -> Identifier -> Bool
+needsDefault instanceParams param =
+    case lookup param instanceParams of
+        Nothing -> True
+        Just (Right Nil) -> True
+        Just _ -> False

src/Convert/ParamType.hs

@@ -6,273 +6,333 @@
 
 module Convert.ParamType (convert) where
 
-import Control.Monad.Writer
+import Control.Monad.Writer.Strict
-import Data.Either (isLeft)
+import Data.Either (isRight, lefts)
-import Data.List.Unique (complex)
-import Data.Maybe (isJust, isNothing, fromJust)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
+import Data.Monoid (Any(Any), getAny)
 
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type MaybeTypeMap = Map.Map Identifier (Maybe Type)
+type TypeMap = Map.Map Identifier Type
-type Info = Map.Map Identifier ([Identifier], MaybeTypeMap)
+type Modules = Map.Map Identifier TypeMap
 
-type Instance = Map.Map Identifier Type
+type Instance = Map.Map Identifier (Type, IdentSet)
-type Instances = [(Identifier, Instance)]
+type Instances = Map.Map String (Identifier, Instance)
 
 type IdentSet = Set.Set Identifier
+type DeclMap = Map.Map Identifier Decl
 type UsageMap = [(Identifier, Set.Set Identifier)]
 
-convert :: [AST] -> [AST]
+convert :: [Identifier] -> [AST] -> [AST]
-convert files =
+convert tops files =
     files'''
     where
-        info = execWriter $
+        modules = execWriter $
             mapM (collectDescriptionsM collectDescriptionM) files
-        (files', instancesRaw) = runWriter $ mapM
+        (files', instancesRaw) =
-            (mapM $ traverseModuleItemsM $ convertModuleItemM info) files
+            runWriter $ mapM (mapM convertDescriptionM) files
-        instances = uniq instancesRaw
+        instances = Map.elems instancesRaw
-        uniq l = l' where (l', _, _) = complex l
 
         -- add type parameter instantiations
         files'' = map (concatMap explodeDescription) files'
         explodeDescription :: Description -> [Description]
-        explodeDescription (part @ (Part _ _ _ _ name _ _)) =
+        explodeDescription part@(Part _ _ _ _ name _ _) =
-            if null theseInstances then
+            (part :) $
-                [part]
-            else
-                (:) part $
             filter (not . alreadyExists) $
-                filter isNonDefault $
             map (rewriteModule part) theseInstances
             where
                 theseInstances = map snd $ filter ((== name) . fst) instances
-                isNonDefault = (name /=) . moduleName
+                alreadyExists = flip Map.member modules . moduleName
-                alreadyExists = (flip Map.member info) . moduleName
                 moduleName :: Description -> Identifier
-                moduleName (Part _ _ _ _ x _ _) = x
+                moduleName = \(Part _ _ _ _ x _ _) -> x
-                moduleName _ = error "not possible"
         explodeDescription other = [other]
 
-        -- remove or rewrite source modules that are no longer needed
+        -- remove or reduce source modules that are no longer needed
-        files''' = map (uniq . concatMap replaceDefault) files''
+        files''' = map (map reduceTypeDefaults . filter keepDescription) files''
-        (usageMapRaw, usedTypedModulesRaw) =
+        -- produce a typed and untyped instantiation graph
-            execWriter $ mapM (mapM collectUsageInfoM) files''
+        (usedUntypedModules, usedTypedModules) =
-        usageMap = Map.unionsWith Set.union $ map (uncurry Map.singleton)
+            both (Map.fromListWith Set.union) $
-            usageMapRaw
+            execWriter $ mapM (mapM collectUsageM) files''
-        usedTypedModules = Map.unionsWith Set.union $ map (uncurry
+        collectUsageM :: Description -> Writer (UsageMap, UsageMap) ()
-            Map.singleton) usedTypedModulesRaw
+        collectUsageM part@(Part _ _ _ _ name _ _) =
-        collectUsageInfoM :: Description -> Writer (UsageMap, UsageMap) ()
+            tell $ both makeList $ execWriter $
-        collectUsageInfoM (part @ (Part _ _ _ _ name _ _)) =
+                (collectModuleItemsM collectModuleItemM) part
-            tell (makeList used, makeList usedTyped)
+            where makeList s = zip (Set.toList s) (repeat $ Set.singleton name)
-            where
+        collectUsageM _ = return ()
-                makeList s = zip (Set.toList s) (repeat $ Set.singleton name)
-                (usedUntyped, usedTyped) =
-                    execWriter $ (collectModuleItemsM collectModuleItemM) part
-                used = Set.union usedUntyped usedTyped
-        collectUsageInfoM _ = return ()
         collectModuleItemM :: ModuleItem -> Writer (IdentSet, IdentSet) ()
-        collectModuleItemM (Instance m bindings _ _ _) = do
+        collectModuleItemM (Instance m bindings _ _ _) =
-            case Map.lookup m info of
+            if all (isRight . snd) bindings
-                Nothing -> tell (Set.singleton m, Set.empty)
+                then tell (Set.singleton m, Set.empty)
-                Just (_, maybeTypeMap) ->
+                else tell (Set.empty, Set.singleton m)
-                    if any (flip Map.member maybeTypeMap) $ map fst bindings
-                        then tell (Set.empty, Set.singleton m)
-                        else tell (Set.singleton m, Set.empty)
         collectModuleItemM _ = return ()
-        replaceDefault :: Description -> [Description]
+        both f (x, y) = (f x, f y) -- simple tuple map helper
-        replaceDefault (part @ (Part _ _ _ _ name _ _)) =
-            if Map.notMember name info then
-                [part]
-            else if Map.null maybeTypeMap then
-                [part]
-            else if Map.member name usedTypedModules && isUsed name then
-                [part]
-            else if all isNothing maybeTypeMap then
-                []
-            else
-                (:) (removeDefaultTypeParams part) $
-                if isNothing typeMap
-                    then []
-                    else [rewriteModule part $ fromJust typeMap]
-            where
-                maybeTypeMap = snd $ info Map.! name
-                typeMap = defaultInstance maybeTypeMap
-        replaceDefault other = [other]
 
-        removeDefaultTypeParams :: Description -> Description
+        -- identify if a module is still in use
-        removeDefaultTypeParams (part @ Part{}) =
+        keepDescription :: Description -> Bool
-            Part attrs extern kw ml (moduleDefaultName name) p items
+        keepDescription (Part _ _ _ _ name _ _) =
+            isNewModule
+            || isntTyped && (isTopOrNoTop || isInstantiated)
+            || isUsedAsUntyped
+            || isUsedAsTyped && isInstantiatedViaNonTyped
+            || allTypesHaveDefaults && notInstantiated && isntTemplateTagged
+                && isTopOrNoTop
             where
-                Part attrs extern kw ml name p items =
+                maybeTypeMap = Map.lookup name modules
-                    traverseModuleItems (traverseDecls rewriteDecl) part
+                Just typeMap = maybeTypeMap
+                isNewModule = maybeTypeMap == Nothing
+                isntTyped = Map.null typeMap
+                isUsedAsTyped = Map.member name usedTypedModules
+                isUsedAsUntyped = Map.member name usedUntypedModules
+                isInstantiatedViaNonTyped = untypedUsageSearch $ Set.singleton name
+                allTypesHaveDefaults = all (/= UnknownType) (Map.elems typeMap)
+                notInstantiated = lookup name instances == Nothing
+                isInstantiated = not notInstantiated
+                isntTemplateTagged = not $ isTemplateTagged name
+                isTopOrNoTop = null tops || elem name tops
+        keepDescription _ = True
+
+        -- instantiate the type parameters if this is a used default instance
+        reduceTypeDefaults :: Description -> Description
+        reduceTypeDefaults part@(Part _ _ _ _ name _ _) =
+            if shouldntReduce
+                then part
+                else traverseModuleItems (traverseDecls rewriteDecl) part
+            where
+                shouldntReduce =
+                    Map.notMember name modules || Map.null typeMap ||
+                    any (== UnknownType) (Map.elems typeMap) ||
+                    isTemplateTagged name
+                typeMap = modules Map.! name
                 rewriteDecl :: Decl -> Decl
-                rewriteDecl (ParamType Parameter x _) =
+                rewriteDecl (ParamType Parameter x t) =
-                    ParamType Parameter x Nothing
+                    ParamType Localparam x t
                 rewriteDecl other = other
-        removeDefaultTypeParams _ = error "not possible"
+        reduceTypeDefaults other = other
 
-        isUsed :: Identifier -> Bool
+        -- modules can be recursive; this checks if a typed module is not
-        isUsed name =
+        -- connected to any modules which are themselves used as typed modules
-            any (flip Map.notMember usedTypedModules) used
+        untypedUsageSearch :: IdentSet -> Bool
+        untypedUsageSearch visited =
+            any (flip Map.notMember usedTypedModules) visited
+            || Set.size visited /= Set.size visited'
+                && untypedUsageSearch visited'
             where
-                used = usageSet $ expandSet name
+                visited' =
+                    Set.union visited $
+                    Set.unions $
+                    Set.map expandSet visited
                 expandSet :: Identifier -> IdentSet
                 expandSet ident =
-                    case ( Map.lookup ident usedTypedModules
+                    Map.findWithDefault Set.empty ident usedTypedModules
-                         , Map.lookup name usageMap) of
-                        (Just x, _) -> x
-                        (Nothing, Just x) -> x
-                        _ -> Set.empty
-                usageSet :: IdentSet -> IdentSet
-                usageSet names =
-                    if names' == names
-                        then names
-                        else usageSet names'
-                    where names' =
-                            Set.union names $
-                            Set.unions $
-                            Set.map expandSet names
 
         -- substitute in a particular instance's parameter types
         rewriteModule :: Description -> Instance -> Description
-        rewriteModule part typeMap =
+        rewriteModule part inst =
-            Part attrs extern kw ml m' p items'
+            Part attrs extern kw ml m' p (additionalParamItems ++ items')
             where
                 Part attrs extern kw ml m p items = part
-                m' = moduleInstanceName m typeMap
+                m' = moduleInstanceName m inst
-                items' = map rewriteDecl items
+                items' = map rewriteModuleItem items
-                rewriteDecl :: ModuleItem -> ModuleItem
+                rewriteModuleItem = traverseNestedModuleItems $ traverseNodes
-                rewriteDecl (MIPackageItem (Decl (ParamType Parameter x _))) =
+                    rewriteExpr rewriteDecl rewriteType rewriteLHS rewriteStmt
-                    MIPackageItem $ Typedef (typeMap Map.! x) x
+                rewriteDecl :: Decl -> Decl
-                rewriteDecl other = other
+                rewriteDecl (ParamType Parameter x t) =
-                -- TODO FIXME: Typedef conversion must be made to handle
+                    ParamType kind x $ rewriteType $
-                -- ParamTypes!
+                    case Map.lookup x inst of
-                -----items' = map (traverseDecls rewriteDecl) items
+                        Nothing -> t
-                -----rewriteDecl :: Decl -> Decl
+                        Just (t', _) -> t'
-                -----rewriteDecl (ParamType Parameter x _) =
+                    where kind = if Map.null inst
-                -----    ParamType Localparam x (Just $ typeMap Map.! x)
+                                    then Parameter
-                -----rewriteDecl other = other
+                                    else Localparam
+                rewriteDecl other =
+                    traverseDeclNodes rewriteType rewriteExpr other
+                additionalParamItems = concatMap makeAddedParams $
+                    Map.toList $ Map.map snd inst
+                rewriteExpr :: Expr -> Expr
+                rewriteExpr orig@(Dot (Ident x) y) =
+                    if x == m
+                        then Dot (Ident m') y
+                        else orig
+                rewriteExpr other =
+                    traverseExprTypes rewriteType $
+                    traverseSinglyNestedExprs rewriteExpr other
+                rewriteLHS :: LHS -> LHS
+                rewriteLHS orig@(LHSDot (LHSIdent x) y) =
+                    if x == m
+                        then LHSDot (LHSIdent m') y
+                        else orig
+                rewriteLHS other =
+                    traverseLHSExprs rewriteExpr $
+                    traverseSinglyNestedLHSs rewriteLHS other
+                rewriteType :: Type -> Type
+                rewriteType =
+                    traverseTypeExprs rewriteExpr .
+                    traverseSinglyNestedTypes rewriteType
+                rewriteStmt :: Stmt -> Stmt
+                rewriteStmt =
+                    traverseStmtLHSs rewriteLHS .
+                    traverseStmtExprs rewriteExpr .
+                    traverseSinglyNestedStmts rewriteStmt
+
+        makeAddedParams :: (Identifier, IdentSet) -> [ModuleItem]
+        makeAddedParams (paramName, identSet) =
+            map (MIPackageItem . Decl) $
+            map toTypeParam idents ++ map toParam idents
+            where
+                idents = Set.toList identSet
+                toParam :: Identifier -> Decl
+                toParam ident =
+                    Param Parameter typ name (RawNum 0)
+                    where
+                        typ = Alias (addedParamTypeName paramName ident) []
+                        name = addedParamName paramName ident
+                toTypeParam :: Identifier -> Decl
+                toTypeParam ident = ParamType Parameter name UnknownType
+                    where name = addedParamTypeName paramName ident
 
 -- write down module parameter names and type parameters
-collectDescriptionM :: Description -> Writer Info ()
+collectDescriptionM :: Description -> Writer Modules ()
-collectDescriptionM (part @ (Part _ _ _ _ name _ _)) =
+collectDescriptionM part@(Part _ _ _ _ name _ _) =
-    tell $ Map.singleton name (paramNames, maybeTypeMap)
+    tell $ Map.singleton name typeMap
     where
-        params = execWriter $
+        typeMap = Map.fromList $ execWriter $
             collectModuleItemsM (collectDeclsM collectDeclM) part
-        paramNames = map fst params
+        collectDeclM :: Decl -> Writer [(Identifier, Type)] ()
-        maybeTypeMap = Map.fromList $
+        collectDeclM (ParamType Parameter x v) = tell [(x, v)]
-            map (\(x, y) -> (x, fromJust y)) $
-            filter (isJust . snd) params
-        collectDeclM :: Decl -> Writer [(Identifier, Maybe (Maybe Type))] ()
-        collectDeclM (Param   Parameter _ x _) = tell [(x, Nothing)]
-        collectDeclM (ParamType Parameter x v) = tell [(x, Just v )]
         collectDeclM _ = return ()
 collectDescriptionM _ = return ()
 
--- produces the default type mapping of a module, if there is one
-defaultInstance :: MaybeTypeMap -> Maybe Instance
-defaultInstance maybeTypeMap =
-    if any isNothing maybeTypeMap
-        then Nothing
-        else Just $ Map.map fromJust maybeTypeMap
-
 -- generate a "unique" name for a particular module type instance
 moduleInstanceName :: Identifier -> Instance -> Identifier
-moduleInstanceName m inst = m ++ "_" ++ shortHash (m, inst)
+moduleInstanceName (TemplateTag m) inst =
+    moduleInstanceName m inst
+moduleInstanceName m inst =
+    if Map.null inst
+        then TemplateTag m
+        else m ++ "_" ++ shortHash (m, inst)
 
--- name for the module without any default type parameters
+-- used to tag modules created for delayed type parameter instantiation
-moduleDefaultName :: Identifier -> Identifier
+pattern TemplateTag :: Identifier -> Identifier
-moduleDefaultName m = m ++ defaultTag
+pattern TemplateTag x = '~' : x
-isDefaultName :: Identifier -> Bool
+isTemplateTagged :: Identifier -> Bool
-isDefaultName m =
+isTemplateTagged TemplateTag{} = True
-    defaultTag == (reverse $ (take $ length defaultTag) $ reverse m)
+isTemplateTagged _ = False
-defaultTag :: Identifier
-defaultTag = "_sv2v_default"
-
--- attempt to convert an expression to syntactically equivalent type
-exprToType :: Expr -> Maybe Type
-exprToType (Ident x) = Just $ Alias Nothing x []
-exprToType (PSIdent x y) = Just $ Alias (Just x) y []
-exprToType (Range e NonIndexed r) =
-    case exprToType e of
-        Nothing -> Nothing
-        Just t -> Just $ tf (rs ++ [r])
-            where (tf, rs) = typeRanges t
-exprToType (Bit e i) =
-    case exprToType e of
-        Nothing -> Nothing
-        Just t -> Just $ tf (rs ++ [r])
-            where
-                (tf, rs) = typeRanges t
-                r = (simplify $ BinOp Sub i (Number "1"), Number "0")
-exprToType _ = Nothing
 
 -- checks where a type is sufficiently resolved to be substituted
--- TODO: If a type parameter contains an expression, that expression should be
--- substituted into the new module, or created as a new parameter.
 isSimpleType :: Type -> Bool
-isSimpleType (IntegerVector _ _ _) = True
+isSimpleType typ =
-isSimpleType (IntegerAtom   _ _  ) = True
+    (not $ typeIsUnresolved typ) &&
-isSimpleType (NonInteger    _    ) = True
+    case typ of
-isSimpleType (Net           _ _ _) = True
+        IntegerVector{} -> True
-isSimpleType _ = False
+        IntegerAtom  {} -> True
+        NonInteger   {} -> True
+        Implicit     {} -> True
+        Struct _ fields _ -> all (isSimpleType . fst) fields
+        Union  _ fields _ -> all (isSimpleType . fst) fields
+        _ -> False
+
+-- returns whether a top-level type contains any dimension queries or
+-- hierarchical references
+typeIsUnresolved :: Type -> Bool
+typeIsUnresolved =
+    getAny . execWriter . collectTypeExprsM
+    (collectNestedExprsM collectUnresolvedExprM)
+    where
+        collectUnresolvedExprM :: Expr -> Writer Any ()
+        collectUnresolvedExprM DimsFn {} = tell $ Any True
+        collectUnresolvedExprM DimFn  {} = tell $ Any True
+        collectUnresolvedExprM Dot    {} = tell $ Any True
+        collectUnresolvedExprM _ = return ()
+
+prepareTypeExprs :: Identifier -> Identifier -> Type -> (Type, (IdentSet, DeclMap))
+prepareTypeExprs instanceName paramName =
+    runWriter . traverseNestedTypesM
+        (traverseTypeExprsM $ traverseNestedExprsM prepareExpr)
+    where
+        prepareExpr :: Expr -> Writer (IdentSet, DeclMap) Expr
+        prepareExpr e@Call{} = do
+            tell (Set.empty, Map.singleton x decl)
+            prepareExpr $ Ident x
+            where
+                decl = Param Localparam (TypeOf e) x e
+                x = instanceName ++ "_sv2v_pfunc_" ++ shortHash e
+        prepareExpr (Ident x) = do
+            tell (Set.singleton x, Map.empty)
+            return $ Ident $ paramName ++ '_' : x
+        prepareExpr other = return other
+
+addedParamName :: Identifier -> Identifier -> Identifier
+addedParamName paramName var = paramName ++ '_' : var
+
+addedParamTypeName :: Identifier -> Identifier -> Identifier
+addedParamTypeName paramName var = paramName ++ '_' : var ++ "_type"
+
+convertDescriptionM :: Description -> Writer Instances Description
+convertDescriptionM (Part attrs extern kw liftetime name ports items) =
+    mapM convertModuleItemM items >>=
+        return . Part attrs extern kw liftetime name ports
+convertDescriptionM other = return other
+
+convertGenItemM :: GenItem -> Writer Instances GenItem
+convertGenItemM (GenModuleItem item) =
+    convertModuleItemM item >>= return . GenModuleItem
+convertGenItemM other =
+    traverseSinglyNestedGenItemsM convertGenItemM other
 
 -- attempt to rewrite instantiations with type parameters
-convertModuleItemM :: Info -> ModuleItem -> Writer Instances ModuleItem
+convertModuleItemM :: ModuleItem -> Writer Instances ModuleItem
-convertModuleItemM info (orig @ (Instance m bindings x r p)) =
+convertModuleItemM orig@(Instance m bindings x r p) =
-    if Map.notMember m info then
+    if hasOnlyExprs then
         return orig
-    else if Map.null maybeTypeMap then
+    else if not hasUnresolvedTypes then do
-        return $ Instance m bindingsNamed x r p
-    else if any (isLeft . snd) bindings' then
-        error $ "param type resolution left type params: " ++ show orig
-            ++ " converted to: " ++ show bindings'
-    else if any (not . isSimpleType) resolvedTypes then do
-        let defaults = Map.map Left resolvedTypes
-        let bindingsDefaulted = Map.toList $ Map.union bindingsMap defaults
-        if isDefaultName m
-            then return $ Instance m bindingsNamed x r p
-            else return $ Instance (moduleDefaultName m) bindingsDefaulted x r p
-    else do
-        tell [(m, resolvedTypes)]
         let m' = moduleInstanceName m resolvedTypes
-        return $ Instance m' bindings' x r p
+        tell $ Map.singleton m' (m, resolvedTypes)
+        return $ Generate $ map GenModuleItem $
+            map (MIPackageItem . Decl) addedDecls ++
+            [Instance m' (additionalBindings ++ exprBindings) x r p]
+    else if isTemplateTagged m then
+        return orig
+    else do
+        let m' = TemplateTag m
+        tell $ Map.singleton m' (m, Map.empty)
+        return $ Instance m' bindings x r p
     where
-        (paramNames, maybeTypeMap) = info Map.! m
+        hasOnlyExprs = all (isRight . snd) bindings
-        -- attach names to unnamed parameters
+        hasUnresolvedTypes = any (not . isSimpleType) (lefts $ map snd bindings)
-        bindingsNamed =
+
-            if all (== "") (map fst bindings) then
-                zip paramNames (map snd bindings)
-            else if any (== "") (map fst bindings) then
-                error $ "instance has a mix of named and unnamed params: "
-                    ++ show orig
-            else bindings
         -- determine the types corresponding to each type parameter
-        bindingsMap = Map.fromList bindingsNamed
+        bindingsMap = Map.fromList bindings
-        resolvedTypes = Map.mapWithKey resolveType maybeTypeMap
+        resolvedTypesWithDecls = Map.mapMaybeWithKey resolveType bindingsMap
-        resolveType :: Identifier -> Maybe Type -> Type
+        resolvedTypes = Map.map (\(a, (b, _)) -> (a, b)) resolvedTypesWithDecls
-        resolveType paramName defaultType =
+        addedDecls = Map.elems $ Map.unions $ map (snd . snd) $
-            case (Map.lookup paramName bindingsMap, defaultType) of
+            Map.elems resolvedTypesWithDecls
-                (Nothing, Just t) -> t
+        resolveType :: Identifier -> TypeOrExpr -> Maybe (Type, (IdentSet, DeclMap))
-                (Nothing, Nothing) ->
+        resolveType _ Right{} = Nothing
-                    error $ "instantiation " ++ show orig ++
+        resolveType paramName (Left t) =
-                        " is missing a type parameter: " ++ paramName
+            Just $ prepareTypeExprs x paramName t
-                (Just (Left t), _) -> t
-                (Just (Right e), _) ->
-                    -- Some types are parsed as expressions because of the
-                    -- ambiguities of defined type names.
-                    case exprToType e of
-                        Just t -> t
-                        Nothing ->
-                            error $ "instantiation " ++ show orig
-                                ++ " has expr " ++ show e
-                                ++ " for type param: " ++ paramName
 
         -- leave only the normal expression params behind
-        isParamType = flip Map.member maybeTypeMap
+        exprBindings = filter (isRight . snd) bindings
-        bindings' = filter (not . isParamType . fst) bindingsNamed
+
-convertModuleItemM _ other = return other
+        -- create additional parameters needed to specify existing type params
+        additionalBindings = concatMap makeAddedParams $
+            Map.toList $ Map.map snd resolvedTypes
+        makeAddedParams :: (Identifier, IdentSet) -> [ParamBinding]
+        makeAddedParams (paramName, identSet) =
+            map toTypeParam idents ++ map toParam idents
+            where
+                idents = Set.toList identSet
+                toParam :: Identifier -> ParamBinding
+                toParam ident =
+                    (addedParamName paramName ident, Right $ Ident ident)
+                toTypeParam :: Identifier -> ParamBinding
+                toTypeParam ident =
+                    (addedParamTypeName paramName ident, Left $ TypeOf $ Ident ident)
+
+convertModuleItemM (Generate items) =
+    mapM convertGenItemM items >>= return . Generate
+convertModuleItemM (MIAttr attr item) =
+    convertModuleItemM item >>= return . MIAttr attr
+convertModuleItemM other = return other

src/Convert/PortDecl.hs

@@ -0,0 +1,150 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for checking and standardizing port declarations
+ -
+ - Non-ANSI style port declarations can be split into two separate declarations.
+ - Section 23.2.2.1 of IEEE 1800-2017 defines rules for determining the
+ - resulting details of such declarations. This conversion is part of the
+ - initial phases to avoid requiring that downstream conversions handle these
+ - unusual otherwise conflicting declarations.
+ -
+ - To avoid creating spurious conflicts for redeclared ports, this conversion is
+ - also responsible for defaulting variable ports to `logic`.
+ -}
+
+module Convert.PortDecl (convert) where
+
+import Data.List (intercalate, (\\))
+import Data.Maybe (mapMaybe)
+
+import Convert.ExprUtils (simplifyDimensions)
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+convert :: [AST] -> [AST]
+convert = map $ traverseDescriptions traverseDescription
+
+traverseDescription :: Description -> Description
+traverseDescription (Part attrs extern kw liftetime name ports items) =
+    Part attrs extern kw liftetime name ports items'
+    where items' = convertPorts name ports items
+traverseDescription (PackageItem item) =
+    PackageItem $ convertPackageItem item
+traverseDescription other = other
+
+convertPackageItem :: PackageItem -> PackageItem
+convertPackageItem (Function l t x decls stmts) =
+    Function l t x (convertTFDecls decls) stmts
+convertPackageItem (Task l x decls stmts) =
+    Task l x (convertTFDecls decls) stmts
+convertPackageItem other = other
+
+convertPorts :: Identifier -> [Identifier] -> [ModuleItem] -> [ModuleItem]
+convertPorts name ports items
+    | not (null name) && not (null extraPorts) =
+        error $ "declared ports " ++ intercalate ", " extraPorts
+            ++ " are not in the port list of " ++ name
+    | otherwise =
+        map traverseItem items
+    where
+        portDecls = mapMaybe (findDecl True ) items
+        dataDecls = mapMaybe (findDecl False) items
+        extraPorts = map fst portDecls \\ ports
+
+        -- rewrite a declaration if necessary
+        traverseItem :: ModuleItem -> ModuleItem
+        traverseItem (MIPackageItem (Decl decl))
+            | Variable d _ x _ e <- decl = rewrite decl (combineIdent x) d x e
+            | Net  d _ _ _ x _ e <- decl = rewrite decl (combineIdent x) d x e
+            | otherwise = MIPackageItem $ Decl decl
+        traverseItem (MIPackageItem item) =
+            MIPackageItem $ convertPackageItem item
+        traverseItem other = other
+
+        -- produce the combined declaration for a port, if it has one
+        combineIdent :: Identifier -> Maybe Decl
+        combineIdent x = do
+            portDecl <- lookup x portDecls
+            dataDecl <- lookup x dataDecls
+            Just $ combineDecls portDecl dataDecl
+
+-- wrapper for convertPorts enabling its application to task or function decls
+convertTFDecls :: [Decl] -> [Decl]
+convertTFDecls =
+    map unwrap . convertPorts "" [] . map wrap
+    where
+        wrap :: Decl -> ModuleItem
+        wrap = MIPackageItem . Decl
+        unwrap :: ModuleItem -> Decl
+        unwrap item = decl
+            where MIPackageItem (Decl decl) = item
+
+-- given helpfully extracted information, update the given declaration
+rewrite :: Decl -> Maybe Decl -> Direction -> Identifier -> Expr -> ModuleItem
+-- implicitly-typed output ports default to `logic` in SystemVerilog
+rewrite (Variable Output (Implicit sg rs) x a e) Nothing _ _ _ =
+    MIPackageItem $ Decl $ Variable Output (IntegerVector TLogic sg rs) x a e
+-- not a relevant port declaration
+rewrite decl Nothing _ _ _ =
+    MIPackageItem $ Decl decl
+-- turn the non-ANSI style port and data declarations into fully-specified ports
+-- and optional continuous assignments, respectively
+rewrite _ (Just combined) d x e
+    | d /= Local =
+        MIPackageItem $ Decl combined
+    | e /= Nil =
+        Assign AssignOptionNone (LHSIdent x) e
+    | otherwise =
+        MIPackageItem $ Decl $ CommentDecl $ "combined with " ++ x
+
+-- combine the two declarations defining a non-ANSI style port
+combineDecls :: Decl -> Decl -> Decl
+combineDecls portDecl dataDecl
+    | eP /= Nil =
+        mismatch "invalid initialization at port declaration"
+    | simplifyDimensions aP /= simplifyDimensions aD =
+        mismatch "different unpacked dimensions"
+    | simplifyDimensions rsP /= simplifyDimensions rsD =
+        mismatch "different packed dimensions"
+    | otherwise =
+        base (tf rsD) ident aD Nil
+    where
+
+        -- signed if *either* declaration is marked signed
+        sg = if sgP == Signed || sgD == Signed
+            then Signed
+            else Unspecified
+
+        -- the port cannot have a variable or net type
+        Implicit sgP rsP = case tP of
+            Implicit{} -> tP
+            _ -> mismatch "redeclaration"
+
+        -- pull out the base type, signedness, and packed dimensions
+        (tf, sgD, rsD) = case tD of
+            Implicit        s r -> (IntegerVector TLogic sg, s, r )
+            IntegerVector k s r -> (IntegerVector k      sg, s, r )
+            IntegerAtom   k s   -> (\[] -> IntegerAtom k s , s, [])
+            -- TODO: other basic types may be worth supporting here
+            _ -> mismatch "non-ANSI port declaration with unsupported data type"
+
+        -- extract the core components of each declaration
+        Variable dir tP ident aP eP = portDecl
+        (base, tD, aD) = case dataDecl of
+            Variable Local t _ a _ -> (Variable dir, t, a)
+            Net  Local n s t _ a _ -> (Net  dir n s, t, a)
+            _ -> undefined -- not possible given findDecl
+
+        -- helpful error message utility
+        mismatch :: String -> a
+        mismatch msg = error $ "declarations `" ++ p portDecl ++ "` and `"
+            ++ p dataDecl ++ "` are incompatible due to " ++ msg
+            where p = init . show
+
+-- used to build independent lists of port and data declarations
+findDecl :: Bool -> ModuleItem -> Maybe (Identifier, Decl)
+findDecl isPort (MIPackageItem (Decl decl))
+    | Variable d _ x _ _ <- decl, (d /= Local) == isPort = Just (x, decl)
+    | Net  d _ _ _ x _ _ <- decl, (d /= Local) == isPort = Just (x, decl)
+findDecl _ _ = Nothing

src/Convert/PortDefault.hs

@@ -0,0 +1,92 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for input ports with default values
+ -
+ - The default values are permitted to depend on complex constants declared
+ - within the instantiated module. The relevant constants are copied into the
+ - site of the instantiation.
+ -}
+
+module Convert.PortDefault (convert) where
+
+import Control.Monad.Writer.Strict
+import Data.Functor ((<&>))
+import qualified Data.Map.Strict as Map
+import Data.Maybe (isNothing)
+
+import Convert.Traverse
+import Convert.UnbasedUnsized (inlineConstants)
+import Language.SystemVerilog.AST
+
+type Part = ([ModuleItem], [PortDefault])
+type Parts = Map.Map Identifier Part
+type PortDefault = (Identifier, Decl)
+
+convert :: [AST] -> [AST]
+convert files =
+    map (traverseDescriptions convertDescription) files'
+    where
+        (files', parts) = runWriter $
+            mapM (traverseDescriptionsM preparePart) files
+        convertDescription = traverseModuleItems $ convertModuleItem parts
+
+-- remove and record input ports with defaults
+preparePart :: Description -> Writer Parts Description
+preparePart description@(Part att ext kw lif name ports items) =
+    if null portDefaults
+        then return description
+        else do
+            tell $ Map.singleton name (items, portDefaults)
+            return $ Part att ext kw lif name ports items'
+    where
+        (items', portDefaults) = runWriter $
+            mapM (traverseNestedModuleItemsM prepareModuleItem) items
+preparePart other = return other
+
+prepareModuleItem :: ModuleItem -> Writer [PortDefault] ModuleItem
+prepareModuleItem (MIPackageItem (Decl decl)) =
+    prepareDecl decl <&> MIPackageItem . Decl
+prepareModuleItem other = return other
+
+prepareDecl :: Decl -> Writer [PortDefault] Decl
+prepareDecl (Variable Input t x [] e) | e /= Nil =
+    preparePortDefault t x e >> return (Variable Input t x [] Nil)
+prepareDecl (Net Input n s t x [] e) | e /= Nil =
+    preparePortDefault t x e >> return (Net Input n s t x [] Nil)
+prepareDecl other = return other
+
+preparePortDefault :: Type -> Identifier -> Expr -> Writer [PortDefault] ()
+preparePortDefault t x e = tell [(x, decl)]
+    where
+        decl = Param Localparam t' x e
+        t' = case t of
+            Implicit sg [] -> Implicit sg [(RawNum 0, RawNum 0)]
+            _ -> t
+
+-- add default port bindings to module instances that need them
+convertModuleItem :: Parts -> ModuleItem -> ModuleItem
+convertModuleItem parts (Instance moduleName params instanceName ds bindings) =
+    if isNothing maybePart || null neededDecls
+        then instanceBase bindings
+        else Generate $ map GenModuleItem $
+                stubItems ++ [instanceBase $ neededBindings ++ bindings]
+    where
+        instanceBase = Instance moduleName params instanceName ds
+        maybePart = Map.lookup moduleName parts
+        Just (moduleItems, portDefaults) = maybePart
+
+        -- determine which defaulted ports are unbound
+        (neededBindings, neededDecls) = unzip
+            [ ( (port, Ident $ blockName ++ '_' : port)
+              , MIPackageItem $ Decl decl
+              )
+            | (port, decl) <- portDefaults
+            , isNothing (lookup port bindings)
+            ]
+
+        -- inline and prefix the declarations used by the defaults
+        stubItems = inlineConstants blockName params moduleItems neededDecls
+        blockName = "sv2v_pd_" ++ instanceName
+
+convertModuleItem _ other = other

src/Convert/RemoveComments.hs

@@ -15,12 +15,52 @@ convert = map convertFile
 convertFile :: AST -> AST
 convertFile =
     traverseDescriptions (traverseModuleItems convertModuleItem) .
-    filter (not . isComment)
+    filter (not . isTopLevelComment)
 
-isComment :: Description -> Bool
+isTopLevelComment :: Description -> Bool
-isComment (PackageItem (Comment _)) = True
+isTopLevelComment (PackageItem (Decl CommentDecl{})) = True
-isComment _ = False
+isTopLevelComment _ = False
 
 convertModuleItem :: ModuleItem -> ModuleItem
-convertModuleItem (MIPackageItem (Comment _)) = Generate []
+convertModuleItem (MIPackageItem (Decl CommentDecl{})) = Generate []
-convertModuleItem other = other
+convertModuleItem (MIPackageItem item) =
+    MIPackageItem $ convertPackageItem item
+convertModuleItem other =
+    traverseStmts (traverseNestedStmts convertStmt) other
+
+convertPackageItem :: PackageItem -> PackageItem
+convertPackageItem (Function l t x decls stmts) =
+    Function l t x decls' stmts'
+    where
+        decls' = convertDecls decls
+        stmts' = convertStmts stmts
+convertPackageItem (Task     l   x decls stmts) =
+    Task     l   x decls' stmts'
+    where
+        decls' = convertDecls decls
+        stmts' = convertStmts stmts
+convertPackageItem (DPIImport spec prop alias typ name decls) =
+    DPIImport spec prop alias typ name decls'
+    where decls' = convertDecls decls
+convertPackageItem other = other
+
+convertStmt :: Stmt -> Stmt
+convertStmt (CommentStmt _) = Null
+convertStmt (Block kw name decls stmts) =
+    Block kw name decls' stmts'
+    where
+        decls' = convertDecls decls
+        stmts' = filter (/= Null) stmts
+convertStmt other = other
+
+convertDecls :: [Decl] -> [Decl]
+convertDecls = filter (not . isCommentDecl)
+    where
+        isCommentDecl :: Decl -> Bool
+        isCommentDecl CommentDecl{} = True
+        isCommentDecl _ = False
+
+convertStmts :: [Stmt] -> [Stmt]
+convertStmts =
+    filter (/= Null) .
+    map (traverseNestedStmts convertStmt)

src/Convert/ResolveBindings.hs

@@ -0,0 +1,145 @@
+{-# LANGUAGE FlexibleInstances #-}
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for `.*` and unnamed bindings
+ -
+ - While positional bindings need not be converted, resolving them here
+ - simplifies downstream conversions. This conversion is also responsible for
+ - performing some basic validation and resolving the ambiguity between types
+ - and expressions in parameter binding contexts.
+ -}
+
+module Convert.ResolveBindings
+    ( convert
+    , resolveBindings
+    ) where
+
+import Control.Monad.Writer.Strict
+import Data.List (intercalate, (\\))
+import Data.Maybe (isNothing)
+import qualified Data.Map.Strict as Map
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+data PartInfo = PartInfo PartKW [(Identifier, Bool)] [Identifier]
+type Parts = Map.Map Identifier PartInfo
+
+convert :: [AST] -> [AST]
+convert =
+    traverseFiles
+        (collectDescriptionsM collectPartsM)
+        (traverseDescriptions . traverseModuleItems . mapInstance)
+
+collectPartsM :: Description -> Writer Parts ()
+collectPartsM (Part _ _ kw _ name ports items) =
+    tell $ Map.singleton name $ PartInfo kw params ports
+    where params = parameterInfos items
+collectPartsM _ = return ()
+
+-- given a list of module items, produces the parameters in order
+parameterInfos :: [ModuleItem] -> [(Identifier, Bool)]
+parameterInfos =
+    execWriter . mapM (collectNestedModuleItemsM $ collectDeclsM collectDeclM)
+    where
+        collectDeclM :: Decl -> Writer [(Identifier, Bool)] ()
+        collectDeclM (Param Parameter   _ x _) = tell [(x, False)]
+        collectDeclM (ParamType Parameter x _) = tell [(x, True)]
+        collectDeclM _ = return ()
+
+mapInstance :: Parts -> ModuleItem -> ModuleItem
+mapInstance parts (Instance m paramBindings x rs portBindings) =
+    -- if we can't find it, just skip :(
+    if isNothing maybePartInfo
+        then Instance m paramBindings x rs portBindings
+        else Instance m paramBindings' x rs portBindings'
+    where
+        maybePartInfo = Map.lookup m parts
+        Just (PartInfo kw paramInfos portNames) = maybePartInfo
+        paramNames = map fst paramInfos
+
+        msg :: String -> String
+        msg = flip (++) $ " in instance " ++ show x ++ " of " ++ show kw ++ " "
+            ++ show m
+
+        paramBindings' = map checkParam $
+            resolveBindings (msg "parameter overrides") paramNames paramBindings
+        portBindings' = resolveBindings (msg "port connections") portNames $
+            concatMap expandStar $
+            -- drop the trailing comma in positional port bindings
+            if length portNames + 1 == length portBindings
+                && last portBindings == ("", Nil)
+                then init portBindings
+                else portBindings
+
+        expandStar :: PortBinding -> [PortBinding]
+        expandStar ("*", Nil) =
+            map (\port -> (port, Ident port)) $
+            filter (flip notElem alreadyBound) portNames
+            where alreadyBound = map fst portBindings
+        expandStar other = [other]
+
+        -- ensures parameter and binding kinds (type vs. expr) match
+        checkParam :: ParamBinding -> ParamBinding
+        checkParam (paramName, Right e) =
+            (paramName, ) $
+            if isType
+                then case exprToType e of
+                    Nothing -> kindMismatch paramName "a type" "expression" e
+                    Just t -> Left t
+                else Right e
+            where Just isType = lookup paramName paramInfos
+        checkParam (paramName, Left t) =
+            if isType
+                then (paramName, Left t)
+                else kindMismatch paramName "an expression" "type" t
+            where Just isType = lookup paramName paramInfos
+
+        kindMismatch :: Show k => Identifier -> String -> String -> k -> a
+        kindMismatch paramName expected actual value =
+            error $ msg ("parameter " ++ show paramName)
+                ++ " expects " ++ expected
+                ++ ", but was given " ++ actual
+                ++ ' ' : show value
+
+mapInstance _ other = other
+
+class BindingArg k where
+    showBinding :: k -> String
+
+instance BindingArg TypeOrExpr where
+    showBinding = either show show
+
+instance BindingArg Expr where
+    showBinding = show
+
+type Binding t = (Identifier, t)
+-- give a set of bindings explicit names
+resolveBindings
+    :: BindingArg t => String -> [Identifier] -> [Binding t] -> [Binding t]
+resolveBindings _ _ [] = []
+resolveBindings location available bindings@(("", _) : _) =
+    if length available < length bindings then
+        error $ "too many bindings specified for " ++ location ++ ": "
+            ++ describeList "specified" (map (showBinding . snd) bindings)
+            ++ ", but only " ++ describeList "available" (map show available)
+    else
+        zip available $ map snd bindings
+resolveBindings location available bindings =
+    if not $ null unknowns then
+        error $ "unknown binding" ++ unknownsPlural ++ " "
+            ++ unknownsStr ++ " specified for " ++ location ++ ", "
+            ++ describeList "available" (map show available)
+    else
+        bindings
+    where
+        unknowns = map fst bindings \\ available
+        unknownsPlural = if length unknowns == 1 then "" else "s"
+        unknownsStr = intercalate ", " $ map show unknowns
+
+describeList :: String -> [String] -> String
+describeList desc [] = "0 " ++ desc
+describeList desc xs =
+    show (length xs) ++ " " ++ desc ++ " (" ++ xsStr ++ ")"
+    where xsStr = intercalate ", " xs

src/Convert/Scoper.hs

@@ -0,0 +1,681 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleInstances #-}
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Standardized scope traversal utilities
+ -
+ - This module provides a series of "scopers" which track the scope of blocks,
+ - generate loops, tasks, and functions, and provides the ability to insert and
+ - lookup elements in a scope-aware way. It also provides the ability to check
+ - whether the current node is within a procedural context.
+ -
+ - The interfaces take in a mappers for each of: Decl, ModuleItem, GenItem, and
+ - Stmt. Note that Function, Task, Always, Initial, and Final are NOT passed
+ - through the ModuleItem mapper as those constructs only provide Stmts and
+ - Decls. For the same reason, Decl ModuleItems are not passed through the
+ - ModuleItem mapper.
+ -
+ - All of the mappers should not recursively traverse any of the items captured
+ - by any of the other mappers. Scope resolution enforces data declaration
+ - ordering.
+ -}
+
+module Convert.Scoper
+    ( Scoper
+    , ScoperT
+    , evalScoper
+    , evalScoperT
+    , runScoper
+    , runScoperT
+    , partScoper
+    , scopeModuleItem
+    , scopeModuleItems
+    , scopePart
+    , scopeModule
+    , accessesToExpr
+    , replaceInType
+    , replaceInExpr
+    , scopeExpr
+    , scopeType
+    , scopeExprWithScopes
+    , scopeTypeWithScopes
+    , insertElem
+    , removeElem
+    , injectItem
+    , injectTopItem
+    , injectDecl
+    , lookupElem
+    , lookupElemM
+    , localAccesses
+    , localAccessesM
+    , Access(..)
+    , ScopeKey
+    , Scopes
+    , extractMapping
+    , embedScopes
+    , withinProcedure
+    , withinProcedureM
+    , procedureLoc
+    , procedureLocM
+    , sourceLocation
+    , sourceLocationM
+    , hierarchyPath
+    , hierarchyPathM
+    , scopedError
+    , scopedErrorM
+    , isLoopVar
+    , isLoopVarM
+    , loopVarDepth
+    , loopVarDepthM
+    , lookupLocalIdent
+    , lookupLocalIdentM
+    , Replacements
+    , LookupResult
+    ) where
+
+import Control.Monad (join, when)
+import Control.Monad.State.Strict
+import Data.Functor ((<&>))
+import Data.List (findIndices, intercalate, isPrefixOf, partition)
+import Data.Maybe (isNothing)
+import qualified Data.Map.Strict as Map
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+-- user monad aliases
+type Scoper a = State (Scopes a)
+type ScoperT a m = StateT (Scopes a) m
+
+-- one tier of scope construction
+data Tier = Tier
+    { tierName :: Identifier
+    , tierIndex :: Identifier
+    } deriving (Eq, Show)
+
+-- one layer of scope inspection
+data Access = Access
+    { accessName :: Identifier
+    , accessIndex :: Expr
+    } deriving (Eq, Show)
+
+type Mapping a = Map.Map Identifier (Entry a)
+
+data Entry a = Entry
+    { eElement :: Maybe a
+    , eIndex :: Identifier
+    , eMapping :: Mapping a
+    } deriving Show
+
+data Scopes a = Scopes
+    { sCurrent :: [Tier]
+    , sMapping :: Mapping a
+    , sProcedureLoc :: [Access]
+    , sInjectedItems :: [(Bool, ModuleItem)]
+    , sInjectedDecls :: [Decl]
+    , sLatestTrace :: String
+    } deriving Show
+
+extractMapping :: Scopes a -> Map.Map Identifier a
+extractMapping =
+    Map.mapMaybe eElement .
+    eMapping . snd .
+    Map.findMin . sMapping
+
+embedScopes :: Monad m => (Scopes a -> b -> c) -> b -> ScoperT a m c
+embedScopes func x = do
+    scopes <- get
+    return $ func scopes x
+
+setScope :: [Tier] -> Entry a -> Mapping a -> Mapping a
+setScope [] _ = error "setScope invariant violated"
+setScope [Tier name _] newEntry =
+    Map.insert name newEntry
+setScope (Tier name _ : tiers) newEntry =
+    Map.adjust adjustment name
+    where
+        adjustment entry =
+            entry { eMapping = setScope tiers newEntry (eMapping entry) }
+
+enterScope :: Monad m => Identifier -> Identifier -> ScoperT a m ()
+enterScope name index = do
+    s <- get
+    let current' = sCurrent s ++ [Tier name index]
+    let existingResult = lookupLocalIdent s name
+    let existingElement = fmap thd3 existingResult
+    let entry = Entry existingElement index Map.empty
+    let mapping' = setScope current' entry $ sMapping s
+    put $ s { sCurrent = current', sMapping = mapping'}
+    where thd3 (_, _, c) = c
+
+exitScope :: Monad m => ScoperT a m ()
+exitScope = modify' $ \s -> s { sCurrent = init $ sCurrent s }
+
+enterProcedure :: Monad m => ScoperT a m ()
+enterProcedure = modify' $ \s -> s { sProcedureLoc = map toAccess (sCurrent s) }
+
+exitProcedure :: Monad m => ScoperT a m ()
+exitProcedure = modify' $ \s -> s { sProcedureLoc = [] }
+
+exprToAccesses :: [Access] -> Expr -> Maybe [Access]
+exprToAccesses accesses (Ident x) =
+    Just $ Access x Nil : accesses
+exprToAccesses accesses (Bit (Ident x) y) =
+    Just $ Access x y : accesses
+exprToAccesses accesses (Bit (Dot e x) y) =
+    exprToAccesses (Access x y : accesses) e
+exprToAccesses accesses (Dot e x) =
+    exprToAccesses (Access x Nil : accesses) e
+exprToAccesses _ _ = Nothing
+
+accessesToExpr :: [Access] -> Expr
+accessesToExpr accesses =
+    foldl accessToExpr (Ident topName) rest
+    where Access topName Nil : rest = accesses
+
+accessToExpr :: Expr -> Access -> Expr
+accessToExpr e (Access x Nil) = Dot e x
+accessToExpr e (Access x i) = Bit (Dot e x) i
+
+replaceInType :: Replacements -> Type -> Type
+replaceInType replacements =
+    if Map.null replacements
+        then id
+        else replaceInType' replacements
+
+replaceInType' :: Replacements -> Type -> Type
+replaceInType' replacements =
+    traverseNestedTypes $ traverseTypeExprs $ replaceInExpr' replacements
+
+replaceInExpr :: Replacements -> Expr -> Expr
+replaceInExpr replacements =
+    if Map.null replacements
+        then id
+        else replaceInExpr' replacements
+
+replaceInExpr' :: Replacements -> Expr -> Expr
+replaceInExpr' replacements (Ident x) =
+    Map.findWithDefault (Ident x) x replacements
+replaceInExpr' replacements other =
+    traverseExprTypes (replaceInType' replacements) $
+    traverseSinglyNestedExprs (replaceInExpr' replacements) other
+
+-- rewrite an expression so that any identifiers it contains unambiguously refer
+-- refer to currently visible declarations so it can be substituted elsewhere
+scopeExpr :: Monad m => Expr -> ScoperT a m Expr
+scopeExpr expr = do
+    details <- lookupElemM expr
+    case details of
+        Just (accesses, replacements, _) ->
+            mapM (scopeResolvedAccess replacements) accesses <&> accessesToExpr
+        _ -> traverseSinglyNestedExprsM scopeExpr expr
+                >>= traverseExprTypesM scopeType
+scopeType :: Monad m => Type -> ScoperT a m Type
+scopeType = traverseNestedTypesM $ traverseTypeExprsM scopeExpr
+
+{-# INLINABLE scopeExpr #-}
+{-# INLINABLE scopeType #-}
+
+scopeResolvedAccess :: Monad m => Replacements -> Access -> ScoperT a m Access
+scopeResolvedAccess _ access@(Access _ Nil) = return access
+scopeResolvedAccess replacements access@(Access _ (Ident index))
+    | Map.member index replacements = return access
+scopeResolvedAccess _ (Access name expr) = scopeExpr expr <&> Access name
+
+scopeExprWithScopes :: Scopes a -> Expr -> Expr
+scopeExprWithScopes scopes = flip evalState scopes . scopeExpr
+
+scopeTypeWithScopes :: Scopes a -> Type -> Type
+scopeTypeWithScopes scopes = flip evalState scopes . scopeType
+
+class ScopePath k where
+    toTiers :: Scopes a -> k -> [Tier]
+
+instance ScopePath Identifier where
+    toTiers scopes name = sCurrent scopes ++ [Tier name ""]
+
+instance ScopePath [Access] where
+    toTiers _ = map toTier
+        where
+            toTier :: Access -> Tier
+            toTier (Access x Nil) = Tier x ""
+            toTier (Access x iy) = Tier x y
+                where Ident y = iy
+
+insertElem :: Monad m => ScopePath k => k -> a -> ScoperT a m ()
+insertElem key = setElem key . Just
+
+removeElem :: Monad m => ScopePath k => k -> ScoperT a m ()
+removeElem key = setElem key Nothing
+
+setElem :: Monad m => ScopePath k => k -> Maybe a -> ScoperT a m ()
+setElem key maybeElement = do
+    s <- get
+    let mapping = sMapping s
+    let entry = Entry maybeElement "" Map.empty
+    let mapping' = setScope (toTiers s key) entry mapping
+    put $ s { sMapping = mapping' }
+
+injectItem :: Monad m => ModuleItem -> ScoperT a m ()
+injectItem item =
+    modify' $ \s -> s { sInjectedItems = (True, item) : sInjectedItems s }
+
+injectTopItem :: Monad m => ModuleItem -> ScoperT a m ()
+injectTopItem item =
+    modify' $ \s -> s { sInjectedItems = (False, item) : sInjectedItems s }
+
+injectDecl :: Monad m => Decl -> ScoperT a m ()
+injectDecl decl =
+    modify' $ \s -> s { sInjectedDecls = decl : sInjectedDecls s }
+
+consumeInjectedItems :: Monad m => ScoperT a m [ModuleItem]
+consumeInjectedItems = do
+    -- only pull out top items if in the top scope
+    inTopLevelScope <- gets $ (== 1) . length . sCurrent
+    let op = if inTopLevelScope then const True else fst
+    (injected, remaining) <- gets $ partition op . sInjectedItems
+    when (not $ null injected) $
+        modify' $ \s -> s { sInjectedItems = remaining }
+    return $ reverse $ map snd $ injected
+
+consumeInjectedDecls :: Monad m => ScoperT a m [Decl]
+consumeInjectedDecls = do
+    injected <- gets sInjectedDecls
+    when (not $ null injected) $
+        modify' $ \s -> s { sInjectedDecls = [] }
+    return $ reverse injected
+
+type Replacements = Map.Map Identifier Expr
+
+-- lookup accesses by direct match (no search)
+directResolve :: Mapping a -> [Access] -> Maybe (Replacements, a)
+directResolve _ [] = Nothing
+directResolve mapping [Access x Nil] = do
+    Entry maybeElement _ _ <- Map.lookup x mapping
+    fmap (Map.empty, ) maybeElement
+directResolve _ [_] = Nothing
+directResolve mapping (Access x Nil : rest) = do
+    Entry _ "" subMapping <- Map.lookup x mapping
+    directResolve subMapping rest
+directResolve mapping (Access x e : rest) = do
+    Entry _ index@(_ : _) subMapping <- Map.lookup x mapping
+    (replacements, element) <- directResolve subMapping rest
+    let replacements' = Map.insert index e replacements
+    Just (replacements', element)
+
+-- lookup accesses given a current scope prefix
+resolveInScope :: Mapping a -> [Tier] -> [Access] -> LookupResult a
+resolveInScope mapping [] accesses = do
+    (replacements, element) <- directResolve mapping accesses
+    Just (accesses, replacements, element)
+resolveInScope mapping (Tier x y : rest) accesses = do
+    Entry _ _ subMapping <- Map.lookup x mapping
+    let deep = resolveInScope subMapping rest accesses
+    let side = resolveInScope subMapping [] accesses
+    let chosen = if isNothing deep then side else deep
+    (accesses', replacements, element) <- chosen
+    if null y
+        then Just (Access x Nil : accesses', replacements, element)
+        else do
+            let replacements' = Map.insert y (Ident y) replacements
+            Just (Access x (Ident y) : accesses', replacements', element)
+
+type LookupResult a = Maybe ([Access], Replacements, a)
+
+class ScopeKey k where
+    lookupElem :: Scopes a -> k -> LookupResult a
+    lookupElemM :: Monad m => k -> ScoperT a m (LookupResult a)
+    lookupElemM = embedScopes lookupElem
+
+instance ScopeKey Expr where
+    lookupElem scopes = join . fmap (lookupAccesses scopes) . exprToAccesses []
+
+instance ScopeKey LHS where
+    lookupElem scopes = lookupElem scopes . lhsToExpr
+
+instance ScopeKey Identifier where
+    lookupElem scopes ident = lookupAccesses scopes [Access ident Nil]
+
+lookupAccesses :: Scopes a -> [Access] -> LookupResult a
+lookupAccesses scopes accesses = do
+    let deep = resolveInScope (sMapping scopes) (sCurrent scopes) accesses
+    let side = resolveInScope (sMapping scopes) [] accesses
+    if isNothing deep then side else deep
+
+localAccesses :: Scopes a -> Identifier -> [Access]
+localAccesses scopes ident =
+    foldr ((:) . toAccess) [Access ident Nil] (sCurrent scopes)
+
+localAccessesM :: Monad m => Identifier -> ScoperT a m [Access]
+localAccessesM = embedScopes localAccesses
+
+lookupLocalIdent :: Scopes a -> Identifier -> LookupResult a
+lookupLocalIdent scopes ident = do
+    (replacements, element) <- directResolve (sMapping scopes) accesses
+    Just (accesses, replacements, element)
+    where accesses = localAccesses scopes ident
+
+toAccess :: Tier -> Access
+toAccess (Tier x "") = Access x Nil
+toAccess (Tier x y) = Access x (Ident y)
+
+lookupLocalIdentM :: Monad m => Identifier -> ScoperT a m (LookupResult a)
+lookupLocalIdentM = embedScopes lookupLocalIdent
+
+withinProcedureM :: Monad m => ScoperT a m Bool
+withinProcedureM = gets withinProcedure
+
+withinProcedure :: Scopes a -> Bool
+withinProcedure = not . null . sProcedureLoc
+
+procedureLocM :: Monad m => ScoperT a m [Access]
+procedureLocM = gets procedureLoc
+
+procedureLoc :: Scopes a -> [Access]
+procedureLoc = sProcedureLoc
+
+debugLocation :: Scopes a -> String
+debugLocation s =
+    hierarchy ++
+    if null location
+        then " (use -v to get approximate source location)"
+        else ", near " ++ location
+    where
+        hierarchy = hierarchyPath s
+        location = sourceLocation s
+
+sourceLocationM :: Monad m => ScoperT a m String
+sourceLocationM = gets sourceLocation
+
+sourceLocation :: Scopes a -> String
+sourceLocation = sLatestTrace
+
+hierarchyPathM :: Monad m => ScoperT a m String
+hierarchyPathM = gets hierarchyPath
+
+hierarchyPath :: Scopes a -> String
+hierarchyPath = intercalate "." . map tierToStr . sCurrent
+    where
+        tierToStr :: Tier -> String
+        tierToStr (Tier "" _) = "<unnamed_block>"
+        tierToStr (Tier x "") = x
+        tierToStr (Tier x y) = x ++ '[' : y ++ "]"
+
+scopedErrorM :: Monad m => String -> ScoperT a m x
+scopedErrorM msg = get >>= flip scopedError msg
+
+scopedError :: Scopes a -> String -> x
+scopedError scopes = error . (++ ", within scope " ++ debugLocation scopes)
+
+isLoopVar :: Scopes a -> Identifier -> Bool
+isLoopVar scopes x = any matches $ sCurrent scopes
+    where matches = (== x) . tierIndex
+
+isLoopVarM :: Monad m => Identifier -> ScoperT a m Bool
+isLoopVarM = embedScopes isLoopVar
+
+loopVarDepth :: Scopes a -> Identifier -> Maybe Int
+loopVarDepth scopes x =
+    case findIndices matches $ sCurrent scopes of
+        [] -> Nothing
+        indices -> Just $ last indices
+    where matches = (== x) . tierIndex
+
+loopVarDepthM :: Monad m => Identifier -> ScoperT a m (Maybe Int)
+loopVarDepthM = embedScopes loopVarDepth
+
+scopeModuleItems
+    :: Monad m
+    => MapperM (ScoperT a m) ModuleItem
+    -> Identifier
+    -> MapperM (ScoperT a m) [ModuleItem]
+scopeModuleItems moduleItemMapper topName items = do
+    enterScope topName ""
+    items' <- mapM moduleItemMapper items
+    exitScope
+    return items'
+
+scopeModule :: Monad m
+    => MapperM (ScoperT a m) ModuleItem
+    -> MapperM (ScoperT a m) Description
+scopeModule moduleItemMapper description
+    | Part _ _ Module _ _ _ _ <- description =
+        scopePart moduleItemMapper description
+    | otherwise = return description
+
+scopePart :: Monad m
+    => MapperM (ScoperT a m) ModuleItem
+    -> MapperM (ScoperT a m) Description
+scopePart moduleItemMapper description
+    | Part attrs extern kw liftetime name ports items <- description =
+        scopeModuleItems moduleItemMapper name items >>=
+        return . Part attrs extern kw liftetime name ports
+    | otherwise = return description
+
+evalScoper :: Scoper a x -> x
+evalScoper = flip evalState initialState
+
+evalScoperT :: Monad m => ScoperT a m x -> m x
+evalScoperT = flip evalStateT initialState
+
+runScoper :: Scoper a x -> (x, Scopes a)
+runScoper = flip runState initialState
+
+runScoperT :: Monad m => ScoperT a m x -> m (x, Scopes a)
+runScoperT = flip runStateT initialState
+
+initialState :: Scopes a
+initialState = Scopes [] Map.empty [] [] [] ""
+
+tracePrefix :: String
+tracePrefix = "Trace: "
+
+scopeModuleItem
+    :: forall a m. Monad m
+    => MapperM (ScoperT a m) Decl
+    -> MapperM (ScoperT a m) ModuleItem
+    -> MapperM (ScoperT a m) GenItem
+    -> MapperM (ScoperT a m) Stmt
+    -> MapperM (ScoperT a m) ModuleItem
+scopeModuleItem declMapperRaw moduleItemMapper genItemMapper stmtMapperRaw =
+    wrappedModuleItemMapper
+    where
+        fullStmtMapper :: Stmt -> ScoperT a m Stmt
+        fullStmtMapper (Block kw name decls stmts) = do
+            enterScope name ""
+            decls' <- fmap concat $ mapM declMapper' decls
+            stmts' <- mapM fullStmtMapper $ filter (/= Null) stmts
+            exitScope
+            return $ Block kw name decls' stmts'
+        -- TODO: Do we need to support the various procedural loops?
+        fullStmtMapper stmt = do
+            stmt' <- stmtMapper stmt
+            injected <- consumeInjectedDecls
+            if null injected
+                then traverseSinglyNestedStmtsM fullStmtMapper stmt'
+                else fullStmtMapper $ Block Seq "" injected [stmt']
+
+        declMapper :: Decl -> ScoperT a m Decl
+        declMapper decl@(CommentDecl c) =
+            consumeComment c >> return decl
+        declMapper decl = declMapperRaw decl
+
+        stmtMapper :: Stmt -> ScoperT a m Stmt
+        stmtMapper stmt@(CommentStmt c) =
+            consumeComment c >> return stmt
+        stmtMapper stmt = stmtMapperRaw stmt
+
+        consumeComment :: String -> ScoperT a m ()
+        consumeComment c =
+            when (tracePrefix `isPrefixOf` c) $
+                modify' $ \s -> s { sLatestTrace = drop (length tracePrefix) c }
+
+        -- converts a decl and adds decls injected during conversion
+        declMapper' :: Decl -> ScoperT a m [Decl]
+        declMapper' decl = do
+            decl' <- declMapper decl
+            injected <- consumeInjectedDecls
+            if null injected
+                then return [decl']
+                else do
+                    injected' <- mapM declMapper injected
+                    return $ injected' ++ [decl']
+
+        mapTFDecls :: [Decl] -> ScoperT a m [Decl]
+        mapTFDecls = mapTFDecls' 0
+            where
+                mapTFDecls' :: Int -> [Decl] -> ScoperT a m [Decl]
+                mapTFDecls' _ [] = return []
+                mapTFDecls' idx (decl : decls) =
+                    case argIdxDecl decl of
+                        Nothing -> do
+                            decl' <- declMapper' decl
+                            decls' <- mapTFDecls' idx decls
+                            return $ decl' ++ decls'
+                        Just declFunc -> do
+                            _ <- declMapper $ declFunc idx
+                            decl' <- declMapper' decl
+                            decls' <- mapTFDecls' (idx + 1) decls
+                            return $ decl' ++ decls'
+
+                argIdxDecl :: Decl -> Maybe (Int -> Decl)
+                argIdxDecl (Variable d t _ a e) =
+                    if d == Local
+                        then Nothing
+                        else Just $ \i -> Variable d t (show i) a e
+                argIdxDecl Net{} = Nothing
+                argIdxDecl Param{} = Nothing
+                argIdxDecl ParamType{} = Nothing
+                argIdxDecl CommentDecl{} = Nothing
+
+        redirectTFDecl :: Type -> Identifier -> ScoperT a m (Type, Identifier)
+        redirectTFDecl typ ident = do
+            res <- declMapper $ Variable Local typ ident [] Nil
+            (newType, newName, newRanges) <-
+                return $ case res of
+                    Variable Local t x r Nil -> (t, x, r)
+                    Net Local TWire DefaultStrength t x r Nil -> (t, x, r)
+                    _ -> error "redirectTFDecl invariant violated"
+            return $ if null newRanges
+                then (newType, newName)
+                else
+                    let (tf, rs2) = typeRanges newType
+                    in (tf $ newRanges ++ rs2, newName)
+
+        wrappedModuleItemMapper :: ModuleItem -> ScoperT a m ModuleItem
+        wrappedModuleItemMapper item = do
+            item' <- fullModuleItemMapper item
+            injected <- consumeInjectedItems
+            if null injected
+                then return item'
+                else do
+                    injected' <- mapM fullModuleItemMapper injected
+                    return $ Generate $ map GenModuleItem $ injected' ++ [item']
+        fullModuleItemMapper :: ModuleItem -> ScoperT a m ModuleItem
+        fullModuleItemMapper (MIPackageItem (Function ml t x decls stmts)) = do
+            (t', x') <- redirectTFDecl t x
+            enterProcedure
+            enterScope x' ""
+            decls' <- mapTFDecls decls
+            stmts' <- mapM fullStmtMapper stmts
+            exitScope
+            exitProcedure
+            return $ MIPackageItem $ Function ml t' x' decls' stmts'
+        fullModuleItemMapper (MIPackageItem (Task ml x decls stmts)) = do
+            (_, x') <- redirectTFDecl (Implicit Unspecified []) x
+            enterProcedure
+            enterScope x' ""
+            decls' <- mapTFDecls decls
+            stmts' <- mapM fullStmtMapper stmts
+            exitScope
+            exitProcedure
+            return $ MIPackageItem $ Task ml x' decls' stmts'
+        fullModuleItemMapper (MIPackageItem (Decl decl)) =
+            declMapper decl >>= return . MIPackageItem . Decl
+        fullModuleItemMapper (MIPackageItem item@DPIImport{}) = do
+            let DPIImport spec prop alias typ name decls = item
+            (typ', name') <- redirectTFDecl typ name
+            decls' <- mapM declMapper decls
+            let item' = DPIImport spec prop alias typ' name' decls'
+            return $ MIPackageItem item'
+        fullModuleItemMapper (MIPackageItem (DPIExport spec alias kw name)) =
+            return $ MIPackageItem $ DPIExport spec alias kw name
+        fullModuleItemMapper (AlwaysC kw stmt) = do
+            enterProcedure
+            stmt' <- fullStmtMapper stmt
+            exitProcedure
+            return $ AlwaysC kw stmt'
+        fullModuleItemMapper (Initial stmt) = do
+            enterProcedure
+            stmt' <- fullStmtMapper stmt
+            exitProcedure
+            return $ Initial stmt'
+        fullModuleItemMapper (Final stmt) = do
+            enterProcedure
+            stmt' <- fullStmtMapper stmt
+            exitProcedure
+            return $ Final stmt'
+        fullModuleItemMapper (Generate genItems) =
+            fullGenItemBlockMapper genItems >>= return . Generate
+        fullModuleItemMapper (MIAttr attr item) =
+            fullModuleItemMapper item >>= return . MIAttr attr
+        fullModuleItemMapper item = moduleItemMapper item
+
+        fullGenItemMapper :: GenItem -> ScoperT a m GenItem
+        fullGenItemMapper genItem = do
+            genItem' <- genItemMapper genItem
+            injected <- consumeInjectedItems
+            genItem'' <- scopeGenItemMapper genItem'
+            mapM_ injectItem injected -- defer until enclosing block
+            return genItem''
+
+        -- akin to fullGenItemMapper, but for lists of generate items, and
+        -- allowing module items to be injected in the middle of the list
+        fullGenItemBlockMapper :: [GenItem] -> ScoperT a m [GenItem]
+        fullGenItemBlockMapper = fmap concat . mapM genblkStep
+        genblkStep :: GenItem -> ScoperT a m [GenItem]
+        genblkStep genItem = do
+            genItem' <- fullGenItemMapper genItem
+            injected <- consumeInjectedItems
+            if null injected
+                then return [genItem']
+                else do
+                    injected' <- mapM fullModuleItemMapper injected
+                    return $ map GenModuleItem injected' ++ [genItem']
+
+        -- enters and exits generate block scopes as appropriate
+        scopeGenItemMapper :: GenItem -> ScoperT a m GenItem
+        scopeGenItemMapper (GenFor _ _ _ GenNull) = return GenNull
+        scopeGenItemMapper (GenFor (index, a) b c genItem) = do
+            let GenBlock name genItems = genItem
+            enterScope name index
+            genItems' <- fullGenItemBlockMapper genItems
+            exitScope
+            let genItem' = GenBlock name genItems'
+            return $ GenFor (index, a) b c genItem'
+        scopeGenItemMapper (GenIf cond thenItem elseItem) = do
+            thenItem' <- fullGenItemMapper thenItem
+            elseItem' <- fullGenItemMapper elseItem
+            return $ GenIf cond thenItem' elseItem'
+        scopeGenItemMapper (GenBlock name genItems) = do
+            enterScope name ""
+            genItems' <- fullGenItemBlockMapper genItems
+            exitScope
+            return $ GenBlock name genItems'
+        scopeGenItemMapper (GenModuleItem moduleItem) =
+            wrappedModuleItemMapper moduleItem >>= return . GenModuleItem
+        scopeGenItemMapper genItem@GenCase{} =
+            traverseSinglyNestedGenItemsM fullGenItemMapper genItem
+        scopeGenItemMapper GenNull = return GenNull
+
+partScoper
+    :: MapperM (Scoper a) Decl
+    -> MapperM (Scoper a) ModuleItem
+    -> MapperM (Scoper a) GenItem
+    -> MapperM (Scoper a) Stmt
+    -> Mapper Description
+partScoper declMapper moduleItemMapper genItemMapper stmtMapper =
+    evalScoper . scopePart scoper
+    where scoper = scopeModuleItem
+            declMapper moduleItemMapper genItemMapper stmtMapper

src/Convert/SeverityTask.hs

@@ -0,0 +1,64 @@
+{- sv2v
+ - Author: Ethan Sifferman <ethan@sifferman.dev>
+ -
+ - Conversion of severity system tasks (IEEE 1800-2017 Section 20.10) and
+ - elaboration system tasks (Section 20.11) `$info`, `$warning`, `$error`, and
+ - `$fatal`, which sv2v collectively refers to as "severity tasks".
+ -
+ - 1. Severity task messages are converted into `$display` tasks.
+ - 2. `$fatal` tasks also run `$finish` directly after running `$display`.
+ -}
+
+module Convert.SeverityTask (convert) where
+
+import Data.Char (toUpper)
+import Data.Functor ((<&>))
+
+import Convert.Scoper
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+type SC = Scoper ()
+
+convert :: [AST] -> [AST]
+convert = map $ traverseDescriptions traverseDescription
+
+traverseDescription :: Description -> Description
+traverseDescription = partScoper return traverseModuleItem return traverseStmt
+
+-- convert elaboration severity tasks
+traverseModuleItem :: ModuleItem -> SC ModuleItem
+traverseModuleItem (ElabTask severity taskArgs) =
+    elab severity taskArgs "elaboration" [] <&> Initial
+traverseModuleItem other = return other
+
+-- convert standard severity tasks
+traverseStmt :: Stmt -> SC Stmt
+traverseStmt (SeverityStmt severity taskArgs) =
+    elab severity taskArgs "%0t" [Ident "$time"]
+traverseStmt other = return other
+
+elab :: Severity -> [Expr] -> String -> [Expr] -> SC Stmt
+elab severity args prefixStr prefixArgs = do
+    scopeName <- hierarchyPathM
+    fileLocation <- sourceLocationM
+    let contextArg = String $ msg scopeName fileLocation
+    let stmtDisplay = call "$display" $ contextArg : prefixArgs ++ displayArgs
+    return $ Block Seq "" [] [stmtDisplay, stmtFinish]
+    where
+        msg scope file = severityToString severity ++ " [" ++ prefixStr ++ "] "
+            ++ file ++ " - " ++ scope
+            ++ if null displayArgs then "" else "\\n msg: "
+        displayArgs = if severity /= SeverityFatal || null args
+            then args
+            else tail args
+        stmtFinish = if severity /= SeverityFatal
+            then Null
+            else call "$finish" $ if null args then [] else [head args]
+
+call :: Identifier -> [Expr] -> Stmt
+call func args = Subroutine (Ident func) (Args args [])
+
+severityToString :: Severity -> String
+severityToString severity = toUpper ch : str
+    where '$' : ch : str = show severity

src/Convert/SignCast.hs

@@ -1,29 +0,0 @@
-{- sv2v
- - Author: Zachary Snow <zach@zachjs.com>
- -
- - Conversion for `signed` and `unsigned` type casts.
- -
- - SystemVerilog has `signed'(foo)` and `unsigned'(foo)` as syntactic sugar for
- - the `$signed` and `$unsigned` system functions present in Verilog-2005. This
- - conversion elaborates these casts.
- -}
-
-module Convert.SignCast (convert) where
-
-import Convert.Traverse
-import Language.SystemVerilog.AST
-
-convert :: [AST] -> [AST]
-convert =
-    map $
-    traverseDescriptions $
-    traverseModuleItems $
-    traverseExprs $
-    traverseNestedExprs convertExpr
-
-convertExpr :: Expr -> Expr
-convertExpr (Cast (Left (Implicit Signed [])) e) =
-    Call (Ident "$signed") (Args [Just e] [])
-convertExpr (Cast (Left (Implicit Unsigned [])) e) =
-    Call (Ident "$unsigned") (Args [Just e] [])
-convertExpr other = other

src/Convert/Simplify.hs

@@ -16,72 +16,147 @@
 
 module Convert.Simplify (convert) where
 
-import Control.Monad.State
+import Convert.ExprUtils
-import qualified Data.Map.Strict as Map
+import Convert.Scoper
-
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type Info = Map.Map Identifier Expr
-
 convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
 convertDescription =
-    scopedConversion traverseDeclM traverseModuleItemM traverseStmtM Map.empty
+    partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
 
-traverseDeclM :: Decl -> State Info Decl
+traverseDeclM :: Decl -> Scoper Expr Decl
 traverseDeclM decl = do
-    case decl of
+    decl' <- traverseDeclExprsM traverseExprM decl
-        Param Localparam _ x e -> modify $ Map.insert x e
+    case decl' of
+        Param Localparam UnknownType x e ->
+            insertExpr x e
+        Param Localparam (Implicit sg rs) x e ->
+            insertExpr x $ Cast (Left t) e
+            where t = IntegerVector TLogic sg rs
+        Param Localparam t x e ->
+            insertExpr x $ Cast (Left t) e
+        Variable _ _ x _ _ -> insertElem x Nil
+        Net  _ _ _ _ x _ _ -> insertElem x Nil
         _ -> return ()
-    return decl
+    return decl'
 
-traverseModuleItemM :: ModuleItem -> State Info ModuleItem
+pattern SimpleVector :: Signing -> Integer -> Integer -> Type
+pattern SimpleVector sg l r <- IntegerVector _ sg [(RawNum l, RawNum r)]
+
+insertExpr :: Identifier -> Expr -> Scoper Expr ()
+insertExpr ident expr = do
+    expr' <- substituteExprM expr
+    insertElem ident $ case expr' of
+        Cast (Left (SimpleVector sg l r)) (Number n) ->
+            Number $ numberCast signed size n
+            where
+                signed = sg == Signed
+                size = fromIntegral $ abs $ l - r + 1
+        _ | isSimpleExpr expr' -> expr'
+        _ -> Nil
+
+isSimpleExpr :: Expr -> Bool
+isSimpleExpr Number{}  = True
+isSimpleExpr String{}  = True
+isSimpleExpr (Cast Left{} e) = isSimpleExpr e
+isSimpleExpr _ = False
+
+traverseModuleItemM :: ModuleItem -> Scoper Expr ModuleItem
+traverseModuleItemM (Genvar x) =
+    insertElem x Nil >> return (Genvar x)
+traverseModuleItemM (Instance m p x rs l) = do
+    p' <- mapM paramBindingMapper p
+    traverseExprsM traverseExprM $ Instance m p' x rs l
+    where
+        paramBindingMapper (param, Left t) = do
+            t' <- traverseNestedTypesM (traverseTypeExprsM substituteExprM) t
+            return (param, Left t')
+        paramBindingMapper (param, Right e) = return (param, Right e)
 traverseModuleItemM item = traverseExprsM traverseExprM item
 
-traverseStmtM :: Stmt -> State Info Stmt
+traverseGenItemM :: GenItem -> Scoper Expr GenItem
-traverseStmtM stmt = traverseStmtExprsM traverseExprM stmt
+traverseGenItemM = traverseGenItemExprsM traverseExprM
 
-traverseExprM :: Expr -> State Info Expr
+traverseStmtM :: Stmt -> Scoper Expr Stmt
-traverseExprM = traverseNestedExprsM $ stately convertExpr
+traverseStmtM = traverseStmtExprsM traverseExprM
 
-convertExpr :: Info -> Expr -> Expr
+traverseExprM :: Expr -> Scoper Expr Expr
-convertExpr info (Cast (Right c) e) =
+traverseExprM = embedScopes convertExpr
-    Cast (Right c') e
+
+substituteExprM :: Expr -> Scoper Expr Expr
+substituteExprM = embedScopes substitute
+
+convertExpr :: Scopes Expr -> Expr -> Expr
+convertExpr info (Cast (Left t) e) =
+    Cast (Left t') e'
     where
-        c' = simplify $ substitute info c
+        t' = traverseNestedTypes (traverseTypeExprs $ substitute info) t
+        e' = convertExpr info e
+convertExpr info (Cast (Right c) e) =
+    Cast (Right c') e'
+    where
+        c' = convertExpr info $ substitute info c
+        e' = convertExpr info e
 convertExpr info (DimFn f v e) =
     DimFn f v e'
+    where e' = convertExpr info $ substitute info e
+convertExpr info (Call (Ident "$clog2") (Args [e] [])) =
+    if val' == val
+        then val
+        else val'
     where
-        e' = simplify $ substitute info e
+        e' = convertExpr info $ substitute info e
-convertExpr info (Call (Ident "$clog2") (Args [Just e] [])) =
+        val = Call (Ident "$clog2") (Args [e'] [])
-    if clog2' == clog2
+        val' = simplifyStep val
-        then clog2
+convertExpr info (MuxA a cc aa bb) =
-        else clog2'
-    where
-        e' = simplify $ substitute info e
-        clog2 = Call (Ident "$clog2") (Args [Just e'] [])
-        clog2' = simplify clog2
-convertExpr info (Mux cc aa bb) =
     if before == after
-        then Mux cc aa bb
+        then simplifyStep $ MuxA a cc' aa' bb'
-        else simplify $ Mux after aa bb
+        else simplifyStep $ MuxA a after aa' bb'
     where
-        before = substitute info cc
+        before = substitute info cc'
-        after = simplify before
+        after = convertExpr info before
-convertExpr _ (other @ Repeat{}) = traverseNestedExprs simplify other
+        aa' = convertExpr info aa
-convertExpr _ (other @ Concat{}) = simplify other
+        bb' = convertExpr info bb
-convertExpr _ other = other
+        cc' = convertExpr info cc
+convertExpr info (BinOpA op a e1 e2) =
+    case simplifyStep $ BinOpA op a e1'Sub e2'Sub of
+        Number n -> Number n
+        _ -> simplifyStep $ BinOpA op a e1' e2'
+    where
+        e1' = convertExpr info e1
+        e2' = convertExpr info e2
+        e1'Sub = substituteIdent info e1'
+        e2'Sub = substituteIdent info e2'
+convertExpr info (UniOpA op a expr) =
+    simplifyStep $ UniOpA op a $ convertExpr info expr
+convertExpr info (Repeat expr exprs) =
+    simplifyStep $ Repeat
+        (convertExpr info expr)
+        (map (convertExpr info) exprs)
+convertExpr info (Concat exprs) =
+    simplifyStep $ Concat (map (convertExpr info) exprs)
+convertExpr info expr =
+    traverseSinglyNestedExprs (convertExpr info) expr
 
-substitute :: Info -> Expr -> Expr
+substitute :: Scopes Expr -> Expr -> Expr
-substitute info expr =
+substitute scopes expr =
-    traverseNestedExprs substitute' $ simplify expr
+    substitute' expr
     where
         substitute' :: Expr -> Expr
         substitute' (Ident x) =
-            case Map.lookup x info of
+            case lookupElem scopes x of
-                Nothing -> Ident x
+                Just (_, _, e) | e /= Nil -> e
-                Just e -> e
+                _ -> Ident x
-        substitute' other = other
+        substitute' other =
+            traverseSinglyNestedExprs substitute' other
+
+substituteIdent :: Scopes Expr -> Expr -> Expr
+substituteIdent scopes (Ident x) =
+    case lookupElem scopes x of
+        Just (_, _, n@Number{}) -> n
+        _ -> Ident x
+substituteIdent _ other = other

src/Convert/SizeCast.hs

@@ -1,137 +0,0 @@
-{- sv2v
- - Author: Zachary Snow <zach@zachjs.com>
- -
- - Conversion of size casts on non-constant expressions.
- -}
-
-module Convert.SizeCast (convert) where
-
-import Control.Monad.State
-import Control.Monad.Writer
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
-
-import Convert.Traverse
-import Language.SystemVerilog.AST
-
-type TypeMap = Map.Map Identifier Type
-type CastSet = Set.Set (Expr, Signing)
-
-type ST = StateT TypeMap (Writer CastSet)
-
-convert :: [AST] -> [AST]
-convert = map convertFile
-
-convertFile :: AST -> AST
-convertFile descriptions =
-    descriptions' ++ map (uncurry castFn) funcs
-    where
-        results = map convertDescription descriptions
-        descriptions' = map fst results
-        funcs = Set.toList $ Set.unions $ map snd results
-
-convertDescription :: Description -> (Description, CastSet)
-convertDescription description =
-    (description', info)
-    where
-        (description', info) =
-            runWriter $
-                scopedConversionM traverseDeclM traverseModuleItemM traverseStmtM
-                Map.empty description
-
-traverseDeclM :: Decl -> ST Decl
-traverseDeclM decl = do
-    case decl of
-        Variable _ t x _ _ -> modify $ Map.insert x t
-        Param    _ t x   _ -> modify $ Map.insert x t
-        ParamType    _ _ _ -> return ()
-    return decl
-
-traverseModuleItemM :: ModuleItem -> ST ModuleItem
-traverseModuleItemM item = traverseExprsM traverseExprM item
-
-traverseStmtM :: Stmt -> ST Stmt
-traverseStmtM stmt = traverseStmtExprsM traverseExprM stmt
-
-traverseExprM :: Expr -> ST Expr
-traverseExprM =
-    traverseNestedExprsM convertExprM
-    where
-        convertExprM :: Expr -> ST Expr
-        convertExprM (Cast (Right s) e) = do
-            typeMap <- get
-            case exprSigning typeMap e of
-                Just sg -> do
-                    lift $ tell $ Set.singleton (s, sg)
-                    let f = castFnName s sg
-                    let args = Args [Just e] []
-                    return $ Call (Ident f) args
-                _ -> return $ Cast (Right s) e
-        convertExprM other = return other
-
-
-castFn :: Expr -> Signing -> Description
-castFn e sg =
-    PackageItem $
-    Function Automatic t fnName [decl] [Return $ Ident inp]
-    where
-        inp = "inp"
-        r = (simplify $ BinOp Sub e (Number "1"), Number "0")
-        t = IntegerVector TLogic sg [r]
-        fnName = castFnName e sg
-        decl = Variable Input t inp [] Nothing
-
-castFnName :: Expr -> Signing -> String
-castFnName e sg =
-    if sg == Unspecified
-        then init name
-        else name
-    where
-        sizeStr = case e of
-            Number n ->
-                case readNumber n of
-                    Just v -> show v
-                    _ -> shortHash e
-            _ -> shortHash e
-        name = "sv2v_cast_" ++ sizeStr ++ "_" ++ show sg
-
-exprSigning :: TypeMap -> Expr -> Maybe Signing
-exprSigning typeMap (Ident x) =
-    case Map.lookup x typeMap of
-        Just t -> typeSigning t
-        Nothing -> Just Unspecified
-exprSigning typeMap (BinOp op e1 e2) =
-    combiner sg1 sg2
-    where
-        sg1 = exprSigning typeMap e1
-        sg2 = exprSigning typeMap e2
-        combiner = case op of
-            BitAnd  -> combineSigning
-            BitXor  -> combineSigning
-            BitXnor -> combineSigning
-            BitOr   -> combineSigning
-            Mul     -> combineSigning
-            Div     -> combineSigning
-            Add     -> combineSigning
-            Sub     -> combineSigning
-            Mod     -> curry fst
-            Pow     -> curry fst
-            ShiftAL -> curry fst
-            ShiftAR -> curry fst
-            _ -> \_ _ -> Just Unspecified
-exprSigning _ _ = Just Unspecified
-
-combineSigning :: Maybe Signing -> Maybe Signing -> Maybe Signing
-combineSigning Nothing _ = Nothing
-combineSigning _ Nothing = Nothing
-combineSigning (Just Unspecified) msg = msg
-combineSigning msg (Just Unspecified) = msg
-combineSigning (Just Signed) _ = Just Signed
-combineSigning _ (Just Signed) = Just Signed
-combineSigning (Just Unsigned) _ = Just Unsigned
-
-typeSigning :: Type -> Maybe Signing
-typeSigning (Net           _ sg _) = Just sg
-typeSigning (Implicit        sg _) = Just sg
-typeSigning (IntegerVector _ sg _) = Just sg
-typeSigning _ = Nothing

src/Convert/StarPort.hs

@@ -1,42 +0,0 @@
-{- sv2v
- - Author: Zachary Snow <zach@zachjs.com>
- -
- - Conversion for `.*` in module instantiation
- -}
-
-module Convert.StarPort (convert) where
-
-import Control.Monad.Writer
-import qualified Data.Map.Strict as Map
-
-import Convert.Traverse
-import Language.SystemVerilog.AST
-
-type Ports = Map.Map Identifier [Identifier]
-
-convert :: [AST] -> [AST]
-convert =
-    traverseFiles
-        (collectDescriptionsM collectPortsM)
-        (traverseDescriptions . traverseModuleItems . mapInstance)
-
-collectPortsM :: Description -> Writer Ports ()
-collectPortsM (Part _ _ _ _ name ports _) = tell $ Map.singleton name ports
-collectPortsM _ = return ()
-
-mapInstance :: Ports -> ModuleItem -> ModuleItem
-mapInstance modulePorts (Instance m p x r bindings) =
-    Instance m p x r $ concatMap expandBinding bindings
-    where
-        alreadyBound :: [Identifier]
-        alreadyBound = map fst bindings
-        expandBinding :: PortBinding -> [PortBinding]
-        expandBinding ("*", Nothing) =
-            case Map.lookup m modulePorts of
-                Just l ->
-                    map (\port -> (port, Just $ Ident port)) $
-                    filter (\s -> not $ elem s alreadyBound) $ l
-                -- if we can't find it, just skip :(
-                Nothing -> [("*", Nothing)]
-        expandBinding other = [other]
-mapInstance _ other = other

src/Convert/StmtBlock.hs

@@ -1,30 +0,0 @@
-{- sv2v
- - Author: Zachary Snow <zach@zachjs.com>
- -
- - Conversion for tasks and functions to use only one statement, as required in
- - Verilog-2005.
- -}
-
-module Convert.StmtBlock (convert) where
-
-import Convert.Traverse
-import Language.SystemVerilog.AST
-
-convert :: [AST] -> [AST]
-convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem
-
-convertModuleItem :: ModuleItem -> ModuleItem
-convertModuleItem (MIPackageItem packageItem) =
-    MIPackageItem $ convertPackageItem packageItem
-convertModuleItem other = other
-
-convertPackageItem :: PackageItem -> PackageItem
-convertPackageItem (Function ml t f decls stmts) =
-    Function ml t f decls [stmtsToStmt stmts]
-convertPackageItem (Task     ml   f decls stmts) =
-    Task     ml   f decls [stmtsToStmt stmts]
-convertPackageItem other = other
-
-stmtsToStmt :: [Stmt] -> Stmt
-stmtsToStmt [stmt] = stmt
-stmtsToStmt stmts = Block Seq "" [] stmts

src/Convert/Stream.hs

@@ -6,95 +6,211 @@
 
 module Convert.Stream (convert) where
 
-import Control.Monad.Writer
+import Control.Monad (zipWithM)
-import Data.List.Unique (complex)
 
+import Convert.Scoper
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type Funcs = [ModuleItem]
-
 convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
-convertDescription (description @ Part{}) =
+convertDescription = partScoper
-    Part attrs extern kw lifetime name ports (items ++ funcs)
+    traverseDeclM traverseModuleItemM return traverseStmtM
-    where
-        (description', funcSet) =
-            runWriter $ traverseModuleItemsM (traverseStmtsM traverseStmtM) description
-        Part attrs extern kw lifetime name ports items = description'
-        (funcs, _, _) = complex funcSet
-convertDescription other = other
 
-streamerBlock :: Expr -> Expr -> (LHS -> Expr -> Stmt) -> LHS -> Expr -> Stmt
+traverseDeclM :: Decl -> Scoper () Decl
-streamerBlock chunk size asgn output input =
+traverseDeclM (Variable d t x [] (Stream StreamR _ exprs)) =
+    return $ Variable d t x [] expr'
+    where
+        expr = Concat exprs
+        expr' = resize exprSize lhsSize expr
+        lhsSize = DimsFn FnBits $ Left t
+        exprSize = sizeof expr
+traverseDeclM (Variable d t x [] expr@(Stream StreamL chunk exprs)) = do
+    inProcedure <- withinProcedureM
+    if inProcedure
+        then return $ Variable d t x [] expr
+        else do
+            injectItem $ MIPackageItem func
+            return $ Variable d t x [] expr'
+    where
+        fnName = streamerFuncName x
+        func = streamerFunc fnName chunk (TypeOf $ Concat exprs) t
+        expr' = Call (Ident fnName) (Args [Concat exprs] [])
+traverseDeclM (Variable d t x a expr) =
+    traverseExprM expr >>= return . Variable d t x a
+traverseDeclM decl@Net{} = traverseNetAsVarM traverseDeclM decl
+traverseDeclM decl = return decl
+
+traverseModuleItemM :: ModuleItem -> Scoper () ModuleItem
+traverseModuleItemM (Assign opt lhs (Stream StreamL chunk exprs)) =
+    injectItem (MIPackageItem func) >> return (Assign opt lhs expr')
+    where
+        fnName = streamerFuncName $ shortHash (lhs, chunk, exprs)
+        t = TypeOf $ lhsToExpr lhs
+        arg = Concat exprs
+        func = streamerFunc fnName chunk (TypeOf arg) t
+        expr' = Call (Ident fnName) (Args [arg] [])
+traverseModuleItemM (Assign opt (LHSStream StreamL chunk lhss) expr) =
+    traverseModuleItemM $
+        Assign opt (LHSConcat lhss)
+        (Stream StreamL chunk [expr])
+traverseModuleItemM (Assign opt lhs (Mux cond expr@Stream{} other)) = do
+    (lhs', expr') <- indirectAssign lhs expr
+    return $ Assign opt lhs' $ Mux cond expr' other
+traverseModuleItemM (Assign opt lhs (Mux cond other expr@Stream{})) = do
+    (lhs', expr') <- indirectAssign lhs expr
+    return $ Assign opt lhs' $ Mux cond other expr'
+traverseModuleItemM (Assign opt lhs expr) =
+    traverseExprM expr' >>= return . Assign opt lhs'
+    where Asgn AsgnOpEq Nothing lhs' expr' =
+            traverseAsgn (lhs, expr) (Asgn AsgnOpEq Nothing)
+traverseModuleItemM item = return item
+
+indirectAssign :: LHS -> Expr -> Scoper () (LHS, Expr)
+indirectAssign lhs expr = do
+    let item = Assign AssignOptionNone lhs expr
+    item' <- traverseModuleItemM item
+    let Assign AssignOptionNone lhs' expr' = item'
+    return (lhs', expr')
+
+traverseStmtM :: Stmt -> Scoper () Stmt
+traverseStmtM (Subroutine fn (Args args [])) = do
+    args' <- traverseCall fn args
+    return $ Subroutine fn $ Args args' []
+traverseStmtM (Asgn op mt lhs expr) = do
+    expr' <- traverseExprM expr
+    return $ traverseAsgn (lhs, expr') (Asgn op mt)
+traverseStmtM stmt = traverseStmtExprsM traverseExprM stmt
+
+-- replace streaming concatenations in function arguments
+traverseExprM :: Expr -> Scoper () Expr
+traverseExprM (Call fn (Args args [])) = do
+    args' <- traverseCall fn args
+    return $ Call fn $ Args args' []
+traverseExprM expr = traverseSinglyNestedExprsM traverseExprM expr
+
+traverseCall :: Expr -> [Expr] -> Scoper () [Expr]
+traverseCall fn = zipWithM wrapper ([0..] :: [Int])
+    where wrapper = traverseCallArg . TypeOf . Dot fn . show
+
+-- task and function arguments are "assignment-like contexts"
+traverseCallArg :: Type -> Expr -> Scoper () Expr
+traverseCallArg t expr@(Stream op _ _) = do
+    inProcedure <- withinProcedureM
+    if inProcedure && op == StreamL
+        then injectDecl decl >> return (Ident tmp)
+        else do
+            decl' <- traverseDeclM decl
+            let Variable _ _ _ _ expr' = decl'
+            return expr'
+    where
+        tmp = "_arg_tmp_" ++ shortHash (t, expr)
+        decl = Variable Local t tmp [] expr
+traverseCallArg _ arg = traverseExprM arg
+
+-- produces a function used to capture an inline streaming concatenation
+streamerFunc :: Identifier -> Expr -> Type -> Type -> PackageItem
+streamerFunc fnName chunk rawInType rawOutType =
+    Function Automatic outType fnName [decl] [stmt]
+    where
+        decl = Variable Input inType "inp" [] Nil
+        lhs = LHSIdent fnName
+        expr = Stream StreamL chunk [Ident "inp"]
+        stmt = traverseAsgn (lhs, expr) (Asgn AsgnOpEq Nothing)
+
+        inType = sizedType rawInType
+        outType = sizedType rawOutType
+        sizedType :: Type -> Type
+        sizedType t = IntegerVector TLogic Unspecified [(hi, RawNum 0)]
+            where hi = BinOp Sub (DimsFn FnBits $ Left t) (RawNum 1)
+
+streamerFuncName :: Identifier -> Identifier
+streamerFuncName = (++) "_sv2v_strm_"
+
+-- produces a block corresponding to the given leftward streaming concatenation
+streamerBlock :: Expr -> Expr -> Expr -> (LHS -> Expr -> Stmt) -> LHS -> Expr -> Stmt
+streamerBlock chunk inSize outSize asgn output input =
     Block Seq ""
-    [ Variable Local t inp [] $ Just input
+    [ Variable Local t inp [] input
-    , Variable Local t out [] Nothing
+    , Variable Local t out [] Nil
-    , Variable Local (IntegerAtom TInteger Unspecified) idx [] Nothing
+    , Variable Local (IntegerAtom TInteger Unspecified) idx [] Nil
-    , Variable Local (IntegerAtom TInteger Unspecified) bas [] Nothing
     ]
     [ For inits cmp incr stmt
-    , AsgnBlk AsgnOpEq (LHSIdent bas) (Ident idx)
+    , If NoCheck cmp2 stmt2 Null
-    , For inits cmp2 incr2 stmt2
+    , asgn output result
-    , asgn output (Ident out)
     ]
     where
-        lo = Number "0"
+        lo = RawNum 0
-        hi = BinOp Sub size (Number "1")
+        hi = BinOp Sub inSize (RawNum 1)
         t = IntegerVector TLogic Unspecified [(hi, lo)]
-        name = streamerBlockName chunk size
+        name = streamerBlockName chunk inSize
         inp = name ++ "_inp"
         out = name ++ "_out"
         idx = name ++ "_idx"
-        bas = name ++ "_bas"
         -- main chunk loop
-        inits = Right [(LHSIdent idx, lo)]
+        inits = [(LHSIdent idx, lo)]
-        cmp = BinOp Le (Ident idx) (BinOp Sub hi chunk)
+        cmp = BinOp Le (Ident idx) (BinOp Sub inSize chunk)
         incr = [(LHSIdent idx, AsgnOp Add, chunk)]
         lhs = LHSRange (LHSIdent out) IndexedMinus (BinOp Sub hi (Ident idx), chunk)
         expr = Range (Ident inp) IndexedPlus (Ident idx, chunk)
-        stmt = AsgnBlk AsgnOpEq lhs expr
+        stmt = Asgn AsgnOpEq Nothing lhs expr
         -- final chunk loop
-        cmp2 = BinOp Lt (Ident idx) (BinOp Sub size (Ident bas))
+        stub = BinOp Mod inSize chunk
-        incr2 = [(LHSIdent idx, AsgnOp Add, Number "1")]
+        lhs2 = LHSRange (LHSIdent out) IndexedPlus (RawNum 0, stub)
-        lhs2 = LHSBit (LHSIdent out) (Ident idx)
+        expr2 = Range (Ident inp) IndexedPlus (Ident idx, stub)
-        expr2 = Bit (Ident inp) (BinOp Add (Ident idx) (Ident bas))
+        stmt2 = Asgn AsgnOpEq Nothing lhs2 expr2
-        stmt2 = AsgnBlk AsgnOpEq lhs2 expr2
+        cmp2 = BinOp Gt stub (RawNum 0)
+        -- size mismatch padding
+        result = resize inSize outSize (Ident out)
 
 streamerBlockName :: Expr -> Expr -> Identifier
 streamerBlockName chunk size =
     "_sv2v_strm_" ++ shortHash (chunk, size)
 
-traverseStmtM :: Stmt -> Writer Funcs Stmt
+-- pad or truncate the right side of an expression
-traverseStmtM (AsgnBlk op lhs expr) =
+resize :: Expr -> Expr -> Expr -> Expr
-    traverseAsgnM (lhs, expr) (AsgnBlk op)
+resize inSize outSize expr =
-traverseStmtM (Asgn mt lhs expr) =
+    Mux
-    traverseAsgnM (lhs, expr) (Asgn mt)
+        (BinOp Le inSize outSize)
-traverseStmtM other = return other
+        (BinOp ShiftL expr (BinOp Sub outSize inSize))
+        (BinOp ShiftR expr (BinOp Sub inSize outSize))
 
-traverseAsgnM :: (LHS, Expr) -> (LHS -> Expr -> Stmt) -> Writer Funcs Stmt
+-- rewrite a given assignment if it uses a streaming concatenation
-traverseAsgnM (lhs, Stream StreamR _ exprs) constructor =
+traverseAsgn :: (LHS, Expr) -> (LHS -> Expr -> Stmt) -> Stmt
-    return $ constructor lhs expr
+traverseAsgn (lhs, Stream StreamR _ exprs) constructor =
+    constructor lhs $ resize exprSize lhsSize expr
     where
-        expr = Concat $ exprs ++ [Repeat delta [Number "1'b0"]]
+        expr = Concat exprs
-        size = DimsFn FnBits $ Right $ lhsToExpr lhs
+        lhsSize = sizeof $ lhsToExpr lhs
-        exprSize = DimsFn FnBits $ Right (Concat exprs)
+        exprSize = sizeof expr
-        delta = BinOp Sub size exprSize
+traverseAsgn (LHSStream StreamR _ lhss, expr) constructor =
-traverseAsgnM (LHSStream StreamR _ lhss, expr) constructor =
+    constructor lhs $ resize exprSize lhsSize expr
-    return $ constructor (LHSConcat lhss) expr
-traverseAsgnM (lhs, Stream StreamL chunk exprs) constructor = do
-    return $ streamerBlock chunk size constructor lhs expr
-    where
-        expr = Concat $ Repeat delta [Number "1'b0"] : exprs
-        size = DimsFn FnBits $ Right $ lhsToExpr lhs
-        exprSize = DimsFn FnBits $ Right (Concat exprs)
-        delta = BinOp Sub size exprSize
-traverseAsgnM (LHSStream StreamL chunk lhss, expr) constructor = do
-    return $ streamerBlock chunk size constructor lhs expr
     where
         lhs = LHSConcat lhss
-        size = DimsFn FnBits $ Right expr
+        lhsSize = sizeof $ lhsToExpr lhs
-traverseAsgnM (lhs, expr) constructor =
+        exprSize = sizeof expr
-    return $ constructor lhs expr
+traverseAsgn (lhs, Stream StreamL chunk exprs) constructor =
+    streamerBlock chunk exprSize lhsSize constructor lhs expr
+    where
+        expr = Concat exprs
+        lhsSize = sizeof $ lhsToExpr lhs
+        exprSize = sizeof expr
+traverseAsgn (LHSStream StreamL chunk lhss, expr) constructor =
+    streamerBlock chunk exprSize lhsSize constructor lhs expr
+    where
+        lhs = LHSConcat lhss
+        lhsSize = sizeof $ lhsToExpr lhs
+        exprSize = sizeof expr
+traverseAsgn (lhs, Mux cond e1@Stream{} e2) constructor =
+    traverseAsgn (lhs, e1) constructor'
+    where constructor' lhs' e1' = constructor lhs' $ Mux cond e1' e2
+traverseAsgn (lhs, Mux cond e1 e2@Stream{}) constructor =
+    traverseAsgn (lhs, e2) constructor'
+    where constructor' lhs' e2' = constructor lhs' $ Mux cond e1 e2'
+traverseAsgn (lhs, expr) constructor =
+    constructor lhs expr
+
+sizeof :: Expr -> Expr
+sizeof = DimsFn FnBits . Right

src/Convert/StringParam.hs

@@ -0,0 +1,107 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for variable-length string parameters
+ -
+ - While implicitly variable-length string parameters are supported in
+ - Verilog-2005, some usages depend on their type information (e.g., size). In
+ - such instances, an additional parameter is added encoding the width of the
+ - parameter.
+ -}
+
+module Convert.StringParam (convert) where
+
+import Control.Monad (when)
+import Control.Monad.Writer.Strict
+import Data.Maybe (mapMaybe)
+import qualified Data.Set as Set
+import qualified Data.Map.Strict as Map
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+type PartStringParams = Map.Map Identifier [Identifier]
+type Idents = Set.Set Identifier
+
+convert :: [AST] -> [AST]
+convert files =
+    if Map.null partStringParams
+        then files
+        else map traverseModuleItem files'
+    where
+        (files', partStringParams) = runWriter $
+            mapM (traverseDescriptionsM traverseDescriptionM) files
+        traverseModuleItem = traverseDescriptions $ traverseModuleItems $
+            mapInstance partStringParams
+
+-- adds automatic width parameters for string parameters
+traverseDescriptionM :: Description -> Writer PartStringParams Description
+traverseDescriptionM (Part attrs extern kw lifetime name ports items) =
+    if null candidateStringParams || Set.null stringParamNames
+        then return $ Part attrs extern kw lifetime name ports items
+        else do
+            tell $ Map.singleton name $ Set.toList stringParamNames
+            return $ Part attrs extern kw lifetime name ports items'
+    where
+        items' = map (elaborateStringParam stringParamNames) items
+        candidateStringParams = mapMaybe candidateStringParam items
+        stringParamNames = execWriter $
+            mapM (collectNestedModuleItemsM collectModuleItemM) items
+        collectModuleItemM = collectTypesM $ collectNestedTypesM $
+            collectQueriedIdentsM $ Set.fromList candidateStringParams
+traverseDescriptionM other = return other
+
+-- utility pattern for candidate string parameter items
+pattern StringParam :: Identifier -> String -> ModuleItem
+pattern StringParam x s <-
+    MIPackageItem (Decl (Param Parameter UnknownType x (String s)))
+
+-- write down which parameters may be variable-length strings
+candidateStringParam :: ModuleItem -> Maybe Identifier
+candidateStringParam (MIAttr _ item) = candidateStringParam item
+candidateStringParam (StringParam x _) = Just x
+candidateStringParam _ = Nothing
+
+-- write down which of the given identifiers are subject to type queries
+collectQueriedIdentsM :: Idents -> Type -> Writer Idents ()
+collectQueriedIdentsM idents (TypeOf (Ident x)) =
+    when (Set.member x idents) $ tell $ Set.singleton x
+collectQueriedIdentsM _ _ = return ()
+
+-- rewrite an existing string parameter
+elaborateStringParam :: Idents -> ModuleItem -> ModuleItem
+elaborateStringParam idents (MIAttr attr item) =
+    MIAttr attr $ elaborateStringParam idents item
+elaborateStringParam idents orig@(StringParam x str) =
+    if Set.member x idents
+        then Generate $ map wrap [width, param]
+        else orig
+    where
+        wrap = GenModuleItem . MIPackageItem . Decl
+        w = widthName x
+        r = (BinOp Sub (Ident w) (RawNum 1), RawNum 0)
+        t' =  IntegerVector TBit Unspecified [r]
+        defaultWidth = DimsFn FnBits $ Right $ String str
+        width = Param Parameter UnknownType w defaultWidth
+        param = Param Parameter t' x (String str)
+elaborateStringParam _ other = other
+
+widthName :: Identifier -> Identifier
+widthName paramName = "_sv2v_width_" ++ paramName
+
+-- convert instances which use the converted string parameters
+mapInstance :: PartStringParams -> ModuleItem -> ModuleItem
+mapInstance partStringParams (Instance m params x rs ports) =
+    case Map.lookup m partStringParams of
+        Nothing -> Instance m params x rs ports
+        Just stringParams -> Instance m params' x rs ports
+            where params' = concatMap (expand stringParams) params
+    where
+        expand :: [Identifier] -> ParamBinding -> [ParamBinding]
+        expand _ (paramName, Left t) = [(paramName, Left t)]
+        expand stringParams orig@(paramName, Right expr) =
+            if elem paramName stringParams
+                then [(widthName paramName, Right width), orig]
+                else [orig]
+            where width = DimsFn FnBits $ Right expr
+mapInstance _ other = other

src/Convert/StringType.hs

@@ -0,0 +1,23 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Drop explicit `string` data type from parameters and localparams
+ -}
+
+module Convert.StringType (convert) where
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+convert :: [AST] -> [AST]
+convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem
+
+convertModuleItem :: ModuleItem -> ModuleItem
+convertModuleItem = traverseNodes id traverseDecl id id traverseStmt
+
+traverseStmt :: Stmt -> Stmt
+traverseStmt = traverseNestedStmts $ traverseStmtDecls traverseDecl
+
+traverseDecl :: Decl -> Decl
+traverseDecl (Param s (NonInteger TString) x e) = Param s UnknownType x e
+traverseDecl other = other

src/Convert/Struct.hs

@@ -6,101 +6,50 @@
 
 module Convert.Struct (convert) where
 
-import Control.Monad.State
+import Control.Monad ((>=>), when)
-import Control.Monad.Writer
+import Control.Monad.State.Strict (get)
-import Data.List (partition)
+import Data.Either (isLeft)
+import Data.List (elemIndex, find, partition, (\\))
+import Data.Maybe (fromJust)
 import Data.Tuple (swap)
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
 
+import Convert.ExprUtils
+import Convert.Scoper
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type TypeFunc = [Range] -> Type
+type StructInfo = (Type, [(Identifier, Range)])
-type StructInfo = (Type, Map.Map Identifier (Range, Expr))
-type Structs = Map.Map TypeFunc StructInfo
-type Types = Map.Map Identifier Type
-type Idents = Set.Set Identifier
 
 convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
-convertDescription (description @ Part{}) =
+convertDescription description@(Part _ _ Module _ _ _ _) =
-    traverseModuleItems (traverseTypes $ convertType structs) $
+    partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
-    Part attrs extern kw lifetime name ports (items ++ funcs)
+    description
-    where
-        description' @ (Part attrs extern kw lifetime name ports items) =
-            scopedConversion (traverseDeclM structs) traverseModuleItemM
-                traverseStmtM tfArgTypes description
-        -- collect information about this description
-        structs = execWriter $ collectModuleItemsM
-            (collectTypesM collectStructM) description
-        tfArgTypes = execWriter $ collectModuleItemsM collectTFArgsM description
-        -- determine which of the packer functions we actually need
-        calledFuncs = execWriter $ collectModuleItemsM
-            (collectExprsM $ collectNestedExprsM collectCallsM) description'
-        packerFuncs = Set.map packerFnName $ Map.keysSet structs
-        calledPackedFuncs = Set.intersection calledFuncs packerFuncs
-        funcs = map packerFn $ filter isNeeded $ Map.keys structs
-        isNeeded tf = Set.member (packerFnName tf) calledPackedFuncs
-        -- helpers for the scoped traversal
-        traverseModuleItemM :: ModuleItem -> State Types ModuleItem
-        traverseModuleItemM item =
-            traverseLHSsM  traverseLHSM  item >>=
-            traverseExprsM traverseExprM      >>=
-            traverseAsgnsM traverseAsgnM
-        traverseStmtM :: Stmt -> State Types Stmt
-        traverseStmtM (Subroutine expr args) = do
-            stateTypes <- get
-            return $ Subroutine expr $
-                convertCall structs stateTypes expr args
-        traverseStmtM stmt =
-            traverseStmtLHSsM  traverseLHSM  stmt >>=
-            traverseStmtExprsM traverseExprM      >>=
-            traverseStmtAsgnsM traverseAsgnM
-        traverseExprM =
-            traverseNestedExprsM $ stately converter
-            where
-                converter :: Types -> Expr -> Expr
-                converter types expr =
-                    snd $ convertAsgn structs types (LHSIdent "", expr)
-        traverseLHSM =
-            traverseNestedLHSsM $ stately converter
-            where
-                converter :: Types -> LHS -> LHS
-                converter types lhs =
-                    fst $ convertAsgn structs types (lhs, Ident "")
-        traverseAsgnM = stately $ convertAsgn structs
 convertDescription other = other
 
--- write down unstructured versions of packed struct types
+convertStruct :: Type -> Maybe StructInfo
-collectStructM :: Type -> Writer Structs ()
+convertStruct (Struct Unpacked fields _) =
-collectStructM (Struct Unpacked fields _) =
+    convertStruct' True Unspecified fields
-    collectStructM' (Struct Unpacked) True Unspecified fields
+convertStruct (Struct (Packed sg) fields _) =
-collectStructM (Struct (Packed sg) fields _) =
+    convertStruct' True sg fields
-    collectStructM' (Struct $ Packed sg) True sg fields
+convertStruct (Union  (Packed sg) fields _) =
-collectStructM (Union  (Packed sg) fields _) =
+    convertStruct' False sg fields
-    collectStructM' (Union $ Packed sg) False sg fields
+convertStruct _ = Nothing
-collectStructM _ = return ()
 
-collectStructM'
+convertStruct' :: Bool -> Signing -> [Field] -> Maybe StructInfo
-    :: ([Field] -> [Range] -> Type)
+convertStruct' isStruct sg fields =
-    -> Bool -> Signing -> [Field] -> Writer Structs ()
-collectStructM' constructor isStruct sg fields = do
     if canUnstructure
-        then tell $ Map.singleton
+        then Just (unstructType, unstructFields)
-            (constructor fields)
+        else Nothing
-            (unstructType, unstructFields)
-        else return ()
     where
-        zero = Number "0"
+        zero = RawNum 0
         typeRange :: Type -> Range
         typeRange t =
-            case ranges of
+            if null ranges
-                [] -> (zero, zero)
+                then (zero, zero)
-                [range] -> range
+                else let [range] = ranges in range
-                _ -> error "Struct.hs invariant failure"
             where ranges = snd $ typeRanges t
 
         -- extract info about the fields
@@ -112,19 +61,18 @@ collectStructM' constructor isStruct sg fields = do
         -- used here because SystemVerilog structs are laid out backwards
         fieldLos =
             if isStruct
-                then map simplify $ tail $ scanr (BinOp Add) (Number  "0") fieldSizes
+                then map simplify $ tail $ scanr (BinOp Add) (RawNum 0) fieldSizes
-                else map simplify $ repeat (Number "0")
+                else map simplify $ repeat (RawNum 0)
         fieldHis =
             if isStruct
-                then map simplify $ init $ scanr (BinOp Add) (Number "-1") fieldSizes
+                then map simplify $ init $ scanr (BinOp Add) minusOne fieldSizes
-                else map simplify $ map (BinOp Add (Number "-1")) fieldSizes
+                else map simplify $ map (BinOp Add minusOne) fieldSizes
+        minusOne = UniOp UniSub $ RawNum 1
 
         -- create the mapping structure for the unstructured fields
-        unstructOffsets = map simplify $ map snd fieldRanges
-        unstructRanges = zip fieldHis fieldLos
         keys = map snd fields
-        vals = zip unstructRanges unstructOffsets
+        unstructRanges = zip fieldHis fieldLos
-        unstructFields = Map.fromList $ zip keys vals
+        unstructFields = zip keys unstructRanges
 
         -- create the unstructured type; result type takes on the signing of the
         -- struct itself to preserve behavior of operations on the whole struct
@@ -132,7 +80,7 @@ collectStructM' constructor isStruct sg fields = do
             if isStruct
                 then foldl1 (BinOp Add) fieldSizes
                 else head fieldSizes
-        packedRange = (simplify $ BinOp Sub structSize (Number "1"), zero)
+        packedRange = (simplify $ BinOp Sub structSize (RawNum 1), zero)
         unstructType = IntegerVector TLogic sg [packedRange]
 
         -- check if this struct can be packed into an integer vector; we only
@@ -145,397 +93,478 @@ collectStructM' constructor isStruct sg fields = do
 
 
 -- convert a struct type to its unstructured equivalent
-convertType :: Structs -> Type -> Type
+convertType :: Type -> Type
-convertType structs t1 =
+convertType t1 =
-    case Map.lookup tf1 structs of
+    case convertStruct t1 of
-        Nothing -> t1
+        Nothing -> traverseSinglyNestedTypes convertType t1
         Just (t2, _) -> tf2 (rs1 ++ rs2)
             where (tf2, rs2) = typeRanges t2
-    where (tf1, rs1) = typeRanges t1
+    where (_, rs1) = typeRanges t1
-
--- writes down the names of called functions
-collectCallsM :: Expr -> Writer Idents ()
-collectCallsM (Call (Ident f) _) = tell $ Set.singleton f
-collectCallsM _ = return ()
-
-collectTFArgsM :: ModuleItem -> Writer Types ()
-collectTFArgsM (MIPackageItem item) = do
-    _ <- case item of
-        Function _ t f decls _ -> do
-            tell $ Map.singleton f t
-            mapM (collect f) (zip [0..] decls)
-        Task     _   f decls _ ->
-            mapM (collect f) (zip [0..] decls)
-        _ -> return []
-    return ()
-    where
-        collect :: Identifier -> (Int, Decl) -> Writer Types ()
-        collect f (idx, (Variable _ t x _ _)) = do
-            tell $ Map.singleton (f ++ ":" ++ show idx) t
-            tell $ Map.singleton (f ++ ":" ++ x) t
-        collect _ _ = return ()
-collectTFArgsM _ = return ()
 
 -- write down the types of declarations
-traverseDeclM :: Structs -> Decl -> State Types Decl
+traverseDeclM :: Decl -> Scoper Type Decl
-traverseDeclM structs origDecl = do
+traverseDeclM decl@Net{} =
-    case origDecl of
+    traverseNetAsVarM traverseDeclM decl
-        Variable d t x a me -> do
+traverseDeclM decl = do
+    decl' <- case decl of
+        Variable d t x a e -> do
             let (tf, rs) = typeRanges t
-            if isRangeable t
+            when (isRangeable t) $
-                then modify $ Map.insert x (tf $ a ++ rs)
+                scopeType (tf $ a ++ rs) >>= insertElem x
-                else return ()
+            scopes <- get
-            case me of
+            let e' = convertExpr scopes t e
-                Nothing -> return origDecl
+            let t' = convertType t
-                Just e -> do
+            return $ Variable d t' x a e'
-                    e' <- convertDeclExpr x e
-                    return $ Variable d t x a (Just e')
         Param s t x e -> do
-            modify $ Map.insert x t
+            scopeType t >>= insertElem x
-            e' <- convertDeclExpr x e
+            scopes <- get
-            return $ Param s t x e'
+            let e' = convertExpr scopes t e
-        ParamType s x mt ->
+            let t' = convertType t
-            return $ ParamType s x mt
+            return $ Param s t' x e'
+        _ -> return decl
+    traverseDeclExprsM traverseExprM decl'
     where
-        convertDeclExpr :: Identifier -> Expr -> State Types Expr
-        convertDeclExpr x e = do
-            types <- get
-            let (LHSIdent _, e') = convertAsgn structs types (LHSIdent x, e)
-            return e'
         isRangeable :: Type -> Bool
-        isRangeable (IntegerAtom _ _) = False
+        isRangeable IntegerAtom{} = False
-        isRangeable (NonInteger  _  ) = False
+        isRangeable NonInteger{}  = False
+        isRangeable TypeOf{}      = False
+        isRangeable TypedefRef{}  = False
         isRangeable _ = True
 
--- produces a function which packs the components of a struct literal
+traverseGenItemM :: GenItem -> Scoper Type GenItem
-packerFn :: TypeFunc -> ModuleItem
+traverseGenItemM = traverseGenItemExprsM traverseExprM
-packerFn structTf =
-    MIPackageItem $
-    Function Automatic (structTf []) fnName decls [retStmt]
-    where
-        Struct _ fields [] = structTf []
-        toInput (t, x) = Variable Input t x [] Nothing
-        decls = map toInput fields
-        retStmt = Return $ Concat $ map (Ident . snd) fields
-        fnName = packerFnName structTf
 
--- returns a "unique" name for the packer for a given struct type
+traverseModuleItemM :: ModuleItem -> Scoper Type ModuleItem
-packerFnName :: TypeFunc -> Identifier
+traverseModuleItemM =
-packerFnName structTf =
+    traverseLHSsM  traverseLHSM  >=>
-    "sv2v_struct_" ++ shortHash structTf
+    traverseExprsM traverseExprM >=>
+    traverseAsgnsM traverseAsgnM
+
+traverseStmtM :: Stmt -> Scoper Type Stmt
+traverseStmtM (Subroutine expr args) = do
+    argsMapper <- embedScopes convertCall expr
+    let args' = argsMapper args
+    let stmt' = Subroutine expr args'
+    traverseStmtM' stmt'
+traverseStmtM stmt = traverseStmtM' stmt
+
+traverseStmtM' :: Stmt -> Scoper Type Stmt
+traverseStmtM' =
+    traverseStmtLHSsM  traverseLHSM  >=>
+    traverseStmtExprsM traverseExprM >=>
+    traverseStmtAsgnsM traverseAsgnM
+
+traverseExprM :: Expr -> Scoper Type Expr
+traverseExprM = embedScopes convertSubExpr >=> return . snd
+
+traverseLHSM :: LHS -> Scoper Type LHS
+traverseLHSM = convertLHS >=> return . snd
 
 -- removes the innermost range from the given type, if possible
 dropInnerTypeRange :: Type -> Type
 dropInnerTypeRange t =
     case typeRanges t of
-        (_, []) -> Implicit Unspecified []
+        (_, []) -> UnknownType
         (tf, rs) -> tf $ tail rs
 
--- This is where the magic happens. This is responsible for converting struct
+-- produces the type of the given part select, if possible
--- accesses, assignments, and literals, given appropriate information about the
+replaceInnerTypeRange :: PartSelectMode -> Range -> Type -> Type
--- structs and the current declaration context. The general strategy involves
+replaceInnerTypeRange NonIndexed r t =
--- looking at the innermost type of a node to convert outer uses of fields, and
+    case typeRanges t of
--- then using the outermost type to figure out the corresponding struct
+        (_, []) -> UnknownType
--- definition for struct literals that are encountered.
+        (tf, rs) -> tf $ r : tail rs
-convertAsgn :: Structs -> Types -> (LHS, Expr) -> (LHS, Expr)
+replaceInnerTypeRange IndexedPlus r t =
-convertAsgn structs types (lhs, expr) =
+    replaceInnerTypeRange NonIndexed (snd r, RawNum 1) t
-    (lhs', expr')
+replaceInnerTypeRange IndexedMinus r t =
-    where
+    replaceInnerTypeRange NonIndexed (snd r, RawNum 1) t
-        (typ, lhs') = convertLHS lhs
-        expr' = snd $ convertSubExpr $ convertExpr typ expr
 
-        -- converting LHSs by looking at the innermost types first
+traverseAsgnM :: (LHS, Expr) -> Scoper Type (LHS, Expr)
-        convertLHS :: LHS -> (Type, LHS)
+traverseAsgnM (lhs, expr) = do
-        convertLHS l =
+    -- convert the LHS using the innermost type information
-            (t, l')
+    (typ, lhs') <- convertLHS lhs
-            where
+    -- convert the RHS using the LHS type information, and then the innermost
-                e = lhsToExpr l
+    -- type information on the resulting RHS
-                (t, e') = convertSubExpr e
+    scopes <- get
-                Just l' = exprToLHS e'
+    let (_, expr') =
+            convertSubExpr scopes $
+            convertExpr scopes typ expr
+    return (lhs', expr')
 
-        specialTag = ':'
+structIsntReady :: Type -> Bool
-        defaultKey = specialTag : "default"
+structIsntReady = (Nothing ==) . convertStruct
 
 -- try expression conversion by looking at the *outermost* type first
-        convertExpr :: Type -> Expr -> Expr
+convertExpr :: Scopes a -> Type -> Expr -> Expr
-        -- TODO: This is really a conversion for using default patterns to
+convertExpr _ _ Nil = Nil
-        -- populate arrays. Maybe this should be somewhere else?
+convertExpr scopes t (MuxA a c e1 e2) =
-        convertExpr (IntegerVector t sg (r:rs)) (Pattern [(":default", e)]) =
+    MuxA a c e1' e2'
-            Repeat (rangeSize r) [e']
-            where e' = convertExpr (IntegerVector t sg rs) e
-        convertExpr (Struct packing fields (_:rs)) (Concat exprs) =
-            Concat $ map (convertExpr (Struct packing fields rs)) exprs
-        convertExpr (Struct packing fields (_:rs)) (Bit e _) =
-            convertExpr (Struct packing fields rs) e
-        convertExpr (Struct packing fields []) (Pattern [("", Repeat (Number nStr) exprs)]) =
-            case readNumber nStr of
-                Just n -> convertExpr (Struct packing fields []) $ Pattern $
-                        zip (repeat "") (concat $ take n $ repeat exprs)
-                Nothing ->
-                    error $ "unable to handle repeat in pattern: " ++
-                        (show $ Repeat (Number nStr) exprs)
-        convertExpr (Struct packing fields []) (Pattern itemsOrig) =
-            if extraNames /= Set.empty then
-                error $ "pattern " ++ show (Pattern itemsOrig) ++
-                    " has extra named fields: " ++
-                    show (Set.toList extraNames) ++ " that are not in " ++
-                    show structTf
-            else if Map.member structTf structs then
-                Call
-                    (Ident $ packerFnName structTf)
-                    (Args (map (Just . snd) items) [])
-            else
-                Pattern items
     where
-                structTf = Struct packing fields
+        e1' = convertExpr scopes t e1
-                fieldNames = map snd fields
+        e2' = convertExpr scopes t e2
-                fieldTypeMap = Map.fromList $ map swap fields
+
+convertExpr scopes struct@(Struct _ fields []) (Pattern itemsOrig) =
+    if not (null extraNames) then
+        scopedError scopes $ "pattern " ++ show (Pattern itemsOrig) ++
+            " has extra named fields " ++ show extraNames ++
+            " that are not in " ++ show struct
+    else if structIsntReady struct then
+        Pattern items
+    else
+        Concat $ zipWith (Cast . Left) fieldTypes (map snd items)
+    where
+        (fieldTypes, fieldNames) = unzip fields
 
         itemsNamed =
             -- patterns either use positions based or name/type/default
-                    if all ((/= "") . fst) itemsOrig then
+            if all ((/= Right Nil) . fst) itemsOrig then
                 itemsOrig
             -- position-based patterns should cover every field
             else if length itemsOrig /= length fields then
-                        error $ "struct pattern " ++ show (Pattern itemsOrig) ++
+                scopedError scopes $ "struct pattern " ++
-                            " doesn't have the same # of items as " ++
+                    show (Pattern itemsOrig) ++
-                            show structTf
+                    " doesn't have the same number of items as " ++ show struct
             -- if the pattern does not use identifiers, use the
             -- identifiers from the struct type definition in order
             else
-                        zip fieldNames (map snd itemsOrig)
+                zip (map (Right . Ident) fieldNames) (map snd itemsOrig)
-                (specialItems, namedItems) =
+        (typedItems, untypedItems) =
-                    partition ((== specialTag) . head . fst) itemsNamed
+            partition (isLeft . fst) $ reverse itemsNamed
-                namedItemMap = Map.fromList namedItems
+        (numberedItems, namedItems) =
-                specialItemMap = Map.fromList specialItems
+            partition (isNumbered . fst) untypedItems
 
-                extraNames = Set.difference
+        isNumbered :: TypeOrExpr -> Bool
-                    (Set.fromList $ map fst namedItems)
+        isNumbered (Right (Number n)) =
-                    (Map.keysSet fieldTypeMap)
+            if maybeIndex == Nothing
+                then scopedError scopes msgNonInteger
+                else 0 <= index && index < length fieldNames
+                        || scopedError scopes msgOutOfBounds
+            where
+                maybeIndex = fmap fromIntegral $ numberToInteger n
+                Just index = maybeIndex
+                msgNonInteger = "pattern index " ++ show (Number n)
+                    ++ " is not an integer"
+                msgOutOfBounds = "pattern index " ++ show index
+                    ++ " is out of bounds for " ++ show struct
+        isNumbered _ = False
 
-                items = zip fieldNames $ map resolveField fieldNames
+        extraNames = map (getName . right . fst) namedItems \\ fieldNames
+        right = \(Right x) -> x
+        getName :: Expr -> Identifier
+        getName (Ident x) = x
+        getName e = scopedError scopes $ "invalid pattern key " ++ show e
+                        ++ " is not a type, field name, or index"
+
+        items = zip
+            (map (Right . Ident) fieldNames)
+            (map resolveField fieldNames)
         resolveField :: Identifier -> Expr
         resolveField fieldName =
-                    convertExpr fieldType $
+            convertExpr scopes fieldType $
             -- look up by name
-                    if Map.member fieldName namedItemMap then
+            if valueByName /= Nothing then
-                        namedItemMap Map.! fieldName
+                fromJust valueByName
             -- recurse for substructures
             else if isStruct fieldType then
-                        Pattern specialItems
+                Pattern typedItems
             -- look up by field type
-                    else if Map.member fieldTypeName specialItemMap then
+            else if valueByType /= Nothing then
-                        specialItemMap Map.! fieldTypeName
+                fromJust valueByType
             -- fall back on the default value
-                    else if Map.member defaultKey specialItemMap then
+            else if valueDefault /= Nothing then
-                        specialItemMap Map.! defaultKey
+                fromJust valueDefault
+            else if valueByIndex /= Nothing then
+                fromJust valueByIndex
             else
-                        error $ "couldn't find field " ++ fieldName ++
+                scopedError scopes $ "couldn't find field '" ++ fieldName ++
-                            " from struct definition " ++ show structTf ++
+                    "' from struct definition " ++ show struct ++
-                            " in struct pattern " ++ show itemsOrig
+                    " in struct pattern " ++ show (Pattern itemsOrig)
             where
-                        fieldType = fieldTypeMap Map.! fieldName
+                valueByName = lookup (Right $ Ident fieldName) namedItems
-                        fieldTypeName =
+                valueByType = lookup (Left fieldType) typedItems
-                            specialTag : (show $ fst $ typeRanges fieldType)
+                valueDefault = lookup (Left UnknownType) typedItems
+                valueByIndex = fmap snd $ find (indexCheck . fst) numberedItems
+
+                fieldType = fst $ fields !! fieldIndex
+                Just fieldIndex = elemIndex fieldName fieldNames
+
                 isStruct :: Type -> Bool
-                        isStruct (Struct{}) = True
+                isStruct Struct{} = True
                 isStruct _ = False
 
-        convertExpr (Struct packing fields (r : rs)) (Pattern items) =
+                indexCheck :: TypeOrExpr -> Bool
-            if all null keys
+                indexCheck item =
-                then convertExpr (structTf (r : rs)) (Concat vals)
+                    fromIntegral value == fieldIndex
-                else Repeat (rangeSize r) [subExpr']
                     where
-                (keys, vals) = unzip items
+                        Just value = numberToInteger n
-                subExpr = Pattern items
+                        Right (Number n) = item
-                structTf = Struct packing fields
+
-                subExpr' = convertExpr (structTf rs) subExpr
+convertExpr scopes (Implicit _ []) expr =
-        convertExpr (Struct packing fields (r : rs)) subExpr =
+    traverseSinglyNestedExprs (convertExpr scopes UnknownType) expr
-            Repeat (rangeSize r) [subExpr']
+convertExpr scopes (Implicit sg rs) expr =
+    convertExpr scopes (IntegerVector TBit sg rs) expr
+
+-- TODO: This is a conversion for concat array literals with elements
+-- that are unsized numbers. This probably belongs somewhere else.
+convertExpr scopes t@IntegerVector{} (Concat exprs) =
+    if all isUnsizedNumber exprs
+        then Concat $ map (Cast $ Left t') exprs
+        else Concat $ map (convertExpr scopes t') exprs
     where
-                structTf = Struct packing fields
+        t' = dropInnerTypeRange t
-                subExpr' = convertExpr (structTf rs) subExpr
+        isUnsizedNumber :: Expr -> Bool
-        convertExpr _ other = other
+        isUnsizedNumber (Number n) = not $ numberIsSized n
+        isUnsizedNumber (UniOpA _ _ e) = isUnsizedNumber e
+        isUnsizedNumber (BinOpA _ _ e1 e2) =
+            isUnsizedNumber e1 || isUnsizedNumber e2
+        isUnsizedNumber _ = False
+
+-- TODO: This is really a conversion for using default patterns to
+-- populate arrays. Maybe this should be somewhere else?
+convertExpr scopes t orig@(Pattern [(Left UnknownType, expr)]) =
+    if null rs
+        then orig
+        else Repeat count [expr']
+    where
+        count = rangeSize $ head rs
+        expr' = Cast (Left t') $ convertExpr scopes t' expr
+        (_, rs) = typeRanges t
+        t' = dropInnerTypeRange t
+
+-- pattern syntax used for simple array literals
+convertExpr scopes t (Pattern items) =
+    if all (== Right Nil) names
+        then convertExpr scopes t $ Concat exprs'
+        else Pattern items
+    where
+        (names, exprs) = unzip items
+        t' = dropInnerTypeRange t
+        exprs' = map (convertExpr scopes t') exprs
+
+-- propagate types through concatenation expressions
+convertExpr scopes t (Concat exprs) =
+    Concat exprs'
+    where
+        t' = dropInnerTypeRange t
+        exprs' = map (convertExpr scopes t') exprs
+
+convertExpr scopes _ expr =
+    traverseSinglyNestedExprs (convertExpr scopes UnknownType) expr
+
+fallbackType :: Scopes Type -> Expr -> (Type, Expr)
+fallbackType scopes e =
+    (t, e)
+    where
+        t = case lookupElem scopes e of
+                Nothing -> UnknownType
+                Just (_, _, typ) -> typ
+
+pattern MakeSigned :: Expr -> Expr
+pattern MakeSigned e = Call (Ident "$signed") (Args [e] [])
+
+-- converting LHSs by looking at the innermost types first
+convertLHS :: LHS -> Scoper Type (Type, LHS)
+convertLHS l = do
+    let e = lhsToExpr l
+    (t, e') <- embedScopes convertSubExpr e
+    -- per IEEE 1800-2017 sections 10.7 and 11.8, the signedness of the LHS does
+    -- not affect the evaluation and sign-extension of the RHS
+    let Just l' = exprToLHS $ case e' of
+                        MakeSigned e'' -> e''
+                        _ -> e'
+    return (t, l')
 
 -- try expression conversion by looking at the *innermost* type first
-        convertSubExpr :: Expr -> (Type, Expr)
+convertSubExpr :: Scopes Type -> Expr -> (Type, Expr)
-        convertSubExpr (Ident x) =
+convertSubExpr scopes (Dot e x) =
-            case Map.lookup x types of
+    if isntStruct subExprType || isHier then
-                Nothing -> (Implicit Unspecified [], Ident x)
+        fallbackType scopes $ Dot e' x
-                Just t -> (t, Ident x)
+    else if structIsntReady subExprType then
-        convertSubExpr (Dot e x) =
+        (fieldType, Dot e' x)
-            case subExprType of
+    else
-                Struct p fields [] -> undot (Struct p fields) fields
+        (fieldType, undottedWithSign)
-                Union  p fields [] -> undot (Union  p fields) fields
-                _ -> (Implicit Unspecified [], Dot e' x)
     where
-                (subExprType, e') = convertSubExpr e
+        (subExprType, e') = convertSubExpr scopes e
-                undot structTf fields =
+        (isHier, fieldType, bounds, dims) = lookupFieldInfo scopes subExprType e' x
-                    if Map.notMember structTf structs
+        -- the offset and size are derived from the struct layout, whose field
-                        then (fieldType, Dot e' x)
+        -- widths may contain member accesses that must themselves be lowered
-                        else (fieldType, Range  e' NonIndexed r)
+        (_, base) = convertSubExpr scopes $ fst bounds
+        (_, len) = convertSubExpr scopes $ rangeSize bounds
+        undotted = if null dims || rangeSize (head dims) == RawNum 1
+            then Bit e' base
+            else Range e' IndexedMinus (base, len)
+        -- retain signedness of fields which would otherwise be lost via the
+        -- resulting bit or range selection
+        IntegerVector _ fieldSg _ = fieldType
+        undottedWithSign =
+            if fieldSg == Signed
+                then MakeSigned undotted
+                else undotted
+
+convertSubExpr scopes (Range (Dot e x) NonIndexed rOuter) =
+    if isntStruct subExprType || isHier then
+        (UnknownType, orig')
+    else if structIsntReady subExprType then
+        (replaceInnerTypeRange NonIndexed rOuter' fieldType, orig')
+    else if null dims then
+        scopedError scopes $ "illegal access to range "
+            ++ show (Range Nil NonIndexed rOuter) ++ " of " ++ show (Dot e x)
+            ++ ", which has type " ++ show fieldType
+    else
+        (replaceInnerTypeRange NonIndexed rOuter' fieldType, undotted)
     where
-                        fieldType = lookupFieldType fields x
+        (roLeft, roRight) = rOuter
-                        r = lookupUnstructRange structTf x
+        (subExprType, e') = convertSubExpr scopes e
-        convertSubExpr (Range eOuter NonIndexed (rOuter @ (hiO, loO))) =
+        (_, roLeft') = convertSubExpr scopes roLeft
-            -- VCS doesn't allow ranges to be cascaded, so we need to combine
+        (_, roRight') = convertSubExpr scopes roRight
-            -- nested Ranges into a single range. My understanding of the
+        rOuter' = (roLeft', roRight')
-            -- semantics are that a range returns a new, zero-indexed sub-range.
+        orig' = Range (Dot e' x) NonIndexed rOuter'
-            case eOuter' of
+        (isHier, fieldType, bounds, dims) = lookupFieldInfo scopes subExprType e' x
-                Range eInner NonIndexed (_, loI) ->
+        [dim] = dims
-                    (t', Range eInner NonIndexed (simplify hi, simplify lo))
+        rangeLeft = ( BinOp Sub (fst bounds) $ BinOp Sub (fst dim) roLeft'
+                    , BinOp Sub (fst bounds) $ BinOp Sub (fst dim) roRight' )
+        rangeRight =( BinOp Add (snd bounds) $ BinOp Sub (snd dim) roLeft'
+                    , BinOp Add (snd bounds) $ BinOp Sub (snd dim) roRight' )
+        undotted = Range e' NonIndexed $
+            endianCondRange dim rangeLeft rangeRight
+convertSubExpr scopes (Range (Dot e x) mode (baseO, lenO)) =
+    if isntStruct subExprType || isHier then
+        (UnknownType, orig')
+    else if structIsntReady subExprType then
+        (replaceInnerTypeRange mode (baseO', lenO') fieldType, orig')
+    else if null dims then
+        scopedError scopes $ "illegal access to range "
+            ++ show (Range Nil mode (baseO, lenO)) ++ " of " ++ show (Dot e x)
+            ++ ", which has type " ++ show fieldType
+    else
+        (replaceInnerTypeRange mode (baseO', lenO') fieldType, undotted)
     where
-                        lo = BinOp Add loI loO
+        (subExprType, e') = convertSubExpr scopes e
-                        hi = BinOp Add loI hiO
+        (_, baseO') = convertSubExpr scopes baseO
-                Range eInner IndexedPlus (baseI, _) ->
+        (_, lenO') = convertSubExpr scopes lenO
-                    (t', Range eInner IndexedPlus (simplify base, simplify len))
+        orig' = Range (Dot e' x) mode (baseO', lenO')
+        (isHier, fieldType, bounds, dims) = lookupFieldInfo scopes subExprType e' x
+        [dim] = dims
+        baseLeft  = BinOp Sub (fst bounds) $ BinOp Sub (fst dim) baseO'
+        baseRight = BinOp Add (snd bounds) $ BinOp Sub (snd dim) baseO'
+        baseDec = baseLeft
+        baseInc = if mode == IndexedPlus
+            then BinOp Add (BinOp Sub baseRight lenO') one
+            else BinOp Sub (BinOp Add baseRight lenO') one
+        base = endianCondExpr dim baseDec baseInc
+        undotted = Range e' mode (base, lenO')
+        one = RawNum 1
+convertSubExpr scopes (Range e mode (left, right)) =
+    (replaceInnerTypeRange mode r' t, Range e' mode r')
     where
-                        base = BinOp Add baseI loO
+        (t, e') = convertSubExpr scopes e
-                        len = rangeSize rOuter
+        (_, left') = convertSubExpr scopes left
-                _ -> (t', Range eOuter' NonIndexed rOuter)
+        (_, right') = convertSubExpr scopes right
+        r' = (left', right')
+convertSubExpr scopes (Bit (Dot e x) i) =
+    if isntStruct subExprType || isHier then
+        (dropInnerTypeRange backupType, orig')
+    else if structIsntReady subExprType then
+        (dropInnerTypeRange fieldType, orig')
+    else if null dims then
+        scopedError scopes $ "illegal access to bit " ++ show i ++ " of "
+            ++ show (Dot e x) ++ ", which has type " ++ show fieldType
+    else
+        (dropInnerTypeRange fieldType, Bit e' iFlat)
     where
-                (t, eOuter') = convertSubExpr eOuter
+        (subExprType, e') = convertSubExpr scopes e
-                t' = dropInnerTypeRange t
+        (_, i') = convertSubExpr scopes i
-        convertSubExpr (Range eOuter IndexedPlus (rOuter @ (baseO, lenO))) =
+        (backupType, _) = fallbackType scopes $ Dot e' x
-            case eOuter' of
+        orig' = Bit (Dot e' x) i'
-                Range eInner NonIndexed (hiI, loI) ->
+        (isHier, fieldType, bounds, dims) = lookupFieldInfo scopes subExprType e' x
-                    (t', Range eInner IndexedPlus (simplify base, simplify len))
+        [dim] = dims
+        left  = BinOp Sub (fst bounds) $ BinOp Sub (fst dim) i'
+        right = BinOp Add (snd bounds) $ BinOp Sub (snd dim) i'
+        iFlat = endianCondExpr dim left right
+convertSubExpr scopes (Bit e i) =
+    if t == UnknownType
+        then (UnknownType, Bit e' i')
+        else (dropInnerTypeRange t, Bit e' i')
     where
-                        base = BinOp Add baseO $
+        (t, e') = convertSubExpr scopes e
-                            endianCondExpr (hiI, loI) loI hiI
+        (_, i') = convertSubExpr scopes i
-                        len = lenO
+convertSubExpr scopes (Call e args) =
-                _ -> (t', Range eOuter' IndexedPlus rOuter)
+    (retType, Call e args')
     where
-                (t, eOuter') = convertSubExpr eOuter
+        (retType, _) = fallbackType scopes e
-                t' = dropInnerTypeRange t
+        args' = convertCall scopes e args
-        convertSubExpr (Range e m r) =
+convertSubExpr scopes (Cast (Left t) e) =
-            (t', Range e' m r)
+    (t, Cast (Left t') e')
     where
-                (t, e') = convertSubExpr e
+        e' = convertExpr scopes t $ snd $ convertSubExpr scopes e
-                t' = dropInnerTypeRange t
+        t' = convertType t
-        convertSubExpr (Concat exprs) =
+
-            (Implicit Unspecified [], Concat $ map (snd . convertSubExpr) exprs)
+convertSubExpr scopes (Pattern items) =
-        convertSubExpr (Stream o e exprs) =
+    if all (== Right Nil) $ map fst items'
-            (Implicit Unspecified [], Stream o e' exprs')
+        then (UnknownType, Concat $ map snd items')
-            where
+        else (UnknownType, Pattern items')
-                e' = (snd . convertSubExpr) e
-                exprs' = map (snd . convertSubExpr) exprs
-        convertSubExpr (BinOp op e1 e2) =
-            (Implicit Unspecified [], BinOp op e1' e2')
-            where
-                (_, e1') = convertSubExpr e1
-                (_, e2') = convertSubExpr e2
-        convertSubExpr (Bit e i) =
-            case e' of
-                Range eInner NonIndexed (_, loI) ->
-                    (t', Bit eInner (simplify $ BinOp Add loI i'))
-                Range eInner IndexedPlus (baseI, _) ->
-                    (t', Bit eInner (simplify $ BinOp Add baseI i'))
-                _ -> (t', Bit e' i')
-            where
-                (t, e') = convertSubExpr e
-                t' = dropInnerTypeRange t
-                (_, i') = convertSubExpr i
-        convertSubExpr (Call e args) =
-            (retType, Call e $ convertCall structs types e' args)
-            where
-                (_, e') = convertSubExpr e
-                retType = case e' of
-                    Ident f -> case Map.lookup f types of
-                        Nothing -> Implicit Unspecified []
-                        Just t -> t
-                    _ -> Implicit Unspecified []
-        convertSubExpr (String s) = (Implicit Unspecified [], String s)
-        convertSubExpr (Number n) = (Implicit Unspecified [], Number n)
-        convertSubExpr (Time   n) = (Implicit Unspecified [], Time   n)
-        convertSubExpr (PSIdent x y) = (Implicit Unspecified [], PSIdent x y)
-        convertSubExpr (Repeat e es) =
-            (Implicit Unspecified [], Repeat e' es')
-            where
-                (_, e') = convertSubExpr e
-                es' = map (snd . convertSubExpr) es
-        convertSubExpr (UniOp op e) =
-            (Implicit Unspecified [], UniOp op e')
-            where (_, e') = convertSubExpr e
-        convertSubExpr (Mux a b c) =
-            (t, Mux a' b' c')
-            where
-                (_, a') = convertSubExpr a
-                (t, b') = convertSubExpr b
-                (_, c') = convertSubExpr c
-        convertSubExpr (Cast (Left t) sub) =
-            (t, Cast (Left t) (snd $ convertSubExpr sub))
-        convertSubExpr (Cast (Right e) sub) =
-            (Implicit Unspecified [], Cast (Right e) (snd $ convertSubExpr sub))
-        convertSubExpr (DimsFn f tore) =
-            (Implicit Unspecified [], DimsFn f tore')
-            where tore' = convertTypeOrExpr tore
-        convertSubExpr (DimFn f tore e) =
-            (Implicit Unspecified [], DimFn f tore' e')
-            where
-                tore' = convertTypeOrExpr tore
-                e' = snd $ convertSubExpr e
-        convertSubExpr (Pattern items) =
-            if all (== "") $ map fst items'
-                then (Implicit Unspecified [], Concat $ map snd items')
-                else (Implicit Unspecified [], Pattern items')
     where
         items' = map mapItem items
-                mapItem (mx, e) = (mx, snd $ convertSubExpr e)
+        mapItem (x, e) = (x, e')
-        convertSubExpr (Inside e l) =
+            where (_, e') = convertSubExpr scopes e
-            (t, Inside e' l')
+convertSubExpr scopes (MuxA r a b c) =
+    (t, MuxA r a' b' c')
     where
-                t = IntegerVector TLogic Unspecified []
+        (_, a') = convertSubExpr scopes a
-                (_, e') = convertSubExpr e
+        (t, b') = convertSubExpr scopes b
-                l' = map mapItem l
+        (_, c') = convertSubExpr scopes c
-                mapItem :: ExprOrRange -> ExprOrRange
+convertSubExpr scopes (Ident x) =
-                mapItem (Left a) = Left $ snd $ convertSubExpr a
+    fallbackType scopes (Ident x)
-                mapItem (Right (a, b)) = Right (a', b')
+convertSubExpr scopes e =
+    (UnknownType, ) $
+        traverseExprTypes typeMapper $
+        traverseSinglyNestedExprs exprMapper e
     where
-                        (_, a') = convertSubExpr a
+        exprMapper = snd . convertSubExpr scopes
-                        (_, b') = convertSubExpr b
+        typeMapper = convertType .
-        convertSubExpr (MinTypMax a b c) =
+            traverseNestedTypes (traverseTypeExprs exprMapper)
-            (t, MinTypMax a' b' c')
+
+-- get the fields and type function of a struct or union
+getFields :: Type -> Maybe [Field]
+getFields (Struct _ fields []) = Just fields
+getFields (Union  _ fields []) = Just fields
+getFields _ = Nothing
+
+isntStruct :: Type -> Bool
+isntStruct = (== Nothing) . getFields
+
+-- get the field type, flattened bounds, and original type dimensions
+lookupFieldInfo :: Scopes Type -> Type -> Expr -> Identifier
+    -> (Bool, Type, Range, [Range])
+lookupFieldInfo scopes struct base fieldName =
+    if maybeFieldType == Nothing
+        then (isHier, err, err, err)
+        else (False, fieldType, bounds, dims)
     where
-                (_, a') = convertSubExpr a
+        Just fields = getFields struct
-                (t, b') = convertSubExpr b
+        maybeFieldType = lookup fieldName $ map swap fields
-                (_, c') = convertSubExpr c
+        Just fieldType = maybeFieldType
-        convertSubExpr Nil = (Implicit Unspecified [], Nil)
+        dims = snd $ typeRanges fieldType
-
+        Just (_, unstructRanges) = convertStruct struct
-        convertTypeOrExpr :: TypeOrExpr -> TypeOrExpr
+        Just bounds = lookup fieldName unstructRanges
-        convertTypeOrExpr (Left t) = Left t
+        err = scopedError scopes $ "field '" ++ fieldName ++ "' not found in "
-        convertTypeOrExpr (Right e) = Right $ snd $ convertSubExpr e
+                ++ show struct ++ ", in expression "
-
+                ++ show (Dot base fieldName)
-        -- lookup the range of a field in its unstructured type
+        isHier = lookupElem scopes (Dot base fieldName) /= Nothing
-        lookupUnstructRange :: TypeFunc -> Identifier -> Range
-        lookupUnstructRange structTf fieldName =
-            case Map.lookup fieldName fieldRangeMap of
-                Nothing -> error $ "field '" ++ fieldName ++
-                    "' not found in struct: " ++ show structTf
-                Just r -> r
-            where fieldRangeMap = Map.map fst $ snd $ structs Map.! structTf
-
-        -- lookup the type of a field in the given field list
-        lookupFieldType :: [(Type, Identifier)] -> Identifier -> Type
-        lookupFieldType fields fieldName = fieldMap Map.! fieldName
-            where fieldMap = Map.fromList $ map swap fields
 
 -- attempts to convert based on the assignment-like contexts of TF arguments
-convertCall :: Structs -> Types -> Expr -> Args -> Args
+convertCall :: Scopes Type -> Expr -> Args -> Args
-convertCall structs types fn (Args pnArgs kwArgs) =
+convertCall scopes fn (Args pnArgs kwArgs) =
-    case fn of
+    Args (map snd pnArgs') kwArgs'
-        Ident _ -> args
-        _ -> Args pnArgs kwArgs
     where
-        Ident f = fn
+        Just fnLHS = exprToLHS fn
+        pnArgs' = map (convertArg fnLHS) $ zip idxs pnArgs
+        kwArgs' = map (convertArg fnLHS) kwArgs
         idxs = map show ([0..] :: [Int])
-        args = Args
+        convertArg :: LHS -> (Identifier, Expr) -> (Identifier, Expr)
-            (map snd $ map convertArg $ zip idxs pnArgs)
+        convertArg lhs (x, e) =
-            (map convertArg kwArgs)
+            (x, e')
-        convertArg :: (Identifier, Maybe Expr) -> (Identifier, Maybe Expr)
-        convertArg (x, Nothing) = (x, Nothing)
-        convertArg (x, Just e ) = (x, Just e')
             where
-                (_, e') = convertAsgn structs types
+                details = lookupElem scopes $ LHSDot lhs x
-                    (LHSIdent $ f ++ ":" ++ x, e)
+                typ = maybe UnknownType thd3 details
-
+                thd3 (_, _, c) = c
+                (_, e') = convertSubExpr scopes $ convertExpr scopes typ e

src/Convert/StructConst.hs

@@ -0,0 +1,98 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - High-level elaboration for struct constant accesses
+ -
+ - This greatly simplifies designs with long sequences of struct parameters
+ - which extend and reference one another, as seen in BlackParrot.
+ -}
+
+module Convert.StructConst (convert) where
+
+import Control.Monad (join, mplus, when)
+import Control.Monad.State.Strict
+import Data.Maybe (fromMaybe)
+import Data.Tuple (swap)
+import qualified Data.Map.Strict as Map
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+type StructType = [Field]
+type StructValue = [(TypeOrExpr, Expr)]
+
+type Const = (StructType, StructValue)
+type Consts = Map.Map Identifier Const
+type Types = Map.Map Identifier StructType
+
+type SC = State (Types, Consts)
+
+convert :: [AST] -> [AST]
+convert = map $ traverseDescriptions convertDescription
+
+convertDescription :: Description -> Description
+convertDescription =
+    flip evalState mempty .
+    traverseModuleItemsM (traverseDeclsM elaborateDecl)
+
+insertType :: Identifier -> [Field] -> SC ()
+insertType ident typ = do
+    (types, consts) <- get
+    let types' = Map.insert ident typ types
+    put (types', consts)
+
+insertConst :: Identifier -> Const -> SC ()
+insertConst ident cnst = do
+    (types, consts) <- get
+    let consts' = Map.insert ident cnst consts
+    put (types, consts')
+
+lookupType :: Type -> SC [Field]
+lookupType (Alias ident []) = do
+    maybeFields <- gets $ Map.lookup ident . fst
+    return $ fromMaybe [] maybeFields
+lookupType (Struct (Packed Unspecified) fields []) =
+    return fields
+lookupType _ = return []
+
+lookupConst :: Identifier -> SC (Maybe Const)
+lookupConst param = gets $ Map.lookup param . snd
+
+elaborateDecl :: Decl -> SC Decl
+-- track struct type parameters
+elaborateDecl decl@(ParamType Localparam x t)
+    | Struct (Packed Unspecified) fields [] <- t =
+        insertType x fields >> return decl
+-- track and resolve struct constants
+elaborateDecl (Param Localparam t x e) = do
+    e' <- elaborateExpr e
+    fields <- lookupType t
+    when (not $ null fields) $ do
+        maybeValues <- extractStructValue e'
+        case maybeValues of
+            Just values -> insertConst x (fields, values)
+            Nothing -> return ()
+    return $ Param Localparam t x e'
+elaborateDecl decl = return decl
+
+-- extract the pattern items, including for simple aliases
+extractStructValue :: Expr -> SC (Maybe StructValue)
+extractStructValue (Pattern values) = return $ Just values
+extractStructValue (Ident param) = fmap (fmap snd) $ lookupConst param
+extractStructValue _ = return Nothing
+
+-- elaborate constant field accesses
+elaborateExpr :: Expr -> SC Expr
+elaborateExpr expr@(Dot (Ident param) field) =
+    fmap (fromMaybe expr . join . fmap (resolveParam field)) (lookupConst param)
+elaborateExpr expr =
+    traverseSinglyNestedExprsM elaborateExpr expr
+
+-- lookup value in struct constant
+resolveParam :: Identifier -> Const -> Maybe Expr
+resolveParam field (fields, values) = do
+    fieldType <- lookup field (map swap fields)
+    value <- mplus
+        (lookup (Right $ Ident field) values)
+        (lookup (Left UnknownType) values)
+    Just $ Cast (Left fieldType) value

src/Convert/TFBlock.hs

@@ -0,0 +1,69 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for tasks and functions to contain only one top-level statement,
+ - as required in Verilog-2005. This conversion also hoists data declarations to
+ - the task or function level for greater portability.
+ -}
+
+module Convert.TFBlock (convert) where
+
+import Data.List (intersect)
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+convert :: [AST] -> [AST]
+convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem
+
+convertModuleItem :: ModuleItem -> ModuleItem
+convertModuleItem (MIPackageItem packageItem) =
+    MIPackageItem $ convertPackageItem packageItem
+convertModuleItem other = other
+
+convertPackageItem :: PackageItem -> PackageItem
+convertPackageItem (Function ml t f decls stmts) =
+    Function ml t f decls' stmts'
+    where (decls', stmts') = convertTFBlock decls stmts
+convertPackageItem (Task     ml   f decls stmts) =
+    Task     ml   f decls' stmts'
+    where (decls', stmts') = convertTFBlock decls stmts
+convertPackageItem other = other
+
+convertTFBlock :: [Decl] -> [Stmt] -> ([Decl], [Stmt])
+convertTFBlock decls [CommentStmt c, stmt] =
+    convertTFBlock (decls ++ [CommentDecl c]) [stmt]
+convertTFBlock decls stmts =
+    (decls', [stmtsToStmt stmts'])
+    where (decls', stmts') = flattenOuterBlocks $ Block Seq "" decls stmts
+
+stmtsToStmt :: [Stmt] -> Stmt
+stmtsToStmt [stmt] = stmt
+stmtsToStmt stmts = Block Seq "" [] stmts
+
+flattenOuterBlocks :: Stmt -> ([Decl], [Stmt])
+flattenOuterBlocks (Block Seq "" declsA [stmt]) =
+    if canCombine declsA declsB
+        then (declsA ++ declsB, stmtsB)
+        else (declsA, [stmt])
+    where (declsB, stmtsB) = flattenOuterBlocks stmt
+flattenOuterBlocks (Block Seq name decls stmts)
+    | null name = (decls, stmts)
+    | otherwise = ([], [Block Seq name decls stmts])
+flattenOuterBlocks stmt = ([], [stmt])
+
+canCombine :: [Decl] -> [Decl] -> Bool
+canCombine [] _ = True
+canCombine _ [] = True
+canCombine declsA declsB =
+    null $ intersect (declNames declsA) (declNames declsB)
+
+declNames :: [Decl] -> [Identifier]
+declNames = filter (not . null) . map declName
+
+declName :: Decl -> Identifier
+declName (Variable _ _ x _ _) = x
+declName (Net  _ _ _ _ x _ _) = x
+declName (Param _ _ x _) = x
+declName (ParamType _ x _) = x
+declName CommentDecl{} = ""

src/Convert/TypeOf.hs

@@ -3,93 +3,397 @@
  -
  - Conversion for the `type` operator
  -
- - TODO: This conversion only supports the most basic expressions so far. We can
+ - This conversion is responsible for explicit type resolution throughout sv2v.
- - add support for range and bit accesses, struct fields, and perhaps even
+ - It uses Scoper to resolve hierarchical expressions in a scope-aware manner.
- - arithmetic operations. Bits and pieces of similar logic exist in other
+ -
- - conversion.
+ - Some other conversions, such as the dimension query and streaming
+ - concatenation conversions, defer the resolution of type information to this
+ - conversion pass by producing nodes with the `type` operator during
+ - elaboration.
+ -
+ - This conversion also elaborates sign and size casts to their primitive types.
+ - Sign casts take on the size of the underlying expression. Size casts take on
+ - the sign of the underlying expression. This conversion incorporates this
+ - elaboration as the canonical source for type information. It also enables the
+ - removal of unnecessary casts often resulting from struct literals or casts in
+ - the source intended to appease certain lint rules.
  -}
 
 module Convert.TypeOf (convert) where
 
-import Control.Monad.State
+import Control.Monad.State.Strict
-import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Tuple (swap)
-import qualified Data.Map.Strict as Map
 
+import Convert.ExprUtils (dimensionsSize, endianCondRange, simplify)
+import Convert.Scoper
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type Info = Map.Map Identifier Type
-
 convert :: [AST] -> [AST]
-convert = map $ traverseDescriptions convertDescription
+convert = map $ traverseDescriptions $ partScoper
+    traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
 
-convertDescription :: Description -> Description
+-- single bit 4-state `logic` type
-convertDescription (description @ Part{}) =
+pattern UnitType :: Type
-    scopedConversion traverseDeclM traverseModuleItemM traverseStmtM
+pattern UnitType = IntegerVector TLogic Unspecified []
-        initialState description
-    where
-        Part _ _ _ _ _ _ items = description
-        initialState = Map.fromList $ mapMaybe returnType items
-        returnType :: ModuleItem -> Maybe (Identifier, Type)
-        returnType (MIPackageItem (Function _ t f _ _)) =
-            if t == Implicit Unspecified []
-                -- functions with no return type implicitly return a single bit
-                then Just (f, IntegerVector TLogic Unspecified [])
-                else Just (f, t)
-        returnType _ = Nothing
-convertDescription other = other
 
-traverseDeclM :: Decl -> State Info Decl
+type ST = Scoper Type
+
+-- insert the given declaration into the scope, and convert an TypeOfs within
+traverseDeclM :: Decl -> ST Decl
+traverseDeclM decl@Net{} =
+    traverseNetAsVarM traverseDeclM decl
 traverseDeclM decl = do
-    item <- traverseModuleItemM (MIPackageItem $ Decl decl)
+    decl' <- traverseDeclNodesM traverseTypeM traverseExprM decl
-    let MIPackageItem (Decl decl') = item
     case decl' of
-        Variable d t ident a me -> do
+        Variable _ (Implicit sg rs) ident a _ ->
+            -- implicit types, which are commonly found in function return
+            -- types, are recast as logics to avoid outputting bare ranges
+            insertType ident t' >> return decl'
+            where t' = injectRanges (IntegerVector TLogic sg rs) a
+        Variable d t ident a e -> do
             let t' = injectRanges t a
-            modify $ Map.insert ident t'
+            insertType ident t'
             return $ case t' of
-                UnpackedType t'' a' -> Variable d t'' ident a' me
+                UnpackedType t'' a' -> Variable d t'' ident a' e
-                _ ->                   Variable d t'  ident [] me
+                _ ->                   Variable d t'  ident [] e
-        Param    _ t ident   _ -> do
+        Param Parameter UnknownType ident String{} ->
-            modify $ Map.insert ident t
+            insertType ident (TypeOf $ Ident ident) >> return decl'
-            return decl'
+        Param _ UnknownType ident e ->
-        ParamType    _     _ _ -> return decl'
+            typeof e >>= insertType ident >> return decl'
+        Param _ (Implicit sg rs) ident _ ->
+            insertType ident t' >> return decl'
+            where t' = IntegerVector TLogic sg rs
+        Param _ t ident _ ->
+            insertType ident t >> return decl'
+        _ -> return decl'
 
-traverseModuleItemM :: ModuleItem -> State Info ModuleItem
+-- rewrite and store a non-genvar data declaration's type information
-traverseModuleItemM item = traverseTypesM traverseTypeM item
+insertType :: Identifier -> Type -> ST ()
+insertType ident typ = do
+    -- hack to make this evaluation lazy
+    typ' <- gets $ evalState $ scopeType typ
+    insertElem ident typ'
 
-traverseStmtM :: Stmt -> State Info Stmt
+-- convert TypeOf in a ModuleItem
-traverseStmtM =
+traverseModuleItemM :: ModuleItem -> ST ModuleItem
-    traverseStmtExprsM $ traverseNestedExprsM $ traverseExprTypesM traverseTypeM
+traverseModuleItemM =
+    traverseNodesM traverseExprM return traverseTypeM traverseLHSM return
+    where traverseLHSM = traverseNestedLHSsM $ traverseLHSExprsM traverseExprM
 
-traverseTypeM :: Type -> State Info Type
+-- convert TypeOf in a GenItem
-traverseTypeM (TypeOf expr) = typeof expr
+traverseGenItemM :: GenItem -> ST GenItem
-traverseTypeM other = return other
+traverseGenItemM = traverseGenItemExprsM traverseExprM
 
-typeof :: Expr -> State Info Type
+-- convert TypeOf in a Stmt
-typeof (orig @ (Ident x)) = do
+traverseStmtM :: Stmt -> ST Stmt
-    res <- gets $ Map.lookup x
+traverseStmtM = traverseStmtExprsM traverseExprM
-    return $ fromMaybe (TypeOf orig) res
+
-typeof (orig @ (Call (Ident x) _)) = do
+-- convert TypeOf in an Expr
-    res <- gets $ Map.lookup x
+traverseExprM :: Expr -> ST Expr
-    return $ fromMaybe (TypeOf orig) res
+traverseExprM (Cast (Left (Implicit sg [])) expr) =
-typeof (orig @ (Bit e _)) = do
+    -- `signed'(foo)` and `unsigned'(foo)` are syntactic sugar for the `$signed`
-    t <- typeof e
+    -- and `$unsigned` system functions present in Verilog-2005
-    return $ case t of
+    traverseExprM $ Call (Ident fn) $ Args [expr] []
-        TypeOf _ -> TypeOf orig
+    where fn = if sg == Signed then "$signed" else "$unsigned"
-        _ -> popRange t
+traverseExprM (Cast (Left t) (Number (UnbasedUnsized bit))) =
-typeof (orig @ (Range e mode r)) = do
+    -- defer until this expression becomes explicit
-    t <- typeof e
+    return $ Cast (Left t) (Number (UnbasedUnsized bit))
-    return $ case t of
+traverseExprM (Cast (Left t@(IntegerAtom TInteger _)) expr) =
-        TypeOf _ -> TypeOf orig
+    -- convert to cast to an integer vector type
-        _ -> replaceRange (lo, hi) t
+    traverseExprM $ Cast (Left t') expr
     where
-        lo = fst r
+        (tf, []) = typeRanges t
-        hi = case mode of
+        t' = tf [(RawNum 1, RawNum 1)]
-            NonIndexed   -> snd r
+traverseExprM (Cast (Left t1) expr) = do
-            IndexedPlus  -> BinOp Sub (uncurry (BinOp Add) r) (Number "1")
+    expr' <- traverseExprM expr
-            IndexedMinus -> BinOp Add (uncurry (BinOp Sub) r) (Number "1")
+    t1' <- traverseTypeM t1
-typeof other = return $ TypeOf other
+    t2 <- typeof expr'
+    if typeCastUnneeded t1' t2
+        then traverseExprM $ makeExplicit expr'
+        else return $ Cast (Left t1') expr'
+traverseExprM (Cast (Right (Ident x)) expr) = do
+    expr' <- traverseExprM expr
+    details <- lookupElemM x
+    isGenvar <- isLoopVarM x
+    if details == Nothing && not isGenvar
+        then return $ Cast (Left $ Alias x []) expr'
+        else elaborateSizeCast (Ident x) expr'
+traverseExprM (Cast (Right size) expr) = do
+    expr' <- traverseExprM expr
+    size' <- traverseExprM size
+    elaborateSizeCast size' expr'
+traverseExprM orig@(Dot (Ident x) f) = do
+    unneeded <- unneededModuleScope x f
+    return $ if unneeded
+        then Ident f
+        else orig
+traverseExprM other =
+    traverseSinglyNestedExprsM traverseExprM other
+    >>= traverseExprTypesM traverseTypeM
+
+-- carry forward the signedness of the expression when cast to the given size
+elaborateSizeCast :: Expr -> Expr -> ST Expr
+elaborateSizeCast (Number size) _ | Just 0 == numberToInteger size =
+    -- special case because zero-width ranges cannot be represented
+    scopedErrorM $ "size cast width " ++ show size
+        ++ " is not a positive integer"
+elaborateSizeCast size value = do
+    t <- typeof value
+    force <- isStringParam value
+    case (typeSignedness t, force) of
+        (Unspecified, False)-> return $ Cast (Right size) value
+        (sg, _) -> traverseExprM $ Cast (Left $ typeOfSize sg size) value
+
+-- string params use a self-referential type to enable the string param
+-- conversion to add a synthetic parameter if necessary; this check enables size
+-- casts to assume a string parameter is unsigned regardless of its length
+isStringParam :: Expr -> ST Bool
+isStringParam (Ident x) = do
+    details <- lookupElemM x
+    return $ case details of
+        Nothing -> False
+        Just (_, _, typ) -> typ == TypeOf (Ident x)
+isStringParam _ = return False
+
+-- checks if referring to part.wire is needlessly explicit
+unneededModuleScope :: Identifier -> Identifier -> ST Bool
+unneededModuleScope part wire = do
+    partDetails <- lookupElemM part
+    accessesLocal <- localAccessesM wire
+    if partDetails /= Nothing then
+        return False
+    else if accessesLocal == accessesTop then
+        return True
+    else if head accessesLocal == head accessesTop then do
+        details <- lookupElemM wire
+        return $ case details of
+            Just (accessesFound, _, _) -> accessesTop == accessesFound
+            _ -> False
+    else
+        return False
+    where accessesTop = [Access part Nil, Access wire Nil]
+
+-- convert TypeOf in a Type
+traverseTypeM :: Type -> ST Type
+traverseTypeM (TypeOf expr) =
+    traverseExprM expr >>= typeof
+traverseTypeM other =
+    traverseSinglyNestedTypesM traverseTypeM other
+    >>= traverseTypeExprsM traverseExprM
+
+-- attempts to find the given (potentially hierarchical or generate-scoped)
+-- expression in the available scope information
+lookupTypeOf :: Expr -> ST Type
+lookupTypeOf expr@(Ident x) = do
+    details <- lookupElemM x
+    loopVar <- loopVarDepthM x
+    return $ case details of
+        Nothing ->
+            if loopVar == Nothing
+                then TypeOf expr
+                else IntegerAtom TInteger Unspecified
+        Just (accesses, replacements, typ) ->
+            if maybe True (length accesses >) loopVar
+                then replaceInType replacements typ
+                else IntegerAtom TInteger Unspecified
+lookupTypeOf expr = do
+    details <- lookupElemM expr
+    return $ case details of
+        Nothing -> TypeOf expr
+        Just (_, replacements, typ) ->
+            replaceInType replacements typ
+
+-- determines the type of an expression based on the available scope information
+-- according the semantics defined in IEEE 1800-2017, especially Section 11.6
+typeof :: Expr -> ST Type
+typeof (Number n) =
+    return $ IntegerVector TLogic sg [r]
+    where
+        r = (RawNum $ size - 1, RawNum 0)
+        size = numberBitLength n
+        sg = if numberIsSigned n then Signed else Unspecified
+typeof (Call (Ident x) args) = typeofCall x args
+typeof orig@(Bit e _) = do
+    t <- typeof e
+    case t of
+        TypeOf{} -> return $ TypeOf orig
+        Alias{} -> return $ TypeOf orig
+        _ -> do
+            t' <- popRange orig t
+            return $ typeSignednessOverride t' Unsigned t'
+typeof orig@(Range e NonIndexed r) = do
+    t <- typeof e
+    case t of
+        TypeOf{} -> return $ TypeOf orig
+        Alias{} -> return $ TypeOf orig
+        _ -> do
+            t' <- replaceRange orig r t
+            return $ typeSignednessOverride t' Unsigned t'
+typeof (Range expr mode (base, len)) =
+    typeof $ Range expr NonIndexed $
+        endianCondRange index (base, end) (end, base)
+    where
+        index =
+            if mode == IndexedPlus
+                then (boundR, boundL)
+                else (boundL, boundR)
+        boundL = DimFn FnLeft  (Left $ TypeOf expr) (RawNum 1)
+        boundR = DimFn FnRight (Left $ TypeOf expr) (RawNum 1)
+        end =
+            if mode == IndexedPlus
+                then BinOp Sub (BinOp Add base len) (RawNum 1)
+                else BinOp Add (BinOp Sub base len) (RawNum 1)
+typeof orig@(Dot e x) = do
+    t <- typeof e
+    case t of
+        Struct _ fields [] -> return $ fieldsType fields
+        Union _  fields [] -> return $ fieldsType fields
+        _ -> lookupTypeOf orig
+    where
+        fieldsType :: [Field] -> Type
+        fieldsType fields =
+            case lookup x $ map swap fields of
+                Just typ -> typ
+                Nothing -> TypeOf orig
+typeof (Cast (Left t) _) = traverseTypeM t
+typeof (UniOpA op _  expr) = typeofUniOp op expr
+typeof (BinOpA op _   a b) = typeofBinOp op a b
+typeof (MuxA      _ _ a b) = largerSizeType a b
+typeof (Concat      exprs) = return $ typeOfSize Unsigned $ concatSize exprs
+typeof (Stream _ _  exprs) = return $ typeOfSize Unsigned $ concatSize exprs
+typeof (Repeat reps exprs) = return $ typeOfSize Unsigned size
+    where size = BinOp Mul reps (concatSize exprs)
+typeof (String str) =
+    return $ IntegerVector TBit Unspecified [r]
+    where
+        r = (RawNum $ len - 1, RawNum 0)
+        len = if null str then 8 else 8 * unescapedLength str
+typeof other = lookupTypeOf other
+
+-- length of a string literal in characters
+unescapedLength :: String -> Integer
+unescapedLength [] = 0
+unescapedLength ('\\' : _ : rest) = 1 + unescapedLength rest
+unescapedLength (_        : rest) = 1 + unescapedLength rest
+
+-- type of a standard (non-member) function call
+typeofCall :: String -> Args -> ST Type
+typeofCall "$unsigned" (Args [e] []) = return $ typeOfSize Unsigned $ sizeof e
+typeofCall "$signed"   (Args [e] []) = return $ typeOfSize Signed   $ sizeof e
+typeofCall "$clog2"    (Args [_] []) =
+    return $ IntegerAtom TInteger Unspecified
+typeofCall fnName _ = typeof $ Ident fnName
+
+-- replaces the signing of a type if possible
+typeSignednessOverride :: Type -> Signing -> Type -> Type
+typeSignednessOverride fallback sg t =
+    case t of
+        IntegerVector base _ rs -> IntegerVector base sg rs
+        IntegerAtom   base _    -> IntegerAtom   base sg
+        _ -> fallback
+
+-- type of a unary operator expression
+typeofUniOp :: UniOp -> Expr -> ST Type
+typeofUniOp UniAdd e = typeof e
+typeofUniOp UniSub e = typeof e
+typeofUniOp BitNot e = typeof e
+typeofUniOp _ _ =
+    -- unary reductions and logical negation
+    return UnitType
+
+-- type of a binary operator expression (Section 11.6.1)
+typeofBinOp :: BinOp -> Expr -> Expr -> ST Type
+typeofBinOp op a b =
+    case op of
+        LogAnd  -> unitType
+        LogOr   -> unitType
+        LogImp  -> unitType
+        LogEq   -> unitType
+        Eq      -> unitType
+        Ne      -> unitType
+        TEq     -> unitType
+        TNe     -> unitType
+        WEq     -> unitType
+        WNe     -> unitType
+        Lt      -> unitType
+        Le      -> unitType
+        Gt      -> unitType
+        Ge      -> unitType
+        Pow     -> typeof a
+        ShiftL  -> typeof a
+        ShiftR  -> typeof a
+        ShiftAL -> typeof a
+        ShiftAR -> typeof a
+        Add     -> largerSizeType a b
+        Sub     -> largerSizeType a b
+        Mul     -> largerSizeType a b
+        Div     -> largerSizeType a b
+        Mod     -> largerSizeType a b
+        BitAnd  -> largerSizeType a b
+        BitXor  -> largerSizeType a b
+        BitXnor -> largerSizeType a b
+        BitOr   -> largerSizeType a b
+    where unitType = return UnitType
+
+-- produces a type large enough to hold either expression
+largerSizeType :: Expr -> Expr -> ST Type
+largerSizeType a (Number (Based 1 _ _ _ _)) = typeof a
+largerSizeType a b = do
+    t <- typeof a
+    u <- typeof b
+    let sg = binopSignedness (typeSignedness t) (typeSignedness u)
+    return $
+        if t == u then
+            t
+        else if sg == Unspecified then
+            TypeOf $ BinOp Add a b
+        else
+            typeOfSize sg $ largerSizeOf a b
+
+-- returns the signedness of a traditional arithmetic binop, if possible
+binopSignedness :: Signing -> Signing -> Signing
+binopSignedness Unspecified _ = Unspecified
+binopSignedness _ Unspecified = Unspecified
+binopSignedness Unsigned _ = Unsigned
+binopSignedness _ Unsigned = Unsigned
+binopSignedness Signed Signed = Signed
+
+-- returns the signedness of the given type, if possible
+typeSignedness :: Type -> Signing
+typeSignedness (IntegerVector _ sg _) = signednessFallback Unsigned sg
+typeSignedness (IntegerAtom   t sg  ) = signednessFallback fallback sg
+    where fallback = if t == TTime then Unsigned else Signed
+typeSignedness _ = Unspecified
+
+-- helper for producing the former signing when the latter is unspecified
+signednessFallback :: Signing -> Signing -> Signing
+signednessFallback fallback Unspecified = fallback
+signednessFallback _ sg = sg
+
+-- returns the total size of concatenated list of expressions
+concatSize :: [Expr] -> Expr
+concatSize exprs =
+    foldl (BinOp Add) (RawNum 0) $
+    map sizeof exprs
+
+-- returns the size of an expression, with the short-circuiting
+sizeof :: Expr -> Expr
+sizeof (Number n) = RawNum $ numberBitLength n
+sizeof (MuxA _ _ a b) = largerSizeOf a b
+sizeof expr = DimsFn FnBits $ Left $ TypeOf expr
+
+-- returns the maximum size of the two given expressions
+largerSizeOf :: Expr -> Expr -> Expr
+largerSizeOf a b =
+    simplify $ Mux cond (sizeof a) (sizeof b)
+    where cond = BinOp Ge (sizeof a) (sizeof b)
+
+-- produces a generic type of the given size
+typeOfSize :: Signing -> Expr -> Type
+typeOfSize sg size =
+    IntegerVector TLogic sg [(hi, RawNum 0)]
+    where hi = simplify $ BinOp Sub size (RawNum 1)
 
 -- combines a type with unpacked ranges
 injectRanges :: Type -> [Range] -> Type
@@ -98,16 +402,54 @@ injectRanges (UnpackedType t rs) unpacked = UnpackedType t $ unpacked ++ rs
 injectRanges t unpacked = UnpackedType t unpacked
 
 -- removes the most significant range of the given type
-popRange :: Type -> Type
+popRange :: Expr -> Type -> ST Type
-popRange (UnpackedType t [_]) = t
+popRange _ (UnpackedType t [_]) = return t
-popRange t =
+popRange _ (IntegerAtom TInteger sg) =
-    tf $ tail rs
+    return $ IntegerVector TLogic sg []
-    where (tf, rs) = typeRanges t
+popRange e t =
+    case typeRanges t of
+        (tf, _ : rs) -> return $ tf rs
+        _ -> indexedAtomError e t
 
 -- replaces the most significant range of the given type
-replaceRange :: Range -> Type -> Type
+replaceRange :: Expr -> Range -> Type -> ST Type
-replaceRange r (UnpackedType t (_ : rs)) =
+replaceRange _ r (UnpackedType t (_ : rs)) =
-    UnpackedType t (r : rs)
+    return $ UnpackedType t (r : rs)
-replaceRange r t =
+replaceRange _ r (IntegerAtom TInteger sg) =
-    tf $ r : tail rs
+    return $ IntegerVector TLogic sg [r]
-    where (tf, rs) = typeRanges t
+replaceRange e r t =
+    case typeRanges t of
+        (tf, _ : rs) -> return $ tf (r : rs)
+        _ -> indexedAtomError e t
+
+-- readable error message when looking up the type of a portion of an atom
+indexedAtomError :: Expr -> Type -> ST a
+indexedAtomError e t =
+    scopedErrorM $ "can't determine the type of " ++ show e ++ " because the"
+        ++ " inner type " ++ show t ++ " can't be indexed"
+
+-- checks for a cast type which already trivially matches the expression type
+typeCastUnneeded :: Type -> Type -> Bool
+typeCastUnneeded t1 t2 =
+    sg1 == sg2 && sz1 == sz2 && sz1 /= Nothing && sz2 /= Nothing
+    where
+        sg1 = typeSignedness t1
+        sg2 = typeSignedness t2
+        sz1 = typeSize t1
+        sz2 = typeSize t2
+        typeSize :: Type -> Maybe Expr
+        typeSize (IntegerVector _ _ rs) = Just $ dimensionsSize rs
+        typeSize t@IntegerAtom{} =
+            typeSize $ tf [(RawNum 1, RawNum 1)]
+            where (tf, []) = typeRanges t
+        typeSize _ = Nothing
+
+-- explicitly sizes top level numbers used in arithmetic expressions
+makeExplicit :: Expr -> Expr
+makeExplicit (Number n) =
+    Number $ numberCast (numberIsSigned n) (fromIntegral $ numberBitLength n) n
+makeExplicit (BinOpA op a e1 e2) =
+    BinOpA op a (makeExplicit e1) (makeExplicit e2)
+makeExplicit (UniOpA op a e) =
+    UniOpA op a $ makeExplicit e
+makeExplicit other = other

src/Convert/Typedef.hs

@@ -1,7 +1,7 @@
 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  -
- - Conversion for `typedef`
+ - Conversion for `typedef` and `localparam type`
  -
  - Aliased types can appear in all data declarations, including modules, blocks,
  - and function parameters. They are also found in type cast expressions.
@@ -9,98 +9,146 @@
 
 module Convert.Typedef (convert) where
 
-import Control.Monad.Writer
+import Control.Monad ((>=>))
-import qualified Data.Map as Map
 
+import Convert.Scoper
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type Types = Map.Map Identifier Type
-
 convert :: [AST] -> [AST]
-convert =
+convert = map $ traverseDescriptions $ evalScoper . scopeModule scoper
-    traverseFiles
+    where scoper = scopeModuleItem
-        (collectDescriptionsM getTypedef)
+            traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
-        (\a -> traverseDescriptions $ removeTypedef . convertDescription a)
-    where
-        getTypedef :: Description -> Writer Types ()
-        getTypedef (PackageItem (Typedef a b)) = tell $ Map.singleton b a
-        getTypedef (Part _ _ Interface _ x _ _) =
-            tell $ Map.singleton x (InterfaceT x Nothing [])
-        getTypedef _ = return ()
-        removeTypedef :: Description -> Description
-        removeTypedef (PackageItem (Typedef _ x)) =
-            PackageItem $ Comment $ "removed typedef: " ++ x
-        removeTypedef other = other
 
-convertDescription :: Types -> Description -> Description
+type SC = Scoper IdentKind
-convertDescription globalTypes description =
-    traverseModuleItems removeTypedef $
-    traverseModuleItems convertModuleItem $
-    traverseModuleItems (traverseExprs $ traverseNestedExprs $ convertExpr) $
-    traverseModuleItems (traverseTypes $ resolveType types) $
-    description
-    where
-        types = Map.union globalTypes $
-            execWriter $ collectModuleItemsM getTypedef description
-        getTypedef :: ModuleItem -> Writer Types ()
-        getTypedef (MIPackageItem (Typedef a b)) = tell $ Map.singleton b a
-        getTypedef _ = return ()
-        removeTypedef :: ModuleItem -> ModuleItem
-        removeTypedef (MIPackageItem (Typedef _ x)) =
-            MIPackageItem $ Comment $ "removed typedef: " ++ x
-        removeTypedef other = other
-        convertTypeOrExpr :: TypeOrExpr -> TypeOrExpr
-        convertTypeOrExpr (Left (TypeOf (Ident x))) =
-            if Map.member x types
-                then Left $ resolveType types (Alias Nothing x [])
-                else Left $ TypeOf (Ident x)
-        convertTypeOrExpr (Right (Ident x)) =
-            if Map.member x types
-                then Left $ resolveType types (Alias Nothing x [])
-                else Right $ Ident x
-        convertTypeOrExpr other = other
-        convertExpr :: Expr -> Expr
-        convertExpr (Cast v e) = Cast (convertTypeOrExpr v) e
-        convertExpr (DimsFn f v) = DimsFn f (convertTypeOrExpr v)
-        convertExpr (DimFn f v e) = DimFn f (convertTypeOrExpr v) e
-        convertExpr other = other
-        convertModuleItem :: ModuleItem -> ModuleItem
-        convertModuleItem (Instance m params x r p) =
-            Instance m (map mapParam params) x r p
-            where mapParam (i, v) = (i, convertTypeOrExpr v)
-        convertModuleItem other = other
 
-resolveItem :: Types -> (Type, Identifier) -> (Type, Identifier)
+data IdentKind
-resolveItem types (t, x) = (resolveType types t, x)
+    = Type Type -- resolved typename
+    | Pending -- unresolved type parameter
+    | NonType String -- anything else
 
-resolveType :: Types -> Type -> Type
+traverseTypeOrExprM :: TypeOrExpr -> SC TypeOrExpr
-resolveType _ (Net           kw sg rs) = Net           kw sg rs
+traverseTypeOrExprM tore
-resolveType _ (Implicit         sg rs) = Implicit         sg rs
+    | Left (TypeOf expr) <- tore = possibleTypeName tore expr
-resolveType _ (IntegerVector kw sg rs) = IntegerVector kw sg rs
+    | Right expr <- tore = possibleTypeName tore expr
-resolveType _ (IntegerAtom   kw sg   ) = IntegerAtom   kw sg
+    | otherwise = return tore
-resolveType _ (NonInteger    kw      ) = NonInteger    kw
+
-resolveType _ (InterfaceT     x my rs) = InterfaceT     x my rs
+possibleTypeName :: TypeOrExpr -> Expr -> SC TypeOrExpr
-resolveType _ (Enum Nothing   vals rs) = Enum Nothing   vals rs
+possibleTypeName orig expr
-resolveType _ (Alias (Just ps)  st rs) = Alias (Just ps)  st rs
+    | Just (x, rs1) <- maybeTypeName = do
-resolveType _ (TypeOf            expr) = TypeOf            expr
+        details <- lookupElemM x
-resolveType _ (UnpackedType  t     rs) = UnpackedType  t     rs
+        return $ case details of
-resolveType types (Enum (Just t) vals rs) = Enum (Just $ resolveType types t) vals rs
+            Just (_, _, Type typ) ->
-resolveType types (Struct p items rs) = Struct p (map (resolveItem types) items) rs
+                Left $ tf $ rs1 ++ rs2
-resolveType types (Union  p items rs) = Union  p (map (resolveItem types) items) rs
+                where (tf, rs2) = typeRanges typ
-resolveType types (Alias Nothing st rs1) =
+            Just (_, _, Pending) ->
-    if Map.notMember st types
+                Left $ Alias x rs1
-    then Alias Nothing st rs1
+            _ -> orig
-    else case resolveType types $ types Map.! st of
+    | otherwise = return orig
-        (Net           kw sg rs2) -> Net           kw sg $ rs1 ++ rs2
+    where maybeTypeName = exprToTypeName [] expr
-        (Implicit         sg rs2) -> Implicit         sg $ rs1 ++ rs2
+
-        (IntegerVector kw sg rs2) -> IntegerVector kw sg $ rs1 ++ rs2
+-- aliases in type-or-expr contexts are parsed as expressions
-        (Enum            t v rs2) -> Enum            t v $ rs1 ++ rs2
+exprToTypeName :: [Range] -> Expr -> Maybe (Identifier, [Range])
-        (Struct          p l rs2) -> Struct          p l $ rs1 ++ rs2
+exprToTypeName rs (Ident x) = Just (x, rs)
-        (Union           p l rs2) -> Union           p l $ rs1 ++ rs2
+exprToTypeName rs (Bit expr idx) =
-        (InterfaceT     x my rs2) -> InterfaceT     x my $ rs1 ++ rs2
+    exprToTypeName (r : rs) expr
-        (Alias          ps x rs2) -> Alias          ps x $ rs1 ++ rs2
+    where r = (RawNum 0, BinOp Sub idx (RawNum 1))
-        (UnpackedType  t     rs2) -> UnpackedType      t $ rs1 ++ rs2
+exprToTypeName rs (Range expr NonIndexed r) = do
-        (IntegerAtom   kw sg    ) -> nullRange (IntegerAtom kw sg) rs1
+    exprToTypeName (r : rs) expr
-        (NonInteger    kw       ) -> nullRange (NonInteger  kw   ) rs1
+exprToTypeName _ _ = Nothing
-        (TypeOf             expr) -> nullRange (TypeOf       expr) rs1
+
+traverseExprM :: Expr -> SC Expr
+traverseExprM (Cast v e) = do
+    v' <- traverseTypeOrExprM v
+    traverseExprM' $ Cast v' e
+traverseExprM (DimsFn f v) = do
+    v' <- traverseTypeOrExprM v
+    traverseExprM' $ DimsFn f v'
+traverseExprM (DimFn f v e) = do
+    v' <- traverseTypeOrExprM v
+    traverseExprM' $ DimFn f v' e
+traverseExprM (Pattern items) = do
+    names <- mapM traverseTypeOrExprM $ map fst items
+    let exprs = map snd items
+    traverseExprM' $ Pattern $ zip names exprs
+traverseExprM other = traverseExprM' other
+
+traverseExprM' :: Expr -> SC Expr
+traverseExprM' =
+    traverseSinglyNestedExprsM traverseExprM
+    >=> traverseExprTypesM traverseTypeM
+
+traverseModuleItemM :: ModuleItem -> SC ModuleItem
+traverseModuleItemM (Instance m params x rs p) = do
+    let mapParam (i, v) = traverseTypeOrExprM v >>= \v' -> return (i, v')
+    params' <- mapM mapParam params
+    traverseModuleItemM' $ Instance m params' x rs p
+traverseModuleItemM item = traverseModuleItemM' item
+
+traverseModuleItemM' :: ModuleItem -> SC ModuleItem
+traverseModuleItemM' =
+    traverseNodesM traverseExprM return traverseTypeM traverseLHSM return
+    where traverseLHSM = traverseNestedLHSsM $ traverseLHSExprsM traverseExprM
+
+traverseGenItemM :: GenItem -> SC GenItem
+traverseGenItemM = traverseGenItemExprsM traverseExprM
+
+traverseDeclM :: Decl -> SC Decl
+traverseDeclM decl = do
+    decl' <- traverseDeclNodesM traverseTypeM traverseExprM decl
+    case decl' of
+        Variable _ _ x _ _ -> insertElem x (NonType "var") >> return decl'
+        Net  _ _ _ _ x _ _ -> insertElem x (NonType "net") >> return decl'
+        Param s (UnpackedType t rs1) x e -> do
+            insertElem x (NonType $ show s)
+            let (tf, rs2) = typeRanges t
+            let t' = tf $ rs1 ++ rs2
+            return $ Param s t' x e
+        Param s _ x _ ->
+            insertElem x (NonType $ show s) >> return decl'
+        ParamType Localparam x t -> do
+            traverseTypeM t >>= scopeType >>= insertElem x . Type
+            return $ case t of
+                Enum{} -> ParamType Localparam tmpX t
+                _ -> CommentDecl $ "removed localparam type " ++ x
+            where tmpX = "_sv2v_keep_enum_for_params"
+        ParamType Parameter x _ ->
+            insertElem x Pending >> return decl'
+        CommentDecl{} -> return decl'
+
+traverseStmtM :: Stmt -> SC Stmt
+traverseStmtM = traverseStmtExprsM traverseExprM
+
+traverseTypeM :: Type -> SC Type
+traverseTypeM (Alias st rs1) = do
+    details <- lookupElemM st
+    rs1' <- mapM traverseRangeM rs1
+    case details of
+        Just (_, _, Type typ) ->
+            return $ tf $ rs1' ++ rs2
+            where (tf, rs2) = typeRanges typ
+        Just (_, _, Pending) ->
+            return $ Alias st rs1'
+        Just (_, _, NonType kind) ->
+            scopedErrorM $ "expected typename, but found " ++ kind
+                ++ " identifier " ++ show st
+        Nothing ->
+            scopedErrorM $ "couldn't resolve typename " ++ show st
+traverseTypeM (TypedefRef expr) = do
+    details <- lookupElemM expr
+    case details of
+        Just (_, _, Type typ) -> return typ
+        Just (_, _, Pending) ->
+            error "TypdefRef invariant violated! Please file an issue."
+        Just (_, _, NonType kind) ->
+            scopedErrorM $ "expected interface-based typename, but found "
+                ++ kind ++ " " ++ show expr
+        -- This can occur when the interface conversion is delayed due to
+        -- multi-dimension instances.
+        Nothing -> return $ TypedefRef expr
+traverseTypeM other =
+    traverseSinglyNestedTypesM traverseTypeM other
+    >>= traverseTypeExprsM traverseExprM
+
+traverseRangeM :: Range -> SC Range
+traverseRangeM = mapBothM traverseExprM

src/Convert/UnbasedUnsized.hs

@@ -3,28 +3,306 @@
  -
  - Conversion for unbased, unsized literals ('0, '1, 'z, 'x)
  -
- - We convert the literals to be signed to enable sign extension, and give them
+ - The literals are given a binary base, a size of 1, and are made signed to
- - a size of 1 and a binary base. These values implicitly cast as desired in
+ - allow sign extension. For context-determined expressions, the converted
- - Verilog-2005.
+ - literals are repeated to match the context-determined size.
+ -
+ - When an unbased, unsized literal depends on the width a module port, the
+ - constant portions of the instantiated module are inlined alongside synthetic
+ - declarations matching the size of the port and filled with the desired bit.
+ - This allows port widths to depend on functions or parameters while avoiding
+ - creating hierarchical or generate-scoped references.
  -}
 
-module Convert.UnbasedUnsized (convert) where
+module Convert.UnbasedUnsized
+    ( convert
+    , inlineConstants
+    ) where
 
+import Control.Monad.Writer.Strict
+import Data.Either (isLeft)
+import Data.Maybe (isNothing, mapMaybe)
+import qualified Data.Map.Strict as Map
+import Data.Monoid (Any(Any), getAny)
+
+import Convert.Package (inject, prefixItems)
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
+type Part = [ModuleItem]
+type Parts = Map.Map Identifier Part
+type PortBit = (Identifier, Bit)
+
+data ExprContext
+    = SelfDetermined
+    | ContextDetermined Expr
+
 convert :: [AST] -> [AST]
-convert =
+convert files =
-    map $
+    map (traverseDescriptions convertDescription) files
-    traverseDescriptions $ traverseModuleItems $
+    where
-    traverseExprs $ traverseNestedExprs convertExpr
+        parts = execWriter $ mapM (collectDescriptionsM collectPartsM) files
+        convertDescription = traverseModuleItems $ convertModuleItem parts
 
-digits :: [Char]
+collectPartsM :: Description -> Writer Parts ()
-digits = ['0', '1', 'x', 'z', 'X', 'Z']
+collectPartsM (Part _ _ _ _ name _ items) =
+    tell $ Map.singleton name items
+collectPartsM _ = return ()
 
-convertExpr :: Expr -> Expr
+convertModuleItem :: Parts -> ModuleItem -> ModuleItem
-convertExpr (Number ['\'', ch]) =
+convertModuleItem parts (Instance moduleName params instanceName ds bindings) =
-    if elem ch digits
+    if null extensionDecls || isNothing maybeModuleItems then
-        then Number ("1'sb" ++ [ch])
+        convertModuleItem' $ instanceBase bindings
-        else error $ "unexpected unbased-unsized digit: " ++ [ch]
+    else if hasTypeParams || not moduleIsResolved then
-convertExpr other = other
+        instanceBase bindings
+    else
+        Generate $ map GenModuleItem $
+            stubItems ++ [instanceBase bindings']
+    where
+        instanceBase = Instance moduleName params instanceName ds
+        maybeModuleItems = Map.lookup moduleName parts
+        Just moduleItems = maybeModuleItems
+
+        -- checking whether we're ready to inline
+        hasTypeParams = any (isLeft . snd) params
+        moduleIsResolved = isEntirelyResolved stubItems
+
+        -- transform the existing bindings to reference extension declarations
+        (bindings', extensionDeclLists) = unzip $
+            map (convertBinding blockName) bindings
+        extensionDecls = map (MIPackageItem . Decl) $ concat extensionDeclLists
+
+        -- inline the necessary portions of the module alongside the selected
+        -- extension declarations
+        stubItems = inlineConstants blockName params moduleItems extensionDecls
+        blockName = "sv2v_uu_" ++ instanceName
+
+convertModuleItem _ other = convertModuleItem' other
+
+inlineConstants :: Identifier -> [ParamBinding] -> [ModuleItem] -> [ModuleItem]
+    -> [ModuleItem]
+inlineConstants blockName params moduleItems =
+    map (traverseDecls overrideParam) .
+    prefixItems blockName .
+    inject (createModuleStub moduleItems)
+    where
+        -- override a parameter value in the stub
+        overrideParam :: Decl -> Decl
+        overrideParam (Param Parameter t x e) =
+            Param Localparam t x $
+            case lookup xOrig params of
+                Just val -> e'
+                    where Right e' = val
+                Nothing -> e
+            where xOrig = drop (length blockName + 1) x
+        overrideParam decl = decl
+
+-- convert a port binding and produce a list of needed extension decls
+convertBinding :: Identifier -> PortBinding -> (PortBinding, [Decl])
+convertBinding blockName (portName, expr) =
+    ((portName, exprPatched), portBits)
+    where
+        exprRaw = convertExpr (ContextDetermined PortTag) expr
+        (exprPatched, portBits) = runWriter $ traverseNestedExprsM
+            (replaceBindingExpr blockName portName) exprRaw
+
+-- identify and rewrite references to the width of the current port
+replaceBindingExpr :: Identifier -> Identifier -> Expr -> Writer [Decl] Expr
+replaceBindingExpr blockName portName (PortTaggedUU v k) = do
+    tell [extensionDecl portBit]
+    return $ Ident $ blockName ++ "_" ++ extensionDeclName portBit
+    where portBit = (portName, bitForBased v k)
+replaceBindingExpr _ _ other = return other
+
+-- standardized name format for the synthetic declarations below
+extensionDeclName :: PortBit -> Identifier
+extensionDeclName (portName, bit) = "ext_" ++ portName ++ "_" ++ show bit
+
+-- synthetic declaration with the type of the port filled with the given bit
+extensionDecl :: PortBit -> Decl
+extensionDecl portBit@(portName, bit) =
+    Param Localparam t x e
+    where
+        t = Alias portName []
+        x = extensionDeclName portBit
+        e = literalFor bit
+
+-- create an all-constant stub for an instantiated module
+createModuleStub :: [ModuleItem] -> [PackageItem]
+createModuleStub =
+    mapMaybe stub
+    where
+        stub :: ModuleItem -> Maybe PackageItem
+        stub (MIPackageItem (Decl decl)) = fmap Decl $ stubDecl decl
+        stub (MIPackageItem item) = Just item
+        stub _ = Nothing
+        -- transform declarations into appropriate constants and type params
+        stubDecl :: Decl -> Maybe Decl
+        stubDecl (Variable d t x a _) = makePortType d t x a
+        stubDecl (Net  d _ _ t x a _) = makePortType d t x a
+        stubDecl decl = Just decl
+        -- make a type parameter for each port declaration
+        makePortType :: Direction -> Type -> Identifier -> [Range] -> Maybe Decl
+        makePortType Input UnknownType x [] = Just $ ParamType Localparam x t
+            where t = IntegerVector TLogic Unspecified []
+        makePortType Input t x [] = Just $ ParamType Localparam x t
+        makePortType _ _ _ _ = Nothing
+
+-- ensure inlining the constants doesn't produce generate-scoped exprs or
+-- expression type references
+isEntirelyResolved :: [ModuleItem] -> Bool
+isEntirelyResolved =
+    not . getAny . execWriter .
+    mapM (collectNestedModuleItemsM collectModuleItem)
+    where
+        collectModuleItem :: ModuleItem -> Writer Any ()
+        collectModuleItem item =
+            collectExprsM collectExpr item >>
+            collectTypesM collectType item
+        collectExpr :: Expr -> Writer Any ()
+        collectExpr Dot{} = tell $ Any True
+        collectExpr expr =
+            collectExprTypesM collectType expr >>
+            collectSinglyNestedExprsM collectExpr expr
+        collectType :: Type -> Writer Any ()
+        collectType TypeOf{} = tell $ Any True
+        collectType typ =
+            collectTypeExprsM collectExpr typ >>
+            collectSinglyNestedTypesM collectType typ
+
+convertModuleItem' :: ModuleItem -> ModuleItem
+convertModuleItem' =
+    traverseExprs (convertExpr SelfDetermined) .
+    traverseTypes (traverseNestedTypes convertType) .
+    traverseAsgns convertAsgn
+
+literalFor :: Bit -> Expr
+literalFor = Number . (uncurry $ Based 1 True Binary) . bitToVK
+
+pattern PortTag :: Expr
+pattern PortTag = Ident "~~uub~~"
+
+-- a converted literal which depends on the current port's width
+pattern PortTaggedUU :: Integer -> Integer -> Expr
+pattern PortTaggedUU v k <- Repeat
+    (DimsFn FnBits (Right PortTag))
+    [Number (Based 1 True Binary v k)]
+
+bitForBased :: Integer -> Integer -> Bit
+bitForBased 0 0 = Bit0
+bitForBased 1 0 = Bit1
+bitForBased 0 1 = BitX
+bitForBased _ _ = BitZ
+
+sizedLiteralFor :: Expr -> Bit -> Expr
+sizedLiteralFor expr bit =
+    Repeat size [literalFor bit]
+    where size = DimsFn FnBits $ Right expr
+
+convertAsgn :: (LHS, Expr) -> (LHS, Expr)
+convertAsgn (lhs, UU bit) =
+    (lhs, literalFor bit)
+convertAsgn (lhs, expr) =
+    (lhs, convertExpr context expr)
+    where context = ContextDetermined $ lhsToExpr lhs
+
+convertExpr :: ExprContext -> Expr -> Expr
+convertExpr _ (DimsFn fn (Right e)) =
+    DimsFn fn $ Right $ convertExpr SelfDetermined e
+convertExpr _ (Cast te e) =
+    Cast te $ convertExpr SelfDetermined e
+convertExpr _ (Concat exprs) =
+    Concat $ map (convertExpr SelfDetermined) exprs
+convertExpr context (Pattern [(Left UnknownType, e@UU{})]) =
+    convertExpr context e
+convertExpr _ (Pattern items) =
+    Pattern $ zip
+    (map fst items)
+    (map (convertExpr SelfDetermined . snd) items)
+convertExpr _ (Call expr (Args pnArgs [])) =
+    Call expr $ Args pnArgs' []
+    where pnArgs' = map (convertExpr SelfDetermined) pnArgs
+convertExpr _ (Repeat count exprs) =
+    Repeat count $ map (convertExpr SelfDetermined) exprs
+convertExpr SelfDetermined (MuxA a cond e1@UU{} e2@UU{}) =
+    MuxA a
+    (convertExpr SelfDetermined cond)
+    (convertExpr SelfDetermined e1)
+    (convertExpr SelfDetermined e2)
+convertExpr SelfDetermined (MuxA a cond e1 e2) =
+    MuxA a
+    (convertExpr SelfDetermined cond)
+    (convertExpr (ContextDetermined e2) e1)
+    (convertExpr (ContextDetermined e1) e2)
+convertExpr (ContextDetermined expr) (MuxA a cond e1 e2) =
+    MuxA a
+    (convertExpr SelfDetermined cond)
+    (convertExpr context e1)
+    (convertExpr context e2)
+    where context = ContextDetermined expr
+convertExpr SelfDetermined (BinOpA op a e1 e2) =
+    if isPeerSizedBinOp op || isParentSizedBinOp op
+        then BinOpA op a
+            (convertExpr (ContextDetermined e2) e1)
+            (convertExpr (ContextDetermined e1) e2)
+        else BinOpA op a
+            (convertExpr SelfDetermined e1)
+            (convertExpr SelfDetermined e2)
+convertExpr (ContextDetermined expr) (BinOpA op a e1 e2) =
+    if isPeerSizedBinOp op then
+        BinOpA op a
+            (convertExpr (ContextDetermined e2) e1)
+            (convertExpr (ContextDetermined e1) e2)
+    else if isParentSizedBinOp op then
+        BinOpA op a
+            (convertExpr context e1)
+            (convertExpr context e2)
+    else
+        BinOpA op a
+            (convertExpr SelfDetermined e1)
+            (convertExpr SelfDetermined e2)
+    where context = ContextDetermined expr
+convertExpr context (UniOpA op a expr) =
+    if isSizedUniOp op
+        then UniOpA op a (convertExpr context expr)
+        else UniOpA op a (convertExpr SelfDetermined expr)
+convertExpr SelfDetermined (UU bit) =
+    literalFor bit
+convertExpr (ContextDetermined expr) (UU bit) =
+    sizedLiteralFor expr bit
+convertExpr _ other = other
+
+pattern UU :: Bit -> Expr
+pattern UU bit <- Number (UnbasedUnsized bit)
+
+convertType :: Type -> Type
+convertType (TypeOf e) = TypeOf $ convertExpr SelfDetermined e
+convertType other = traverseTypeExprs (convertExpr SelfDetermined) other
+
+isParentSizedBinOp :: BinOp -> Bool
+isParentSizedBinOp BitAnd  = True
+isParentSizedBinOp BitXor  = True
+isParentSizedBinOp BitXnor = True
+isParentSizedBinOp BitOr   = True
+isParentSizedBinOp Mul     = True
+isParentSizedBinOp Div     = True
+isParentSizedBinOp Mod     = True
+isParentSizedBinOp Add     = True
+isParentSizedBinOp Sub     = True
+isParentSizedBinOp _       = False
+
+isPeerSizedBinOp :: BinOp -> Bool
+isPeerSizedBinOp Eq      = True
+isPeerSizedBinOp Ne      = True
+isPeerSizedBinOp TEq     = True
+isPeerSizedBinOp TNe     = True
+isPeerSizedBinOp WEq     = True
+isPeerSizedBinOp WNe     = True
+isPeerSizedBinOp Lt      = True
+isPeerSizedBinOp Le      = True
+isPeerSizedBinOp Gt      = True
+isPeerSizedBinOp Ge      = True
+isPeerSizedBinOp _       = False
+
+isSizedUniOp :: UniOp -> Bool
+isSizedUniOp = (/= LogNot)

src/Convert/Unique.hs

@@ -3,9 +3,9 @@
  -
  - Conversion for `unique`, `unique0`, and `priority` (verification checks)
  -
- - This conversion simply drops these keywords, as they are only used for
+ - For `case`, these verification checks are replaced with equivalent
- - optimization and verification. There may be ways to communicate these
+ - `full_case` and `parallel_case` attributes. For `if`, they are simply
- - attributes to certain downstream toolchains.
+ - dropped.
  -}
 
 module Convert.Unique (convert) where
@@ -15,11 +15,25 @@ import Language.SystemVerilog.AST
 
 convert :: [AST] -> [AST]
 convert =
-    map $ traverseDescriptions $ traverseModuleItems $ traverseStmts convertStmt
+    map $ traverseDescriptions $ traverseModuleItems $ traverseStmts $
+        traverseNestedStmts convertStmt
 
 convertStmt :: Stmt -> Stmt
 convertStmt (If _ cc s1 s2) =
     If NoCheck cc s1 s2
-convertStmt (Case _ kw expr cases) =
+convertStmt (Case Priority kw expr cases) =
-    Case NoCheck kw expr cases
+    StmtAttr caseAttr caseStmt
+    where
+        caseAttr = Attr [("full_case", Nil)]
+        caseStmt = Case NoCheck kw expr cases
+convertStmt (Case Unique kw expr cases) =
+    StmtAttr caseAttr caseStmt
+    where
+        caseAttr = Attr [("full_case", Nil), ("parallel_case", Nil)]
+        caseStmt = Case NoCheck kw expr cases
+convertStmt (Case Unique0 kw expr cases) =
+    StmtAttr caseAttr caseStmt
+    where
+        caseAttr = Attr [("parallel_case", Nil)]
+        caseStmt = Case NoCheck kw expr cases
 convertStmt other = other

src/Convert/UnnamedGenBlock.hs

@@ -0,0 +1,123 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Labels any unnamed generate blocks, per IEEE 1800-2017 Section 27.6
+ -
+ - This transformation is performed before any others, and is only performed
+ - once. The AST traversal utilities are not used here to avoid the automatic
+ - elaboration they perform.
+ -}
+
+module Convert.UnnamedGenBlock (convert) where
+
+import Control.Monad (when)
+import Control.Monad.State.Strict
+import Data.List (isPrefixOf)
+
+import Language.SystemVerilog.AST
+
+convert :: [AST] -> [AST]
+convert = map $ map traverseDescription
+
+traverseDescription :: Description -> Description
+traverseDescription (Part attrs extern kw lifetime name ports items) =
+    Part attrs extern kw lifetime name ports $
+        evalState (mapM traverseModuleItemM items) initialState
+traverseDescription other = other
+
+type S = State Info
+type Info = ([Identifier], Int)
+
+initialState :: Info
+initialState = ([], 1)
+
+traverseModuleItemM :: ModuleItem -> S ModuleItem
+traverseModuleItemM item@(Genvar x) = declaration x item
+traverseModuleItemM item@(NInputGate  _ _ x _ _ _) = declaration x item
+traverseModuleItemM item@(NOutputGate _ _ x _ _ _) = declaration x item
+traverseModuleItemM item@(Instance    _ _ x _   _) = declaration x item
+traverseModuleItemM (MIPackageItem (Decl decl)) =
+    traverseDeclM decl >>= return . MIPackageItem . Decl
+traverseModuleItemM (MIAttr attr item) =
+    traverseModuleItemM item >>= return . MIAttr attr
+traverseModuleItemM (Generate items) =
+    mapM traverseGenItemM items >>= return . Generate
+traverseModuleItemM item = return item
+
+-- add a declaration to the conflict list
+traverseDeclM :: Decl -> S Decl
+traverseDeclM decl =
+    case decl of
+        Variable  _ _ x _ _ -> declaration x decl
+        Net   _ _ _ _ x _ _ -> declaration x decl
+        Param     _ _ x _   -> declaration x decl
+        ParamType _   x _   -> declaration x decl
+        CommentDecl{} -> return decl
+
+-- label the generate blocks within an individual generate item which is already
+-- in a list of generate items (top level or generate block)
+traverseGenItemM :: GenItem -> S GenItem
+traverseGenItemM item@GenIf{} = do
+    item' <- labelGenElse item
+    incrCount >> return item'
+traverseGenItemM item@GenBlock{} = do
+    item' <- labelBlock item
+    incrCount >> return item'
+traverseGenItemM (GenFor a b c item) = do
+    item' <- labelBlock item
+    incrCount >> return (GenFor a b c item')
+traverseGenItemM (GenCase expr cases) = do
+    let (exprs, items) = unzip cases
+    items' <- mapM labelBlock items
+    let cases' = zip exprs items'
+    incrCount >> return (GenCase expr cases')
+traverseGenItemM (GenModuleItem item) =
+    traverseModuleItemM item >>= return . GenModuleItem
+traverseGenItemM GenNull = return GenNull
+
+-- increment the counter each time a generate construct is encountered
+incrCount :: S ()
+incrCount = modify' $ \(idents, count) -> (idents, count + 1)
+
+genblk :: Identifier
+genblk = "genblk"
+
+-- adds the given identifier to the list of possible identifier conflicts, if
+-- necessary, and then returns the second argument as a shorthand courtesy
+declaration :: Identifier -> a -> S a
+declaration x a = do
+    when (genblk `isPrefixOf` x) $ do
+        let ident = drop (length genblk) x
+        modify' $ \(idents, count) -> (ident : idents, count)
+    return a
+
+-- generate a locally unique gen block name
+makeBlockName :: S Identifier
+makeBlockName = do
+    (idents, count) <- get
+    let uniqueSuffix = prependZeroes idents (show count)
+    return $ genblk ++ uniqueSuffix
+
+-- prepend zeroes until the string isn't in the list
+prependZeroes :: [String] -> String -> String
+prependZeroes xs x | notElem x xs = x
+prependZeroes xs x = prependZeroes xs ('0' : x)
+
+-- if the item is a generate conditional item, give its `then` block and any
+-- direct `else if` blocks the same name
+labelGenElse :: GenItem -> S GenItem
+labelGenElse (GenIf cond thenItem elseItem) = do
+    thenItem' <- labelBlock thenItem
+    elseItem' <- labelGenElse elseItem
+    return $ GenIf cond thenItem' elseItem'
+labelGenElse other = labelBlock other
+
+-- transform the given item into a named generate block
+labelBlock :: GenItem -> S GenItem
+labelBlock (GenBlock "" items) =
+    makeBlockName >>= labelBlock . flip GenBlock items
+labelBlock (GenBlock x items) =
+    return $ GenBlock x $
+        evalState (mapM traverseGenItemM items) initialState
+labelBlock GenNull = return GenNull
+labelBlock item = labelBlock $ GenBlock "" [item]

src/Convert/UnpackedArray.hs

@@ -1,103 +1,147 @@
+{-# LANGUAGE FlexibleInstances #-}
 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  -
  - Conversion for any unpacked array which must be packed because it is: A) a
- - port; B) is bound to a port; or C) is assigned a value in a single
+ - port; B) is bound to a port; C) is assigned a value in a single assignment;
- - assignment.
+ - or D) is assigned to an unpacked array which itself must be packed. The
- -
+ - conversion allows for an array to be partially packed if all flat usages of
- - The scoped nature of declarations makes this challenging. While scoping is
+ - the array explicitly specify some of the unpacked dimensions.
- - obeyed in general, any of a set of *equivalent* declarations within a module
- - is packed, all of the declarations are packed. This is because we only record
- - the declaration that needs to be packed when a relevant usage is encountered.
  -}
 
 module Convert.UnpackedArray (convert) where
 
-import Control.Monad.State
+import Control.Monad (when, (>=>))
-import Control.Monad.Writer
+import Control.Monad.State.Strict
 import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
 
+import Convert.Scoper
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
-type DeclMap = Map.Map Identifier Decl
+type Location = [Identifier]
-type DeclSet = Set.Set Decl
+type Locations = Map.Map Location Int
-
+type ST = ScoperT () (State Locations)
-type ST = StateT DeclMap (Writer DeclSet)
 
 convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
-convertDescription description =
+convertDescription description@(Part _ _ Module _ _ ports _) =
-    traverseModuleItems (traverseDecls $ packDecl declsToPack) description'
+    evalScoper $ scopePart conScoper description
     where
-        (description', declsToPack) = runWriter $
+        locations = execState
-            scopedConversionM traverseDeclM traverseModuleItemM traverseStmtM
+            (evalScoperT $ scopePart locScoper description) Map.empty
-            Map.empty description
+        locScoper = scopeModuleItem
+            (traverseDeclM ports) traverseModuleItemM return traverseStmtM
+        conScoper = scopeModuleItem
+            (rewriteDeclM locations) return return return
+convertDescription other = other
 
--- collects and converts multi-dimensional packed-array declarations
+-- tracks multi-dimensional unpacked array declarations
-traverseDeclM :: Decl -> ST Decl
+traverseDeclM :: [Identifier] -> Decl -> ST Decl
-traverseDeclM (orig @ (Variable dir _ x _ me)) = do
+traverseDeclM _ decl@(Variable _ _ _ [] e) =
-    modify $ Map.insert x orig
+    traverseExprArgsM e >> return decl
-    () <- if dir /= Local || me /= Nothing
+traverseDeclM ports decl@(Variable dir _ x _ e) = do
-        then lift $ tell $ Set.singleton orig
+    insertElem x ()
-        else return ()
+    when (dir /= Local || elem x ports || e /= Nil) $
-    return orig
+        flatUsageM x
-traverseDeclM (orig @ (Param _ _ _ _)) =
+    traverseExprArgsM e >> return decl
-    return orig
+traverseDeclM ports decl@Net{} =
-traverseDeclM (orig @ (ParamType _ _ _)) =
+    traverseNetAsVarM (traverseDeclM ports) decl
-    return orig
+traverseDeclM _ other = return other
 
--- pack the given decls marked for packing
+-- pack decls marked for packing
-packDecl :: DeclSet -> Decl -> Decl
+rewriteDeclM :: Locations -> Decl -> Scoper () Decl
-packDecl decls (orig @ (Variable d t x a me)) = do
+rewriteDeclM _ decl@(Variable _ _ _ [] _) = return decl
-    if Set.member orig decls
+rewriteDeclM locations decl@(Variable d t x a e) = do
-        then do
+    accesses <- localAccessesM x
+    let location = map accessName accesses
+    case Map.lookup location locations of
+        Just depth -> do
             let (tf, rs) = typeRanges t
-            let t' = tf $ a ++ rs
+            let (unpacked, packed) = splitAt depth a
-            Variable d t' x [] me
+            let t' = tf $ packed ++ rs
-        else orig
+            return $ Variable d t' x unpacked e
-packDecl _ (orig @ Param{}) = orig
+        Nothing -> return decl
-packDecl _ (orig @ ParamType{}) = orig
+rewriteDeclM locations decl@Net{} =
-
+    traverseNetAsVarM (rewriteDeclM locations) decl
+rewriteDeclM _ other = return other
 
 traverseModuleItemM :: ModuleItem -> ST ModuleItem
+traverseModuleItemM item@(Instance _ _ _ _ bindings) =
+    mapM_ (flatUsageM . snd) bindings >> return item
 traverseModuleItemM item =
-    traverseModuleItemM' item
+    traverseLHSsM traverseLHSM item
-    >>= traverseLHSsM  traverseLHSM
     >>= traverseExprsM traverseExprM
-
+    >>= traverseAsgnsM traverseAsgnM
-traverseModuleItemM' :: ModuleItem -> ST ModuleItem
-traverseModuleItemM' (Instance a b c d bindings) = do
-    bindings' <- mapM collectBinding bindings
-    return $ Instance a b c d bindings'
-    where
-        collectBinding :: PortBinding -> ST PortBinding
-        collectBinding (y, Just (Ident x)) = do
-            flatUsageM x
-            return (y, Just (Ident x))
-        collectBinding other = return other
-traverseModuleItemM' other = return other
 
 traverseStmtM :: Stmt -> ST Stmt
-traverseStmtM stmt =
+traverseStmtM =
-    traverseStmtLHSsM  traverseLHSM  stmt >>=
+    traverseStmtLHSsM  traverseLHSM  >=>
-    traverseStmtExprsM traverseExprM
+    traverseStmtExprsM traverseExprM >=>
+    traverseStmtAsgnsM traverseAsgnM >=>
+    traverseStmtArgsM
+
+traverseStmtArgsM :: Stmt -> ST Stmt
+traverseStmtArgsM stmt@(Subroutine (Ident ('$' : _)) _) =
+    return stmt
+traverseStmtArgsM stmt@(Subroutine _ (Args args [])) =
+    mapM_ flatUsageM args >> return stmt
+traverseStmtArgsM stmt = return stmt
 
 traverseExprM :: Expr -> ST Expr
-traverseExprM = return
+traverseExprM (Range x mode i) =
+    flatUsageM x >> return (Range x mode i)
+traverseExprM expr = traverseExprArgsM expr
+
+traverseExprArgsM :: Expr -> ST Expr
+traverseExprArgsM expr@(Call _ (Args args [])) =
+    mapM_ (traverseExprArgsM >=> flatUsageM) args >> return expr
+traverseExprArgsM expr =
+    traverseSinglyNestedExprsM traverseExprArgsM expr
 
 traverseLHSM :: LHS -> ST LHS
-traverseLHSM (LHSIdent x) = do
+traverseLHSM x = flatUsageM x >> return x
-    flatUsageM x
-    return $ LHSIdent x
-traverseLHSM other = return other
 
-flatUsageM :: Identifier -> ST ()
+traverseAsgnM :: (LHS, Expr) -> ST (LHS, Expr)
-flatUsageM x = do
+traverseAsgnM (x, y) = do
-    declMap <- get
+    flatUsageM x
-    case Map.lookup x declMap of
+    flatUsageM y
-        Just decl -> lift $ tell $ Set.singleton decl
+    return (x, y)
+
+class ScopeKey t => Key t where
+    unbit :: t -> (t, Int)
+    split :: t -> Maybe (t, t)
+    split = const Nothing
+
+instance Key Expr where
+    unbit (Bit e _) = (e', n + 1)
+        where (e', n) = unbit e
+    unbit (Range e _ _) = (e', n)
+        where (e', n) = unbit e
+    unbit e = (e, 0)
+    split (MuxA _ _ a b) = Just (a, b)
+    split _ = Nothing
+
+instance Key LHS where
+    unbit (LHSBit e _) = (e', n + 1)
+        where (e', n) = unbit e
+    unbit (LHSRange e _ _) = (e', n)
+        where (e', n) = unbit e
+    unbit e = (e, 0)
+
+instance Key Identifier where
+    unbit x = (x, 0)
+
+flatUsageM :: Key k => k -> ST ()
+flatUsageM k | Just (a, b) <- split k =
+    flatUsageM a >> flatUsageM b
+flatUsageM k = do
+    let (k', depth) = unbit k
+    details <- lookupElemM k'
+    case details of
+        Just (accesses, _, ()) -> do
+            let location = map accessName accesses
+            lift $ modify $ Map.insertWith min location depth
         Nothing -> return ()

src/Convert/Unsigned.hs

@@ -18,10 +18,12 @@ convert =
     map $
     traverseDescriptions $
     traverseModuleItems $
+    -- doesn't need to visit nested types, as they have been elaborated
     traverseTypes convertType
 
 convertType :: Type -> Type
 convertType (Implicit        Unsigned rs) = Implicit        Unspecified rs
 convertType (IntegerVector t Unsigned rs) = IntegerVector t Unspecified rs
-convertType (Net           t Unsigned rs) = Net           t Unspecified rs
+convertType (IntegerAtom TInteger Unsigned) =
+    IntegerVector TReg Unspecified [(RawNum 31, RawNum 0)]
 convertType other = other

src/Convert/Wildcard.hs

@@ -4,32 +4,100 @@
  - Conversion for `==?` and `!=?`
  -
  - `a ==? b` is defined as the bitwise comparison of `a` and `b`, where X and Z
- - values in `b` (but not those in `a`) are used as wildcards. We convert `a ==?
+ - values in `b` (but not those in `a`) are used as wildcards. This conversion
- - b` to `a ^ b === b ^ b`. This works because any value xor'ed with X or Z
+ - relies on the fact that works because any value xor'ed with X or Z becomes X.
- - becomes X.
+ -
+ - Procedure for `A ==? B`:
+ - 1. If there is any bit in A that doesn't match a non-wildcarded bit in B,
+ -    then the result is always `1'b0`.
+ - 2. If there is any X or Z in A that is not wildcarded in B, then the result
+ -    is `1'bx`.
+ - 3. Otherwise, the result is `1'b1`.
  -
  - `!=?` is simply converted as the logical negation of `==?`, which is
- - converted as described above.
+ -
+ - The conversion for `inside` produces wildcard equality comparisons as per the
+ - SystemVerilog specification. However, many usages of `inside` don't depend on
+ - the wildcard behavior. To avoid generating needlessly complex output, this
+ - conversion use the standard equality operator if the pattern obviously
+ - contains no wildcard bits.
  -}
 
 module Convert.Wildcard (convert) where
 
+import Control.Monad (when)
+import Data.Bits ((.|.))
+
+import Convert.Scoper
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
 convert :: [AST] -> [AST]
-convert =
+convert = map $ traverseDescriptions convertDescription
-    map $
-    traverseDescriptions $ traverseModuleItems $
-    traverseExprs $ traverseNestedExprs convertExpr
 
-convertExpr :: Expr -> Expr
+convertDescription :: Description -> Description
-convertExpr (BinOp WEq l r) =
+convertDescription =
-    BinOp TEq
+    partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
-    (BinOp BitXor r r)
+
-    (BinOp BitXor r l)
+traverseDeclM :: Decl -> Scoper Number Decl
-convertExpr (BinOp WNe l r) =
+traverseDeclM decl = do
+    case decl of
+        Param Localparam _ x (Number n) -> insertElem x n
+        Param Parameter  _ x (Number n) ->
+            when (numberToInteger n /= Nothing) $ insertElem x n
+        _ -> return ()
+    let mi = MIPackageItem $ Decl decl
+    mi' <- traverseModuleItemM mi
+    let MIPackageItem (Decl decl') = mi'
+    return decl'
+
+traverseModuleItemM :: ModuleItem -> Scoper Number ModuleItem
+traverseModuleItemM = traverseExprsM traverseExprM
+
+traverseGenItemM :: GenItem -> Scoper Number GenItem
+traverseGenItemM = traverseGenItemExprsM traverseExprM
+
+traverseStmtM :: Stmt -> Scoper Number Stmt
+traverseStmtM = traverseStmtExprsM traverseExprM
+
+traverseExprM :: Expr -> Scoper Number Expr
+traverseExprM = traverseNestedExprsM $ embedScopes convertExpr
+
+lookupPattern :: Scopes Number -> Expr -> Maybe Number
+lookupPattern _ (Number n) = Just n
+lookupPattern scopes e =
+    case lookupElem scopes e of
+        Nothing -> Nothing
+        Just (_, _, n) -> Just n
+
+convertExpr :: Scopes Number -> Expr -> Expr
+convertExpr scopes (BinOp WEq l r) =
+    if maybePattern == Nothing then
+        BinOp BitAnd couldMatch $
+        BinOp BitOr  noExtraXZs $
+        Number (Based 1 False Binary 0 1)
+    else if numberToInteger pat /= Nothing then
+        BinOp Eq l r
+    else
+        BinOp Eq (BinOp BitOr l mask) pat'
+    where
+        lxl = BinOp BitXor l l
+        rxr = BinOp BitXor r r
+        -- Step #1: definitive mismatch
+        couldMatch = BinOp TEq rxlxl lxrxr
+        rxlxl = BinOp BitXor r lxl
+        lxrxr = BinOp BitXor l rxr
+        -- Step #2: extra X or Z
+        noExtraXZs = BinOp TEq lxlxrxr rxr
+        lxlxrxr = BinOp BitXor lxl rxr
+        -- For wildcard patterns we can find, use masking
+        maybePattern = lookupPattern scopes r
+        Just pat = maybePattern
+        Based size signed base vals knds = pat
+        mask = Number $ Based size signed base knds 0
+        pat' = Number $ Based size signed base (vals .|. knds) 0
+convertExpr scopes (BinOp WNe l r) =
     UniOp LogNot $
-    convertExpr $
+    convertExpr scopes $
     BinOp WEq l r
-convertExpr other = other
+convertExpr _ other = other

src/Job.hs

@@ -1,4 +1,6 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE TemplateHaskell #-}
 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  -
@@ -7,46 +9,111 @@
 
 module Job where
 
+import Control.Monad (when)
+import Data.Char (toLower)
+import Data.List (isPrefixOf, isSuffixOf)
+import Data.Version (showVersion)
+#if MIN_VERSION_githash(0,1,5)
+import GitHash (giTag, tGitInfoCwdTry)
+#endif
+import qualified Paths_sv2v (version)
 import System.IO (stderr, hPutStr)
 import System.Console.CmdArgs
-import System.Environment (getArgs, withArgs)
+import System.Directory (doesDirectoryExist)
+import System.Exit (exitFailure)
 
 data Exclude
     = Always
+    | Assert
     | Interface
     | Logic
+    | SeverityTask
     | Succinct
-    deriving (Show, Typeable, Data, Eq)
+    | UnbasedUnsized
+    deriving (Typeable, Data, Eq)
+
+data Write
+    = Stdout
+    | Adjacent
+    | File FilePath
+    | Directory FilePath
+    deriving (Typeable, Data)
 
 data Job = Job
     { files :: [FilePath]
     , incdir :: [FilePath]
+    , libdir :: [FilePath]
     , define :: [String]
     , siloed :: Bool
+    , skipPreprocessor :: Bool
+    , passThrough :: Bool
     , exclude :: [Exclude]
     , verbose :: Bool
-    } deriving (Show, Typeable, Data)
+    , write :: Write
+    , writeRaw :: String
+    , top :: [String]
+    , oversizedNumbers :: Bool
+    , dumpPrefix :: FilePath
+    , bugpoint :: [String]
+    } deriving (Typeable, Data)
+
+version :: String
+#if MIN_VERSION_githash(0,1,5)
+version = either (const backup) giTag $$tGitInfoCwdTry
+#else
+version = backup
+#endif
+    where backup = showVersion Paths_sv2v.version
 
 defaultJob :: Job
 defaultJob = Job
     { files = def &= args &= typ "FILES"
     , incdir = nam_ "I" &= name "incdir" &= typDir
-        &= help "Add directory to include search path"
+        &= help "Add a directory to the include search path"
         &= groupname "Preprocessing"
+    , libdir = nam_ "y" &= name "libdir" &= typDir
+        &= help ("Add a directory to the library search path used when looking"
+            ++ " for undefined modules and interfaces")
     , define = nam_ "D" &= name "define" &= typ "NAME[=VALUE]"
         &= help "Define a macro for preprocessing"
     , siloed = nam_ "siloed" &= help ("Lex input files separately, so"
         ++ " macros from earlier files are not defined in later files")
-    , exclude = nam_ "exclude" &= name "E" &= typ "CONV"
+    , skipPreprocessor = nam_ "skip-preprocessor"
-        &= help "Exclude a particular conversion (always, interface, or logic)"
+        &= help "Disable preprocessing of macros, comments, etc."
+    , passThrough = nam_ "pass-through" &= help "Dump input without converting"
         &= groupname "Conversion"
+    , exclude = nam_ "exclude" &= name "E" &= typ "CONV"
+        &= help ("Exclude a particular conversion (Always, Assert, Interface,"
+            ++ " Logic, SeverityTask, or UnbasedUnsized)")
     , verbose = nam "verbose" &= help "Retain certain conversion artifacts"
+    , write = Stdout &= ignore -- parsed from the flexible flag below
+    , writeRaw = "s" &= name "write" &= name "w" &= explicit
+        &= typ "MODE/FILE/DIR"
+        &= help ("How to write output; default is 'stdout'; use 'adjacent' to"
+            ++ " create a .v file next to each input; use a path ending in .v"
+            ++ " to write to a file; use a path to an existing directory to"
+            ++ " create a .v within for each converted module")
+    , top = def &= name "top" &= explicit &= typ "NAME"
+        &= help ("Remove uninstantiated modules except the given top module;"
+            ++ " can be used multiple times")
+    , oversizedNumbers = nam_ "oversized-numbers"
+        &= help ("Disable standard-imposed 32-bit limit on unsized number"
+            ++ " literals (e.g., 'h1_ffff_ffff, 4294967296)")
+        &= groupname "Other"
+    , dumpPrefix = def &= name "dump-prefix" &= explicit &= typ "PATH"
+        &= help ("Create intermediate output files with the given path prefix;"
+            ++ " used for internal debugging")
+    , bugpoint = nam_ "bugpoint" &= typ "SUBSTR"
+        &= help ("Reduce the input by pruning modules, wires, etc., that"
+            ++ " aren't needed to produce the given output or error substring"
+            ++ " when converted")
     }
     &= program "sv2v"
-    &= summary "sv2v v0.0.1, (C) 2019 Zachary Snow, 2011-2015 Tom Hawkins"
+    &= summary ("sv2v " ++ version)
     &= details [ "sv2v converts SystemVerilog to Verilog."
-               , "More info: https://github.com/zachjs/sv2v" ]
+               , "More info: https://github.com/zachjs/sv2v"
-    &= helpArg [explicit, name "help", groupname "Other"]
+               , "(C) 2019-2024 Zachary Snow, 2011-2015 Tom Hawkins" ]
+    &= helpArg [explicit, name "help", help "Display this help message"]
     &= versionArg [explicit, name "version"]
     &= verbosityArgs [ignore] [ignore]
     where
@@ -54,49 +121,32 @@ defaultJob = Job
         nam xs = nam_ xs &= name [head xs]
         nam_ xs = def &= name xs &= explicit
 
-type DeprecationPhase = [String] -> IO [String]
+parseWrite :: String -> IO Write
+parseWrite w | w `matches` "stdout" = return Stdout
+parseWrite w | w `matches` "adjacent" = return Adjacent
+parseWrite w | ".v" `isSuffixOf` w = return $ File w
+parseWrite w | otherwise = do
+    isDir <- doesDirectoryExist w
+    when (not isDir) $ do
+        hPutStr stderr $ "invalid --write " ++ show w ++ ", expected stdout,"
+            ++ " adjacent, a path ending in .v, or a path to an existing"
+            ++ " directory"
+        exitFailure
+    return $ Directory w
 
-oneunit :: DeprecationPhase
+matches :: String -> String -> Bool
-oneunit strs = do
+matches = isPrefixOf . map toLower
-    let strs' = filter (not . isOneunitArg) strs
-    if strs == strs'
-        then return strs
-        else do
-            hPutStr stderr $ "Deprecation warning: --oneunit has been removed, "
-                ++ "and is now on by default\n"
-            return strs'
-    where
-        isOneunitArg :: String -> Bool
-        isOneunitArg "-o" = True
-        isOneunitArg "--oneunit" = True
-        isOneunitArg _ = False
-
-flagRename :: String -> String -> DeprecationPhase
-flagRename before after strs = do
-    let strs' = map rename strs
-    if strs == strs'
-        then return strs
-        else do
-            hPutStr stderr $ "Deprecation warning: " ++ before ++
-                " has been renamed to " ++ after ++ "\n"
-            return strs'
-    where
-        rename :: String -> String
-        rename arg =
-            if before == take (length before) arg
-                then after ++ drop (length before) arg
-                else arg
 
 readJob :: IO Job
-readJob = do
+readJob =
-    strs <- getArgs
+    cmdArgs defaultJob
-    strs' <- oneunit strs
+        >>= setWrite . setSuccinct
-        >>= flagRename "-i" "-I"
+
-        >>= flagRename "-d" "-D"
+setWrite :: Job -> IO Job
-        >>= flagRename "-e" "-E"
+setWrite job = do
-        >>= flagRename "-V" "--version"
+    w <- parseWrite $ writeRaw job
-        >>= flagRename "-?" "--help"
+    return $ job { write = w }
-    job <- withArgs (strs') $ cmdArgs defaultJob
+
-    return $ if verbose job
+setSuccinct :: Job -> Job
-        then job { exclude = Succinct : exclude job }
+setSuccinct job | verbose job = job { exclude = Succinct : exclude job }
-        else job
+setSuccinct job | otherwise = job

src/Language/SystemVerilog/AST.hs

@@ -22,15 +22,18 @@ module Language.SystemVerilog.AST
     , module GenItem
     , module LHS
     , module ModuleItem
+    , module Number
     , module Op
     , module Stmt
     , module Type
     , exprToLHS
     , lhsToExpr
+    , exprToType
     , shortHash
     ) where
 
 import Text.Printf (printf)
+import Data.Bits ((.&.))
 import Data.Hashable (hash)
 
 import Language.SystemVerilog.AST.Attr as Attr
@@ -40,6 +43,7 @@ import Language.SystemVerilog.AST.Expr as Expr
 import Language.SystemVerilog.AST.GenItem as GenItem
 import Language.SystemVerilog.AST.LHS as LHS
 import Language.SystemVerilog.AST.ModuleItem as ModuleItem
+import Language.SystemVerilog.AST.Number as Number
 import Language.SystemVerilog.AST.Op as Op
 import Language.SystemVerilog.AST.Stmt as Stmt
 import Language.SystemVerilog.AST.Type as Type
@@ -60,6 +64,11 @@ exprToLHS (Dot   l x  ) = do
 exprToLHS (Concat ls  ) = do
     ls' <- mapM exprToLHS ls
     Just $ LHSConcat ls'
+exprToLHS (Pattern ls ) = do
+    ls' <- mapM exprToLHS $ map snd ls
+    if all ((== Right Nil) . fst) ls
+        then Just $ LHSConcat ls'
+        else Nothing
 exprToLHS (Stream o e ls) = do
     ls' <- mapM exprToLHS ls
     Just $ LHSStream o e ls'
@@ -73,7 +82,21 @@ lhsToExpr (LHSDot    l x   ) = Dot   (lhsToExpr l) x
 lhsToExpr (LHSConcat     ls) = Concat $ map lhsToExpr ls
 lhsToExpr (LHSStream o e ls) = Stream o e $ map lhsToExpr ls
 
+-- attempt to convert an expression to a syntactically equivalent type
+exprToType :: Expr -> Maybe Type
+exprToType (Ident       x) = Just $ Alias       x []
+exprToType (PSIdent y   x) = Just $ PSAlias y   x []
+exprToType (CSIdent y p x) = Just $ CSAlias y p x []
+exprToType (Range e NonIndexed r) = do
+    (tf, rs) <- fmap typeRanges $ exprToType e
+    Just $ tf (rs ++ [r])
+exprToType (Bit e i) = do
+    (tf, rs) <- fmap typeRanges $ exprToType e
+    let r = (BinOp Sub i (RawNum 1), RawNum 0)
+    Just $ tf (rs ++ [r])
+exprToType _ = Nothing
+
 shortHash :: (Show a) => a -> String
 shortHash x =
-    take 5 $ printf "%05X" val
+    printf "%05X" $ val .&. 0xFFFFF
     where val = hash $ show x

src/Language/SystemVerilog/AST/Attr.hs

@@ -8,6 +8,7 @@
 module Language.SystemVerilog.AST.Attr
     ( Attr (..)
     , AttrSpec
+    , showsAttrs
     ) where
 
 import Text.Printf (printf)
@@ -20,10 +21,13 @@ data Attr
     = Attr [AttrSpec]
     deriving Eq
 
-type AttrSpec = (Identifier, Maybe Expr)
+type AttrSpec = (Identifier, Expr)
 
 instance Show Attr where
     show (Attr specs) = printf "(* %s *)" $ commas $ map showSpec specs
 
+showsAttrs :: [Attr] -> ShowS
+showsAttrs = foldr (\a f -> shows a . showChar ' ' . f) id
+
 showSpec :: AttrSpec -> String
-showSpec (x, me) = x ++ showAssignment me
+showSpec (x, e) = x ++ showAssignment e

src/Language/SystemVerilog/AST/Attr.hs-boot

@@ -0,0 +1,9 @@
+module Language.SystemVerilog.AST.Attr
+    ( Attr
+    , showsAttrs
+    ) where
+
+data Attr
+instance Eq Attr
+
+showsAttrs :: [Attr] -> ShowS

src/Language/SystemVerilog/AST/Decl.hs

@@ -2,9 +2,7 @@
  - Author: Zachary Snow <zach@zachjs.com>
  - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>
  -
- - SystemVerilog left-hand sides (aka lvals)
+ - SystemVerilog data, net, and parameter declarations
- -
- - TODO: Normal parameters can be declared with no default valu.
  -}
 
 module Language.SystemVerilog.AST.Decl
@@ -15,28 +13,37 @@ module Language.SystemVerilog.AST.Decl
 
 import Text.Printf (printf)
 
-import Language.SystemVerilog.AST.ShowHelp (showPad, unlines')
+import Language.SystemVerilog.AST.ShowHelp (showPad, showPadBefore, unlines')
-import Language.SystemVerilog.AST.Type (Type, Identifier)
+import Language.SystemVerilog.AST.Type (Type(TypedefRef, UnpackedType), Identifier, pattern UnknownType, NetType, Strength)
 import Language.SystemVerilog.AST.Expr (Expr, Range, showRanges, showAssignment)
 
 data Decl
     = Param     ParamScope Type Identifier Expr
-    | ParamType ParamScope Identifier (Maybe Type)
+    | ParamType ParamScope Identifier Type
-    | Variable   Direction Type Identifier [Range] (Maybe Expr)
+    | Variable   Direction Type Identifier [Range] Expr
-    deriving (Eq, Ord)
+    | Net Direction NetType Strength Type Identifier [Range] Expr
+    | CommentDecl String
+    deriving Eq
 
 instance Show Decl where
     showList l _ = unlines' $ map show l
-    show (Param s t x e) = printf "%s %s%s = %s;" (show s) (showPad t) x (show e)
+    show (Param s t x e) = printf "%s %s%s%s;" (show s) (showPad t) x (showAssignment e)
-    show (ParamType s x mt) = printf "%s type %s%s;" (show s) x (showAssignment mt)
+    show (ParamType Localparam x (TypedefRef e)) =
-    show (Variable d t x a me) = printf "%s%s%s%s%s;" (showPad d) (showPad t) x (showRanges a) (showAssignment me)
+        printf "typedef %s %s;" (show e) x
+    show (ParamType Localparam x (UnpackedType t rs)) =
+        printf "typedef %s %s%s;" (show t) x (showRanges rs)
+    show (ParamType s x t) = printf "%s type %s%s;" (show s) x tStr
+        where tStr = if t == UnknownType then "" else  " = " ++ show t
+    show (Variable d t x a e) = printf "%s%s%s%s%s;" (showPad d) (showPad t) x (showRanges a) (showAssignment e)
+    show (Net  d n s t x a e) = printf "%s%s%s %s%s%s%s;" (showPad d) (show n) (showPadBefore s) (showPad t) x (showRanges a) (showAssignment e)
+    show (CommentDecl c) = "// " ++ c
 
 data Direction
     = Input
     | Output
     | Inout
     | Local
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show Direction where
     show Input  = "input"
@@ -47,7 +54,7 @@ instance Show Direction where
 data ParamScope
     = Parameter
     | Localparam
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show ParamScope where
     show Parameter  = "parameter"

src/Language/SystemVerilog/AST/Description.hs

@@ -10,28 +10,32 @@ module Language.SystemVerilog.AST.Description
     , PackageItem (..)
     , PartKW      (..)
     , Lifetime    (..)
+    , Qualifier   (..)
+    , ClassItem
+    , DPIImportProperty (..)
+    , DPIExportKW (..)
     ) where
 
-import Data.Maybe (fromMaybe)
 import Data.List (intercalate)
 import Text.Printf (printf)
 
 import Language.SystemVerilog.AST.ShowHelp
 
 import Language.SystemVerilog.AST.Attr (Attr)
-import Language.SystemVerilog.AST.Decl (Decl)
+import Language.SystemVerilog.AST.Decl (Decl(CommentDecl))
 import Language.SystemVerilog.AST.Stmt (Stmt)
-import Language.SystemVerilog.AST.Type (Type, Identifier)
+import Language.SystemVerilog.AST.Type (Type, Identifier, pattern UnknownType)
 import {-# SOURCE #-} Language.SystemVerilog.AST.ModuleItem (ModuleItem)
 
 data Description
     = Part [Attr] Bool PartKW Lifetime Identifier [Identifier] [ModuleItem]
     | PackageItem PackageItem
     | Package Lifetime Identifier [PackageItem]
+    | Class   Lifetime Identifier [Decl] [ClassItem]
     deriving Eq
 
 instance Show Description where
-    showList descriptions _ = intercalate "\n" $ map show descriptions
+    showList l _ = unlines' $ map show l
     show (Part attrs True  kw lifetime name _ items) =
         printf "%sextern %s %s%s %s;"
             (concatMap showPad attrs)
@@ -51,38 +55,70 @@ instance Show Description where
             (showPad lifetime) name bodyStr
         where
             bodyStr = indent $ unlines' $ map show items
+    show (Class lifetime name decls items) =
+        printf "class %s%s%s;\n%s\nendclass"
+            (showPad lifetime) name (showParamDecls decls) bodyStr
+        where
+            bodyStr = indent $ unlines' $ map showClassItem items
     show (PackageItem i) = show i
 
+showParamDecls :: [Decl] -> String
+showParamDecls [] = ""
+showParamDecls decls = " #(\n\t" ++ showDecls decls ++ "\n)"
+
+showDecls :: [Decl] -> String
+showDecls =
+    dropDelim . intercalate "\n\t" . map showDecl
+    where
+        dropDelim :: String -> String
+        dropDelim [] = []
+        dropDelim [x] = if x == ',' then [] else [x]
+        dropDelim (x : xs) = x : dropDelim xs
+        showDecl comment@CommentDecl{} = show comment
+        showDecl decl = (init $ show decl) ++ ","
+
 data PackageItem
-    = Typedef Type Identifier
+    = Function Lifetime Type Identifier [Decl] [Stmt]
-    | Function Lifetime Type Identifier [Decl] [Stmt]
     | Task     Lifetime      Identifier [Decl] [Stmt]
-    | Import Identifier (Maybe Identifier)
+    | Import Identifier Identifier
-    | Export (Maybe (Identifier, Maybe Identifier))
+    | Export Identifier Identifier
     | Decl Decl
     | Directive String
-    | Comment String
+    | DPIImport String DPIImportProperty Identifier Type Identifier [Decl]
+    | DPIExport String Identifier DPIExportKW Identifier
     deriving Eq
 
 instance Show PackageItem where
-    show (Typedef t x) = printf "typedef %s %s;" (show t) x
     show (Function ml t x i b) =
-        printf "function %s%s%s;\n%s\n%s\nendfunction"
+        printf "function %s%s%s;\n%s\nendfunction" (showPad ml) (showPad t) x
-            (showPad ml) (showPad t) x (indent $ show i)
+        (showBlock i b)
-            (indent $ unlines' $ map show b)
     show (Task ml x i b) =
-        printf "task %s%s;\n%s\n%s\nendtask"
+        printf "task %s%s;\n%s\nendtask"
-            (showPad ml) x (indent $ show i)
+            (showPad ml) x (showBlock i b)
-            (indent $ unlines' $ map show b)
+    show (Import x y) = printf "import %s::%s;" x (showWildcard y)
-    show (Import x y) = printf "import %s::%s;" x (fromMaybe "*" y)
+    show (Export x y) = printf "export %s::%s;" (showWildcard x) (showWildcard y)
-    show (Export Nothing) = "export *::*";
-    show (Export (Just (x, y))) = printf "export %s::%s;" x (fromMaybe "*" y)
     show (Decl decl) = show decl
     show (Directive str) = str
-    show (Comment c) =
+    show (DPIImport spec prop alias typ name decls) =
-        if elem '\n' c
+        printf "import %s %s%s %s %s(%s);"
-            then "// " ++ show c
+            (show spec) (showPad prop) aliasStr protoStr name declsStr
-            else "// " ++ c
+        where
+            aliasStr = if null alias then "" else alias ++ " = "
+            protoStr =
+                if typ == UnknownType
+                    then "task"
+                    else "function " ++ show typ
+            declsStr =
+                if null decls
+                    then ""
+                    else "\n\t" ++ showDecls decls ++ "\n"
+    show (DPIExport spec alias kw name) =
+        printf "export %s %s%s %s;" (show spec) aliasStr (show kw) name
+        where aliasStr = if null alias then "" else alias ++ " = "
+
+showWildcard :: Identifier -> String
+showWildcard "" = "*"
+showWildcard x = x
 
 data PartKW
     = Module
@@ -97,9 +133,47 @@ data Lifetime
     = Static
     | Automatic
     | Inherit
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show Lifetime where
     show Static    = "static"
     show Automatic = "automatic"
     show Inherit   = ""
+
+type ClassItem = (Qualifier, PackageItem)
+
+showClassItem :: ClassItem -> String
+showClassItem (qualifier, item) = showPad qualifier ++ show item
+
+data Qualifier
+    = QNone
+    | QStatic
+    | QLocal
+    | QProtected
+    deriving Eq
+
+instance Show Qualifier where
+    show QNone      = ""
+    show QStatic    = "static"
+    show QLocal     = "local"
+    show QProtected = "protected"
+
+data DPIImportProperty
+    = DPIContext
+    | DPIPure
+    | DPINone
+    deriving Eq
+
+instance Show DPIImportProperty where
+    show DPIContext = "context"
+    show DPIPure    = "pure"
+    show DPINone    = ""
+
+data DPIExportKW
+    = DPIExportTask
+    | DPIExportFunction
+    deriving Eq
+
+instance Show DPIExportKW where
+    show DPIExportTask     = "task"
+    show DPIExportFunction = "function"

src/Language/SystemVerilog/AST/Expr.hs

@@ -9,108 +9,155 @@ module Language.SystemVerilog.AST.Expr
     ( Expr (..)
     , Range
     , TypeOrExpr
-    , ExprOrRange
     , Args (..)
     , PartSelectMode (..)
     , DimsFn (..)
     , DimFn (..)
     , showAssignment
+    , showRange
     , showRanges
-    , showExprOrRange
+    , ParamBinding
-    , simplify
+    , showParams
-    , rangeSize
+    , pattern RawNum
-    , endianCondExpr
+    , pattern UniOp
-    , endianCondRange
+    , pattern BinOp
-    , dimensionsSize
+    , pattern Mux
-    , readNumber
     ) where
 
 import Data.List (intercalate)
 import Text.Printf (printf)
-import Text.Read (readMaybe)
 
+import Language.SystemVerilog.AST.Number (Number(..))
 import Language.SystemVerilog.AST.Op
 import Language.SystemVerilog.AST.ShowHelp
+import {-# SOURCE #-} Language.SystemVerilog.AST.Attr
 import {-# SOURCE #-} Language.SystemVerilog.AST.Type
 
 type Range = (Expr, Expr)
 
 type TypeOrExpr = Either Type Expr
-type ExprOrRange = Either Expr Range
+
+pattern RawNum :: Integer -> Expr
+pattern RawNum n = Number (Decimal (-32) True n)
+
+pattern UniOp :: UniOp -> Expr -> Expr
+pattern UniOp op e = UniOpA op [] e
+pattern BinOp :: BinOp -> Expr -> Expr -> Expr
+pattern BinOp op l r = BinOpA op [] l r
+pattern Mux :: Expr -> Expr -> Expr -> Expr
+pattern Mux c t f = MuxA [] c t f
 
 data Expr
     = String  String
-    | Number  String
+    | Real    String
+    | Number  Number
     | Time    String
     | Ident   Identifier
     | PSIdent Identifier Identifier
+    | CSIdent Identifier [ParamBinding] Identifier
     | Range   Expr PartSelectMode Range
     | Bit     Expr Expr
     | Repeat  Expr [Expr]
     | Concat  [Expr]
     | Stream  StreamOp Expr [Expr]
     | Call    Expr Args
-    | UniOp   UniOp Expr
+    | UniOpA  UniOp [Attr] Expr
-    | BinOp   BinOp Expr Expr
+    | BinOpA  BinOp [Attr] Expr Expr
-    | Mux     Expr Expr Expr
+    | MuxA    [Attr] Expr Expr Expr
     | Cast    TypeOrExpr Expr
     | DimsFn  DimsFn TypeOrExpr
     | DimFn   DimFn  TypeOrExpr Expr
     | Dot     Expr Identifier
-    | Pattern [(Identifier, Expr)]
+    | Pattern [(TypeOrExpr, Expr)]
-    | Inside Expr [ExprOrRange]
+    | Inside  Expr [Expr]
     | MinTypMax Expr Expr Expr
+    | ExprAsgn Expr Expr
     | Nil
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show Expr where
     show (Nil          ) = ""
-    show (Number  str  ) = str
     show (Time    str  ) = str
     show (Ident   str  ) = str
+    show (Real    str  ) = str
+    show (Number  n    ) = show n
     show (PSIdent x y  ) = printf "%s::%s" x y
+    show (CSIdent x p y) = printf "%s#%s::%s" x (showParams p) y
     show (String  str  ) = printf "\"%s\"" str
     show (Bit     e b  ) = printf "%s[%s]"     (show e) (show b)
     show (Range   e m r) = printf "%s[%s%s%s]" (show e) (show $ fst r) (show m) (show $ snd r)
     show (Repeat  e l  ) = printf "{%s {%s}}"  (show e) (commas $ map show l)
     show (Concat  l    ) = printf "{%s}"                (commas $ map show l)
     show (Stream  o e l) = printf "{%s %s%s}"  (show o) (show e) (show $ Concat l)
-    show (UniOp   o e  ) = printf "%s%s"       (show o) (show e)
+    show (Cast tore e  ) = printf "%s'(%s)"    toreStr  (show e)
-    show (BinOp   o a b) = printf "(%s %s %s)" (show a) (show o) (show b)
+        where toreStr = either show (flip showBinOpPrec []) tore
-    show (Dot     e n  ) = printf "%s.%s"      (show e) n
-    show (Mux     c a b) = printf "(%s ? %s : %s)" (show c) (show a) (show b)
-    show (Call    e l  ) = printf "%s%s"       (show e) (show l)
-    show (Cast tore e  ) = printf "%s'(%s)"    (showEither tore) (show e)
     show (DimsFn  f v  ) = printf "%s(%s)"     (show f) (showEither v)
     show (DimFn   f v e) = printf "%s(%s, %s)" (show f) (showEither v) (show e)
-    show (Inside  e l  ) = printf "(%s inside { %s })"  (show e) (intercalate ", " strs)
+    show (Inside  e l  ) = printf "(%s inside { %s })" (show e) (intercalate ", " $ map show l)
-        where
-            strs = map showExprOrRange l
     show (Pattern l    ) =
         printf "'{\n%s\n}" (indent $ intercalate ",\n" $ map showPatternItem l)
         where
-            showPatternItem :: (Identifier, Expr) -> String
+            showPatternItem :: (TypeOrExpr, Expr) -> String
-            showPatternItem (""     , e) = show e
+            showPatternItem (Right Nil, v) = show v
-            showPatternItem (':' : n, e) = showPatternItem (n, e)
+            showPatternItem (Right e, v) = printf "%s: %s" (show e) (show v)
-            showPatternItem (n      , e) = printf "%s: %s" n (show e)
+            showPatternItem (Left t, v) = printf "%s: %s" tStr (show v)
+                where tStr = if null (show t) then "default" else show t
     show (MinTypMax a b c) = printf "(%s : %s : %s)" (show a) (show b) (show c)
+    show (ExprAsgn l r) = printf "(%s = %s)" (show l) (show r)
+    show e@UniOpA{} = showsPrec 0 e ""
+    show e@BinOpA{} = showsPrec 0 e ""
+    show e@Dot   {} = showsPrec 0 e ""
+    show e@MuxA  {} = showsPrec 0 e ""
+    show e@Call  {} = showsPrec 0 e ""
+
+    showsPrec _ (UniOpA o a e  ) =
+        shows o .
+        (if null a then id else showChar ' ') .
+        showsAttrs a .
+        showUniOpPrec e
+    showsPrec _ (BinOpA o a l r) =
+        showBinOpPrec l .
+        showChar ' ' .
+        shows o .
+        showChar ' ' .
+        showsAttrs a .
+        case (o, r) of
+            (BitAnd, UniOp RedAnd _) -> showExprWrapped r
+            (BitOr , UniOp RedOr  _) -> showExprWrapped r
+            _ -> showBinOpPrec r
+    showsPrec _ (Dot      e n  ) =
+        shows e .
+        showChar '.' .
+        showString n
+    showsPrec _ (MuxA   a c t f) =
+        showChar '(' .
+        shows c .
+        showString " ? " .
+        showsAttrs a .
+        shows t .
+        showString " : " .
+        shows f .
+        showChar ')'
+    showsPrec _ (Call     e l  ) =
+        shows e .
+        shows l
+    showsPrec _ e = \s -> show e ++ s
 
 data Args
-    = Args [Maybe Expr] [(Identifier, Maybe Expr)]
+    = Args [Expr] [(Identifier, Expr)]
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show Args where
-    show (Args pnArgs kwArgs) = "(" ++ (commas strs) ++ ")"
+    show (Args pnArgs kwArgs) = '(' : commas strs ++ ")"
         where
-            strs = (map showPnArg pnArgs) ++ (map showKwArg kwArgs)
+            strs = (map show pnArgs) ++ (map showKwArg kwArgs)
-            showPnArg = maybe "" show
+            showKwArg (x, e) = printf ".%s(%s)" x (show e)
-            showKwArg (x, me) = printf ".%s(%s)" x (showPnArg me)
 
 data PartSelectMode
     = NonIndexed
     | IndexedPlus
     | IndexedMinus
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show PartSelectMode where
     show NonIndexed   = ":"
@@ -121,7 +168,7 @@ data DimsFn
     = FnBits
     | FnDimensions
     | FnUnpackedDimensions
-    deriving (Eq, Ord)
+    deriving Eq
 
 data DimFn
     = FnLeft
@@ -130,7 +177,7 @@ data DimFn
     | FnHigh
     | FnIncrement
     | FnSize
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show DimsFn where
     show FnBits               = "$bits"
@@ -146,145 +193,34 @@ instance Show DimFn where
     show FnSize               = "$size"
 
 
-showAssignment :: Show a => Maybe a -> String
+showAssignment :: Expr -> String
-showAssignment Nothing = ""
+showAssignment Nil = ""
-showAssignment (Just val) = " = " ++ show val
+showAssignment val = " = " ++ show val
 
 showRanges :: [Range] -> String
 showRanges [] = ""
-showRanges l = " " ++ (concatMap showRange l)
+showRanges l = ' ' : concatMap showRange l
 
 showRange :: Range -> String
-showRange (h, l) = printf "[%s:%s]" (show h) (show l)
+showRange (h, l) = '[' : show h ++ ':' : show l ++ "]"
 
-showExprOrRange :: ExprOrRange -> String
+showUniOpPrec :: Expr -> ShowS
-showExprOrRange (Left  x) = show x
+showUniOpPrec e@UniOp{} = showExprWrapped e
-showExprOrRange (Right x) = show x
+showUniOpPrec e@BinOp{} = showExprWrapped e
+showUniOpPrec e = shows e
 
-clog2Help :: Int -> Int -> Int
+showBinOpPrec :: Expr -> ShowS
-clog2Help p n = if p >= n then 0 else 1 + clog2Help (p*2) n
+showBinOpPrec e@BinOp{} = showExprWrapped e
-clog2 :: Int -> Int
+showBinOpPrec e = shows e
-clog2 n = if n < 2 then 0 else clog2Help 1 n
 
-readNumber :: String -> Maybe Int
+showExprWrapped :: Expr -> ShowS
-readNumber n =
+showExprWrapped = showParen True . shows
-    readMaybe n' :: Maybe Int
-    where
-        n' = case n of
-            '\'' : 'd' : rest -> rest
-            _ -> n
 
--- basic expression simplfication utility to help us generate nicer code in the
+type ParamBinding = (Identifier, TypeOrExpr)
--- common case of ranges like `[FOO-1:0]`
-simplify :: Expr -> Expr
-simplify (UniOp LogNot (Number "1")) = Number "0"
-simplify (UniOp LogNot (Number "0")) = Number "1"
-simplify (orig @ (UniOp UniSub (Number n))) =
-    case readNumber n of
-        Nothing -> orig
-        Just x -> Number $ show (-x)
-simplify (orig @ (Repeat (Number n) exprs)) =
-    case readNumber n of
-        Nothing -> orig
-        Just 0 -> Concat []
-        Just 1 -> Concat exprs
-        Just x ->
-            if x < 0
-                then error $ "negative repeat count: " ++ show orig
-                else orig
-simplify (Concat [expr]) = expr
-simplify (Concat exprs) =
-    Concat $ filter (/= Concat []) exprs
-simplify (orig @ (Call (Ident "$clog2") (Args [Just (Number n)] []))) =
-    case readNumber n of
-        Nothing -> orig
-        Just x -> Number $ show $ clog2 x
-simplify (Mux cc e1 e2) =
-    case cc' of
-        Number "1" -> e1'
-        Number "0" -> e2'
-        _ -> Mux cc' e1' e2'
-    where
-        cc' = simplify cc
-        e1' = simplify e1
-        e2' = simplify e2
-simplify (Range e NonIndexed r) = Range e NonIndexed r
-simplify (Range e _ (i, Number "0")) = Bit e i
-simplify (BinOp Sub (Number n1) (BinOp Sub (Number n2) e)) =
-    simplify $ BinOp Add (BinOp Sub (Number n1) (Number n2)) e
-simplify (BinOp Sub (Number n1) (BinOp Sub e (Number n2))) =
-    simplify $ BinOp Sub (BinOp Add (Number n1) (Number n2)) e
-simplify (BinOp Add (BinOp Sub (Number n1) e) (Number n2)) =
-    case (readNumber n1, readNumber n2) of
-        (Just x, Just y) ->
-            simplify $ BinOp Sub (Number $ show (x + y)) e'
-        _ -> nochange
-    where
-        e' = simplify e
-        nochange = BinOp Add (BinOp Sub (Number n1) e') (Number n2)
-simplify (BinOp op e1 e2) =
-    case (op, e1', e2') of
-        (Add, Number "0", e) -> e
-        (Add, e, Number "0") -> e
-        (Mul, _, Number "0") -> Number "0"
-        (Mul, Number "0", _) -> Number "0"
-        (Mul, e, Number "1") -> e
-        (Mul, Number "1", e) -> e
-        (Sub, e, Number "0") -> e
-        (Add, BinOp Sub e (Number "1"), Number "1") -> e
-        (Add, e, BinOp Sub (Number "0") (Number "1")) -> BinOp Sub e (Number "1")
-        (_  , Number a, Number b) ->
-            case (op, readNumber a :: Maybe Int, readNumber b :: Maybe Int) of
-                (Add, Just x, Just y) -> Number $ show (x + y)
-                (Sub, Just x, Just y) -> Number $ show (x - y)
-                (Mul, Just x, Just y) -> Number $ show (x * y)
-                (Div, Just _, Just 0) -> Number "x"
-                (Div, Just x, Just y) -> Number $ show (x `quot` y)
-                (Eq , Just x, Just y) -> bool $ x == y
-                (Ne , Just x, Just y) -> bool $ x /= y
-                (Gt , Just x, Just y) -> bool $ x >  y
-                (Ge , Just x, Just y) -> bool $ x >= y
-                (Lt , Just x, Just y) -> bool $ x <  y
-                (Le , Just x, Just y) -> bool $ x <= y
-                _ -> BinOp op e1' e2'
-        (Add, BinOp Add e (Number a), Number b) ->
-            case (readNumber a, readNumber b) of
-                (Just x, Just y) -> BinOp Add e $ Number $ show (x + y)
-                _ -> BinOp op e1' e2'
-        (Sub, e, Number "-1") -> BinOp Add e (Number "1")
-        _ -> BinOp op e1' e2'
-    where
-        e1' = simplify e1
-        e2' = simplify e2
-        bool True = Number "1"
-        bool False = Number "0"
-simplify other = other
 
-rangeSize :: Range -> Expr
+showParams :: [ParamBinding] -> String
-rangeSize (s, e) =
+showParams params = indentedParenList $ map showParam params
-    endianCondExpr (s, e) a b
-    where
-        a = simplify $ BinOp Add (BinOp Sub s e) (Number "1")
-        b = simplify $ BinOp Add (BinOp Sub e s) (Number "1")
 
--- chooses one or the other expression based on the endianness of the given
+showParam :: ParamBinding -> String
--- range; [hi:lo] chooses the first expression
+showParam ("", arg) = showEither arg
-endianCondExpr :: Range -> Expr -> Expr -> Expr
+showParam (i, arg) = printf ".%s(%s)" i (showEither arg)
-endianCondExpr r e1 e2 = simplify $ Mux (uncurry (BinOp Ge) r) e1 e2
-
--- chooses one or the other range based on the endianness of the given range,
--- but in such a way that the result is itself also usable as a range even if
--- the endianness cannot be resolved during conversion, i.e. if it's dependent
--- on a parameter value; [hi:lo] chooses the first range
-endianCondRange :: Range -> Range -> Range -> Range
-endianCondRange r r1 r2 =
-    ( endianCondExpr r (fst r1) (fst r2)
-    , endianCondExpr r (snd r1) (snd r2)
-    )
-
-dimensionsSize :: [Range] -> Expr
-dimensionsSize ranges =
-    simplify $
-    foldl (BinOp Mul) (Number "1") $
-    map rangeSize $
-    ranges

src/Language/SystemVerilog/AST/GenItem.hs

@@ -22,7 +22,7 @@ import {-# SOURCE #-} Language.SystemVerilog.AST.ModuleItem (ModuleItem)
 data GenItem
     = GenBlock Identifier [GenItem]
     | GenCase  Expr [GenCase]
-    | GenFor   (Bool, Identifier, Expr) Expr (Identifier, AsgnOp, Expr) GenItem
+    | GenFor   (Identifier, Expr) Expr (Identifier, AsgnOp, Expr) GenItem
     | GenIf    Expr GenItem GenItem
     | GenNull
     | GenModuleItem ModuleItem
@@ -31,26 +31,34 @@ data GenItem
 instance Show GenItem where
     showList i _ = unlines' $ map show i
     show (GenBlock x i) =
-        printf "begin%s\n%s\nend"
+        "if (1) " ++ showBareBlock (GenBlock x i)
-            (if null x then "" else " : " ++ x)
-            (indent $ unlines' $ map show i)
     show (GenCase e cs) =
         printf "case (%s)\n%s\nendcase" (show e) bodyStr
         where bodyStr = indent $ unlines' $ map showGenCase cs
-    show (GenIf e a GenNull) = printf "if (%s) %s"          (show e) (show a)
+    show (GenIf e a GenNull) = printf "if (%s) %s"          (show e) (showBareBlock a)
-    show (GenIf e a b      ) = printf "if (%s) %s\nelse %s" (show e) (show a) (show b)
+    show (GenIf e a b      ) = printf "if (%s) %s\nelse %s" (show e) (showBlockedBranch a) (showBareBlock b)
-    show (GenFor (new, x1, e1) c (x2, o2, e2) s) =
+    show (GenFor (x1, e1) c (x2, o2, e2) s) =
-        printf "for (%s%s = %s; %s; %s %s %s) %s"
+        printf "for (%s = %s; %s; %s %s %s) %s"
-            (if new then "genvar " else "")
             x1 (show e1)
             (show c)
             x2 (show o2) (show e2)
-            (show s)
+            (showBareBlock s)
     show (GenNull) = ";"
     show (GenModuleItem item) = show item
 
+showBareBlock :: GenItem -> String
+showBareBlock (GenBlock x i) =
+    printf "begin%s\n%s\nend"
+        (if null x then "" else " : " ++ x)
+        (indent $ show i)
+showBareBlock item = show item
+
+showBlockedBranch :: GenItem -> String
+showBlockedBranch genItem@GenBlock{} = showBareBlock genItem
+showBlockedBranch genItem = showBareBlock $ GenBlock "" [genItem]
+
 type GenCase = ([Expr], GenItem)
 
 showGenCase :: GenCase -> String
-showGenCase (a, b) = printf "%s: %s" exprStr (show b)
+showGenCase (a, b) = printf "%s: %s" exprStr (showBareBlock b)
     where exprStr = if null a then "default" else commas $ map show a

src/Language/SystemVerilog/AST/ModuleItem.hs

@@ -8,16 +8,15 @@
 module Language.SystemVerilog.AST.ModuleItem
     ( ModuleItem    (..)
     , PortBinding
-    , ParamBinding
     , ModportDecl
     , AlwaysKW      (..)
     , NInputGateKW  (..)
     , NOutputGateKW (..)
+    , AssignOption  (..)
+    , AssertionItem (..)
     ) where
 
 import Data.List (intercalate)
-import Data.Maybe (maybe, fromJust, isJust)
-import Data.Either (either)
 import Text.Printf (printf)
 
 import Language.SystemVerilog.AST.ShowHelp
@@ -25,26 +24,27 @@ import Language.SystemVerilog.AST.ShowHelp
 import Language.SystemVerilog.AST.Attr (Attr)
 import Language.SystemVerilog.AST.Decl (Direction)
 import Language.SystemVerilog.AST.Description (PackageItem)
-import Language.SystemVerilog.AST.Expr (Expr(Ident, Nil), Range, TypeOrExpr, showRanges)
+import Language.SystemVerilog.AST.Expr (Expr(Nil), pattern Ident, Range, showRanges, ParamBinding, showParams, Args(Args))
 import Language.SystemVerilog.AST.GenItem (GenItem)
 import Language.SystemVerilog.AST.LHS (LHS)
-import Language.SystemVerilog.AST.Stmt (Stmt, AssertionItem)
+import Language.SystemVerilog.AST.Stmt (Stmt, Assertion, Severity, Timing(Delay), PropertySpec, SeqExpr)
-import Language.SystemVerilog.AST.Type (Identifier)
+import Language.SystemVerilog.AST.Type (Identifier, Strength0, Strength1)
 
 data ModuleItem
     = MIAttr     Attr ModuleItem
     | AlwaysC    AlwaysKW Stmt
-    | Assign     (Maybe Expr) LHS Expr
+    | Assign     AssignOption LHS Expr
     | Defparam   LHS Expr
-    | Instance   Identifier [ParamBinding] Identifier (Maybe Range) [PortBinding]
+    | Instance   Identifier [ParamBinding] Identifier [Range] [PortBinding]
     | Genvar     Identifier
     | Generate   [GenItem]
     | Modport    Identifier [ModportDecl]
     | Initial    Stmt
     | Final      Stmt
+    | ElabTask   Severity [Expr]
     | MIPackageItem PackageItem
-    | NInputGate  NInputGateKW  (Maybe Identifier)  LHS [Expr]
+    | NInputGate  NInputGateKW  Expr Identifier [Range]  LHS [Expr]
-    | NOutputGate NOutputGateKW (Maybe Identifier) [LHS] Expr
+    | NOutputGate NOutputGateKW Expr Identifier [Range] [LHS] Expr
     | AssertionItem AssertionItem
     deriving Eq
 
@@ -52,57 +52,52 @@ instance Show ModuleItem where
     show (MIPackageItem i) = show i
     show (MIAttr attr mi ) = printf "%s %s" (show attr) (show mi)
     show (AlwaysC     k b) = printf "%s %s" (show k) (show b)
+    show (Assign    o a b) = printf "assign %s%s = %s;" (showPad o) (show a) (show b)
     show (Defparam    a b) = printf "defparam %s = %s;" (show a) (show b)
     show (Genvar      x  ) = printf "genvar %s;" x
-    show (Generate    b  ) = printf "generate\n%s\nendgenerate" (indent $ unlines' $ map show b)
+    show (Generate    b  ) = printf "generate\n%s\nendgenerate" (indent $ show b)
     show (Modport     x l) = printf "modport %s(\n%s\n);" x (indent $ intercalate ",\n" $ map showModportDecl l)
     show (Initial     s  ) = printf "initial %s" (show s)
     show (Final       s  ) = printf   "final %s" (show s)
-    show (NInputGate  kw x lhs exprs) = printf "%s%s (%s, %s);" (show kw) (maybe "" (" " ++) x) (show lhs) (commas $ map show exprs)
+    show (ElabTask    s a) = printf "%s%s;" (show s) (show $ Args a [])
-    show (NOutputGate kw x lhss expr) = printf "%s%s (%s, %s);" (show kw) (maybe "" (" " ++) x) (commas $ map show lhss) (show expr)
+    show (NInputGate  kw d x rs lhs exprs) =
-    show (Assign d a b) =
+        showGate kw d x rs $ show lhs : map show exprs
-        printf "assign %s%s = %s;" delayStr (show a) (show b)
+    show (NOutputGate kw d x rs lhss expr) =
-        where delayStr = maybe "" (\e -> "#(" ++ show e ++ ") ") d
+        showGate kw d x rs $ (map show lhss) ++ [show expr]
-    show (AssertionItem (mx, a)) =
+    show (AssertionItem i) = show i
-        if mx == Nothing
+    show (Instance   m params i rs ports) =
-            then show a
-            else printf "%s : %s" (fromJust mx) (show a)
-    show (Instance   m params i r ports) =
         if null params
-            then printf "%s %s%s%s;"     m                     i rStr (showPorts ports)
+            then printf "%s %s%s%s;"     m                     i rsStr (showPorts ports)
-            else printf "%s #%s %s%s%s;" m (showParams params) i rStr (showPorts ports)
+            else printf "%s #%s %s%s%s;" m (showParams params) i rsStr (showPorts ports)
-        where rStr = maybe "" (\a -> showRanges [a] ++ " ") r
+        where rsStr = if null rs then "" else tail $ showRanges rs
 
 showPorts :: [PortBinding] -> String
 showPorts ports = indentedParenList $ map showPort ports
 
 showPort :: PortBinding -> String
-showPort ("*", Nothing) = ".*"
+showPort ("*", Nil) = ".*"
 showPort (i, arg) =
     if i == ""
-        then show (fromJust arg)
+        then show arg
-        else printf ".%s(%s)" i (if isJust arg then show $ fromJust arg else "")
+        else printf ".%s(%s)" i (show arg)
 
-showParams :: [ParamBinding] -> String
+showGate :: Show k => k -> Expr -> Identifier -> [Range] -> [String] -> String
-showParams params = indentedParenList $ map showParam params
+showGate kw d x rs args =
-
+    printf "%s %s%s%s(%s);" (show kw) delayStr nameStr rsStr (commas args)
-showParam :: ParamBinding -> String
+    where
-showParam ("*", Right Nil) = ".*"
+        delayStr = if d == Nil then "" else showPad $ Delay d
-showParam (i, arg) =
+        nameStr = showPad $ Ident x
-    printf fmt i (either show show arg)
+        rsStr = if null rs then "" else tail $ showRanges rs
-    where fmt = if i == "" then "%s%s" else ".%s(%s)"
 
 showModportDecl :: ModportDecl -> String
-showModportDecl (dir, ident, me) =
+showModportDecl (dir, ident, e) =
-    if me == Just (Ident ident)
+    if e == Ident ident
         then printf "%s %s" (show dir) ident
-        else printf "%s .%s(%s)" (show dir) ident (maybe "" show me)
+        else printf "%s .%s(%s)" (show dir) ident (show e)
 
-type PortBinding = (Identifier, Maybe Expr)
+type PortBinding = (Identifier, Expr)
 
-type ParamBinding = (Identifier, TypeOrExpr)
+type ModportDecl = (Direction, Identifier, Expr)
-
-type ModportDecl = (Direction, Identifier, Maybe Expr)
 
 data AlwaysKW
     = Always
@@ -124,6 +119,16 @@ data NInputGateKW
     | GateNor
     | GateXor
     | GateXnor
+    | GateBufif0
+    | GateBufif1
+    | GateNotif0
+    | GateNotif1
+    | GateCmos
+    | GateRcmos
+    | GateNmos
+    | GatePmos
+    | GateRnmos
+    | GateRpmos
     deriving Eq
 
 instance Show NInputGateKW where
@@ -133,6 +138,18 @@ instance Show NInputGateKW where
     show GateNor    = "nor"
     show GateXor    = "xor"
     show GateXnor   = "xnor"
+    show GateBufif0 = "bufif0"
+    show GateBufif1 = "bufif1"
+    show GateNotif0 = "notif0"
+    show GateNotif1 = "notif1"
+    -- these technically require exactly 3 inputs: input, ncontrol, pcontrol
+    show GateCmos   = "cmos"
+    show GateRcmos  = "rcmos"
+    -- these technically require exactly 2 inputs: input, enable
+    show GateNmos   = "nmos"
+    show GatePmos   = "pmos"
+    show GateRnmos  = "rnmos"
+    show GateRpmos  = "rpmos"
 
 data NOutputGateKW
     = GateBuf
@@ -142,3 +159,27 @@ data NOutputGateKW
 instance Show NOutputGateKW where
     show GateBuf  = "buf"
     show GateNot  = "not"
+
+data AssignOption
+    = AssignOptionNone
+    | AssignOptionDelay Expr
+    | AssignOptionDrive Strength0 Strength1
+    deriving Eq
+
+instance Show AssignOption where
+    show AssignOptionNone = ""
+    show (AssignOptionDelay de) = printf "#(%s)" (show de)
+    show (AssignOptionDrive s0 s1) = printf "(%s, %s)" (show s0) (show s1)
+
+data AssertionItem
+    = MIAssertion  Identifier Assertion
+    | PropertyDecl Identifier PropertySpec
+    | SequenceDecl Identifier SeqExpr
+    deriving Eq
+
+instance Show AssertionItem where
+    show (MIAssertion x a)
+        | null x = show a
+        | otherwise = printf "%s : %s" x (show a)
+    show (PropertyDecl  x p) = printf "property %s;\n%s\nendproperty" x (indent $ show p)
+    show (SequenceDecl  x e) = printf "sequence %s;\n%s\nendsequence" x (indent $ show e)

src/Language/SystemVerilog/AST/Number.hs

@@ -0,0 +1,540 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - SystemVerilog number literals
+ -}
+
+module Language.SystemVerilog.AST.Number
+    ( Number (..)
+    , Base (..)
+    , Bit (..)
+    , parseNumber
+    , numberBitLength
+    , numberIsSigned
+    , numberIsSized
+    , numberToInteger
+    , numberCast
+    , bitToVK
+    ) where
+
+import Data.Bits ((.&.), shiftL, xor)
+import Data.Char (digitToInt, intToDigit, toLower)
+import Data.List (elemIndex)
+import Text.Read (readMaybe)
+
+{-# NOINLINE parseNumber #-}
+parseNumber :: Bool -> String -> (Number, String)
+parseNumber oversizedNumbers =
+    (parseNormalized oversizedNumbers) . normalizeNumber
+
+-- normalize the number first, making everything lowercase and removing
+-- visual niceties like spaces and underscores
+normalizeNumber :: String -> String
+normalizeNumber = map toLower . filter (not . isPad)
+    where isPad = flip elem "_ \n\t"
+
+-- truncate the given decimal number literal, if necessary
+validateDecimal :: Bool -> String -> Int -> Bool -> Integer -> (Number, String)
+validateDecimal oversizedNumbers str sz sg v
+    | sz < -32 && oversizedNumbers =
+        valid $ Decimal sz sg v
+    | sz < -32 =
+        addTruncateMessage str $
+        if sg && v' > widthMask 31
+            -- avoid zero-pad on signed decimals
+            then Based (-32) sg Hex v' 0
+            else Decimal (-32) sg v'
+    | sz > 0 && v > widthMask sz =
+        addTruncateMessage str $
+            Decimal sz sg v'
+    | otherwise =
+        valid $ Decimal sz sg v
+    where
+        v' = v .&. widthMask truncWidth
+        truncWidth = if sz < -32 then -32 else sz
+
+-- produce a warning message describing the applied truncation
+addTruncateMessage :: String -> Number -> (Number, String)
+addTruncateMessage orig trunc = (trunc, msg)
+    where
+        width = show $ numberBitLength trunc
+        bit = if width == "1" then "bit" else "bits"
+        msg = "Number literal " ++ orig ++ " exceeds " ++ width ++ " " ++ bit
+            ++ "; truncating to " ++ show trunc ++ "."
+
+-- when extending a wide unsized number, we use the bit width if the digits
+-- cover exactly that many bits, and add an extra 0 padding bit otherwise
+extendUnsizedBased :: Int -> Number -> Number
+extendUnsizedBased sizeByDigits n
+    | size > -32 || sizeByBits < 32 = n
+    | sizeByBits == sizeByDigits    = useWidth sizeByBits
+    | otherwise                     = useWidth $ sizeByBits + 1
+    where
+        Based size sg base vals knds = n
+        sizeByBits = fromIntegral $ max (bits vals) (bits knds)
+        useWidth sz = Based (negate sz) sg base vals knds
+
+-- truncate the given based number literal, if necessary
+validateBased :: String -> Int -> Int -> Number -> (Number, String)
+validateBased orig sizeIfPadded sizeByDigits n
+    -- more digits than the size would allow for, regardless of their values
+    | sizeIfPadded < sizeByDigits            = truncated
+    -- unsized literal with fewer than 32 bits
+    | 0 > size && size > -32                 = validated
+    -- no padding bits are present
+    | abs size >= sizeIfPadded               = validated
+    -- check the padding bits in the leading digit, if there are any
+    | all (isLegalPad sizethBit) paddingBits = validated
+    -- some of the padding bits aren't legal
+    | otherwise                              = truncated
+    where
+        Based size sg base vals knds = n
+        n' = Based size sg base' vals' knds'
+
+        validated = valid n
+        truncated = addTruncateMessage orig n'
+
+        -- checking padding bits
+        sizethBit = getBit $ abs size - 1
+        paddingBits = map getBit [abs size..sizeIfPadded - 1]
+        getBit = getVKBit vals knds
+
+        -- truncated the number, and selected a valid new base
+        vals' = vals .&. widthMask size
+        knds' = knds .&. widthMask size
+        base' = if size == -32 && baseSelect == Octal
+            then Binary
+            else baseSelect
+        baseSelect = selectBase base vals' knds'
+
+-- if the MSB post-truncation is X or Z, then any padding bits must match; if
+-- the MSB post-truncation is 0 or 1, then non-zero padding bits are forbidden
+isLegalPad :: Bit -> Bit -> Bool
+isLegalPad Bit1 = (== Bit0)
+isLegalPad bit = (== bit)
+
+parseNormalized :: Bool -> String -> (Number, String)
+parseNormalized _ "'0" = valid $ UnbasedUnsized Bit0
+parseNormalized _ "'1" = valid $ UnbasedUnsized Bit1
+parseNormalized _ "'x" = valid $ UnbasedUnsized BitX
+parseNormalized _ "'z" = valid $ UnbasedUnsized BitZ
+parseNormalized oversizedNumbers str =
+    -- simple decimal number
+    if maybeIdx == Nothing then
+        let num = readDecimal str
+            sz = negate (decimalSize True num)
+        in decimal sz True num
+    -- non-decimal based integral number
+    else if maybeBase /= Nothing then
+        let (values, kinds) = parseBasedDigits (baseSize base) digitsExtended
+            number = Based size signed base values kinds
+            sizeIfPadded = sizeDigits * bitsPerDigit
+            sizeByDigits = length digitsExtended * bitsPerDigit
+        in if oversizedNumbers && size < 0
+            then valid $ extendUnsizedBased sizeByDigits number
+            else validateBased str sizeIfPadded sizeByDigits number
+    -- decimal X or Z literal
+    else if numDigits == 1 && leadDigitIsXZ then
+        let vals = if elem leadDigit zDigits then widthMask size else 0
+            knds = widthMask size
+        in valid $ Based size signed Binary vals knds
+    -- explicitly-based decimal number
+    else
+        let num = readDecimal digits
+            sz = if rawSize == 0 then negate (decimalSize signed num) else size
+        in decimal sz signed num
+    where
+        -- pull out the components of the literals
+        maybeIdx = elemIndex '\'' str
+        Just idx = maybeIdx
+        signBasedAndDigits = drop (idx + 1) str
+        (signed, baseAndDigits) = takeSign signBasedAndDigits
+        (maybeBase, digits) = takeBase baseAndDigits
+
+        -- high-order X or Z is extended up to the size of the literal
+        leadDigit = head digits
+        numDigits = length digits + if isSignedUnsizedWithLeading1 then 1 else 0
+        leadDigitIsXZ = elem leadDigit xzDigits
+        digitsExtended =
+            if leadDigitIsXZ
+                then replicate (sizeDigits - numDigits) leadDigit ++ digits
+                else digits
+        isSignedUnsizedWithLeading1 =
+            maybeBase /= Nothing &&
+            not leadDigitIsXZ &&
+            signed &&
+            digitToInt leadDigit >= div (baseSize base) 2
+
+        -- determine the number of digits needed based on the size
+        sizeDigits = ((abs size) `div` bitsPerDigit) + sizeExtraDigit
+        sizeExtraDigit =
+            if (abs size) `mod` bitsPerDigit == 0
+                then 0
+                else 1
+
+        -- determine the explicit size of the literal in bites
+        Just base = maybeBase
+        rawSize =
+            if idx == 0
+                then 0
+                else readDecimal $ take idx str
+        size =
+            if rawSize /= 0 then
+                rawSize
+            else if maybeBase == Nothing || leadDigitIsXZ then
+                -32
+            else
+                negate $ min 32 $ bitsPerDigit * numDigits
+        bitsPerDigit = bits $ baseSize base - 1
+
+        -- shortcut for decimal outputs
+        decimal :: Int -> Bool -> Integer -> (Number, String)
+        decimal = validateDecimal oversizedNumbers str
+
+-- shorthand denoting a valid number literal
+valid :: Number -> (Number, String)
+valid = (, "")
+
+-- mask with the lowest N bits set
+widthMask :: Int -> Integer
+widthMask pow = 2 ^ (abs pow) - 1
+
+-- read a simple unsigned decimal number
+readDecimal :: Read a => String -> a
+readDecimal str =
+    case readMaybe str of
+        Nothing -> error $ "could not parse decimal " ++ show str
+        Just n -> n
+
+-- returns the number of bits necessary to represent a number; it gives an extra
+-- bit for signed numbers so that the literal doesn't sign extend unnecessarily
+decimalSize :: Bool -> Integer -> Int
+decimalSize True = max 32 . fromIntegral . bits . (* 2)
+decimalSize False = max 32 . fromIntegral . bits
+
+-- remove the leading sign specified, if it is present
+takeSign :: String -> (Bool, String)
+takeSign ('s' : rest) = (True, rest)
+takeSign rest = (False, rest)
+
+-- pop the leading base specified from a based coda
+takeBase :: String -> (Maybe Base, String)
+takeBase ('d' : rest) = (Nothing, rest)
+takeBase ('b' : rest) = (Just Binary, rest)
+takeBase ('o' : rest) = (Just Octal, rest)
+takeBase ('h' : rest) = (Just Hex, rest)
+takeBase rest = error $ "cannot parse based coda " ++ show rest
+
+-- convert the digits of a based number to its corresponding value and kind bits
+parseBasedDigits :: Integer -> String -> (Integer, Integer)
+parseBasedDigits base str =
+    (values, kinds)
+    where
+        values = parseDigits parseValueDigit str
+        kinds = parseDigits parseKindDigit str
+
+        parseDigits :: (Char -> Integer) -> String -> Integer
+        parseDigits f = foldl sumStep 0 . map f
+        sumStep :: Integer -> Integer -> Integer
+        sumStep total digit = total * base + digit
+
+        parseValueDigit :: Char -> Integer
+        parseValueDigit x =
+            if elem x xDigits then
+                0
+            else if elem x zDigits then
+                base - 1
+            else
+                fromIntegral $ digitToInt x
+
+        parseKindDigit :: Char -> Integer
+        parseKindDigit x =
+            if elem x xzDigits
+                then base - 1
+                else 0
+
+xDigits :: [Char]
+xDigits = ['x']
+zDigits :: [Char]
+zDigits = ['z', '?']
+xzDigits :: [Char]
+xzDigits = xDigits ++ zDigits
+
+data Bit
+    = Bit0
+    | Bit1
+    | BitX
+    | BitZ
+    deriving Eq
+
+instance Show Bit where
+    show Bit0 = "0"
+    show Bit1 = "1"
+    show BitX = "x"
+    show BitZ = "z"
+
+-- convet an unbased unsized bit to its (values, kinds) pair
+bitToVK :: Bit -> (Integer, Integer)
+bitToVK Bit0 = (0, 0)
+bitToVK Bit1 = (1, 0)
+bitToVK BitX = (0, 1)
+bitToVK BitZ = (1, 1)
+
+-- get the logical bit value at the given index in a (values, kinds) pair
+getVKBit :: Integer -> Integer -> Int -> Bit
+getVKBit v k i =
+    case (v .&. select, k .&. select) of
+        (0, 0) -> Bit0
+        (_, 0) -> Bit1
+        (0, _) -> BitX
+        (_, _) -> BitZ
+    where select = 2 ^ i
+
+data Base
+    = Binary
+    | Octal
+    | Hex
+    deriving (Eq, Ord)
+
+instance Show Base where
+    show Binary = "b"
+    show Octal  = "o"
+    show Hex    = "h"
+
+data Number
+    = UnbasedUnsized Bit
+    | Decimal Int Bool Integer
+    | Based   Int Bool Base Integer Integer
+    deriving Eq
+
+baseSize :: Integral a => Base -> a
+baseSize Binary = 2
+baseSize Octal  = 8
+baseSize Hex    = 16
+
+-- get the number of bits in a number
+numberBitLength :: Number -> Integer
+numberBitLength UnbasedUnsized{} = 1
+numberBitLength (Decimal size _ _) = fromIntegral $ abs size
+numberBitLength (Based size _ _ _ _) =
+    fromIntegral $
+    if size < 0
+        then max 32 $ negate size
+        else size
+
+-- get whether or not a number is signed
+numberIsSized :: Number -> Bool
+numberIsSized UnbasedUnsized{} = False
+numberIsSized (Decimal size _ _) = size > 0
+numberIsSized (Based size _ _ _ _) = size > 0
+
+-- get whether or not a number is signed
+numberIsSigned :: Number -> Bool
+numberIsSigned UnbasedUnsized{} = False
+numberIsSigned (Decimal _ signed _) = signed
+numberIsSigned (Based _ signed _ _ _) = signed
+
+-- get the integer value of a number, provided it has not X or Z bits
+numberToInteger :: Number -> Maybe Integer
+numberToInteger (UnbasedUnsized Bit1) = Just 1
+numberToInteger (UnbasedUnsized Bit0) = Just 0
+numberToInteger UnbasedUnsized{} = Nothing
+numberToInteger (Decimal sz sg num)
+    | not sg || num .&. pow == 0 = Just num
+    | otherwise                  = Just $ negate $ num `xor` mask + 1
+    where
+        pow = 2 ^ (abs sz - 1)
+        mask = pow + pow - 1
+numberToInteger (Based sz sg _ num 0) =
+    numberToInteger $ Decimal sz sg num
+numberToInteger Based{} = Nothing
+
+-- return the number of bits in a number (i.e. ilog2)
+bits :: Integral a => a -> a
+bits 0 = 0
+bits n = 1 + bits (quot n 2)
+
+-- number to string conversion
+instance Show Number where
+    show (UnbasedUnsized bit) =
+        '\'' : show bit
+    show (Decimal (-32) True value) =
+        if value < 0
+            then error $ "illegal decimal: " ++ show value
+            else show value
+    show (Decimal size signed value) =
+        if size == 0
+            then error $ "illegal decimal literal: "
+                ++ show (size, signed, value)
+            else sizeStr ++ '\'' : signedStr ++ 'd' : valueStr
+        where
+            sizeStr = if size > 0 then show size else ""
+            signedStr = if signed then "s" else ""
+            valueStr = show value
+    show (Based size signed base value kinds) =
+        if size == 0 || value < 0 || kinds < 0
+            then error $ "illegal based literal: "
+                ++ show (size, signed, base, value, kinds)
+            else sizeStr ++ '\'' : signedStr ++ baseCh : valueStr
+        where
+            sizeStr = if size > 0 then show size else ""
+            signedStr = if signed then "s" else ""
+            [baseCh] = show base
+            valueStr = showBasedDigits signed (baseSize base) size value kinds
+
+showBasedDigits :: Bool -> Int -> Int -> Integer -> Integer -> String
+showBasedDigits signed base size values kinds =
+    if numDigits > sizeDigits then
+        error $ "invalid based literal digits: "
+            ++ show (base, size, values, kinds, numDigits, sizeDigits)
+    else if size < -32 || (size < 0 && signed) then
+        padList '0' sizeDigits digits
+    else if leadingXZ && size < 0 && sizeDigits == numDigits then
+        removeExtraPadding digits
+    else if leadingXZ || (256 >= size && size > 0) then
+        padList '0' sizeDigits digits
+    else
+        digits
+    where
+        valChunks = chunk (fromIntegral base) values
+        kndChunks = chunk (fromIntegral base) kinds
+        numDigits = max (length valChunks) (length kndChunks)
+
+        digits = zipWith combineChunks
+            (padList 0 numDigits valChunks)
+            (padList 0 numDigits kndChunks)
+        leadingXZ = elem (head digits) xzDigits
+
+        removeExtraPadding :: String -> String
+        removeExtraPadding ('x' : 'x' : chs) = removeExtraPadding ('x' : chs)
+        removeExtraPadding ('z' : 'z' : chs) = removeExtraPadding ('z' : chs)
+        removeExtraPadding chs = chs
+
+        -- determine the number of digits needed based on the explicit size
+        sizeDigits = ((abs size) `div` bitsPerDigit) + sizeExtraDigit
+        sizeExtraDigit =
+            if (abs size) `mod` bitsPerDigit == 0
+                then 0
+                else 1
+        bitsPerDigit = bits $ base - 1
+
+        -- combine a value and kind digit into their corresponding character
+        combineChunks :: Int -> Int -> Char
+        combineChunks value kind =
+            if kind == 0 then
+                intToDigit value
+            else if kind /= base - 1 then
+                invalid
+            else if value == 0 then
+                'x'
+            else if value == base - 1 then
+                'z'
+            else
+                invalid
+            where
+                invalid = error $ "based bits inconsistent: "
+                    ++ show (base, values, kinds, value, kind)
+
+-- pad the left side of a list with `padding` to be at least `size` elements
+padList :: a -> Int -> [a] -> [a]
+padList padding size values =
+    replicate (size - length values) padding ++ values
+
+-- split an integer into chunks of `base` bits
+chunk :: Integer -> Integer -> [Int]
+chunk base n0 =
+    reverse $ chunkStep (quotRem n0 base)
+    where
+        chunkStep (n, d) =
+            case n of
+                0 -> [d']
+                _ -> d' : chunkStep (quotRem n base)
+            where d' = fromIntegral d
+
+-- number concatenation
+instance Semigroup Number where
+    n1@Based{} <> n2@Based{} =
+        Based size signed base values kinds
+        where
+            size = size1 + size2
+            signed = False
+            base = selectBase (max base1 base2) values kinds
+            trim = flip mod . (2 ^)
+            values = trim size2 values2 + shiftL (trim size1 values1) size2
+            kinds = trim size2 kinds2 + shiftL (trim size1 kinds1) size2
+            size1 = fromIntegral $ numberBitLength n1
+            size2 = fromIntegral $ numberBitLength n2
+            Based _ _ base1 values1 kinds1 = n1
+            Based _ _ base2 values2 kinds2 = n2
+    n1 <> n2 =
+        toBased n1 <> toBased n2
+        where
+            toBased n@Based{} = n
+            toBased (Decimal size signed num) =
+                Based size signed Hex num 0
+            toBased (UnbasedUnsized bit) =
+                uncurry (Based 1 False Binary) (bitToVK bit)
+
+-- size cast raw bits with optional sign extension
+rawCast :: Bool -> Int -> Int -> Integer -> Integer
+rawCast signed inSize outSize val =
+    if outSize <= inSize then
+        val `mod` (2 ^ outSize)
+    else if signed && val >= 2 ^ (inSize - 1) then
+        valTrim + 2 ^ outSize - 2 ^ inSize
+    else
+        valTrim
+    where valTrim = val `mod` (2 ^ inSize)
+
+-- check if the based number is valid under the given base
+checkBase :: Integer -> Integer -> Integer -> Bool
+checkBase _ _ 0 = True
+checkBase base v k =
+    -- kind bits in this chunk must all be the same
+    (rK == 0 || rK == base - 1) &&
+    -- if the X/Z, it must be all X or all Z
+    (rK == 0 || rV == 0 || rV == base - 1) &&
+    -- check the next chunk
+    checkBase base qV qK
+    where
+        (qV, rV) = v `divMod` base
+        (qK, rK) = k `divMod` base
+
+-- select the maximal valid base
+selectBase :: Base -> Integer -> Integer -> Base
+selectBase Binary _ _ = Binary
+selectBase Octal v k =
+    if checkBase 8 v k
+        then Octal
+        else Binary
+selectBase Hex v k =
+    if checkBase 16 v k
+        then Hex
+        else selectBase Octal v k
+
+-- utility for size and/or sign casting a number
+numberCast :: Bool -> Int -> Number -> Number
+numberCast outSigned outSize (Decimal inSizeRaw inSigned inVal) =
+    Decimal outSize outSigned outVal
+    where
+        inSize = abs inSizeRaw
+        outVal = rawCast inSigned inSize outSize inVal
+numberCast outSigned outSize (Based inSizeRaw inSigned inBase inVal inKnd) =
+    Based outSize outSigned outBase outVal outKnd
+    where
+        inSize = abs inSizeRaw
+        -- sign extend signed inputs, or unsized literals with a leading X/Z
+        doExtend = inSigned || inKnd >= 2 ^ (inSize - 1) && inSizeRaw < 0
+        outVal = rawCast doExtend inSize outSize inVal
+        outKnd = rawCast doExtend inSize outSize inKnd
+        -- note that we could try patching the upper bits of the result to allow
+        -- the use of a higher base as in 5'(6'ozx), but this should be rare
+        outBase = selectBase inBase outVal outKnd
+numberCast signed size (UnbasedUnsized bit) =
+    numberCast signed size $
+    uncurry (Based 1 True Binary) $
+        case bit of
+            Bit0 -> (0, 0)
+            Bit1 -> (1, 0)
+            BitX -> (0, 1)
+            BitZ -> (1, 1)

src/Language/SystemVerilog/AST/Op.hs

@@ -23,7 +23,7 @@ data UniOp
     | RedNor
     | RedXor
     | RedXnor
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show UniOp where
     show LogNot  = "!"
@@ -66,7 +66,7 @@ data BinOp
     | Le
     | Gt
     | Ge
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show BinOp where
     show LogAnd  = "&&"
@@ -100,17 +100,19 @@ instance Show BinOp where
 
 data AsgnOp
     = AsgnOpEq
+    | AsgnOpNonBlocking
     | AsgnOp BinOp
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show AsgnOp where
     show AsgnOpEq = "="
+    show AsgnOpNonBlocking = "<="
     show (AsgnOp op) = (show op) ++ "="
 
 data StreamOp
     = StreamL
     | StreamR
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show StreamOp where
     show StreamL  = "<<"

src/Language/SystemVerilog/AST/ShowHelp.hs

@@ -13,13 +13,14 @@ module Language.SystemVerilog.AST.ShowHelp
     , commas
     , indentedParenList
     , showEither
+    , showBlock
     ) where
 
 import Data.List (intercalate)
 
 showPad :: Show t => t -> String
 showPad x =
-    if str == ""
+    if null str
         then ""
         else str ++ " "
     where str = show x
@@ -28,14 +29,14 @@ showPadBefore :: Show t => t -> String
 showPadBefore x =
     if str == ""
         then ""
-        else " " ++ str
+        else ' ' : str
     where str = show x
 
 indent :: String -> String
-indent a = '\t' : f a
+indent = (:) '\t' . f
     where
         f [] = []
-        f ('\n' : xs) = "\n\t" ++ f xs
+        f ('\n' : xs) = '\n' : '\t' : f xs
         f (x : xs) = x : f xs
 
 unlines' :: [String] -> String
@@ -46,9 +47,14 @@ commas = intercalate ", "
 
 indentedParenList :: [String] -> String
 indentedParenList [] = "()"
-indentedParenList [x] = "(" ++ x ++ ")"
+indentedParenList [x] = '(' : x ++ ")"
 indentedParenList l = "(\n" ++ (indent $ intercalate ",\n" l) ++ "\n)"
 
 showEither :: (Show a, Show b) => Either a b -> String
 showEither (Left  v) = show v
 showEither (Right v) = show v
+
+showBlock :: (Show a, Show b) => [a] -> [b] -> String
+showBlock a [] = indent $ show a
+showBlock [] b = indent $ show b
+showBlock a b = indent $ show a ++ '\n' : show b

src/Language/SystemVerilog/AST/Stmt.hs

@@ -8,27 +8,30 @@
 module Language.SystemVerilog.AST.Stmt
     ( Stmt   (..)
     , Timing (..)
-    , Sense  (..)
+    , Event        (..)
+    , EventExpr    (..)
+    , Edge         (..)
     , CaseKW (..)
     , Case
     , ActionBlock  (..)
     , PropExpr     (..)
-    , SeqMatchItem
+    , SeqMatchItem (..)
     , SeqExpr      (..)
-    , AssertionItem
-    , AssertionExpr
     , Assertion    (..)
+    , AssertionKind(..)
+    , Deferral     (..)
     , PropertySpec (..)
     , ViolationCheck (..)
     , BlockKW (..)
+    , Severity      (..)
     ) where
 
 import Text.Printf (printf)
 
-import Language.SystemVerilog.AST.ShowHelp (commas, indent, unlines', showPad)
+import Language.SystemVerilog.AST.ShowHelp (commas, indent, unlines', showPad, showBlock)
 import Language.SystemVerilog.AST.Attr (Attr)
 import Language.SystemVerilog.AST.Decl (Decl)
-import Language.SystemVerilog.AST.Expr (Expr(Inside, Nil), Args(..), showExprOrRange)
+import Language.SystemVerilog.AST.Expr (Expr(Call, Ident, Nil), Args(..), Range, showRange, showAssignment)
 import Language.SystemVerilog.AST.LHS (LHS)
 import Language.SystemVerilog.AST.Op (AsgnOp(AsgnOpEq))
 import Language.SystemVerilog.AST.Type (Identifier)
@@ -37,36 +40,42 @@ data Stmt
     = StmtAttr Attr Stmt
     | Block   BlockKW Identifier [Decl] [Stmt]
     | Case    ViolationCheck CaseKW Expr [Case]
-    | For     (Either [Decl] [(LHS, Expr)]) Expr [(LHS, AsgnOp, Expr)] Stmt
+    | For     [(LHS, Expr)] Expr [(LHS, AsgnOp, Expr)] Stmt
-    | AsgnBlk AsgnOp LHS Expr
+    | Asgn    AsgnOp (Maybe Timing) LHS Expr
-    | Asgn    (Maybe Timing) LHS Expr
     | While   Expr Stmt
     | RepeatL Expr Stmt
     | DoWhile Expr Stmt
     | Forever Stmt
-    | Foreach Identifier [Maybe Identifier] Stmt
+    | Foreach Identifier [Identifier] Stmt
     | If      ViolationCheck Expr Stmt Stmt
     | Timing  Timing Stmt
     | Return  Expr
     | Subroutine Expr Args
+    | SeverityStmt Severity [Expr]
     | Trigger Bool Identifier
     | Assertion Assertion
+    | Force Bool LHS Expr
+    | Wait Expr Stmt
     | Continue
     | Break
     | Null
+    | CommentStmt String
     deriving Eq
 
 instance Show Stmt where
+    showList l _ = unlines' $ map show l
     show (StmtAttr attr stmt) = printf "%s\n%s" (show attr) (show stmt)
     show (Block kw name decls stmts) =
         printf "%s%s\n%s\n%s" (show kw) header body (blockEndToken kw)
         where
             header = if null name then "" else " : " ++ name
-            bodyLines = (map show decls) ++ (map show stmts)
+            body = showBlock decls stmts
-            body = indent $ unlines' bodyLines
     show (Case u kw e cs) =
-        printf "%s%s (%s)\n%s\nendcase" (showPad u) (show kw) (show e) bodyStr
+        printf "%s%s (%s)%s\n%s\nendcase" (showPad u) (show kw) (show e)
-        where bodyStr = indent $ unlines' $ map showCase cs
+            insideStr bodyStr
+        where
+            insideStr = if kw == CaseInside then " inside" else ""
+            bodyStr = indent $ unlines' $ map showCase cs
     show (For inits cond assigns stmt) =
         printf "for (%s; %s; %s)\n%s"
             (showInits inits)
@@ -74,60 +83,77 @@ instance Show Stmt where
             (commas $ map showAssign assigns)
             (indent $ show stmt)
         where
-            showInits :: Either [Decl] [(LHS, Expr)] -> String
+            showInits :: [(LHS, Expr)] -> String
-            showInits (Left decls) = commas $ map (init . show) decls
+            showInits = commas . map showInit
-            showInits (Right asgns) = commas $ map showInit asgns
                 where showInit (l, e) = showAssign (l, AsgnOpEq, e)
-            showAssign :: (LHS, AsgnOp, Expr) -> String
-            showAssign (l, op, e) = printf "%s %s %s" (show l) (show op) (show e)
     show (Subroutine e a) = printf "%s%s;" (show e) aStr
         where aStr = if a == Args [] [] then "" else show a
-    show (AsgnBlk o v e) = printf "%s %s %s;" (show v) (show o) (show e)
+    show (SeverityStmt s a) = printf "%s%s;" (show s) (show $ Args a [])
-    show (Asgn    t v e) = printf "%s <= %s%s;" (show v) (maybe "" showPad t) (show e)
+    show (Asgn  o t v e) = printf "%s %s %s%s;" (show v) (show o) tStr (show e)
+        where tStr = maybe "" showPad t
+    show (If u c s1 s2) =
+        -- print the then branch inside a block to avoid dangling else issues
+        printf "%sif (%s)%s%s" (showPad u) (show c) (showBlockedBranch s1) (showElseBranch s2)
     show (While     e s) = printf  "while (%s) %s" (show e) (show s)
     show (RepeatL   e s) = printf "repeat (%s) %s" (show e) (show s)
     show (DoWhile   e s) = printf "do %s while (%s);" (show s) (show e)
     show (Forever     s) = printf "forever %s" (show s)
-    show (Foreach x i s) = printf "foreach (%s [ %s ]) %s" x (commas $ map (maybe "" id) i) (show s)
+    show (Foreach x i s) = printf "foreach (%s [ %s ]) %s" x (commas i) (show s)
-    show (If u a b Null) = printf "%sif (%s)%s"         (showPad u) (show a) (showBranch b)
-    show (If u a b c   ) = printf "%sif (%s)%s\nelse%s" (showPad u) (show a) (showBlockedBranch b) (showElseBranch c)
     show (Return    e  ) = printf "return %s;" (show e)
     show (Timing    t s) = printf "%s%s" (show t) (showShortBranch s)
     show (Trigger   b x) = printf "->%s %s;" (if b then "" else ">") x
     show (Assertion   a) = show a
+    show (Force  kw l e) = printf "%s %s%s;" kwStr (show l) (showAssignment e)
+        where
+            kwStr = case (kw, e /= Nil) of
+                (True , True ) -> "force"
+                (True , False) -> "release"
+                (False, True ) -> "assign"
+                (False, False) -> "deassign"
+    show (Wait      e s) = printf "wait (%s)%s" (show e) (showShortBranch s)
     show (Continue     ) = "continue;"
     show (Break        ) = "break;"
     show (Null         ) = ";"
+    show (CommentStmt c) = "// " ++ c
+
+showAssign :: (LHS, AsgnOp, Expr) -> String
+showAssign (l, op, e) = (showPad l) ++ (showPad op) ++ (show e)
 
 showBranch :: Stmt -> String
-showBranch (block @ Block{}) = ' ' : show block
+showBranch (Block Seq "" [] stmts@[CommentStmt{}, _]) =
+    '\n' : (indent $ show stmts)
+showBranch block@Block{} = ' ' : show block
 showBranch stmt = '\n' : (indent $ show stmt)
 
+-- add a block around the true branch of an if statement when a dangling else is
+-- possible to avoid any potential ambiguity downstream
 showBlockedBranch :: Stmt -> String
 showBlockedBranch stmt =
     showBranch $
-    if isControl stmt
+    if danglingElse stmt
         then Block Seq "" [] [stmt]
         else stmt
-    where
+
-        isControl s = case s of
+danglingElse :: Stmt -> Bool
+danglingElse s = case s of
     If{} -> True
-            For{} -> True
+    For   _ _ _ subStmt -> danglingElse subStmt
-            While{} -> True
+    While   _   subStmt -> danglingElse subStmt
-            RepeatL{} -> True
+    RepeatL _   subStmt -> danglingElse subStmt
-            DoWhile{} -> True
+    Forever     subStmt -> danglingElse subStmt
-            Forever{} -> True
+    Foreach _ _ subStmt -> danglingElse subStmt
-            Foreach{} -> True
+    Timing  _   subStmt -> danglingElse subStmt
-            Timing _ subStmt -> isControl subStmt
+    StmtAttr  _ subStmt -> danglingElse subStmt
+    Block Seq "" [] [CommentStmt{}, subStmt] -> danglingElse subStmt
     _ -> False
 
 showElseBranch :: Stmt -> String
-showElseBranch (stmt @ If{}) = ' ' : show stmt
+showElseBranch Null = ""
-showElseBranch stmt = showBranch stmt
+showElseBranch stmt@If{} = "\nelse " ++ show stmt
+showElseBranch stmt = "\nelse" ++ showBranch stmt
 
 showShortBranch :: Stmt -> String
-showShortBranch (stmt @ AsgnBlk{}) = ' ' : show stmt
+showShortBranch stmt@Asgn{} = ' ' : show stmt
-showShortBranch (stmt @ Asgn{}) = ' ' : show stmt
 showShortBranch stmt = showBranch stmt
 
 showCase :: Case -> String
@@ -135,57 +161,72 @@ showCase (a, b) = printf "%s:%s" exprStr (showShortBranch b)
     where
         exprStr = case a of
             [] -> "default"
-            [Inside Nil c] -> commas $ map showExprOrRange c
             _ -> commas $ map show a
 
 data CaseKW
     = CaseN
     | CaseZ
     | CaseX
+    | CaseInside
     deriving Eq
 
 instance Show CaseKW where
     show CaseN = "case"
     show CaseZ = "casez"
     show CaseX = "casex"
+    show CaseInside = "case"
 
 type Case = ([Expr], Stmt)
 
 data Timing
-    = Event Sense
+    = Event Event
     | Delay Expr
     | Cycle Expr
     deriving Eq
 
 instance Show Timing where
-    show (Event s) = printf  "@(%s)" (show s)
+    show (Event e) = printf  "@(%s)" (show e)
     show (Delay e) = printf  "#(%s)" (show e)
     show (Cycle e) = printf "##(%s)" (show e)
 
-data Sense
+data Event
-    = Sense        LHS
+    = EventStar
-    | SenseOr      Sense Sense
+    | EventExpr EventExpr
-    | SensePosedge LHS
-    | SenseNegedge LHS
-    | SenseStar
     deriving Eq
 
-instance Show Sense where
+instance Show Event where
-    show (Sense        a  ) = show a
+    show EventStar = "*"
-    show (SenseOr      a b) = printf "%s or %s" (show a) (show b)
+    show (EventExpr e) = show e
-    show (SensePosedge a  ) = printf "posedge %s" (show a)
+
-    show (SenseNegedge a  ) = printf "negedge %s" (show a)
+data EventExpr
-    show (SenseStar       ) = "*"
+    = EventExprEdge Edge Expr
+    | EventExprOr EventExpr EventExpr
+    deriving Eq
+
+instance Show EventExpr where
+    show (EventExprEdge g e) = printf "%s%s" (showPad g) (show e)
+    show (EventExprOr   a b) = printf "%s or %s" (show a) (show b)
+
+data Edge
+    = Posedge
+    | Negedge
+    | Edge
+    | NoEdge
+    deriving Eq
+
+instance Show Edge where
+    show Posedge = "posedge"
+    show Negedge = "negedge"
+    show Edge    = "edge"
+    show NoEdge  = ""
 
 data ActionBlock
-    = ActionBlockIf   Stmt
+    = ActionBlock Stmt Stmt
-    | ActionBlockElse (Maybe Stmt) Stmt
     deriving Eq
 instance Show ActionBlock where
-    show (ActionBlockIf   Null        ) = ";"
+    show (ActionBlock s Null) = printf " %s" (show s)
-    show (ActionBlockIf   s           ) = printf " %s" (show s)
+    show (ActionBlock Null s) = printf " else %s" (show s)
-    show (ActionBlockElse Nothing   s ) = printf " else %s" (show s)
+    show (ActionBlock s1  s2) = printf " %s else %s" (show s1) (show s2)
-    show (ActionBlockElse (Just s1) s2) = printf " %s else %s" (show s1) (show s2)
 
 data PropExpr
     = PropExpr SeqExpr
@@ -194,6 +235,10 @@ data PropExpr
     | PropExprFollowsO  SeqExpr PropExpr
     | PropExprFollowsNO SeqExpr PropExpr
     | PropExprIff PropExpr PropExpr
+    | PropExprNeg    PropExpr
+    | PropExprStrong SeqExpr
+    | PropExprWeak   SeqExpr
+    | PropExprNextTime Bool Expr PropExpr
     deriving Eq
 instance Show PropExpr where
     show (PropExpr se) = show se
@@ -201,8 +246,22 @@ instance Show PropExpr where
     show (PropExprImpliesNO a b) = printf "(%s |=> %s)" (show a) (show b)
     show (PropExprFollowsO  a b) = printf "(%s #-# %s)" (show a) (show b)
     show (PropExprFollowsNO a b) = printf "(%s #=# %s)" (show a) (show b)
-    show (PropExprIff a b) = printf "(%s and %s)" (show a) (show b)
+    show (PropExprIff a b) = printf "(%s iff %s)" (show a) (show b)
-type SeqMatchItem = Either (LHS, AsgnOp, Expr) (Identifier, Args)
+    show (PropExprNeg    pe) = printf    "not (%s)" (show pe)
+    show (PropExprStrong se) = printf "strong (%s)" (show se)
+    show (PropExprWeak   se) = printf   "weak (%s)" (show se)
+    show (PropExprNextTime strong index prop) =
+        printf "%s%s (%s)" kwStr indexStr (show prop)
+        where
+            kwStr = (if strong then "s_" else "") ++ "nexttime"
+            indexStr = if index == Nil then "" else printf " [%s]" (show index)
+data SeqMatchItem
+    = SeqMatchAsgn (LHS, AsgnOp, Expr)
+    | SeqMatchCall Identifier Args
+    deriving Eq
+instance Show SeqMatchItem where
+    show (SeqMatchAsgn asgn) = showAssign asgn
+    show (SeqMatchCall ident args) = show $ Call (Ident ident) args
 data SeqExpr
     = SeqExpr Expr
     | SeqExprAnd        SeqExpr SeqExpr
@@ -210,7 +269,7 @@ data SeqExpr
     | SeqExprIntersect  SeqExpr SeqExpr
     | SeqExprThroughout Expr    SeqExpr
     | SeqExprWithin     SeqExpr SeqExpr
-    | SeqExprDelay (Maybe SeqExpr) Expr SeqExpr
+    | SeqExprDelay (Maybe SeqExpr) Range SeqExpr
     | SeqExprFirstMatch SeqExpr [SeqMatchItem]
     deriving Eq
 instance Show SeqExpr where
@@ -220,38 +279,55 @@ instance Show SeqExpr where
     show (SeqExprIntersect  a b) = printf "(%s %s %s)" (show a) "intersect"  (show b)
     show (SeqExprThroughout a b) = printf "(%s %s %s)" (show a) "throughout" (show b)
     show (SeqExprWithin     a b) = printf "(%s %s %s)" (show a) "within"     (show b)
-    show (SeqExprDelay   me e s) = printf "%s##%s %s" (maybe "" showPad me) (show e) (show s)
+    show (SeqExprDelay   me r s) = printf "%s##%s %s" (maybe "" showPad me) (showCycleDelayRange r) (show s)
-    show (SeqExprFirstMatch e a) = printf "first_match(%s, %s)" (show e) (show a)
+    show (SeqExprFirstMatch e a) = printf "first_match(%s, %s)" (show e) (commas $ map show a)
+
+showCycleDelayRange :: Range -> String
+showCycleDelayRange (Nil, e) = printf "(%s)" (show e)
+showCycleDelayRange (e, Nil) = printf "[%s:$]" (show e)
+showCycleDelayRange r = showRange r
 
-type AssertionItem = (Maybe Identifier, Assertion)
-type AssertionExpr = Either PropertySpec Expr
 data Assertion
-    = Assert AssertionExpr ActionBlock
+    = Assert AssertionKind ActionBlock
-    | Assume AssertionExpr ActionBlock
+    | Assume AssertionKind ActionBlock
-    | Cover  AssertionExpr Stmt
+    | Cover  AssertionKind Stmt
     deriving Eq
 instance Show Assertion where
-    show (Assert e a) = printf "assert %s%s" (showAssertionExpr e) (show a)
+    show (Assert k a) = printf "assert %s%s" (show k) (show a)
-    show (Assume e a) = printf "assume %s%s" (showAssertionExpr e) (show a)
+    show (Assume k a) = printf "assume %s%s" (show k) (show a)
-    show (Cover  e a) = printf  "cover %s%s" (showAssertionExpr e) (show a)
+    show (Cover  k a) = printf  "cover %s%s" (show k) (show a)
 
-showAssertionExpr :: AssertionExpr -> String
+data AssertionKind
-showAssertionExpr (Left e) = printf "property (%s\n)" (show e)
+    = Concurrent PropertySpec
-showAssertionExpr (Right e) = printf "(%s)" (show e)
+    | Immediate Deferral Expr
+    deriving Eq
+instance Show AssertionKind where
+    show (Concurrent e) = printf "property (%s\n)" (show e)
+    show (Immediate d e) = printf "%s(%s)" (showPad d) (show e)
+
+data Deferral
+    = NotDeferred
+    | ObservedDeferred
+    | FinalDeferred
+    deriving Eq
+instance Show Deferral where
+    show NotDeferred = ""
+    show ObservedDeferred = "#0"
+    show FinalDeferred = "final"
 
 data PropertySpec
-    = PropertySpec (Maybe Sense) (Maybe Expr) PropExpr
+    = PropertySpec (Maybe EventExpr) Expr PropExpr
     deriving Eq
 instance Show PropertySpec where
-    show (PropertySpec ms me pe) =
+    show (PropertySpec mv e pe) =
-        printf "%s%s\n\t%s" msStr meStr (show pe)
+        printf "%s%s\n\t%s" mvStr eStr (show pe)
         where
-            msStr = case ms of
+            mvStr = case mv of
                 Nothing -> ""
-                Just s -> printf "@(%s) " (show s)
+                Just v -> printf "@(%s) " (show v)
-            meStr = case me of
+            eStr = case e of
-                Nothing -> ""
+                Nil -> ""
-                Just e -> printf "disable iff (%s)" (show e)
+                _ -> printf "disable iff (%s)" (show e)
 
 data ViolationCheck
     = Unique
@@ -278,3 +354,16 @@ instance Show BlockKW where
 blockEndToken :: BlockKW -> Identifier
 blockEndToken Seq = "end"
 blockEndToken Par = "join"
+
+data Severity
+    = SeverityInfo
+    | SeverityWarning
+    | SeverityError
+    | SeverityFatal
+    deriving Eq
+
+instance Show Severity where
+    show SeverityInfo    = "$info"
+    show SeverityWarning = "$warning"
+    show SeverityError   = "$error"
+    show SeverityFatal   = "$fatal"

src/Language/SystemVerilog/AST/Type.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE FlexibleInstances #-}
 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>
@@ -8,6 +7,7 @@
 
 module Language.SystemVerilog.AST.Type
     ( Identifier
+    , EnumItem
     , Field
     , Type               (..)
     , Signing            (..)
@@ -16,8 +16,12 @@ module Language.SystemVerilog.AST.Type
     , IntegerVectorType  (..)
     , IntegerAtomType    (..)
     , NonIntegerType     (..)
+    , Strength           (..)
+    , Strength0          (..)
+    , Strength1          (..)
+    , ChargeStrength     (..)
+    , pattern UnknownType
     , typeRanges
-    , nullRange
     , elaborateIntegerAtom
     ) where
 
@@ -28,42 +32,50 @@ import Language.SystemVerilog.AST.ShowHelp
 
 type Identifier = String
 
-type Item = (Identifier, Maybe Expr)
+type EnumItem = (Identifier, Expr)
 type Field = (Type, Identifier)
 
 data Type
     = IntegerVector IntegerVectorType  Signing [Range]
     | IntegerAtom   IntegerAtomType    Signing
     | NonInteger    NonIntegerType
-    | Net           NetType            Signing [Range]
     | Implicit                         Signing [Range]
-    | Alias    (Maybe Identifier) Identifier   [Range]
+    | Alias               Identifier           [Range]
-    | Enum     (Maybe Type) [Item]             [Range]
+    | PSAlias  Identifier Identifier           [Range]
+    | CSAlias  Identifier [ParamBinding] Identifier [Range]
+    | Enum     Type         [EnumItem]         [Range]
     | Struct   Packing      [Field]            [Range]
     | Union    Packing      [Field]            [Range]
-    | InterfaceT Identifier (Maybe Identifier) [Range]
+    | InterfaceT Identifier Identifier         [Range]
     | TypeOf Expr
+    | TypedefRef Expr
     | UnpackedType Type [Range] -- used internally
-    deriving (Eq, Ord)
+    | Void
+    deriving Eq
 
 instance Show Type where
-    show (Alias      ps xx    rs) = printf "%s%s%s" (maybe "" (++ "::") ps)  xx  (showRanges rs)
+    show (Alias         xx    rs) = printf "%s%s" xx (showRanges rs)
-    show (Net           kw sg rs) = printf "%s%s%s" (show kw) (showPadBefore sg) (showRanges rs)
+    show (PSAlias ps    xx    rs) = printf "%s::%s%s" ps xx (showRanges rs)
+    show (CSAlias ps pm xx    rs) = printf "%s#%s::%s%s" ps (showParams pm) xx (showRanges rs)
+    show (Implicit         sg []) = show sg
     show (Implicit         sg rs) = printf "%s%s"             (showPad       sg) (dropWhile (== ' ') $ showRanges rs)
     show (IntegerVector kw sg rs) = printf "%s%s%s" (show kw) (showPadBefore sg) (showRanges rs)
     show (IntegerAtom   kw sg   ) = printf "%s%s"   (show kw) (showPadBefore sg)
     show (NonInteger    kw      ) = printf "%s"     (show kw)
-    show (InterfaceT x my r) = x ++ yStr ++ (showRanges r)
+    show (InterfaceT    "" "" rs) = printf "interface%s"   (showRanges rs)
-        where yStr = maybe "" ("."++) my
+    show (InterfaceT    xx "" rs) = printf "%s%s"    xx    (showRanges rs)
-    show (Enum mt vals r) = printf "enum %s{%s}%s" tStr (commas $ map showVal vals) (showRanges r)
+    show (InterfaceT    xx yy rs) = printf "%s.%s%s" xx yy (showRanges rs)
+    show (Enum t vals r) = printf "enum %s{%s}%s" tStr (commas $ map showVal vals) (showRanges r)
         where
-            tStr = maybe "" showPad mt
+            tStr = showPad t
-            showVal :: (Identifier, Maybe Expr) -> String
+            showVal :: EnumItem -> String
             showVal (x, e) = x ++ (showAssignment e)
     show (Struct p items r) = printf "struct %s{\n%s\n}%s" (showPad p) (showFields items) (showRanges r)
     show (Union  p items r) = printf  "union %s{\n%s\n}%s" (showPad p) (showFields items) (showRanges r)
     show (TypeOf expr) = printf "type(%s)" (show expr)
     show (UnpackedType t rs) = printf "UnpackedType(%s, %s)" (show t) (showRanges rs)
+    show (TypedefRef e) = show e
+    show Void = "void"
 
 showFields :: [Field] -> String
 showFields items = itemsStr
@@ -71,40 +83,36 @@ showFields items = itemsStr
         itemsStr = indent $ unlines' $ map showItem items
         showItem (t, x) = printf "%s %s;" (show t) x
 
-instance Show ([Range] -> Type) where
+-- internal representation of a fully implicit or unknown type
-    show tf = show (tf [])
+pattern UnknownType :: Type
-instance Eq ([Range] -> Type) where
+pattern UnknownType = Implicit Unspecified []
-    (==) tf1 tf2 = (tf1 []) == (tf2 [])
-instance Ord ([Range] -> Type) where
-    compare tf1 tf2 = compare (tf1 []) (tf2 [])
-
-instance Show (Signing -> [Range] -> Type) where
-    show tf = show (tf Unspecified)
-instance Eq (Signing -> [Range] -> Type) where
-    (==) tf1 tf2 = (tf1 Unspecified) == (tf2 Unspecified)
-instance Ord (Signing -> [Range] -> Type) where
-    compare tf1 tf2 = compare (tf1 Unspecified) (tf2 Unspecified)
 
 typeRanges :: Type -> ([Range] -> Type, [Range])
-typeRanges (Alias      ps xx    rs) = (Alias      ps xx   , rs)
+typeRanges typ =
-typeRanges (Net           kw sg rs) = (Net           kw sg, rs)
+    case typ of
-typeRanges (Implicit         sg rs) = (Implicit         sg, rs)
+        Implicit         sg rs -> (Implicit         sg, rs)
-typeRanges (IntegerVector kw sg rs) = (IntegerVector kw sg, rs)
+        IntegerVector kw sg rs -> (IntegerVector kw sg, rs)
-typeRanges (IntegerAtom   kw sg   ) = (nullRange $ IntegerAtom kw sg, [])
+        Enum            t v rs -> (Enum            t v, rs)
-typeRanges (NonInteger    kw      ) = (nullRange $ NonInteger  kw   , [])
+        Struct          p l rs -> (Struct          p l, rs)
-typeRanges (Enum   t v r) = (Enum   t v, r)
+        Union           p l rs -> (Union           p l, rs)
-typeRanges (Struct p l r) = (Struct p l, r)
+        InterfaceT      x y rs -> (InterfaceT      x y, rs)
-typeRanges (Union  p l r) = (Union  p l, r)
+        Alias            xx rs -> (Alias            xx, rs)
-typeRanges (InterfaceT x my r) = (InterfaceT x my, r)
+        PSAlias    ps    xx rs -> (PSAlias    ps    xx, rs)
-typeRanges (TypeOf expr) = (UnpackedType $ TypeOf expr, [])
+        CSAlias    ps pm xx rs -> (CSAlias    ps pm xx, rs)
-typeRanges (UnpackedType t rs) = (UnpackedType t, rs)
+        UnpackedType  t     rs -> (UnpackedType      t, rs)
+        IntegerAtom   kw sg    -> (nullRange $ IntegerAtom kw sg, [])
+        NonInteger    kw       -> (nullRange $ NonInteger  kw   , [])
+        TypeOf            expr -> (nullRange $ TypeOf       expr, [])
+        TypedefRef        expr -> (nullRange $ TypedefRef   expr, [])
+        Void                   -> (nullRange Void               , [])
 
 nullRange :: Type -> ([Range] -> Type)
 nullRange t [] = t
-nullRange t [(Number "0", Number "0")] = t
+nullRange t [(RawNum 0, RawNum 0)] = t
 nullRange (IntegerAtom TInteger sg) rs =
     -- integer arrays are allowed in SystemVerilog but not in Verilog
-    IntegerVector TBit sg (rs ++ [(Number "31", Number "0")])
+    IntegerVector TBit sg' (rs ++ [(RawNum 31, RawNum 0)])
+    where sg' = if sg == Unsigned then Unsigned else Signed
 nullRange t rs1 =
     if t == t'
         then error $ "non-vector type " ++ show t ++
@@ -118,16 +126,16 @@ elaborateIntegerAtom :: Type -> Type
 elaborateIntegerAtom (IntegerAtom TInt      sg) = baseIntType sg Signed 32
 elaborateIntegerAtom (IntegerAtom TShortint sg) = baseIntType sg Signed 16
 elaborateIntegerAtom (IntegerAtom TLongint  sg) = baseIntType sg Signed 64
-elaborateIntegerAtom (IntegerAtom TByte     sg) = baseIntType sg Unspecified  8
+elaborateIntegerAtom (IntegerAtom TByte     sg) = baseIntType sg Signed  8
 elaborateIntegerAtom other = other
 
 -- makes a integer "compatible" type with the given signing, base signing and
 -- size; if not unspecified, the first signing overrides the second
 baseIntType :: Signing -> Signing -> Int -> Type
 baseIntType sgOverride sgBase size =
-    IntegerVector TReg sg [(Number hi, Number "0")]
+    IntegerVector TLogic sg [(RawNum hi, RawNum 0)]
     where
-        hi = show (size - 1)
+        hi = fromIntegral $ size - 1
         sg = if sgOverride /= Unspecified
                 then sgOverride
                 else sgBase
@@ -136,7 +144,7 @@ data Signing
     = Unspecified
     | Signed
     | Unsigned
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show Signing where
     show Unspecified = ""
@@ -156,12 +164,12 @@ data NetType
     | TWire
     | TWand
     | TWor
-    deriving (Eq, Ord)
+    deriving Eq
 data IntegerVectorType
     = TBit
     | TLogic
     | TReg
-    deriving (Eq, Ord)
+    deriving Eq
 data IntegerAtomType
     = TByte
     | TShortint
@@ -169,14 +177,15 @@ data IntegerAtomType
     | TLongint
     | TInteger
     | TTime
-    deriving (Eq, Ord)
+    deriving Eq
 data NonIntegerType
     = TShortreal
     | TReal
     | TRealtime
     | TString
     | TEvent
-    deriving (Eq, Ord)
+    | TChandle
+    deriving Eq
 
 instance Show NetType where
     show TSupply0   = "supply0"
@@ -208,12 +217,65 @@ instance Show NonIntegerType where
     show TRealtime  = "realtime"
     show TString    = "string"
     show TEvent     = "event"
+    show TChandle   = "chandle"
 
 data Packing
     = Unpacked
     | Packed Signing
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show Packing where
     show (Unpacked) = ""
     show (Packed s) = "packed" ++ (showPadBefore s)
+
+data Strength
+    = DefaultStrength
+    | DriveStrength Strength0 Strength1
+    | ChargeStrength ChargeStrength
+    deriving Eq
+
+instance Show Strength where
+    show DefaultStrength = ""
+    show (ChargeStrength cs) = printf "(%s)" (show cs)
+    show (DriveStrength s0 s1) = printf "(%s, %s)" (show s0) (show s1)
+
+data Strength0
+    = Supply0
+    | Strong0
+    | Pull0
+    | Weak0
+    | Highz0
+    deriving Eq
+
+instance Show Strength0 where
+    show Supply0 = "supply0"
+    show Strong0 = "strong0"
+    show Pull0   = "pull0"
+    show Weak0   = "weak0"
+    show Highz0  = "highz0"
+
+data Strength1
+    = Supply1
+    | Strong1
+    | Pull1
+    | Weak1
+    | Highz1
+    deriving Eq
+
+instance Show Strength1 where
+    show Supply1 = "supply1"
+    show Strong1 = "strong1"
+    show Pull1   = "pull1"
+    show Weak1   = "weak1"
+    show Highz1  = "highz1"
+
+data ChargeStrength
+    = Small
+    | Medium
+    | Large
+    deriving Eq
+
+instance Show ChargeStrength where
+    show Small  = "small"
+    show Medium = "medium"
+    show Large  = "large"

src/Language/SystemVerilog/AST/Type.hs-boot

@@ -7,5 +7,4 @@ type Identifier = String
 
 data Type
 instance Eq Type
-instance Ord Type
 instance Show Type

src/Language/SystemVerilog/Parser.hs

@@ -3,34 +3,111 @@
  -}
 module Language.SystemVerilog.Parser
     ( parseFiles
+    , Config(..)
     ) where
 
+import Control.Monad (when)
+import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Except
+import Data.List (elemIndex)
+import Data.Maybe (catMaybes)
+import System.Directory (findFile)
 import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+
 import Language.SystemVerilog.AST (AST)
-import Language.SystemVerilog.Parser.Lex (lexFile, Env)
+import Language.SystemVerilog.Parser.Lex (lexStr)
 import Language.SystemVerilog.Parser.Parse (parse)
+import Language.SystemVerilog.Parser.Preprocess (preprocess, annotate, Env, Contents)
+import Language.SystemVerilog.Parser.Tokens (Position)
 
--- parses a compilation unit given include search paths and predefined macros
+type Output = (FilePath, AST)
-parseFiles :: [FilePath] -> [(String, String)] -> Bool -> [FilePath] -> IO (Either String [AST])
+type Strings = Set.Set String
-parseFiles includePaths defines siloed paths = do
+type Positions = Map.Map String Position
-    let env = Map.map (\a -> (a, [])) $ Map.fromList defines
-    runExceptT (parseFiles' includePaths env siloed paths)
 
--- parses a compilation unit given include search paths and predefined macros
+data Config = Config
-parseFiles' :: [FilePath] -> Env -> Bool -> [FilePath] -> ExceptT String IO [AST]
+    { cfDefines :: [String]
-parseFiles' _ _ _ [] = return []
+    , cfIncludePaths :: [FilePath]
-parseFiles' includePaths env siloed (path : paths) = do
+    , cfLibraryPaths :: [FilePath]
-    (ast, envEnd) <- parseFile' includePaths env path
+    , cfSiloed :: Bool
-    let envNext = if siloed then env else envEnd
+    , cfSkipPreprocessor :: Bool
-    asts <- parseFiles' includePaths envNext siloed paths
+    , cfOversizedNumbers :: Bool
-    return $ ast : asts
+    }
 
--- parses a file given include search paths, a table of predefined macros, and
+data Context = Context
--- the file path
+    { ctConfig :: Config
-parseFile' :: [String] -> Env -> FilePath -> ExceptT String IO (AST, Env)
+    , ctEnv :: Env
-parseFile' includePaths env path = do
+    , ctUsed :: Strings
-    result <- liftIO $ lexFile includePaths env path
+    , ctHave :: Positions
-    (tokens, env') <- liftEither result
+    }
-    ast <- parse tokens
+
-    return (ast, env')
+-- parse CLI macro definitions into the internal macro environment format
+initialEnv :: [String] -> Env
+initialEnv = Map.map (, []) . Map.fromList . map splitDefine
+
+-- split a raw CLI macro definition at the '=', if present
+splitDefine :: String -> (String, String)
+splitDefine str =
+    case elemIndex '=' str of
+        Nothing -> (str, "")
+        Just idx -> (name, tail rest)
+            where (name, rest) = splitAt idx str
+
+-- parse a list of files according to the given configuration
+parseFiles :: Config -> [FilePath] -> ExceptT String IO [Output]
+parseFiles config = parseFiles' context . zip (repeat "")
+    where
+        context = Context config env mempty mempty
+        env = initialEnv $ cfDefines config
+
+-- parse files, keeping track of which parts are defined and used
+parseFiles' :: Context -> [(String, FilePath)] -> ExceptT String IO [Output]
+
+-- look for missing parts in libraries if any library paths were provided
+parseFiles' context []
+    | null libdirs = return []
+    | otherwise = do
+        possibleFiles <- catMaybes <$> mapM lookupLibrary missingParts
+        if null possibleFiles
+            then return []
+            else parseFiles' context possibleFiles
+    where
+        missingParts = Set.toList $ ctUsed context Set.\\
+            (Map.keysSet $ ctHave context)
+        libdirs = cfLibraryPaths $ ctConfig context
+        lookupLibrary partName = ((partName, ) <$>) <$> lookupLibFile partName
+        lookupLibFile = liftIO . findFile libdirs . (++ ".sv")
+
+-- load the files, but complain if an expected part is missing
+parseFiles' context ((part, path) : files) = do
+    (context', ast) <- parseFile context path
+    let misdirected = not $ null part || Map.member part (ctHave context')
+    when misdirected $ throwError $
+        "Expected to find module or interface " ++ show part ++ " in file "
+        ++ show path ++ " selected from the library path."
+    ((path, ast) :) <$> parseFiles' context' files
+
+-- parse an individual file, updating the context
+parseFile :: Context -> FilePath -> ExceptT String IO (Context, AST)
+parseFile context path = do
+    (context', contents) <- preprocessFile context path
+    tokens <- liftEither $ runExcept $ lexStr contents
+    (ast, used, have') <-
+        parse (cfOversizedNumbers config) (ctHave context) tokens
+    let context'' = context' { ctUsed = used <> ctUsed context
+                             , ctHave = have' }
+    return (context'', ast)
+    where config = ctConfig context
+
+-- preprocess an individual file, potentially updating the environment
+preprocessFile :: Context -> FilePath -> ExceptT String IO (Context, Contents)
+preprocessFile context path
+    | cfSkipPreprocessor config =
+        (context, ) <$> annotate path
+    | otherwise = do
+        (env', contents) <- preprocess (cfIncludePaths config) env path
+        let context' = context { ctEnv = if cfSiloed config then env else env' }
+        return (context', contents)
+    where
+        config = ctConfig context
+        env = ctEnv context

src/Language/SystemVerilog/Parser/Keywords.hs

@@ -33,13 +33,13 @@ newKeywords = [
     KW_trireg, KW_vectored, KW_wait, KW_wand, KW_weak0, KW_weak1, KW_while,
     KW_wire, KW_wor, KW_xnor, KW_xor]),
 
-    ("1364-2001-noconfig", [KW_cell, KW_config, KW_design, KW_endconfig,
+    ("1364-2001-noconfig", [KW_automatic, KW_endgenerate, KW_generate,
-    KW_incdir, KW_include, KW_instance, KW_liblist, KW_library, KW_use]),
+    KW_genvar, KW_localparam, KW_noshowcancelled, KW_pulsestyle_ondetect,
-
-    ("1364-2001", [KW_automatic, KW_endgenerate, KW_generate, KW_genvar,
-    KW_localparam, KW_noshowcancelled, KW_pulsestyle_ondetect,
     KW_pulsestyle_onevent, KW_showcancelled, KW_signed, KW_unsigned]),
 
+    ("1364-2001", [KW_cell, KW_config, KW_design, KW_endconfig, KW_incdir,
+    KW_include, KW_instance, KW_liblist, KW_library, KW_use]),
+
     ("1364-2005", [KW_uwire]),
 
     ("1800-2005", [KW_alias, KW_always_comb, KW_always_ff, KW_always_latch,

src/Language/SystemVerilog/Parser/Lex.x

@@ -2,47 +2,29 @@
 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  - Original Lexer Author: Tom Hawkins <tomahawkins@gmail.com>
+ - vim: filetype=haskell
  -
- - Combined source lexing and preprocessing
+ - SystemVerilog Lexer
  -
- - These procedures are combined so that we can simultaneously process macros in
+ - All preprocessor directives are handled separately by the preprocessor. The
- - a sane way (something analogous to character-by-character) and have our
+ - `begin_keywords` and `end_keywords` lexer directives are handled here.
- - lexemes properly tagged with source file positions.
- -
- - The scariest piece of this module is the use of `unsafePerformIO`. We want to
- - be able to search for and read files whenever we see an include directive.
- - Trying to thread the IO Monad through alex's interface would be very
- - convoluted. The operations performed are not effectful, and are type safe.
- -
- - It may be possible to separate the preprocessor from the lexer by having a
- - preprocessor which produces location annotations. This could improve error
- - messaging and remove the include file and macro boundary hacks.
  -}
 
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
--- The above pragma gets rid of annoying warning caused by alex 3.2.4. This has
--- been fixed on their development branch, so this can be removed once they roll
--- a new release. (no new release as of 3/29/2018)
-
 module Language.SystemVerilog.Parser.Lex
-    ( lexFile
+    ( lexStr
-    , Env
     ) where
 
-import System.FilePath (dropFileName)
+import Control.Monad.Except
-import System.Directory (findFile)
-import System.IO.Unsafe (unsafePerformIO)
-import Text.Read (readMaybe)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
-import Data.List (span, elemIndex, dropWhileEnd)
+import qualified Data.Vector as Vector
-import Data.Maybe (isJust, fromJust)
 
 import Language.SystemVerilog.Parser.Keywords (specMap)
+import Language.SystemVerilog.Parser.Preprocess (Contents)
 import Language.SystemVerilog.Parser.Tokens
 }
 
-%wrapper "monadUserState"
+%wrapper "posn"
 
 -- Numbers
 
@@ -72,28 +54,25 @@ import Language.SystemVerilog.Parser.Tokens
     = @fixedPointNumber
     | @unsignedNumber ("." @unsignedNumber)? @exp @sign? @unsignedNumber
 
-@size = @nonZeroUnsignedNumber " "?
+@size = @nonZeroUnsignedNumber $white*
 
-@binaryNumber = @size? @binaryBase " "? @binaryValue
+@binaryNumber = @size? @binaryBase $white* @binaryValue
-@octalNumber  = @size? @octalBase  " "? @octalValue
+@octalNumber  = @size? @octalBase  $white* @octalValue
-@hexNumber    = @size? @hexBase    " "? @hexValue
+@hexNumber    = @size? @hexBase    $white* @hexValue
 
 @unbasedUnsizedLiteral = "'" ( 0 | 1 | x | X | z | Z )
 
 @decimalNumber
     = @unsignedNumber
-    | @size? @decimalBase " "? @unsignedNumber
+    | @size? @decimalBase $white* @unsignedNumber
-    | @size? @decimalBase " "? @xDigit "_"*
+    | @size? @decimalBase $white* @xDigit "_"*
-    | @size? @decimalBase " "? @zDigit "_"*
+    | @size? @decimalBase $white* @zDigit "_"*
 @integralNumber
     = @decimalNumber
     | @octalNumber
     | @binaryNumber
     | @hexNumber
     | @unbasedUnsizedLiteral
-@number
-    = @integralNumber
-    | @realNumber
 
 -- Strings
 
@@ -112,15 +91,6 @@ import Language.SystemVerilog.Parser.Tokens
 @simpleIdentifier  = [a-zA-Z_] [a-zA-Z0-9_\$]*
 @systemIdentifier = "$" [a-zA-Z0-9_\$]+
 
--- Comments
-
-@commentBlock = "/*"
-@commentLine = "//"
-
--- Directives
-
-@directive = "`" @simpleIdentifier
-
 -- Whitespace
 
 @newline = \n
@@ -138,6 +108,10 @@ tokens :-
     "$high"                { tok KW_dollar_high                }
     "$increment"           { tok KW_dollar_increment           }
     "$size"                { tok KW_dollar_size                }
+    "$info"                { tok KW_dollar_info                }
+    "$warning"             { tok KW_dollar_warning             }
+    "$error"               { tok KW_dollar_error               }
+    "$fatal"               { tok KW_dollar_fatal               }
 
     "accept_on"        { tok KW_accept_on    }
     "alias"            { tok KW_alias        }
@@ -392,7 +366,8 @@ tokens :-
     @escapedIdentifier { tok Id_escaped }
     @systemIdentifier  { tok Id_system  }
 
-    @number            { tok Lit_number }
+    @realNumber        { tok Lit_real }
+    @integralNumber    { tok Lit_number }
     @string            { tok Lit_string }
     @time              { tok Lit_time }
 
@@ -486,671 +461,70 @@ tokens :-
     "<<<="             { tok Sym_lt_lt_lt_eq }
     ">>>="             { tok Sym_gt_gt_gt_eq }
 
-    @directive         { handleDirective }
+    "`celldefine"          { tok Dir_celldefine }
-    @commentLine       { removeUntil "\n" }
+    "`endcelldefine"       { tok Dir_endcelldefine }
-    @commentBlock      { removeUntil "*/" }
+    "`unconnected_drive"   { tok Dir_unconnected_drive }
+    "`nounconnected_drive" { tok Dir_nounconnected_drive }
+    "`default_nettype"     { tok Dir_default_nettype }
+    "`resetall"            { tok Dir_resetall }
+    "`begin_keywords"      { tok Dir_begin_keywords }
+    "`end_keywords"        { tok Dir_end_keywords }
 
     $white             ;
 
     .                  { tok Unknown }
 
 {
-
+-- lexer entrypoint
--- our actions don't return any data
+lexStr :: Contents -> Except String [Token]
-type Action = AlexInput -> Int -> Alex ()
+lexStr contents =
-
+    postProcess [] tokens
--- keeps track of the state of an if-else cascade level
-data Cond
-    = CurrentlyTrue
-    | PreviouslyTrue
-    | NeverTrue
-    deriving (Eq, Show)
-
--- map from macro to definition, plus arguments
-type Env = Map.Map String (String, [(String, Maybe String)])
-
--- our custom lexer state
-data AlexUserState = LS
-    { lsToks         :: [Token] -- tokens read so far, *in reverse order* for efficiency
-    , lsCurrFile     :: FilePath -- currently active filename
-    , lsEnv          :: Env -- active macro definitions
-    , lsCondStack    :: [Cond] -- if-else cascade state
-    , lsIncludePaths :: [FilePath] -- folders to search for includes
-    , lsSpecStack    :: [Set.Set TokenName] -- stack of non-keyword token names
-    } deriving (Eq, Show)
-
--- this initial user state does not contain the initial filename, environment,
--- or include paths; alex requires that this be defined; we override it before
--- we begin the actual lexing procedure
-alexInitUserState :: AlexUserState
-alexInitUserState = LS [] "" Map.empty [] [] []
-
--- public-facing lexer entrypoint
-lexFile :: [String] -> Env -> FilePath -> IO (Either String ([Token], Env))
-lexFile includePaths env path = do
-    str <-
-        if path == "-"
-            then getContents
-            else readFile path >>= return . normalize
-    let result = runAlex str $ setEnv >> alexMonadScan >> get
-    return $ case result of
-        Left msg -> Left msg
-        Right finalState ->
-            if not $ null $ lsCondStack finalState then
-                Left $ path ++ ": unfinished conditional directives: " ++
-                    (show $ length $ lsCondStack finalState)
-            else if not $ null $ lsSpecStack finalState then
-                Left $ path ++ ": unterminated begin_keywords blocks: " ++
-                    (show $ length $ lsSpecStack finalState)
-            else
-                Right (finalToks, lsEnv finalState)
     where
-                finalToks = coalesce $ combineBoundaries $
+        (chars, positions) = unzip contents
-                    reverse $ lsToks finalState
+        tokensRaw = alexScanTokens chars
-    where
+        positionsVec = Vector.fromList positions
-        setEnv = do
+        tokens = map (\tkf -> tkf positionsVec) tokensRaw
-            modify $ \s -> s
-                { lsEnv = env
-                , lsIncludePaths = includePaths
-                , lsCurrFile = path
-                }
 
--- combines identifiers and numbers that cross macro boundaries
+-- process begin/end keywords directives
-coalesce :: [Token] -> [Token]
+postProcess :: [Set.Set TokenName] -> [Token] -> Except String [Token]
-coalesce [] = []
+postProcess stack [] =
-coalesce (Token MacroBoundary _ _ : rest) = coalesce rest
+    if null stack
-coalesce (Token t1 str1 pn1 : Token MacroBoundary _ _ : Token t2 str2 pn2 : rest) =
+        then return []
-    case (t1, t2, immediatelyFollows) of
+        else throwError $ "unterminated begin_keywords blocks: " ++ show stack
-        (Lit_number, Lit_number, _) ->
+postProcess stack (Token Dir_begin_keywords _ pos : ts) =
-            Token t1 (str1 ++ str2) pn1 : (coalesce rest)
+    case ts of
-        (Id_simple, Id_simple, True) ->
+        Token Lit_string quotedSpec _ : ts' ->
-            Token t1 (str1 ++ str2) pn1 : (coalesce rest)
-        _ ->
-            Token t1 str1 pn1 : (coalesce $ Token t2 str2 pn2 : rest)
-    where
-        Position _ l1 c1 = pn1
-        Position _ l2 c2 = pn2
-        apn1 = AlexPn 0 l1 c1
-        apn2 = AlexPn (length str1) l2 c2
-        immediatelyFollows = apn2 == foldl alexMove apn1 str1
-coalesce (x : xs) = x : coalesce xs
-
-combineBoundaries :: [Token] -> [Token]
-combineBoundaries [] = []
-combineBoundaries (Token MacroBoundary s p : Token MacroBoundary _ _ : rest) =
-    combineBoundaries $ Token MacroBoundary s p : rest
-combineBoundaries (x : xs) = x : combineBoundaries xs
-
--- invoked by alexMonadScan
-alexEOF :: Alex ()
-alexEOF = return ()
-
--- raises an alexError with the current file position appended
-lexicalError :: String -> Alex a
-lexicalError msg = do
-    (pn, _, _, _) <- alexGetInput
-    pos <- toTokPos pn
-    alexError $ show pos ++ ": Lexical error: " ++ msg
-
--- get the current user state
-get :: Alex AlexUserState
-get = Alex $ \s -> Right (s, alex_ust s)
-
--- get the current user state and apply a function to it
-gets :: (AlexUserState -> a) -> Alex a
-gets f = get >>= return . f
-
--- apply a transformation to the current user state
-modify :: (AlexUserState -> AlexUserState) -> Alex ()
-modify f = Alex func
-    where func s = Right (s { alex_ust = new }, ())
-            where new = f (alex_ust s)
-
--- helpers specifically accessing the current file state
-getCurrentFile :: Alex String
-getCurrentFile = gets lsCurrFile
-setCurrentFile :: String -> Alex ()
-setCurrentFile x = modify $ \s -> s { lsCurrFile = x }
-
--- find the given file for inclusion
-includeSearch :: FilePath -> Alex FilePath
-includeSearch file = do
-    base <- getCurrentFile
-    includePaths <- gets lsIncludePaths
-    let directories = dropFileName base : includePaths
-    let result = unsafePerformIO $ findFile directories file
-    case result of
-        Just path -> return path
-        Nothing -> lexicalError $ "Could not find file " ++ show file ++
-                        ", included from " ++ show base
-
--- read in the given file
-loadFile :: FilePath -> Alex String
-loadFile = return . normalize . unsafePerformIO . readFile
-
--- removes carriage returns before newlines
-normalize :: String -> String
-normalize ('\r' : '\n' : rest) = '\n' : (normalize rest)
-normalize (ch : chs) = ch : (normalize chs)
-normalize [] = []
-
-isIdentChar :: Char -> Bool
-isIdentChar ch =
-    ('a' <= ch && ch <= 'z') ||
-    ('A' <= ch && ch <= 'Z') ||
-    ('0' <= ch && ch <= '9') ||
-    (ch == '_') || (ch == '$')
-
-takeString :: Alex String
-takeString = do
-    (pos, _, _, str) <- alexGetInput
-    let (x, rest) = span isIdentChar str
-    let lastChar = if null x then ' ' else last x
-    alexSetInput (foldl alexMove pos x, lastChar, [], rest)
-    return x
-
-toTokPos :: AlexPosn -> Alex Position
-toTokPos (AlexPn _ l c) = do
-    file <- getCurrentFile
-    return $ Position file l c
-
--- read tokens after the name until the first (un-escaped) newline
-takeUntilNewline :: Alex String
-takeUntilNewline = do
-    (pos, _, _, str) <- alexGetInput
-    case str of
-        []                 -> return ""
-        '\n' :        _    -> do
-            return ""
-        '/' : '/' : _ -> do
-            remainder <- takeThrough '\n'
-            case last $ init remainder of
-                '\\' -> takeUntilNewline >>= return . (' ' :)
-                _ -> return ""
-        '\\' : '\n' : rest -> do
-            let newPos = alexMove (alexMove pos '\\') '\n'
-            alexSetInput (newPos, '\n', [], rest)
-            takeUntilNewline >>= return . (' ' :)
-        ch   :        rest -> do
-            let newPos = alexMove pos ch
-            alexSetInput (newPos, ch, [], rest)
-            takeUntilNewline >>= return . (ch :)
-
--- select characters up to and including the given character
-takeThrough :: Char -> Alex String
-takeThrough goal = do
-    (_, _, _, str) <- alexGetInput
-    if null str
-        then lexicalError $
-                "unexpected end of input, looking for " ++ (show goal)
-        else do
-            ch <- takeChar
-            if ch == goal
-                then return [ch]
-                else do
-                    rest <- takeThrough goal
-                    return $ ch : rest
-
--- pop one character from the input stream
-takeChar :: Alex Char
-takeChar = do
-    (pos, _, _, str) <- alexGetInput
-    (ch, chs) <-
-        if null str
-            then lexicalError "unexpected end of input"
-            else return (head str, tail str)
-    let newPos = alexMove pos ch
-    alexSetInput (newPos, ch, [], chs)
-    return ch
-
--- drop spaces in the input until a non-space is reached or EOF
-dropSpaces :: Alex ()
-dropSpaces = do
-    (pos, _, _, str) <- alexGetInput
-    if null str then
-        return ()
-    else do
-        let ch : rest = str
-        if ch == '\t' || ch == ' ' then do
-            alexSetInput (alexMove pos ch, ch, [], tail str)
-            dropSpaces
-        else
-            return ()
-
-isWhitespaceChar :: Char -> Bool
-isWhitespaceChar ch = elem ch [' ', '\t', '\n']
-
--- drop all leading whitespace in the input
-dropWhitespace :: Alex ()
-dropWhitespace = do
-    (pos, _, _, str) <- alexGetInput
-    case str of
-        ch : chs ->
-            if isWhitespaceChar ch
-                then do
-                    alexSetInput (alexMove pos ch, ch, [], chs)
-                    dropWhitespace
-                else return()
-        [] -> return ()
-
--- lex the remainder of the current line into tokens and return them, rather
--- than storing them in the lexer state
-tokenizeLine :: Alex [Token]
-tokenizeLine = do
-    -- read in the rest of the current line
-    str <- takeUntilNewline
-    dropWhitespace
-    -- save the current lexer state
-    currInput <- alexGetInput
-    currFile <- getCurrentFile
-    currToks <- gets lsToks
-    -- parse the line into tokens (which includes macro processing)
-    modify $ \s -> s { lsToks = [] }
-    let newInput = (alexStartPos, ' ', [], str)
-    alexSetInput newInput
-    alexMonadScan
-    toks <- gets lsToks
-    -- return to the previous state
-    alexSetInput currInput
-    setCurrentFile currFile
-    modify $ \s -> s { lsToks = currToks }
-    -- remove macro boundary tokens and put the tokens in order
-    let isntMacroBoundary = \(Token t _ _ ) -> t /= MacroBoundary
-    let toks' = filter isntMacroBoundary toks
-    return $ reverse toks'
-
--- removes and returns a decimal number
-takeNumber :: Alex Int
-takeNumber = do
-    dropSpaces
-    leadCh <- peekChar
-    if '0' <= leadCh && leadCh <= '9'
-        then step 0
-        else lexicalError $ "expected number, but found unexpected char: "
-                ++ show leadCh
-    where
-        step number = do
-            ch <- takeChar
-            if ch == ' ' || ch == '\n' then
-                return number
-            else if '0' <= ch && ch <= '9' then do
-                let digit = ord ch - ord '0'
-                step $ number * 10 + digit
-            else
-                lexicalError $ "unexpected char while reading number: "
-                    ++ show ch
-
-peekChar :: Alex Char
-peekChar = do
-    (_, _, _, str) <- alexGetInput
-    if null str
-        then lexicalError "unexpected end of input"
-        else return $head str
-
-takeMacroDefinition :: Alex (String, [(String, Maybe String)])
-takeMacroDefinition = do
-    leadCh <- peekChar
-    if leadCh /= '('
-        then do
-            body <- takeUntilNewline
-            return (body, [])
-        else do
-            args <- takeMacroArguments
-            body <- takeUntilNewline
-            argsWithDefaults <- mapM splitArg args
-            if null args
-                then lexicalError "macros cannot have 0 args"
-                else return (body, argsWithDefaults)
-    where
-        splitArg :: String -> Alex (String, Maybe String)
-        splitArg [] = lexicalError "macro defn. empty argument"
-        splitArg str = do
-            let (name, rest) = span isIdentChar str
-            if null name || not (all isIdentChar name) then
-                lexicalError $ "invalid macro arg name: " ++ show name
-            else if null rest then
-                return (name, Nothing)
-            else do
-                let trimmed = dropWhile isWhitespaceChar rest
-                let leadCh = head trimmed
-                if leadCh /= '='
-                then lexicalError $ "bad char after arg name: " ++ (show leadCh)
-                else return (name, Just $ tail trimmed)
-
--- commas and right parens are forbidden outside matched pairs of: (), [], {},
--- "", except to delimit arguments or end the list of arguments; see 22.5.1
-takeMacroArguments :: Alex [String]
-takeMacroArguments = do
-    dropWhitespace
-    leadCh <- takeChar
-    if leadCh == '('
-        then argLoop
-        else lexicalError $ "expected begining of macro arguments, but found "
-                ++ show leadCh
-    where
-        argLoop :: Alex [String]
-        argLoop = do
-            dropWhitespace
-            (arg, isEnd) <- loop "" []
-            let arg' = dropWhileEnd isWhitespaceChar arg
-            if isEnd
-                then return [arg']
-                else do
-                    rest <- argLoop
-                    return $ arg' : rest
-        loop :: String -> [Char] -> Alex (String, Bool)
-        loop curr stack = do
-            ch <- takeChar
-            case (stack, ch) of
-                (      s,'\\') -> do
-                    ch2 <- takeChar
-                    loop (curr ++ [ch, ch2]) s
-                ([     ], ',') -> return (curr, False)
-                ([     ], ')') -> return (curr, True)
-
-                ('"' : s, '"') -> loop (curr ++ [ch]) s
-                (      s, '"') -> loop (curr ++ [ch]) ('"' : s)
-                ('[' : s, ']') -> loop (curr ++ [ch]) s
-                (      s, '[') -> loop (curr ++ [ch]) ('[' : s)
-                ('(' : s, ')') -> loop (curr ++ [ch]) s
-                (      s, '(') -> loop (curr ++ [ch]) ('(' : s)
-                ('{' : s, '}') -> loop (curr ++ [ch]) s
-                (      s, '{') -> loop (curr ++ [ch]) ('{' : s)
-
-                (      s,'\n') -> loop (curr ++ [' ']) s
-                (      s, _  ) -> loop (curr ++ [ch ]) s
-
-findUnescapedQuote :: String -> (String, String)
-findUnescapedQuote [] = ([], [])
-findUnescapedQuote ('`' : '\\' : '`' : '"' : rest) = ('\\' : '"' : start, end)
-    where (start, end) = findUnescapedQuote rest
-findUnescapedQuote ('\\' : '"' : rest) = ('\\' : '"' : start, end)
-    where (start, end) = findUnescapedQuote rest
-findUnescapedQuote ('"' : rest) = ("\"", rest)
-findUnescapedQuote ('`' : '"' : rest) = ("\"", rest)
-findUnescapedQuote (ch : rest) = (ch : start, end)
-    where (start, end) = findUnescapedQuote rest
-
--- substitute in the arguments for a macro expension
-substituteArgs :: String -> [String] -> [String] -> String
-substituteArgs "" _ _ = ""
-substituteArgs ('`' : '`' : body) names args =
-    substituteArgs body names args
-substituteArgs ('"' : body) names args =
-    '"' : start ++ substituteArgs rest names args
-    where (start, rest) = findUnescapedQuote body
-substituteArgs ('\\' : '"' : body) names args =
-    '\\' : '"' : substituteArgs body names args
-substituteArgs ('`' : '"' : body) names args =
-    '"' : substituteArgs (init start) names args
-    ++ '"' : substituteArgs rest names args
-    where (start, rest) = findUnescapedQuote body
-substituteArgs body names args =
-    case span isIdentChar body of
-        ([], _) -> head body : substituteArgs (tail body) names args
-        (ident, rest) ->
-            case elemIndex ident names of
-                Nothing -> ident ++ substituteArgs rest names args
-                Just idx -> (args !! idx) ++ substituteArgs rest names args
-
-defaultMacroArgs :: [Maybe String] -> [String] -> Alex [String]
-defaultMacroArgs [] [] = return []
-defaultMacroArgs [] _ = lexicalError "too many macro arguments given"
-defaultMacroArgs defaults [] = do
-    if all isJust defaults
-        then return $ map fromJust defaults
-        else lexicalError "too few macro arguments given"
-defaultMacroArgs (f : fs) (a : as) = do
-    let arg = if a == "" && isJust f
-            then fromJust f
-            else a
-    args <- defaultMacroArgs fs as
-    return $ arg : args
-
--- directives that must always be processed even if the current code block is
--- being excluded; we have to process conditions so we can match them up with
--- their ending tag, even if they're being skipped
-unskippableDirectives :: [String]
-unskippableDirectives = ["else", "elsif", "endif", "ifdef", "ifndef"]
-
-handleDirective :: Action
-handleDirective (posOrig, _, _, strOrig) len = do
-    let thisTokenStr = take len strOrig
-    let directive = tail $ thisTokenStr
-    let newPos = foldl alexMove posOrig thisTokenStr
-    alexSetInput (newPos, last thisTokenStr, [], drop len strOrig)
-
-    env <- gets lsEnv
-    tempInput <- alexGetInput
-    let dropUntilNewline = removeUntil "\n" tempInput 0
-    let passThrough = do
-            rest <- takeUntilNewline
-            let str = '`' : directive ++ rest
-            tok Spe_Directive (posOrig, ' ', [], strOrig) (length str)
-
-    condStack <- gets lsCondStack
-    if any (/= CurrentlyTrue) condStack
-        && not (elem directive unskippableDirectives)
-    then alexMonadScan
-    else case directive of
-
-        "timescale" -> dropUntilNewline
-
-        "celldefine" -> passThrough
-        "endcelldefine" -> passThrough
-
-        "unconnected_drive" -> passThrough
-        "nounconnected_drive" -> passThrough
-
-        "default_nettype" -> passThrough
-        "pragma" -> do
-            leadCh <- peekChar
-            if leadCh == '\n' || leadCh == '\r'
-                then lexicalError "pragma directive cannot be empty"
-                else passThrough
-        "resetall" -> passThrough
-
-        "begin_keywords" -> do
-            toks <- tokenizeLine
-            quotedSpec <- case toks of
-                [Token Lit_string str _] -> return str
-                _ -> lexicalError $ "unexpected tokens following `begin_keywords: " ++ show toks
-            let spec = tail $ init quotedSpec
             case Map.lookup spec specMap of
-                Nothing ->
+                Nothing -> throwError $ show pos
-                    lexicalError $ "invalid keyword set name: " ++ show spec
+                    ++ ": invalid keyword set name: " ++ show spec
-                Just set -> do
+                Just set -> postProcess (set : stack) ts'
-                    specStack <- gets lsSpecStack
+            where spec = tail $ init quotedSpec
-                    modify $ \s -> s { lsSpecStack = set : specStack }
+        _ -> throwError $ show pos ++ ": begin_keywords not followed by string"
-                    dropWhitespace
+postProcess stack (Token Dir_end_keywords _ pos : ts) =
-                    alexMonadScan
+    case stack of
-        "end_keywords" -> do
+        (_ : stack') -> postProcess stack' ts
-            specStack <- gets lsSpecStack
+        [] -> throwError $ show pos ++ ": unmatched end_keywords"
-            if null specStack
+postProcess stack (Token Id_escaped str pos : ts) =
-                then
+    postProcess stack ts >>= return . (t' :)
-                    lexicalError "unexpected end_keywords before begin_keywords"
-                else do
-                    modify $ \s -> s { lsSpecStack = tail specStack }
-                    dropWhitespace
-                    alexMonadScan
-
-        "__FILE__" -> do
-            tokPos <- toTokPos posOrig
-            currFile <- gets lsCurrFile
-            let tokStr = show currFile
-            modify $ push $ Token Lit_string tokStr tokPos
-            alexMonadScan
-        "__LINE__" -> do
-            tokPos <- toTokPos posOrig
-            let Position _ currLine _ = tokPos
-            let tokStr = show currLine
-            modify $ push $ Token Lit_number tokStr tokPos
-            alexMonadScan
-
-        "line" -> do
-            toks <- tokenizeLine
-            (lineNumber, quotedFilename, levelNumber) <-
-                case toks of
-                    [ Token Lit_number lineStr _,
-                      Token Lit_string filename _,
-                      Token Lit_number levelStr _] -> do
-                        let Just line = readMaybe lineStr :: Maybe Int
-                        let Just level = readMaybe levelStr :: Maybe Int
-                        return (line, filename, level)
-                    _ -> lexicalError $ "unexpected tokens following `begin_keywords: " ++ show toks
-            let filename = init $ tail quotedFilename
-            setCurrentFile filename
-            (AlexPn f _ c, prev, _, str) <- alexGetInput
-            alexSetInput (AlexPn f (lineNumber + 1) c, prev, [], str)
-            if 0 <= levelNumber && levelNumber <= 2
-                then alexMonadScan
-                else lexicalError "line directive invalid level number"
-
-        "include" -> do
-            toks <- tokenizeLine
-            quotedFilename <- case toks of
-                [Token Lit_string str _] -> return str
-                _ -> lexicalError $ "unexpected tokens following `include: " ++ show toks
-            inputFollow <- alexGetInput
-            fileFollow <- getCurrentFile
-            -- process the included file
-            let filename = init $ tail quotedFilename
-            path <- includeSearch filename
-            content <- loadFile path
-            let inputIncluded = (alexStartPos, ' ', [], content)
-            setCurrentFile path
-            alexSetInput inputIncluded
-            alexMonadScan
-            -- resume processing the original file
-            setCurrentFile fileFollow
-            alexSetInput inputFollow
-            alexMonadScan
-
-        "ifdef" -> do
-            dropSpaces
-            name <- takeString
-            let newCond = if Map.member name env
-                    then CurrentlyTrue
-                    else NeverTrue
-            modify $ \s -> s { lsCondStack = newCond : condStack }
-            alexMonadScan
-        "ifndef" -> do
-            dropSpaces
-            name <- takeString
-            let newCond = if Map.notMember name env
-                    then CurrentlyTrue
-                    else NeverTrue
-            modify $ \s -> s { lsCondStack = newCond : condStack }
-            alexMonadScan
-        "else" -> do
-            let newCond = if head condStack == NeverTrue
-                    then CurrentlyTrue
-                    else NeverTrue
-            modify $ \s -> s { lsCondStack = newCond : tail condStack }
-            alexMonadScan
-        "elsif" -> do
-            dropSpaces
-            name <- takeString
-            let currCond = head condStack
-            let newCond =
-                    if currCond /= NeverTrue then
-                        PreviouslyTrue
-                    else if Map.member name env then
-                        CurrentlyTrue
-                    else
-                        NeverTrue
-            modify $ \s -> s { lsCondStack = newCond : tail condStack }
-            alexMonadScan
-        "endif" -> do
-            modify $ \s -> s { lsCondStack = tail condStack }
-            alexMonadScan
-
-        "define" -> do
-            dropSpaces
-            name <- takeString
-            defn <- takeMacroDefinition
-            modify $ \s -> s { lsEnv = Map.insert name defn env }
-            alexMonadScan
-        "undef" -> do
-            dropSpaces
-            name <- takeString
-            modify $ \s -> s { lsEnv = Map.delete name env }
-            alexMonadScan
-        "undefineall" -> do
-            modify $ \s -> s { lsEnv = Map.empty }
-            alexMonadScan
-
-        _ -> do
-            case Map.lookup directive env of
-                Nothing -> lexicalError $ "Undefined macro: " ++ directive
-                Just (body, formalArgs) -> do
-                    (AlexPn _ l c, _, _, _) <- alexGetInput
-                    replacement <- if null formalArgs
-                        then return body
-                        else do
-                            actualArgs <- takeMacroArguments
-                            defaultedArgs <- defaultMacroArgs (map snd formalArgs) actualArgs
-                            return $ substituteArgs body (map fst formalArgs) defaultedArgs
-                    -- save our current state
-                    currInput <- alexGetInput
-                    currToks <- gets lsToks
-                    modify $ \s -> s { lsToks = [] }
-                    -- lex the macro expansion, preserving the file and line
-                    alexSetInput (AlexPn 0 l 0, ' ', [], replacement)
-                    alexMonadScan
-                    -- re-tag and save tokens from the macro expansion
-                    newToks <- gets lsToks
-                    currFile <- getCurrentFile
-                    let loc = "macro expansion of " ++ directive ++ " at " ++ currFile
-                    let pos = Position loc l (c - length directive - 1)
-                    let reTag (Token a b _) = Token a b pos
-                    let boundary = Token MacroBoundary "" (Position "" 0 0)
-                    let boundedToks = boundary : (map reTag newToks) ++ boundary : currToks
-                    modify $ \s -> s { lsToks = boundedToks }
-                    -- continue lexing after the macro
-                    alexSetInput currInput
-                    alexMonadScan
-
--- remove characters from the input until the pattern is reached
-removeUntil :: String -> Action
-removeUntil pattern _ _ = loop
     where
-        patternLen = length pattern
+        t' = Token Id_escaped str' pos
-        wantNewline = pattern == "\n"
+        str' = (++ " ") $ init str
-        loop = do
+postProcess _ (Token Unknown str pos : _) =
-            (pos, _, _, str) <- alexGetInput
+    throwError $ show pos ++ ": unknown token '" ++ str ++ "'"
-            let found = (null str && wantNewline)
+postProcess [] (t : ts) = do
-                     || pattern == take patternLen str
+    ts' <- postProcess [] ts
-            let nextPos = alexMove pos (head str)
+    return $ t : ts'
-            let afterPos = if wantNewline
+postProcess stack (t : ts) = do
-                    then alexMove pos '\n'
+    ts' <- postProcess stack ts
-                    else foldl alexMove pos pattern
+    return $ t' : ts'
-            let (newPos, newStr) = if found
+    where
-                    then (afterPos, drop patternLen str)
+        Token tokId str pos = t
-                    else (nextPos, drop 1 str)
+        t' = if Set.member tokId (head stack)
-            if not found && null str
+                then Token Id_simple ('_' : str) pos
-                then lexicalError $ "Reached EOF while looking for: " ++
+                else t
-                        show pattern
-                else do
-                    alexSetInput (newPos, ' ', [], newStr)
-                    if found
-                        then alexMonadScan
-                        else loop
 
-push :: Token -> AlexUserState -> AlexUserState
+tok :: TokenName -> AlexPosn -> String -> Vector.Vector Position -> Token
-push t s = s { lsToks = t : (lsToks s) }
+tok tokId (AlexPn charPos _ _) tokStr positions =
-
+    Token tokId tokStr tokPos
-tok :: TokenName -> Action
+    where tokPos = positions Vector.! charPos
-tok tokId (pos, _, _, input) len = do
-    let tokStr = take len input
-    tokPos <- toTokPos pos
-    condStack <- gets lsCondStack
-    () <- if any (/= CurrentlyTrue) condStack
-        then return ()
-        else do
-            specStack <- gets lsSpecStack
-            if null specStack || Set.notMember tokId (head specStack)
-                then modify (push $ Token tokId tokStr tokPos)
-                else modify (push $ Token Id_simple ('_' : tokStr) tokPos)
-    alexMonadScan
 }

src/Language/SystemVerilog/Parser/ParseDecl.hs

@@ -1,12 +1,12 @@
 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  -
- - Advanced parser for declarations and module instantiations.
+ - Advanced parser for declarations, module instantiations, and some statements.
  -
- - This module exists because the SystemVerilog grammar has conflicts which
+ - This module exists because the SystemVerilog grammar is not LALR(1), and
- - cannot be resolved by an LALR(1) parser. This module provides an interface
+ - Happy can only produce LALR(1) parsers. This module provides an interface for
- - for parsing an list of "DeclTokens" into `Decl`s and/or `ModuleItem`s. This
+ - parsing a list of "DeclTokens" into `Decl`s, `ModuleItem`s, or `Stmt`s. This
- - works through a series of functions which have an greater lookahead for
+ - works through a series of functions which have use a greater lookahead for
  - resolving the conflicts.
  -
  - Consider the following two module declarations:
@@ -16,12 +16,25 @@
  - When `{one} two ,` is on the stack, it is impossible to know whether to A)
  - shift `three` to add to the current declaration list; or B) to reduce the
  - stack and begin a new port declaration; without looking ahead more than 1
- - token (even ignoring the fact that a range is itself multiple tokens).
+ - token.
  -
- - While I previous had some success dealing with conflicts in the parser with
+ - While I previously had some success dealing with these conflicts with
  - increasingly convoluted grammars, this became more and more untenable as I
  - added support for more SystemVerilog constructs.
  -
+ - Because declarations and statements are subject to the same kind of
+ - conflicts, this module additionally provides an interface for parsing
+ - DeclTokens as either declarations or the basic statements (either assignments
+ - or task/function calls) with which they can conflict. The initialization
+ - portion of a for loop also allows for declarations and assignments, and so a
+ - similar interface is provided for this case.
+ -
+ - Parameter port lists allow the omission of the `parameter` and `localparam`
+ - keywords, and so require special handling in the same vein as other
+ - declarations. However, this custom parsing is not necessary for parameter
+ - declarations outside of parameter port lists because the leading keyword is
+ - otherwise required.
+ -
  - This parser is very liberal, and so accepts some syntactically invalid files.
  - In the future, we may add some basic type-checking to complain about
  - malformed input files. However, we generally assume that users have tested
@@ -32,409 +45,652 @@ module Language.SystemVerilog.Parser.ParseDecl
 ( DeclToken (..)
 , parseDTsAsPortDecls
 , parseDTsAsModuleItems
-, parseDTsAsDecls
+, parseDTsAsTFDecls
 , parseDTsAsDecl
-, parseDTsAsDeclOrAsgn
+, parseDTsAsDeclOrStmt
 , parseDTsAsDeclsOrAsgns
+, parseDTsAsParams
 ) where
 
-import Data.List (elemIndex, findIndex, findIndices, partition)
+import Data.List (findIndex, partition, uncons)
-import Data.Maybe (mapMaybe)
 
 import Language.SystemVerilog.AST
+import Language.SystemVerilog.Parser.Tokens (Position(..))
 
 -- [PUBLIC]: combined (irregular) tokens for declarations
 data DeclToken
-    = DTComma
+    = DTComma    Position
-    | DTAutoDim
+    | DTAutoDim  Position
-    | DTAsgn     AsgnOp Expr
+    | DTConst    Position
-    | DTAsgnNBlk (Maybe Timing) Expr
+    | DTVar      Position
-    | DTRange    (PartSelectMode, Range)
+    | DTAsgn     Position AsgnOp (Maybe Timing) Expr
-    | DTIdent    Identifier
+    | DTRange    Position PartSelectMode Range
-    | DTPSIdent  Identifier Identifier
+    | DTIdent    Position Identifier
-    | DTDir      Direction
+    | DTPSIdent  Position Identifier Identifier
-    | DTType     (Signing -> [Range] -> Type)
+    | DTCSIdent  Position Identifier [ParamBinding] Identifier
-    | DTParams   [ParamBinding]
+    | DTDir      Position Direction
-    | DTInstance [PortBinding]
+    | DTType     Position (Signing -> [Range] -> Type)
-    | DTBit      Expr
+    | DTNet      Position NetType Strength
-    | DTConcat   [LHS]
+    | DTParams   Position [ParamBinding]
-    | DTStream   StreamOp Expr [LHS]
+    | DTPorts    Position [PortBinding]
-    | DTDot      Identifier
+    | DTBit      Position Expr
-    | DTSigning  Signing
+    | DTLHSBase  Position LHS
-    | DTLifetime Lifetime
+    | DTDot      Position Identifier
-    deriving (Show, Eq)
+    | DTSigning  Position Signing
-
+    | DTSeverity Position Severity
-
+    | DTLifetime Position Lifetime
--- entrypoints besides `parseDTsAsDeclOrAsgn` use this to disallow `DTAsgnNBlk`
+    | DTAttr     Position Attr
--- and `DTAsgn` with a binary assignment operator because we don't expect to see
+    | DTEnd      Position Char
--- those assignment oeprators in declarations
+    | DTParamKW  Position ParamScope
-forbidNonEqAsgn :: [DeclToken] -> a -> a
+    | DTTypeDecl Position
-forbidNonEqAsgn tokens =
+    | DTTypeAsgn Position
-    if any isNonEqAsgn tokens
-        then error $ "decl tokens contain bad assignment operator: " ++ show tokens
-        else id
-    where
-        isNonEqAsgn :: DeclToken -> Bool
-        isNonEqAsgn (DTAsgnNBlk _ _) = True
-        isNonEqAsgn (DTAsgn (AsgnOp _) _) = True
-        isNonEqAsgn _ = False
 
 
 -- [PUBLIC]: parser for module port declarations, including interface ports
 -- Example: `input foo, bar, One inst`
 parseDTsAsPortDecls :: [DeclToken] -> ([Identifier], [ModuleItem])
-parseDTsAsPortDecls pieces =
+parseDTsAsPortDecls = parseDTsAsPortDecls' . dropTrailingComma
-    forbidNonEqAsgn pieces $
+
+-- internal utility to drop a single trailing comma in port or parameter lists,
+-- which we allow for compatibility with Yosys
+dropTrailingComma :: [DeclToken] -> [DeclToken]
+dropTrailingComma [] = []
+dropTrailingComma [DTComma{}, end@DTEnd{}] = [end]
+dropTrailingComma (tok : toks) = tok : dropTrailingComma toks
+
+-- internal parseDTsAsPortDecls after the removal of an optional trailing comma
+parseDTsAsPortDecls' :: [DeclToken] -> ([Identifier], [ModuleItem])
+parseDTsAsPortDecls' pieces =
     if isSimpleList
         then (simpleIdents, [])
-        else (portNames declarations, map (MIPackageItem . Decl) declarations)
+        else (portNames declarations, applyAttrs [] pieces declarations)
     where
-        commaIdxs = findIndices isComma pieces
+        maybeSimpleIdents = parseDTsAsIdents pieces
-        identIdxs = findIndices isIdent pieces
+        Just simpleIdents = maybeSimpleIdents
-        isSimpleList =
+        isSimpleList = maybeSimpleIdents /= Nothing
-            all even identIdxs &&
-            all odd commaIdxs &&
-            odd (length pieces) &&
-            length pieces == length commaIdxs + length identIdxs
 
-        simpleIdents = map extractIdent $ filter isIdent pieces
+        declarations = parseDTsAsDecls Input ModeDefault pieces'
-        declarations = parseDTsAsDecls pieces
 
-        isComma :: DeclToken -> Bool
+        pieces' = filter (not . isAttr) pieces
-        isComma token = token == DTComma
-        extractIdent = \(DTIdent x) -> x
 
         portNames :: [Decl] -> [Identifier]
-        portNames items = mapMaybe portName items
+        portNames = filter (not . null) . map portName
-        portName :: Decl -> Maybe Identifier
+        portName :: Decl -> Identifier
-        portName (Variable _ _ ident _ _) = Just ident
+        portName (Variable _ _ ident _ _) = ident
-        portName decl =
+        portName (Net  _ _ _ _ ident _ _) = ident
-            error $ "unexpected non-variable port declaration: " ++ (show decl)
+        portName _ = ""
+
+        applyAttrs :: [Attr] -> [DeclToken] -> [Decl] -> [ModuleItem]
+        applyAttrs _ tokens (CommentDecl c : decls) =
+            MIPackageItem (Decl $ CommentDecl c) : applyAttrs [] tokens decls
+        applyAttrs attrs (DTAttr _ attr : tokens) decls =
+            applyAttrs (attr : attrs) tokens decls
+        applyAttrs attrs [] [decl] =
+            [wrapDecl attrs decl]
+        applyAttrs attrs (DTComma{} : tokens) (decl : decls) =
+            wrapDecl attrs decl : applyAttrs attrs tokens decls
+        applyAttrs attrs (_ : tokens) decls =
+            applyAttrs attrs tokens decls
+        applyAttrs _ [] _ = undefined
+
+        wrapDecl :: [Attr] -> Decl -> ModuleItem
+        wrapDecl attrs decl = foldr MIAttr (MIPackageItem $ Decl decl) attrs
+
+-- internal utility for a simple list of port identifiers
+parseDTsAsIdents :: [DeclToken] -> Maybe [Identifier]
+parseDTsAsIdents [DTIdent _ x, DTEnd _ _] = Just [x]
+parseDTsAsIdents [_, _] = Nothing
+parseDTsAsIdents (DTIdent _ x : DTComma _ : rest) =
+    fmap (x :) (parseDTsAsIdents rest)
+parseDTsAsIdents _ = Nothing
 
 
 -- [PUBLIC]: parser for single (semicolon-terminated) declarations (including
 -- parameters) and module instantiations
 parseDTsAsModuleItems :: [DeclToken] -> [ModuleItem]
 parseDTsAsModuleItems tokens =
-    forbidNonEqAsgn tokens $
+    if maybeElabTask /= Nothing then
-    if isElabTask $ head tokens then
+        [elabTask]
-        asElabTask tokens
+    else if any isPorts tokens then
-    else if any isInstance tokens then
         parseDTsAsIntantiations tokens
     else
         map (MIPackageItem . Decl) $ parseDTsAsDecl tokens
     where
-        isElabTask :: DeclToken -> Bool
+        Just elabTask = maybeElabTask
-        isElabTask (DTIdent x) = elem x elabTasks
+        maybeElabTask = asElabTask tokens
-            where elabTasks = ["$fatal", "$error", "$warning", "$info"]
-        isElabTask _ = False
-        isInstance :: DeclToken -> Bool
-        isInstance (DTInstance _) = True
-        isInstance _ = False
-
--- internal; approximates the behavior of the elaboration system tasks
-asElabTask :: [DeclToken] -> [ModuleItem]
-asElabTask [DTIdent name, DTInstance args] =
-    if name == "$info"
-        then [] -- just drop them for simplicity
-        else [Instance "ThisModuleDoesNotExist" [] name' Nothing args]
-    where name' = "__sv2v_elab_" ++ tail name
-asElabTask [DTIdent name] =
-    asElabTask [DTIdent name, DTInstance []]
-asElabTask tokens =
-    error $ "could not parse elaboration system task: " ++ show tokens
 
+-- internal; attempt to parse an elaboration system task
+asElabTask :: [DeclToken] -> Maybe ModuleItem
+asElabTask (DTSeverity _ severity : toks) =
+    Just $ ElabTask severity args
+    where
+        args =
+            case toks of
+                [DTEnd{}] -> []
+                [DTPorts _ ports, DTEnd{}] -> portsToExprs (head toks) ports
+                DTPorts{} : tok : _ -> parseError tok msg
+                _ -> parseError (head toks) msg
+        msg = "unexpected token after elaboration system task"
+asElabTask _ = Nothing
 
 -- internal; parser for module instantiations
 parseDTsAsIntantiations :: [DeclToken] -> [ModuleItem]
-parseDTsAsIntantiations (DTIdent name : tokens) =
+parseDTsAsIntantiations (DTIdent _ name : DTParams _ params : tokens) =
-    if not (all isInstanceToken rest)
+    step tokens
-        then error $ "instantiations mixed with other items: " ++ (show rest)
-        else step rest
     where
         step :: [DeclToken] -> [ModuleItem]
-        step [] = error $ "unexpected end of instantiation list: " ++ (show tokens)
+        step [] = []
-        step toks =
+        step toks = inst : step restToks
-            Instance name params x mr p : follow
             where
-                (inst, toks') = span (DTComma /=) toks
+                inst = Instance name params x rs p
-                (x, mr, p) = case inst of
+                (x, rs, p) = parseDTsAsIntantiation instToks delimTok
-                    [DTIdent a, DTRange (NonIndexed, s), DTInstance b] ->
+                (instToks, delimTok : restToks) = break isCommaOrEnd toks
-                        (a, Just s , b)
+parseDTsAsIntantiations (DTIdent pos name : tokens) =
-                    [DTIdent a, DTInstance b] -> (a, Nothing, b)
+    parseDTsAsIntantiations $ DTIdent pos name : DTParams pos [] : tokens
-                    _ -> error $ "unrecognized instantiation of " ++ name
-                            ++ ": " ++ show inst
-                follow = x `seq` if null toks' then [] else step (tail toks')
-        (params, rest) =
-            case head tokens of
-                DTParams ps -> (ps, tail tokens)
-                _           -> ([],      tokens)
-        isInstanceToken :: DeclToken -> Bool
-        isInstanceToken (DTInstance _) = True
-        isInstanceToken (DTRange _) = True
-        isInstanceToken (DTIdent _) = True
-        isInstanceToken DTComma = True
-        isInstanceToken _ = False
 parseDTsAsIntantiations tokens =
-    error $
+    parseError (head tokens)
-        "DeclTokens contain instantiations, but start with non-ident: "
+        "expected module or interface name at beginning of instantiation list"
-        ++ (show tokens)
+
+-- internal; parser for an individual instantiations
+parseDTsAsIntantiation :: [DeclToken] -> DeclToken
+    -> (Identifier, [Range], [PortBinding])
+parseDTsAsIntantiation l0 delimTok =
+    if null l0 then
+        parseError delimTok $ "expected instantiation before " ++ delimStr
+    else if not (isIdent nameTok) then
+        parseError nameTok "expected instantiation name"
+    else if null l1 then
+        parseError delimTok $ "expected port connections before " ++ delimStr
+    else if seq ranges not (isPorts portsTok) then
+        parseError portsTok "expected port connections"
+    else
+        (name, ranges, ports)
+    where
+        delimChar = case delimTok of
+                        DTEnd _ char -> char
+                        _ -> ','
+        delimStr = ['\'', delimChar, '\'']
+        Just (nameTok, l1) = uncons l0
+        rangeToks = init l1
+        portsTok = last l1
+        DTIdent _ name = nameTok
+        DTPorts _ ports = portsTok
+        ranges = map asRange rangeToks
+        asRange :: DeclToken -> Range
+        asRange (DTRange _ NonIndexed s) = s
+        asRange (DTBit _ s) = (RawNum 0, BinOp Sub s (RawNum 1))
+        asRange tok = parseError tok "expected instantiation dimensions"
 
 
--- [PUBLIC]: parser for generic, comma-separated declarations
+-- [PUBLIC]: parser for comma-separated task/function port declarations
-parseDTsAsDecls :: [DeclToken] -> [Decl]
+parseDTsAsTFDecls :: [DeclToken] -> [Decl]
-parseDTsAsDecls tokens =
+parseDTsAsTFDecls = parseDTsAsDecls Input ModeDefault
-    forbidNonEqAsgn tokens $
-    concat $ map finalize $ parseDTsAsComponents tokens
 
 
--- [PUBLIC]: used for "single" declarations, i.e., declarations appearing
+-- [PUBLIC]; used for "single" declarations, i.e., declarations appearing
 -- outside of a port list
 parseDTsAsDecl :: [DeclToken] -> [Decl]
-parseDTsAsDecl tokens =
+parseDTsAsDecl = parseDTsAsDecls Local ModeSingle
-    forbidNonEqAsgn tokens $
-    if length components /= 1
-        then error $ "too many declarations: " ++ (show tokens)
-        else finalize $ head components
-    where components = parseDTsAsComponents tokens
 
 
 -- [PUBLIC]: parser for single block item declarations or assign or arg-less
--- subroutine call statetments
+-- subroutine call statements
-parseDTsAsDeclOrAsgn :: [DeclToken] -> ([Decl], [Stmt])
+parseDTsAsDeclOrStmt :: [DeclToken] -> ([Decl], [Stmt])
-parseDTsAsDeclOrAsgn [DTIdent     f] = ([], [Subroutine (Ident     f) (Args [] [])])
+parseDTsAsDeclOrStmt tokens =
-parseDTsAsDeclOrAsgn [DTPSIdent p f] = ([], [Subroutine (PSIdent p f) (Args [] [])])
+    if declLookahead tokens
-parseDTsAsDeclOrAsgn tokens =
+        then (parseDTsAsDecl tokens, [])
-    if (isStmt (last tokens) || tripLookahead tokens) && maybeLhs /= Nothing
+        else ([], parseDTsAsStmt $ shiftIncOrDec tokens)
-        then ([], [stmt])
+
-        else (parseDTsAsDecl tokens, [])
+-- check if the necessary tokens for a complete declaration exist at the
+-- beginning of the given token list
+declLookahead :: [DeclToken] -> Bool
+declLookahead l0 =
+    length l0 /= length l6 && tripLookahead l6
     where
-        stmt = case last tokens of
+        (_, l1) = takeDir      l0 Local
-            DTAsgn     op e -> AsgnBlk op lhs e
+        (_, l2) = takeLifetime l1
-            DTAsgnNBlk mt e -> Asgn    mt lhs e
+        (_, l3) = takeConst    l2
-            DTInstance args -> Subroutine (lhsToExpr lhs) (instanceToArgs args)
+        (_, l4) = takeVarOrNet l3
-            _ -> error $ "invalid block item decl or stmt: " ++ (show tokens)
+        (_, l5) = takeType     l4
-        maybeLhs = takeLHS $ init tokens
+        (_, l6) = takeRanges   l5
-        Just lhs = maybeLhs
+
-        isStmt :: DeclToken -> Bool
+-- internal; parser for leading statements in a procedural block
-        isStmt (DTAsgnNBlk{}) = True
+parseDTsAsStmt :: [DeclToken] -> [Stmt]
-        isStmt (DTAsgn{}) = True
+parseDTsAsStmt (tok@(DTSeverity _ severity) : toks) =
-        isStmt (DTInstance{}) = True
+    [traceStmt tok, SeverityStmt severity args]
-        isStmt _ = False
+    where
+        args = case init toks of
+            [] -> []
+            [DTPorts _ ports] -> portsToExprs (head toks) ports
+            extraTok : _ -> parseError extraTok "unexpected severity task token"
+parseDTsAsStmt l0 =
+    [traceStmt $ head l0, stmt]
+    where
+        (lhs, _) = takeLHS l0
+        (expr, l1) = takeExpr l0
+        stmt = case init l1 of
+            [DTAsgn _ op mt e] -> Asgn op mt lhs e
+            [DTPorts _ ports] -> Subroutine expr (portsToArgs ports)
+            [] -> Subroutine expr (Args [] [])
+            tok : _ -> parseError tok "unexpected statement token"
+
+traceStmt :: DeclToken -> Stmt
+traceStmt tok = CommentStmt $ "Trace: " ++ show (tokPos tok)
+
+-- read the given tokens as the root of a subroutine invocation
+takeExpr :: [DeclToken] -> (Expr, [DeclToken])
+takeExpr (DTPSIdent _ p   x : toks) = (PSIdent p   x, toks)
+takeExpr (DTCSIdent _ c p x : toks) = (CSIdent c p x, toks)
+takeExpr toks = (lhsToExpr lhs, rest)
+    where (lhs, rest) = takeLHS toks
 
 -- converts port bindings to call args
-instanceToArgs :: [PortBinding] -> Args
+portsToArgs :: [PortBinding] -> Args
-instanceToArgs bindings =
+portsToArgs bindings =
     Args pnArgs kwArgs
     where
         (pnBindings, kwBindings) = partition (null . fst) bindings
         pnArgs = map snd pnBindings
         kwArgs = kwBindings
 
+-- converts port bindings to a list of expressions
+portsToExprs :: DeclToken -> [PortBinding] -> [Expr]
+portsToExprs tok bindings =
+    case portsToArgs bindings of
+        Args args [] -> args
+        _ -> parseError tok "unexpected keyword argument"
+
 -- [PUBLIC]: parser for comma-separated declarations or assignment lists; this
 -- is only used for `for` loop initialization lists
 parseDTsAsDeclsOrAsgns :: [DeclToken] -> Either [Decl] [(LHS, Expr)]
 parseDTsAsDeclsOrAsgns tokens =
-    forbidNonEqAsgn tokens $
+    if declLookahead tokens
-    if hasLeadingAsgn || tripLookahead tokens
+        then Left $ parseDTsAsDecls Local ModeForLoop tokens
-        then Right $ parseDTsAsAsgns tokens
+        else Right $ parseDTsAsAsgns $ shiftIncOrDec tokens
-        else Left  $ parseDTsAsDecls tokens
-    where
-        hasLeadingAsgn =
-            -- if there is an asgn token before the next comma
-            case (elemIndex DTComma tokens, findIndex isAsgnToken tokens) of
-                (Just a, Just b) -> a > b
-                (Nothing, Just _) -> True
-                _ -> False
 
 -- internal parser for basic assignment lists
 parseDTsAsAsgns :: [DeclToken] -> [(LHS, Expr)]
 parseDTsAsAsgns tokens =
-    case l1 of
+    if not (isAsgn asgnTok) then
-        [] -> [asgn]
+        parseError asgnTok "expected assignment operator"
-        DTComma : remaining -> asgn : parseDTsAsAsgns remaining
+    else if mt /= Nothing then
-        _ -> error $ "bad assignment tokens: " ++ show tokens
+        unexpected "timing modifier"
+    else (lhs, expr) : case head remaining of
+        DTEnd{} -> []
+        DTComma{} -> parseDTsAsAsgns $ tail remaining
+        tok -> parseError tok "expected ',' or ';'"
     where
-        (lhsToks, l0) = break isDTAsgn tokens
+        (lhs, asgnTok : remaining) = takeLHS tokens
-        lhs = case takeLHS lhsToks of
+        DTAsgn _ op mt rhs = asgnTok
-            Nothing -> error $ "could not parse as LHS: " ++ show lhsToks
+        expr = case op of
-            Just l -> l
+            AsgnOpEq -> rhs
-        DTAsgn AsgnOpEq expr : l1 = l0
+            AsgnOpNonBlocking -> unexpected "non-blocking assignment"
-        asgn = (lhs, expr)
+            AsgnOp binop -> BinOp binop (lhsToExpr lhs) rhs
 
-        isDTAsgn :: DeclToken -> Bool
+        unexpected surprise = parseError asgnTok $
-        isDTAsgn (DTAsgn _ _) = True
+            "unexpected " ++ surprise ++ " in for loop initialization"
-        isDTAsgn _ = False
 
-isAsgnToken :: DeclToken -> Bool
+shiftIncOrDec :: [DeclToken] -> [DeclToken]
-isAsgnToken (DTBit             _) = True
+shiftIncOrDec (tok@(DTAsgn _ AsgnOp{} _ _) : toks) =
-isAsgnToken (DTConcat          _) = True
+    before ++ tok : delim : shiftIncOrDec after
-isAsgnToken (DTStream      _ _ _) = True
+    where (before, delim : after) = break isCommaOrEnd toks
-isAsgnToken (DTDot             _) = True
+shiftIncOrDec [] = []
-isAsgnToken (DTAsgnNBlk      _ _) = True
+shiftIncOrDec toks =
-isAsgnToken (DTAsgn (AsgnOp _) _) = True
+    before ++ delim : shiftIncOrDec after
-isAsgnToken _ = False
+    where (before, delim : after) = break isCommaOrEnd toks
 
-takeLHS :: [DeclToken] -> Maybe LHS
+takeLHS :: [DeclToken] -> (LHS, [DeclToken])
-takeLHS [] = Nothing
+takeLHS tokens = takeLHSStep (takeLHSStart tok) toks
-takeLHS (t : ts) =
+    where tok : toks = tokens
-    foldl takeLHSStep (takeLHSStart t) ts
 
-takeLHSStart :: DeclToken -> Maybe LHS
+takeLHSStart :: DeclToken -> LHS
-takeLHSStart (DTConcat     lhss) = Just $ LHSConcat lhss
+takeLHSStart (DTLHSBase _ lhs) = lhs
-takeLHSStart (DTStream o e lhss) = Just $ LHSStream o e lhss
+takeLHSStart (DTIdent _ x) = LHSIdent x
-takeLHSStart (DTIdent  x       ) = Just $ LHSIdent x
+takeLHSStart tok = parseError tok "expected primary token or type"
-takeLHSStart _ = Nothing
 
-takeLHSStep :: Maybe LHS -> DeclToken -> Maybe LHS
+takeLHSStep :: LHS -> [DeclToken] -> (LHS, [DeclToken])
-takeLHSStep (Just curr) (DTBit    e   ) = Just $ LHSBit   curr e
+takeLHSStep curr (DTBit   _ e   : toks) = takeLHSStep (LHSBit   curr e  ) toks
-takeLHSStep (Just curr) (DTRange (m,r)) = Just $ LHSRange curr m r
+takeLHSStep curr (DTRange _ m r : toks) = takeLHSStep (LHSRange curr m r) toks
-takeLHSStep (Just curr) (DTDot    x   ) = Just $ LHSDot curr x
+takeLHSStep curr (DTDot   _ x   : toks) = takeLHSStep (LHSDot   curr x  ) toks
-takeLHSStep _ _ = Nothing
+takeLHSStep lhs toks = (lhs, toks)
 
+type DeclBase = Identifier -> [Range] -> Expr -> Decl
+type Triplet = (Identifier, [Range], Expr)
 
--- batches together seperate declaration lists
+data Mode
-type Triplet = (Identifier, [Range], Maybe Expr)
+    = ModeForLoop -- initialization always required
-type Component = (Direction, Type, [Triplet])
+    | ModeSingle -- single declaration (not port list)
-finalize :: Component -> [Decl]
+    | ModeDefault -- comma separated, multiple declarations
-finalize (dir, typ, trips) =
+    deriving Eq
-    map (\(x, a, me) -> Variable dir typ x a me) trips
-
 
 -- internal; entrypoint of the critical portion of our parser
-parseDTsAsComponents :: [DeclToken] -> [Component]
+parseDTsAsDecls :: Direction -> Mode -> [DeclToken] -> [Decl]
-parseDTsAsComponents [] = []
+parseDTsAsDecls backupDir mode l0 =
-parseDTsAsComponents tokens =
+    if l /= Nothing && l /= Just Automatic then
-    component : parseDTsAsComponents tokens'
+        parseError (head l1) "unexpected non-automatic lifetime"
+    else if dir == Local && isImplicit t && not (isNet $ head l3) then
+        parseError (head l0) "declaration missing type information"
+    else if null l7 then
+        decls
+    else if mode == ModeSingle then
+        parseError (head l7) "unexpected token in declaration"
+    else
+        decls ++ parseDTsAsDecls dir mode l7
     where
-        (component, tokens') = parseDTsAsComponent tokens
+        initReason
-
+            | hasDriveStrength (head l3) = "net with drive strength"
-parseDTsAsComponent :: [DeclToken] -> (Component, [DeclToken])
+            | mode == ModeForLoop = "for loop"
-parseDTsAsComponent [] = error "parseDTsAsComponent unexpected end of tokens"
+            | con = "const"
-parseDTsAsComponent l0 =
+            | otherwise = ""
-    if l /= Nothing && l /= Just Automatic
+        (dir, l1) = takeDir      l0 backupDir
-        then error $ "unexpected non-automatic lifetime: " ++ show l0
-        else (component, l5)
-    where
-        (dir, l1) = takeDir      l0
         (l  , l2) = takeLifetime l1
-        (tf , l3) = takeType     l2
+        (con, l3) = takeConst    l2
-        (rs , l4) = takeRanges   l3
+        (von, l4) = takeVarOrNet l3
-        (tps, l5) = takeTrips    l4 True
+        (tf , l5) = takeType     l4
-        component = (dir, tf rs, tps)
+        (rs , l6) = takeRanges   l5
+        (tps, l7) = takeTrips    l6 initReason
+        base = von dir t
+        t = tf rs
+        decls =
+            traceComment l0 :
+            map (\(x, a, e) -> base x a e) tps
 
+traceComment :: [DeclToken] -> Decl
+traceComment = CommentDecl . ("Trace: " ++) . show . tokPos . head
 
-takeTrips :: [DeclToken] -> Bool -> ([Triplet], [DeclToken])
+hasDriveStrength :: DeclToken -> Bool
-takeTrips [] True = error "incomplete declaration"
+hasDriveStrength (DTNet _ _ DriveStrength{}) = True
-takeTrips [] False = ([], [])
+hasDriveStrength _ = False
-takeTrips l0 force =
+
-    if not force && not (tripLookahead l0)
+isImplicit :: Type -> Bool
-        then ([], l0)
+isImplicit Implicit{} = True
-        else (trip : trips, l5)
+isImplicit _ = False
+
+takeTrips :: [DeclToken] -> String -> ([Triplet], [DeclToken])
+takeTrips l0 initReason =
+    (trip : trips, l5)
     where
         (x, l1) = takeIdent  l0
         (a, l2) = takeRanges l1
-        (me, l3) = takeAsgn   l2
+        (e, l3) = takeAsgn   l2 initReason
-        (_ , l4) = takeComma  l3
+        l4 = takeCommaOrEnd  l3
-        trip = (x, a, me)
+        trip = (x, a, e)
-        (trips, l5) = takeTrips l4 False
+        (trips, l5) =
+            if tripLookahead l4
+                then takeTrips l4 initReason
+                else ([], l4)
 
 tripLookahead :: [DeclToken] -> Bool
-tripLookahead [] = False
 tripLookahead l0 =
+    not (null l0) &&
     -- every triplet *must* begin with an identifier
-    if not (isIdent $ head l0) then
+    isIdent (head l0) &&
-        False
+    -- expecting to see a comma or the ending token after the identifier and
-    -- if the identifier is the last token, or if it assigned a value, then we
+    -- optional ranges and/or assignment
-    -- know we must have a valid triplet ahead
+    isCommaOrEnd (head l3)
-    else if null l1 || asgn /= Nothing then
-        True
-    -- if there is an ident followed by some number of ranges, and that's it,
-    -- then there is a trailing declaration of an array ahead
-    else if (not $ null l1) && (null l2) then
-        True
-    -- if there is a comma after the identifier (and optional ranges and
-    -- assignment) that we're looking at, then we know this identifier is not a
-    -- type name, as type names must be followed by a first identifier before a
-    -- comma or the end of the list
-    else
-        (not $ null l3) && (head l3 == DTComma)
     where
         (_, l1) = takeIdent  l0
         (_, l2) = takeRanges l1
-        (asgn, l3) = takeAsgn   l2
+        (_, l3) = takeAsgn   l2 ""
 
-takeDir :: [DeclToken] -> (Direction, [DeclToken])
+
-takeDir (DTDir dir : rest) = (dir  , rest)
+-- [PUBLIC]: parser for parameter lists in headers of modules, interfaces, etc.
-takeDir              rest  = (Local, rest)
+parseDTsAsParams :: [DeclToken] -> [Decl]
+parseDTsAsParams = parseDTsAsParams' Parameter . dropTrailingComma
+
+-- internal variant of the above, used recursively after the optional trailing
+-- comma has been removed
+parseDTsAsParams' :: ParamScope -> [DeclToken] -> [Decl]
+parseDTsAsParams' _ [] = []
+parseDTsAsParams' prevParamScope l0 =
+    nextStep paramScope l2
+    where
+        nextStep = if isParamType
+            then parseDTsAsParamType
+            else parseDTsAsParam
+        (paramScope , l1) = takeParamScope l0 prevParamScope
+        (isParamType, l2) = takeParamType  l1
+
+-- parse one or more regular parameter declarations at the beginning of the decl
+-- token list before continuing on to subsequent declarations
+parseDTsAsParam :: ParamScope -> [DeclToken] -> [Decl]
+parseDTsAsParam paramScope l0 =
+    traceComment l0 :
+    map base tps ++
+    parseDTsAsParams' paramScope l3
+    where
+        (tfO, l1) = takeType   l0
+        (rsO, l2) = takeRanges l1
+        (tps, l3) = takeTrips  l2 ""
+        base :: Triplet -> Decl
+        (tf, rs) = typeRanges $ tfO rsO -- for packing tolerance
+        base (x, a, e) = Param paramScope (tf $ a ++ rs) x e
+
+-- parse a single type parameter declaration at the beginning of the decl token
+-- list before continuing on to subsequent declarations
+parseDTsAsParamType :: ParamScope -> [DeclToken] -> [Decl]
+parseDTsAsParamType paramScope l0 =
+    traceComment l0 :
+    ParamType paramScope x t :
+    nextStep paramScope l3
+    where
+        nextStep = if typeAsgnLookahead l3
+            then parseDTsAsParamType
+            else parseDTsAsParams'
+        (x, l1) = takeIdent    l0
+        (t, l2) = takeTypeAsgn l1
+        l3 = takeCommaOrEnd    l2
+
+-- take the optional default value assignment for a type parameter declaration;
+-- note that aliases are parsed as regular assignments to avoid conflicts, and
+-- so are converted to types when encountered
+takeTypeAsgn :: [DeclToken] -> (Type, [DeclToken])
+takeTypeAsgn (DTTypeAsgn _ : l0) =
+    (tf rs, l2)
+    where
+        (tf, l1) = takeType   l0
+        (rs, l2) = takeRanges l1
+takeTypeAsgn (DTAsgn pos AsgnOpEq Nothing expr : toks) =
+    case exprToType expr of
+        Nothing -> parseError pos "unexpected non-type parameter assignment"
+        Just t -> (t, toks)
+takeTypeAsgn toks = (UnknownType, toks)
+
+-- check whether the front of the tokens could plausibly form a type parameter
+-- declaration and optional assignment; type parameter declaration assignments
+-- can only be "escaped" using an explicit non-type parameter/localparam keyword
+typeAsgnLookahead :: [DeclToken] -> Bool
+typeAsgnLookahead l0 =
+    not (null l0) &&
+    -- every type assignment *must* begin with an identifier
+    isIdent (head l0) &&
+    -- expecting to see a comma or the ending token after the identifier and
+    -- optional assignment
+    isCommaOrEnd (head l2)
+    where
+        (_, l1) = takeIdent    l0
+        (_, l2) = takeTypeAsgn l1
+
+
+takeDir :: [DeclToken] -> Direction -> (Direction, [DeclToken])
+takeDir (DTDir _ dir : rest) _   = (dir, rest)
+takeDir                rest  dir = (dir, rest)
 
 takeLifetime :: [DeclToken] -> (Maybe Lifetime, [DeclToken])
-takeLifetime (DTLifetime l : rest) = (Just  l, rest)
+takeLifetime (DTLifetime _ l : rest) = (Just  l, rest)
 takeLifetime                   rest  = (Nothing, rest)
 
+takeConst :: [DeclToken] -> (Bool, [DeclToken])
+takeConst (DTConst{} : DTConst pos : _) =
+    parseError pos "duplicate const modifier"
+takeConst (DTConst pos : DTNet _ typ _ : _) =
+    parseError pos $ show typ ++ " cannot be const"
+takeConst (DTConst{} : tokens) = (True, tokens)
+takeConst tokens = (False, tokens)
+
+takeVarOrNet :: [DeclToken] -> (Direction -> Type -> DeclBase, [DeclToken])
+takeVarOrNet (DTNet{} : DTVar pos : _) =
+    parseError pos "unexpected var after net type"
+takeVarOrNet (DTNet pos n s : tokens) =
+    if n /= TTrireg && isChargeStrength s
+        then parseError pos "only trireg can have a charge strength"
+        else (\d -> Net d n s, tokens)
+    where
+        isChargeStrength :: Strength -> Bool
+        isChargeStrength ChargeStrength{} = True
+        isChargeStrength _ = False
+takeVarOrNet tokens = (Variable, tokens)
+
 takeType :: [DeclToken] -> ([Range] -> Type, [DeclToken])
-takeType (DTIdent a  : DTDot b      : rest) = (InterfaceT a (Just b), rest)
+takeType (DTIdent _ a  : DTDot _ b      : rest) = (InterfaceT a  b      , rest)
-takeType (DTType  tf : DTSigning sg : rest) = (tf       sg          , rest)
+takeType (DTType  _ tf : DTSigning _ sg : rest) = (tf       sg          , rest)
-takeType (DTType  tf                : rest) = (tf       Unspecified , rest)
+takeType (DTType  _ tf                  : rest) = (tf       Unspecified , rest)
-takeType (DTSigning sg              : rest) = (Implicit sg          , rest)
+takeType (DTSigning _ sg                : rest) = (Implicit sg          , rest)
-takeType (DTPSIdent ps tn           : rest) = (Alias (Just ps) tn   , rest)
+takeType (DTPSIdent _ ps    tn          : rest) = (PSAlias ps    tn     , rest)
-takeType (DTIdent tn                : rest) =
+takeType (DTCSIdent _ ps pm tn          : rest) = (CSAlias ps pm tn     , rest)
+takeType (DTIdent pos tn                : rest) =
     if couldBeTypename
-        then (Alias (Nothing) tn  ,              rest)
+        then (Alias tn            ,                  rest)
-        else (Implicit Unspecified, DTIdent tn : rest)
+        else (Implicit Unspecified, DTIdent pos tn : rest)
     where
         couldBeTypename =
-            case (findIndex isIdent rest, elemIndex DTComma rest) of
+            case (findIndex isIdent rest, findIndex isComma rest) of
                 -- no identifiers left => no decl asgns
                 (Nothing, _) -> False
                 -- an identifier is left, and no more commas
                 (_, Nothing) -> True
                 -- if comma is first, then this ident is a declaration
                 (Just a, Just b) -> a < b
+takeType (DTVar{} : DTVar pos : _) =
+    parseError pos "duplicate var modifier"
+takeType (DTVar _ : rest) =
+    case tf [] of
+        Implicit sg [] -> (IntegerVector TLogic sg, rest')
+        _ -> (tf, rest')
+    where (tf, rest') = takeType rest
 takeType rest = (Implicit Unspecified, rest)
 
 takeRanges :: [DeclToken] -> ([Range], [DeclToken])
-takeRanges [] = ([], [])
+takeRanges tokens =
-takeRanges (token : tokens) =
+    case head tokens of
-    case token of
+        DTRange _ NonIndexed r -> (r         : rs, rest)
-        DTRange (NonIndexed, r) -> (r         : rs, rest          )
+        DTBit   _ s            -> (asRange s : rs, rest)
-        DTBit   s               -> (asRange s : rs, rest          )
+        DTAutoDim _            ->
-        DTAutoDim               ->
+            case head $ tail tokens of
-            case rest of
+                DTAsgn _ AsgnOpEq Nothing (Pattern l) -> autoDim l
-                (DTAsgn AsgnOpEq (Pattern l) : _) -> autoDim l
+                DTAsgn _ AsgnOpEq Nothing (Concat  l) -> autoDim l
-                (DTAsgn AsgnOpEq (Concat  l) : _) -> autoDim l
+                _ -> ([], tokens)
-                _ ->               ([]            , token : tokens)
+        _ -> ([], tokens)
-        _                       -> ([]            , token : tokens)
     where
-        (rs, rest) = takeRanges tokens
+        (rs, rest) = takeRanges $ tail tokens
-        asRange s = (Number "0", BinOp Sub s (Number "1"))
+        asRange s = (RawNum 0, BinOp Sub s (RawNum 1))
         autoDim :: [a] -> ([Range], [DeclToken])
         autoDim l =
             ((lo, hi) : rs, rest)
             where
                 n = length l
-                lo = Number "0"
+                lo = RawNum 0
-                hi = Number $ show (n - 1)
+                hi = RawNum $ fromIntegral $ n - 1
 
--- Matching DTAsgnNBlk here allows tripLookahead to work both for standard
+takeAsgn :: [DeclToken] -> String -> (Expr, [DeclToken])
--- declarations and in `parseDTsAsDeclOrAsgn`, where we're checking for an
+takeAsgn (DTAsgn pos op mt e : rest) _ =
--- assignment assignment statement. The other entry points disallow
+    if op == AsgnOpNonBlocking then
--- `DTAsgnNBlk`, so this doesn't liberalize the parser.
+        unexpected "non-blocking assignment operator"
-takeAsgn :: [DeclToken] -> (Maybe Expr, [DeclToken])
+    else if op /= AsgnOpEq then
-takeAsgn (DTAsgn AsgnOpEq e : rest) = (Just e , rest)
+        unexpected "binary assignment operator"
-takeAsgn (DTAsgnNBlk    _ e : rest) = (Just e , rest)
+    else if mt /= Nothing then
-takeAsgn                 rest  = (Nothing, rest)
+        unexpected "timing modifier"
+    else
+        (e, rest)
+    where
+        unexpected surprise =
+            parseError pos $ "unexpected " ++ surprise ++ " in declaration"
+takeAsgn rest "" = (Nil, rest)
+takeAsgn toks initReason =
+    parseError (head toks) $
+        initReason ++ " declaration is missing initialization"
 
-takeComma :: [DeclToken] -> (Bool, [DeclToken])
+takeCommaOrEnd :: [DeclToken] -> [DeclToken]
-takeComma [] = (False, [])
+takeCommaOrEnd tokens =
-takeComma (DTComma : rest) = (True, rest)
+    if isCommaOrEnd tok
-takeComma toks = error $ "expected comma or end of decl, got: " ++ show toks
+        then toks
+        else parseError tok "expected comma or end of declarations"
+    where tok : toks = tokens
 
 takeIdent :: [DeclToken] -> (Identifier, [DeclToken])
-takeIdent (DTIdent x : rest) = (x, rest)
+takeIdent (DTIdent _ x : rest) = (x, rest)
-takeIdent tokens = error $ "takeIdent didn't find identifier: " ++ show tokens
+takeIdent tokens = parseError (head tokens) "expected identifier"
 
 
+takeParamScope :: [DeclToken] -> ParamScope -> (ParamScope, [DeclToken])
+takeParamScope (DTParamKW _ psc : toks) _   = (psc, toks)
+takeParamScope                    toks  psc = (psc, toks)
+
+takeParamType :: [DeclToken] -> (Bool, [DeclToken])
+takeParamType (DTTypeDecl _ : toks) = (True , toks)
+takeParamType                 toks  = (False, toks)
+
+
+isAttr :: DeclToken -> Bool
+isAttr DTAttr{} = True
+isAttr _ = False
+
+isAsgn :: DeclToken -> Bool
+isAsgn DTAsgn{} = True
+isAsgn _ = False
+
 isIdent :: DeclToken -> Bool
-isIdent (DTIdent _) = True
+isIdent DTIdent{} = True
 isIdent _ = False
+
+isComma :: DeclToken -> Bool
+isComma DTComma{} = True
+isComma _ = False
+
+isCommaOrEnd :: DeclToken -> Bool
+isCommaOrEnd DTEnd{} = True
+isCommaOrEnd tok = isComma tok
+
+isPorts :: DeclToken -> Bool
+isPorts DTPorts{} = True
+isPorts _ = False
+
+isNet :: DeclToken -> Bool
+isNet DTNet{} = True
+isNet _ = False
+
+tokPos :: DeclToken -> Position
+tokPos (DTComma    p) = p
+tokPos (DTAutoDim  p) = p
+tokPos (DTConst    p) = p
+tokPos (DTVar      p) = p
+tokPos (DTAsgn     p _ _ _) = p
+tokPos (DTRange    p _ _) = p
+tokPos (DTIdent    p _) = p
+tokPos (DTPSIdent  p _ _) = p
+tokPos (DTCSIdent  p _ _ _) = p
+tokPos (DTDir      p _) = p
+tokPos (DTType     p _) = p
+tokPos (DTNet      p _ _) = p
+tokPos (DTParams   p _) = p
+tokPos (DTPorts    p _) = p
+tokPos (DTBit      p _) = p
+tokPos (DTLHSBase  p _) = p
+tokPos (DTDot      p _) = p
+tokPos (DTSigning  p _) = p
+tokPos (DTSeverity p _) = p
+tokPos (DTLifetime p _) = p
+tokPos (DTAttr     p _) = p
+tokPos (DTEnd      p _) = p
+tokPos (DTParamKW  p _) = p
+tokPos (DTTypeDecl p) = p
+tokPos (DTTypeAsgn p) = p
+
+class Loc t where
+    parseError :: t -> String -> a
+
+instance Loc Position where
+    parseError pos msg = error $ show pos ++ ": Parse error: " ++ msg
+
+instance Loc DeclToken where
+    parseError = parseError . tokPos

src/Language/SystemVerilog/Parser/Preprocess.hs

@@ -0,0 +1,980 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - SystemVerilog Preprocessor
+ -
+ - This preprocessor handles all preprocessor directives and produces an output
+ - stream that is tagged with the effective source position of resulting
+ - characters.
+ -}
+module Language.SystemVerilog.Parser.Preprocess
+    ( preprocess
+    , annotate
+    , Env
+    , Contents
+    ) where
+
+import Control.Monad (when)
+import Control.Monad.Except
+import Control.Monad.State.Strict
+import Data.Char (ord)
+import Data.List (tails, isPrefixOf, findIndex, intercalate)
+import Data.Maybe (isJust, fromJust)
+import GHC.IO.Encoding.Failure (CodingFailureMode(TransliterateCodingFailure))
+import GHC.IO.Encoding.UTF8 (mkUTF8)
+import System.Directory (findFile)
+import System.FilePath (dropFileName)
+import System.IO (hGetContents, hSetEncoding, openFile, stdin, IOMode(ReadMode))
+import qualified Data.Map.Strict as Map
+
+import Language.SystemVerilog.Parser.Tokens (Position(..))
+
+type Env = Map.Map String (String, [(String, Maybe String)])
+type Contents = [(Char, Position)]
+
+type PPS = StateT PP (ExceptT String IO)
+
+data PP = PP
+    { ppInput        :: String -- current input string
+    , ppOutput       :: [(Char, Position)] -- preprocessor output (in reverse)
+    , ppPosition     :: Position -- current file position
+    , ppFilePath     :: FilePath -- currently active filename
+    , ppEnv          :: Env -- active macro definitions
+    , ppCondStack    :: [Level] -- if-else cascade state
+    , ppIncludePaths :: [FilePath] -- folders to search for includes
+    , ppMacroStack   :: [[(String, String)]] -- arguments for in-progress macro expansions
+    , ppIncludeStack :: [(FilePath, Env)] -- in-progress includes for loop detection
+    }
+
+-- if-else cascade level state and error information
+data Level = Level
+    { cfDesc :: String -- text of the directive, e.g., "ifdef FOO"
+    , cfPos :: Position -- location where this level started
+    , cfCond :: Cond -- whether or not this level is as has been satisfied
+    }
+
+-- keeps track of the state of an if-else cascade level
+data Cond
+    = CurrentlyTrue -- an active if/elsif/else branch (condition is met)
+    | PreviouslyTrue -- an inactive else/elsif block due to an earlier if/elsif
+    | NeverTrue -- an inactive if/elsif block; a subsequent else will be met
+    deriving Eq
+
+-- update a Cond for an `else block, where this block is active if and only if
+-- no previous block was active
+elseCond :: Cond -> Cond
+elseCond NeverTrue = CurrentlyTrue
+elseCond _ = NeverTrue
+
+-- generate a Cond for an `if/`elsif that is not part of a PreviouslyTrue chain
+ifCond :: Bool -> Cond
+ifCond True = CurrentlyTrue
+ifCond False = NeverTrue
+
+-- update a Cond for an `elsif block. The boolean argument is whether the
+-- `elsif block's test is true.
+elsifCond :: Bool -> Cond -> Cond
+elsifCond defined c =
+    case c of
+        NeverTrue -> ifCond defined
+        _ -> PreviouslyTrue
+
+-- preprocessor entrypoint
+preprocess :: [String] -> Env -> FilePath -> ExceptT String IO (Env, Contents)
+preprocess includePaths env path = do
+    contents <- liftIO $ loadFile path
+    let initialState = PP
+            { ppInput        = contents
+            , ppOutput       = []
+            , ppPosition     = Position path 1 1
+            , ppFilePath     = path
+            , ppEnv          = env
+            , ppCondStack    = []
+            , ppIncludePaths = includePaths
+            , ppMacroStack   = []
+            , ppIncludeStack = [(path, env)]
+            }
+    finalState <- execStateT (preprocessInput >> checkConds) initialState
+    let env' = ppEnv finalState
+    let output = reverse $ ppOutput finalState
+    return (env', output)
+
+checkConds :: PPS ()
+checkConds = do
+    condStack <- getCondStack
+    when (not $ null condStack) $ do
+        let level = head condStack
+        lexicalError $ "unfinished conditional directive `" ++ cfDesc level ++
+            " started at " ++ show (cfPos level)
+
+-- position annotator entrypoint used for files that don't need any
+-- preprocessing
+annotate :: FilePath -> ExceptT String IO Contents
+annotate path = do
+    contents <- liftIO $ loadFile path
+    let positions = scanl advance (Position path 1 1) contents
+    return $ zip contents positions
+
+-- read in the given file
+loadFile :: FilePath -> IO String
+loadFile path = do
+    handle <-
+        if path == "-"
+            then return stdin
+            else openFile path ReadMode
+    hSetEncoding handle $ mkUTF8 TransliterateCodingFailure
+    contents <- hGetContents handle
+    return $ normalize contents
+
+-- removes carriage returns before newlines
+normalize :: String -> String
+normalize ('\r' : '\n' : rest) = '\n' : (normalize rest)
+normalize (ch : chs) = ch : (normalize chs)
+normalize [] = []
+
+-- find the given file for inclusion
+includeSearch :: FilePath -> PPS FilePath
+includeSearch file = do
+    base <- getFilePath
+    includePaths <- gets ppIncludePaths
+    let directories = dropFileName base : includePaths
+    result <- liftIO $ findFile directories file
+    case result of
+        Just path -> return path
+        Nothing -> lexicalError $ "Could not find file " ++ show file ++
+                        ", included from " ++ show base
+
+lexicalError :: String -> PPS a
+lexicalError msg = do
+    pos <- getPosition
+    lift $ throwError $ show pos ++ ": Lexical error: " ++ msg
+
+-- input accessors
+setInput :: String -> PPS ()
+setInput x = modify $ \s -> s { ppInput = x }
+getInput :: PPS String
+getInput = gets ppInput
+-- output accessors
+setOutput :: [(Char, Position)] -> PPS ()
+setOutput x = modify $ \s -> s { ppOutput = x }
+getOutput :: PPS [(Char, Position)]
+getOutput = gets ppOutput
+-- position accessors
+getPosition :: PPS Position
+getPosition = gets ppPosition
+setPosition :: Position -> PPS ()
+setPosition x = modify $ \s -> s { ppPosition = x }
+-- file path accessors
+getFilePath :: PPS FilePath
+getFilePath = gets ppFilePath
+setFilePath :: String -> PPS ()
+setFilePath x = modify $ \s -> s { ppFilePath = x }
+-- environment accessors
+getEnv :: PPS Env
+getEnv = gets ppEnv
+setEnv :: Env -> PPS ()
+setEnv x = modify $ \s -> s { ppEnv = x }
+-- cond stack accessors
+getCondStack :: PPS [Level]
+getCondStack = gets ppCondStack
+setCondStack :: [Level] -> PPS ()
+setCondStack x = modify $ \s -> s { ppCondStack = x }
+-- macro stack accessors
+getMacroStack :: PPS [[(String, String)]]
+getMacroStack = gets ppMacroStack
+setMacroStack :: [[(String, String)]] -> PPS ()
+setMacroStack x = modify $ \s -> s { ppMacroStack = x }
+-- combined input and position accessors
+setBuffer :: (String, Position) -> PPS ()
+setBuffer (x, p) = do
+    setInput x
+    setPosition p
+getBuffer :: PPS (String, Position)
+getBuffer = do
+    x <- getInput
+    p <- getPosition
+    return (x, p)
+
+-- mark the start of an include for include loop detection
+pushIncludeStack :: FilePath -> PPS ()
+pushIncludeStack path = do
+    stack <- gets ppIncludeStack
+    env <- gets ppEnv
+    let entry = (path, env)
+    let stack' = entry : stack
+    if elem entry stack then do
+        let first : rest = reverse $ map fst stack'
+        lexicalError $ "include loop: " ++ show first ++ " includes "
+            ++ intercalate ", which includes " (map show rest)
+    else
+        modify $ \s -> s { ppIncludeStack = stack' }
+
+-- mark the end of an include for include loop detection
+popIncludeStack :: PPS ()
+popIncludeStack = do
+    stack <- gets ppIncludeStack
+    let stack' = tail stack
+    modify $ \s -> s { ppIncludeStack = stack' }
+
+-- Push a condition onto the top of the preprocessor condition stack
+pushCondStack :: String -> String -> Position -> Cond -> PPS ()
+pushCondStack typ name pos cond =
+    getCondStack >>= setCondStack . (level :)
+    where
+        level = Level { cfDesc = desc, cfPos = pos, cfCond = cond }
+        desc = typ ++ if null name then "" else " " ++ name
+
+-- Pop the top from the preprocessor condition stack
+popCondStack :: String -> PPS Level
+popCondStack directive = do
+    cs <- getCondStack
+    case cs of
+        [] -> lexicalError $
+                "`" ++ directive ++ " directive outside of an `if/`endif block"
+        c : cs' -> setCondStack cs' >> return c
+
+isIdentChar :: Char -> Bool
+isIdentChar ch =
+    ('a' <= ch && ch <= 'z') ||
+    ('A' <= ch && ch <= 'Z') ||
+    ('0' <= ch && ch <= '9') ||
+    (ch == '_') || (ch == '$')
+
+-- reads an identifier from the front of the input
+takeIdentifier :: PPS String
+takeIdentifier = do
+    str <- getInput
+    macroStack <- getMacroStack
+    if null macroStack
+        then do
+            let (ident, rest) = span isIdentChar str
+            advancePositions ident
+            setInput rest
+            return ident
+        else takeIdentifierFollow True
+takeIdentifierFollow :: Bool -> PPS String
+takeIdentifierFollow firstPass = do
+    str <- getInput
+    case str of
+        '`' : '`' : '`' : _ -> do
+            '`' <- takeChar
+            '`' <- takeChar
+            process $ handleDirective True
+        '`' : '`' : _ -> do
+            '`' <- takeChar
+            '`' <- takeChar
+            process consumeWithSubstitution
+        _ -> if firstPass
+                then process consumeWithSubstitution
+                else return ""
+    where
+        process :: (PPS ()) -> PPS String
+        process action = do
+            -- save the state
+            outputOrig <- getOutput
+            condStackOrig <- getCondStack
+            -- process this chunk of the identifier
+            setOutput []
+            setCondStack []
+            () <- action
+            outputIdent <- getOutput
+            -- restore the previous state
+            setOutput outputOrig
+            setCondStack condStackOrig
+            -- move on to the next chunk
+            let ident = reverse $ map fst outputIdent
+            identFollow <- takeIdentifierFollow False
+            return $ ident ++ identFollow
+
+-- read tokens after the name until the first (un-escaped) newline
+takeUntilNewline :: PPS String
+takeUntilNewline = do
+    str <- getInput
+    case str of
+        []                 -> return ""
+        '\n' :        _    -> do
+            return ""
+        '/' : '/' : _ -> do
+            remainder <- takeThrough '\n'
+            case last $ init remainder of
+                '\\' -> takeUntilNewline >>= return . (' ' :)
+                _ -> return ""
+        '\\' : '\n' : rest -> do
+            advancePosition '\\'
+            advancePosition '\n'
+            setInput rest
+            takeUntilNewline >>= return . (' ' :)
+        ch   :        rest -> do
+            advancePosition ch
+            setInput rest
+            takeUntilNewline >>= return . (ch :)
+
+-- select characters up to and including the given character
+takeThrough :: Char -> PPS String
+takeThrough goal = do
+    str <- getInput
+    if null str
+        then lexicalError $ "unexpected end of input, looking for " ++ show goal
+        else do
+            ch <- takeChar
+            if ch == goal
+                then return [ch]
+                else do
+                    rest <- takeThrough goal
+                    return $ ch : rest
+
+-- pop one character from the input stream
+takeChar :: PPS Char
+takeChar = do
+    str <- getInput
+    (ch, chs) <-
+        if null str
+            then lexicalError "unexpected end of input"
+            else return (head str, tail str)
+    advancePosition ch
+    setInput chs
+    return ch
+
+-- removes and returns a quoted string such as <foo.bar> or "foo.bar"
+takeQuotedString :: PPS String
+takeQuotedString = do
+    dropSpaces
+    ch <- takeChar
+    end <-
+        case ch of
+            '"' -> return '"'
+            '<' -> return '>'
+            _ -> lexicalError $ "bad beginning of include arg: " ++ (show ch)
+    rest <- takeThrough end
+    let res = ch : rest
+    return res
+
+-- removes and returns a decimal number
+takeNumber :: PPS Int
+takeNumber = do
+    dropSpaces
+    leadCh <- peekChar
+    if '0' <= leadCh && leadCh <= '9'
+        then step 0
+        else lexicalError $ "expected number, but found unexpected char: "
+                ++ show leadCh
+    where
+        step number = do
+            ch <- peekChar
+            if ch == ' ' || ch == '\n' then
+                return number
+            else if '0' <= ch && ch <= '9' then do
+                _ <- takeChar
+                let digit = ord ch - ord '0'
+                step $ number * 10 + digit
+            else
+                lexicalError $ "unexpected char while reading number: "
+                    ++ show ch
+
+peekChar :: PPS Char
+peekChar = do
+    str <- getInput
+    if null str
+        then lexicalError "unexpected end of input"
+        else return $ head str
+
+takeMacroDefinition :: PPS (String, [(String, Maybe String)])
+takeMacroDefinition = do
+    leadCh <- peekChar
+    if leadCh /= '('
+        then do
+            dropSpaces
+            body <- takeUntilNewline
+            return (body, [])
+        else do
+            args <- takeMacroArguments
+            dropSpaces
+            body <- takeUntilNewline
+            argsWithDefaults <- mapM splitArg args
+            return (body, argsWithDefaults)
+    where
+        splitArg :: String -> PPS (String, Maybe String)
+        splitArg [] = lexicalError "macro definition missing argument name"
+        splitArg str =
+            if null name then
+                lexicalError $ "invalid macro definition argument: " ++ show str
+            else if null rest then
+                return (name, Nothing)
+            else if leadCh /= '=' then
+                lexicalError $ "bad char after argument name: " ++ show leadCh
+            else
+                return (name, Just value)
+            where
+                (name, rest) = span isIdentChar str
+                leadCh : after = dropWhile isWhitespaceChar rest
+                value = dropWhile isWhitespaceChar after
+
+-- commas and right parens are forbidden outside matched pairs of: (), [], {},
+-- "", except to delimit arguments or end the list of arguments; see 22.5.1
+takeMacroArguments :: PPS [String]
+takeMacroArguments = do
+    dropWhitespace
+    leadCh <- takeChar
+    if leadCh == '('
+        then argLoop >>= mapM preprocessString
+        else lexicalError $ "expected beginning of macro arguments, but found "
+                ++ show leadCh
+    where
+        argLoop :: PPS [String]
+        argLoop = do
+            dropWhitespace
+            (argRev, isEnd) <- loop "" []
+            let arg = trimAndRev argRev
+            if isEnd
+                then return [arg]
+                else do
+                    rest <- argLoop
+                    return $ arg : rest
+        loop :: String -> [Char] -> PPS (String, Bool)
+        loop curr stack = do
+            ch <- takeChar
+            case (stack, ch) of
+                ([     ], ',') -> return (curr, False)
+                ([     ], ')') -> return (curr, True)
+
+                -- simple quoted strings, allowing escaped quotes
+                ('\\': s, _  ) -> loop (ch : curr) s
+                ('"' : s, '"') -> loop (ch : curr) s
+                ('"' : _,'\\') -> loop (ch : curr) ('\\': stack)
+                ('"' : _, _  ) -> loop (ch : curr) stack
+                (      _, '"') -> loop (ch : curr) ('"' : stack)
+
+                ('[' : s, ']') -> loop (ch : curr) s
+                (      s, '[') -> loop (ch : curr) ('[' : s)
+                ('(' : s, ')') -> loop (ch : curr) s
+                (      s, '(') -> loop (ch : curr) ('(' : s)
+                ('{' : s, '}') -> loop (ch : curr) s
+                (      s, '{') -> loop (ch : curr) ('{' : s)
+
+                (      s, '/') -> do
+                    next <- peekChar
+                    case next of
+                        '/' -> takeChar >> dropLineComment >> loop curr s
+                        '*' -> takeChar >> dropBlockComment >> loop curr s
+                        _ -> loop ('/' : curr) s
+
+                (      s,'\n') -> loop (' ' : curr) s
+                (      s, _  ) -> loop (ch  : curr) s
+
+        trimAndRev = -- drop surrounding whitespace and reverse string
+            dropWhile isWhitespaceChar . reverse . dropWhile isWhitespaceChar
+
+        dropLineComment :: PPS ()
+        dropLineComment = do
+            ch <- takeChar
+            when (ch /= '\n') dropLineComment
+
+        dropBlockComment :: PPS ()
+        dropBlockComment = do
+            ch1 <- takeChar
+            ch2 <- peekChar
+            if ch1 == '*' && ch2 == '/'
+                then takeChar >> return ()
+                else dropBlockComment
+
+defaultMacroArgs :: [Maybe String] -> [String] -> PPS [String]
+defaultMacroArgs [] [] = return []
+defaultMacroArgs [] _ = lexicalError "too many macro arguments given"
+defaultMacroArgs defaults [] = do
+    if all isJust defaults
+        then return $ map fromJust defaults
+        else lexicalError "too few macro arguments given"
+defaultMacroArgs (f : fs) (a : as) = do
+    let arg = if a == "" && isJust f
+            then fromJust f
+            else a
+    args <- defaultMacroArgs fs as
+    return $ arg : args
+
+-- drop spaces in the input until a non-space is reached or EOF
+dropSpaces :: PPS ()
+dropSpaces = do
+    str <- getInput
+    if null str then
+        return ()
+    else do
+        let ch : rest = str
+        if ch == '\t' || ch == ' ' then do
+            advancePosition ch
+            setInput rest
+            dropSpaces
+        else
+            return ()
+
+isWhitespaceChar :: Char -> Bool
+isWhitespaceChar ch = elem ch [' ', '\t', '\n']
+
+-- drop all leading whitespace in the input
+dropWhitespace :: PPS ()
+dropWhitespace = do
+    str <- getInput
+    case str of
+        ch : chs ->
+            when (isWhitespaceChar ch) $ do
+                advancePosition ch
+                setInput chs
+                dropWhitespace
+        [] -> return ()
+
+-- directives that must always be processed even if the current code block is
+-- being excluded; we have to process conditions so we can match them up with
+-- their ending tag, even if they're being skipped
+unskippableDirectives :: [String]
+unskippableDirectives = ["else", "elsif", "endif", "ifdef", "ifndef"]
+
+-- list of all of the supported directive names; used to prevent defining macros
+-- with illegal names
+directives :: [String]
+directives =
+    [ "timescale"
+    , "celldefine"
+    , "endcelldefine"
+    , "unconnected_drive"
+    , "nounconnected_drive"
+    , "default_nettype"
+    , "pragma"
+    , "resetall"
+    , "begin_keywords"
+    , "end_keywords"
+    , "__FILE__"
+    , "__LINE__"
+    , "line"
+    , "include"
+    , "ifdef"
+    , "ifndef"
+    , "else"
+    , "elsif"
+    , "endif"
+    , "define"
+    , "undef"
+    , "undefineall"
+    ]
+
+-- primary preprocessor loop
+preprocessInput :: PPS ()
+preprocessInput = do
+    str <- getInput
+    macroStack <- getMacroStack
+    case str of
+        '/' : '/' : _ -> removeThrough "\n"
+        '/' : '*' : _ ->
+            -- prevent treating `/*/` as self-closing
+            takeChar >> takeChar >>
+            removeThrough "*/"
+        '`' : '"' : _ -> handleBacktickString
+        '"' : _ -> handleString
+        '/' : '`' : '`' : '*' : _ ->
+            if null macroStack
+                then consume
+                else removeThrough "*``/"
+        '`' : '`' : _ -> do
+            if null macroStack
+                then do
+                    consume
+                    consume
+                else do
+                    '`' <- takeChar
+                    '`' <- takeChar
+                    return ()
+        '`' : _ -> handleDirective False
+        _ : _ -> do
+            condStack <- map cfCond <$> getCondStack
+            if null macroStack && all (== CurrentlyTrue) condStack
+                then consumeMany
+                else consumeWithSubstitution
+        [] -> return ()
+    if str == []
+        then return ()
+        else preprocessInput
+
+-- if we are expanding a macro, and the leading tokens form an identifier, then
+-- attempt to replace that identifier with the arguments of this macro, if
+-- applicable; otherwise, just consume the top character
+consumeWithSubstitution :: PPS ()
+consumeWithSubstitution = do
+    str <- getInput
+    macroStack <- getMacroStack
+    if null macroStack then
+        consume
+    else do
+        let (ident, rest) = span isIdentChar str
+        if null ident then
+            consume
+        else do
+            pos <- getPosition
+            let args = head macroStack
+            let chars = case lookup ident args of
+                            Nothing -> ident
+                            Just val -> val
+            pushChars chars pos
+            advancePositions ident
+            setInput rest
+
+-- consume takes the lead input character and pushes it into the output,
+-- advancing the position state and removing the lead character from the input
+consume :: PPS ()
+consume = do
+    ch : chs <- getInput
+    pos <- getPosition
+    advancePosition ch
+    setInput chs
+    pushChar ch pos
+
+-- consumeMany processes chars in a batch until a potential delimiter is reached
+consumeMany :: PPS ()
+consumeMany = do
+    consume -- always consume first character
+    (str, pos) <- getBuffer
+    let (content, rest) = break (flip elem stopChars) str
+    let positions = scanl advance pos content
+    output <- getOutput
+    setOutput $ (reverse $ zip content positions) ++ output
+    setBuffer (rest, last positions)
+    where stopChars = ['`', '"', '/']
+
+-- preprocess a leading string literal; this routine is largely necessary to
+-- avoid doing any macro or directive related manipulations within standard
+-- string literals; it also handles escaped newlines in the string
+handleString :: PPS ()
+handleString = do
+    consume
+    loop
+    where
+        -- processes the remainder of a standard string literal
+        loop :: PPS ()
+        loop = do
+            input <- getInput
+            case input of
+                '"' : _ -> do
+                    consume
+                    -- end of loop!
+                '\\' : '\n' : _ -> do
+                    '\\' <- takeChar
+                    '\n' <- takeChar
+                    loop
+                '\\' : '\\' : _ -> do
+                    consume
+                    consume
+                    loop
+                '\\' : '"' : _ -> do
+                    consume
+                    consume
+                    loop
+                _ : _ -> do
+                    consume
+                    loop
+                [] -> lexicalError "unterminated string literal"
+
+-- preprocess a "backtick string", which begins and ends with a backtick
+-- followed by a slash (`"), and within which macros can be invoked as normal;
+-- otherwise, normal string literal rules apply, except that unescaped quotes
+-- are forbidden, and backticks must be escaped using a backslash to avoid being
+-- interpreted as a macro or marking the end of a string
+handleBacktickString :: PPS ()
+handleBacktickString = do
+    '`' <- takeChar
+    consume
+    loop
+    where
+        -- processes the remainder of a leading backtick string, up to and
+        -- including the ending `"
+        loop :: PPS ()
+        loop = do
+            input <- getInput
+            macroStack <- getMacroStack
+            case input of
+                '`' : '"' : _ -> do
+                    '`' <- takeChar
+                    consume -- ending quote
+                    -- end of loop!
+                '\\' : '`' : _ -> do
+                    '\\' <- takeChar
+                    consume -- now un-escaped backtick
+                    loop
+                '\\' : '\\' : _ -> do
+                    consume
+                    consume
+                    loop
+                '\\' : '"' : _ -> do
+                    consume
+                    consume
+                    loop
+                '\\' : '\n' : _ -> do
+                    '\\' <- takeChar
+                    '\n' <- takeChar
+                    loop
+                '`' : '\\' : '`' : '"' : _ -> do
+                    '`' <- takeChar
+                    consume
+                    '`' <- takeChar
+                    consume
+                    if null macroStack
+                        then lexicalError "`\\`\" is not allowed outside of macros"
+                        else loop
+                '`' : '`' : _ -> do
+                    '`' <- takeChar
+                    '`' <- takeChar
+                    loop
+                '`' : _ -> do
+                    handleDirective True
+                    loop
+                '"' : _ ->
+                    if null macroStack
+                        then lexicalError "unescaped quote in backtick string"
+                        else consume -- end of loop!
+                _ : _ -> do
+                    consumeWithSubstitution
+                    loop
+                [] -> lexicalError "unterminated backtick string"
+
+handleDirective :: Bool -> PPS ()
+handleDirective macrosOnly = do
+    directivePos <- getPosition
+    '`' <- takeChar
+    directive <- takeIdentifier
+
+    -- helper for directives which are not operated on
+    let passThrough = do
+            pushChar '`' directivePos
+            pushChars directive directivePos
+
+    env <- getEnv
+    condStack <- map cfCond <$> getCondStack
+    if any (/= CurrentlyTrue) condStack
+        && not (elem directive unskippableDirectives) then
+        return ()
+    else if macrosOnly && elem directive directives then
+        lexicalError "compiler directives are forbidden inside strings"
+    else case directive of
+
+        "timescale" -> removeThrough "\n"
+
+        "celldefine" -> passThrough
+        "endcelldefine" -> passThrough
+
+        "unconnected_drive" -> passThrough
+        "nounconnected_drive" -> passThrough
+
+        "default_nettype" -> passThrough
+        "pragma" -> do
+            leadCh <- peekChar
+            if leadCh == '\n'
+                then lexicalError "pragma directive cannot be empty"
+                else removeThrough "\n"
+        "resetall" -> passThrough
+
+        "begin_keywords" -> passThrough
+        "end_keywords" -> passThrough
+
+        "__FILE__" -> do
+            currFile <- getFilePath
+            insertChars directivePos (show currFile)
+        "__LINE__" -> do
+            Position _ currLine _ <- getPosition
+            insertChars directivePos (show currLine)
+
+        "line" -> do
+            lineLookahead
+            lineNumber <- takeNumber
+            quotedFilename <- takeQuotedString
+            levelNumber <- takeNumber
+            let filename = init $ tail quotedFilename
+            setFilePath filename
+            let newPos = Position filename lineNumber 0
+            setPosition newPos
+            when (levelNumber < 0 || 2 < levelNumber) $
+                lexicalError "line directive invalid level number"
+
+        "include" -> do
+            lineLookahead
+            quotedFilename <- takeQuotedString
+            fileFollow <- getFilePath
+            bufFollow <- getBuffer
+            -- find and load the included file
+            let filename = init $ tail quotedFilename
+            includePath <- includeSearch filename
+            pushIncludeStack includePath
+            includeContent <- liftIO $ loadFile includePath
+            -- pre-process the included file
+            setFilePath includePath
+            setBuffer (includeContent, Position includePath 1 1)
+            preprocessInput
+            -- resume processing the original file
+            popIncludeStack
+            setFilePath fileFollow
+            setBuffer bufFollow
+
+        "ifdef" -> do
+            dropSpaces
+            name <- takeIdentifier
+            pushCondStack "ifdef" name directivePos $
+                ifCond $ Map.member name env
+        "ifndef" -> do
+            dropSpaces
+            name <- takeIdentifier
+            pushCondStack "ifndef" name directivePos $
+                ifCond $ Map.notMember name env
+        "else" -> do
+            c <- cfCond <$> popCondStack "else"
+            pushCondStack "else" "" directivePos (elseCond c)
+        "elsif" -> do
+            dropSpaces
+            name <- takeIdentifier
+            c <- cfCond <$> popCondStack "elsif"
+            pushCondStack "elsif" name directivePos $
+                elsifCond (Map.member name env) c
+        "endif" -> do
+            _ <- popCondStack "endif"
+            return ()
+
+        "define" -> do
+            dropSpaces
+            name <- do
+                str <- takeIdentifier
+                if elem str directives
+                    then lexicalError $ "illegal macro name: " ++ str
+                    else return str
+            defn <- do
+                str <- getInput
+                if null str
+                    then return ("", [])
+                    else takeMacroDefinition
+            setEnv $ Map.insert name defn env
+        "undef" -> do
+            dropSpaces
+            name <- takeIdentifier
+            setEnv $ Map.delete name env
+        "undefineall" -> do
+            setEnv Map.empty
+
+        _ -> do
+            case Map.lookup directive env of
+                Nothing -> lexicalError $ "Undefined macro: " ++ directive
+                Just (body, formalArgs) -> do
+                    (names, args) <- if null formalArgs
+                        then return ([], [])
+                        else do
+                            actualArgs <- takeMacroArguments
+                            defaultedArgs <- defaultMacroArgs (map snd formalArgs) actualArgs
+                            return (map fst formalArgs, defaultedArgs)
+                    -- save our current state
+                    currFile <- getFilePath
+                    macroStack <- getMacroStack
+                    bufFollow <- getBuffer
+                    -- lex the macro expansion, preserving the file and line
+                    let Position _ l c = snd bufFollow
+                    let loc = "macro expansion of " ++ directive ++ " at " ++ currFile
+                    let pos = Position loc l (c - length directive - 1)
+                    setMacroStack $ (zip names args) : macroStack
+                    setBuffer (body, pos)
+                    preprocessInput
+                    "" <- getInput
+                    -- return to the rest of the input
+                    setMacroStack macroStack
+                    setBuffer bufFollow
+
+-- inserts the given string into the output at the given position
+insertChars :: Position -> String -> PPS ()
+insertChars pos str = do
+    bufFollow <- getBuffer
+    setBuffer (str, pos)
+    preprocessInput
+    setBuffer bufFollow
+
+-- pre-pre-processes the current line, such that macros can be used in
+-- directives
+lineLookahead :: PPS ()
+lineLookahead = do
+    line <- takeUntilNewline
+    -- save the state
+    outputOrig <- getOutput
+    condStackOrig <- getCondStack
+    inputOrig <- getInput
+    -- process the line
+    setOutput []
+    setCondStack []
+    setInput line
+    preprocessInput
+    outputAfter <- getOutput
+    -- add in the new characters
+    let newChars = reverse $ map fst outputAfter
+    setInput $ newChars ++ inputOrig
+    -- restore the previous state
+    setOutput outputOrig
+    setCondStack condStackOrig
+
+-- run the given string through the current preprocessor state, but out of band
+preprocessString :: String -> PPS String
+preprocessString str = do
+    -- save the state
+    outputOrig <- getOutput
+    condStackOrig <- getCondStack
+    bufferOrig <- getBuffer
+    -- process the line
+    setOutput []
+    setCondStack []
+    setInput str
+    preprocessInput
+    outputAfter <- getOutput
+    -- restore the previous state
+    setBuffer bufferOrig
+    setOutput outputOrig
+    setCondStack condStackOrig
+    -- get the result characters
+    return $ reverse $ map fst outputAfter
+
+-- update the position in the preprocessor state according to the movement of
+-- the given character
+advancePosition :: Char -> PPS ()
+advancePosition '\n' = do
+    Position f l _ <- getPosition
+    setPosition $ Position f (l + 1) 1
+advancePosition _ = do
+    Position f l c <- getPosition
+    setPosition $ Position f l (c + 1)
+
+-- advances position for multiple characters
+advancePositions :: String -> PPS ()
+advancePositions = mapM_ advancePosition
+
+-- update the given position based on the movement of the given character
+advance :: Position -> Char -> Position
+advance (Position f l _) '\n' = Position f (l + 1) 1
+advance (Position f l c) _    = Position f l (c + 1)
+
+-- adds a character (and its position) to the output state
+pushChar :: Char -> Position -> PPS ()
+pushChar c p = do
+    condStack <- map cfCond <$> getCondStack
+    when (all (== CurrentlyTrue) condStack) $ do
+        output <- getOutput
+        setOutput $ (c, p) : output
+
+-- adds a sequence of characters all at the same given position
+pushChars :: String -> Position -> PPS ()
+pushChars s p = mapM_ (flip pushChar p) s
+
+-- search for a pattern in the input and remove remove characters up to and
+-- including the first occurrence of the pattern
+removeThrough :: String -> PPS ()
+removeThrough pat = do
+    str <- getInput
+    case findIndex (isPrefixOf pat) (tails str) of
+        Nothing ->
+            if pat == "\n"
+                then setInput ""
+                else lexicalError $ "Reached EOF while looking for: "
+                        ++ show pat
+        Just patternIdx -> do
+            let chars = patternIdx + length pat
+            let (dropped, rest) = splitAt chars str
+            advancePositions dropped
+            when (pat == "\n") $ do
+                pos <- getPosition
+                pushChar '\n' pos
+            setInput rest

src/Language/SystemVerilog/Parser/Tokens.hs

@@ -9,24 +9,25 @@ module Language.SystemVerilog.Parser.Tokens
     ( Token     (..)
     , TokenName (..)
     , Position  (..)
-    , tokenString
+    , pattern TokenEOF
     ) where
 
 import Text.Printf
 
-tokenString :: Token -> String
+pattern TokenEOF :: Token
-tokenString (Token _ s _) = s
+pattern TokenEOF = Token Unknown "" (Position "" 0 0)
 
 data Position
     = Position String Int Int
-    deriving Eq
 
 instance Show Position where
     show (Position f l c) = printf "%s:%d:%d" f l c
 
-data Token
+data Token = Token
-    = Token TokenName String Position
+    { tokenName :: TokenName
-    deriving (Show, Eq)
+    , tokenString :: String
+    , tokenPosition :: Position
+    }
 
 data TokenName
     = KW_dollar_bits
@@ -38,6 +39,10 @@ data TokenName
     | KW_dollar_high
     | KW_dollar_increment
     | KW_dollar_size
+    | KW_dollar_info
+    | KW_dollar_warning
+    | KW_dollar_error
+    | KW_dollar_fatal
     | KW_accept_on
     | KW_alias
     | KW_always
@@ -289,6 +294,7 @@ data TokenName
     | Id_simple
     | Id_escaped
     | Id_system
+    | Lit_real
     | Lit_number
     | Lit_string
     | Lit_time
@@ -378,7 +384,13 @@ data TokenName
     | Sym_amp_amp_amp
     | Sym_lt_lt_lt_eq
     | Sym_gt_gt_gt_eq
-    | Spe_Directive
+    | Dir_celldefine
+    | Dir_endcelldefine
+    | Dir_unconnected_drive
+    | Dir_nounconnected_drive
+    | Dir_default_nettype
+    | Dir_resetall
+    | Dir_begin_keywords
+    | Dir_end_keywords
     | Unknown
-    | MacroBoundary
     deriving (Show, Eq, Ord)

src/Split.hs

@@ -0,0 +1,106 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Split descriptions into individual files
+ -}
+
+module Split (splitDescriptions) where
+
+import Data.List (isPrefixOf)
+
+import Language.SystemVerilog.AST
+
+splitDescriptions :: AST -> [PackageItem] -> ([(String, AST)], [PackageItem])
+splitDescriptions (PackageItem item : ungrouped) itemsBefore =
+    (grouped, item : itemsAfter)
+    where
+        (grouped, itemsAfter) = splitDescriptions ungrouped (item : itemsBefore)
+splitDescriptions (description : descriptions) itemsBefore =
+    ((name, surrounded) : grouped, itemsAfter)
+    where
+        (grouped, itemsAfter) = splitDescriptions descriptions itemsBefore
+        name = case description of
+            Part _ _ _  _ x _ _ -> x
+            Package     _ x   _ -> x
+            Class       _ x _ _ -> x
+        surrounded = surroundDescription itemsBefore description itemsAfter
+splitDescriptions [] _ = ([], [])
+
+data SurroundState = SurroundState
+    { sKeptBefore :: [PackageItem]
+    , sKeptAfter :: [PackageItem]
+    , sCellDefine :: Bool
+    , sUnconnectedDrive :: Maybe PackageItem
+    , sDefaultNettype :: Maybe PackageItem
+    , sComment :: Maybe PackageItem
+    }
+
+-- filter and include the surrounding package items for this description
+surroundDescription :: [PackageItem] -> Description -> [PackageItem] -> AST
+surroundDescription itemsBefore description itemsAfter =
+    map PackageItem itemsBefore' ++ description : map PackageItem itemsAfter'
+    where
+        itemsBefore' = extraBefore ++ reverse (sKeptBefore state2)
+        itemsAfter' = sKeptAfter state2 ++ reverse extraAfter
+
+        state0 = SurroundState [] [] False Nothing Nothing Nothing
+        state1 = foldr stepBefore state0 itemsBefore
+        state2 = foldr stepAfter state1 itemsAfter
+
+        (extraBefore, extraAfter) = foldr (<>) mempty $ map ($ state2) $
+            [ applyLeader sDefaultNettype
+            , applyCellDefine
+            , applyUnconnectedDrive
+            , applyLeader sComment
+            ]
+
+applyCellDefine :: SurroundState -> ([PackageItem], [PackageItem])
+applyCellDefine state
+    | sCellDefine state =
+        ([Directive "`celldefine"], [Directive "`endcelldefine"])
+    | otherwise = ([], [])
+
+applyUnconnectedDrive :: SurroundState -> ([PackageItem], [PackageItem])
+applyUnconnectedDrive state
+    | Just item <- sUnconnectedDrive state =
+        ([item], [Directive "`nounconnected_drive"])
+    | otherwise = ([], [])
+
+applyLeader :: (SurroundState -> Maybe PackageItem) -> SurroundState
+    -> ([PackageItem], [PackageItem])
+applyLeader getter state
+    | Just item <- getter state = ([item], [])
+    | otherwise = ([], [])
+
+-- update the state with a pre-description item
+stepBefore :: PackageItem -> SurroundState -> SurroundState
+stepBefore item@(Decl CommentDecl{}) state =
+    state { sComment = Just item }
+stepBefore item@(Directive directive) state
+    | matches "celldefine" = state { sCellDefine = True }
+    | matches "endcelldefine" = state { sCellDefine = False }
+    | matches "unconnected_drive" = state { sUnconnectedDrive = Just item }
+    | matches "nounconnected_drive" = state { sUnconnectedDrive = Nothing }
+    | matches "default_nettype" = state { sDefaultNettype = Just item }
+    | matches "resetall" = state
+        { sCellDefine = False
+        , sUnconnectedDrive = Nothing
+        , sDefaultNettype = Nothing
+        }
+    where matches = flip isPrefixOf directive . ('`' :)
+stepBefore item state =
+    state { sKeptBefore = item : sKeptBefore state }
+
+-- update the state with a post-description item
+stepAfter :: PackageItem -> SurroundState -> SurroundState
+stepAfter (Decl CommentDecl{}) state = state
+stepAfter (Directive directive) state
+    | matches "celldefine" = state
+    | matches "endcelldefine" = state
+    | matches "unconnected_drive" = state
+    | matches "nounconnected_drive" = state
+    | matches "default_nettype" = state
+    | matches "resetall" = state
+    where matches = flip isPrefixOf directive . ('`' :)
+stepAfter item state =
+    state { sKeptAfter = item : sKeptAfter state }

src/sv2v.hs

@@ -4,33 +4,115 @@
  - conversion entry point
  -}
 
-import System.IO
+import System.IO (hPrint, hPutStrLn, stderr, stdout)
-import System.Exit
+import System.Exit (exitFailure, exitSuccess)
+import System.FilePath (combine, splitExtension)
 
-import Data.List (elemIndex)
+import Control.Monad (when, zipWithM_)
-import Job (readJob, files, exclude, incdir, define, siloed)
+import Control.Monad.Except (runExceptT)
+import Data.List (nub)
+
+import Bugpoint (runBugpoint)
 import Convert (convert)
-import Language.SystemVerilog.Parser (parseFiles)
+import Job (readJob, Job(..), Write(..))
+import Language.SystemVerilog.AST
+import Language.SystemVerilog.Parser (parseFiles, Config(..))
+import Split (splitDescriptions)
 
-splitDefine :: String -> (String, String)
+isComment :: Description -> Bool
-splitDefine str =
+isComment (PackageItem (Decl CommentDecl{})) = True
-    case elemIndex '=' str of
+isComment _ = False
-        Nothing -> (str, "")
+
-        Just idx -> (take idx str, drop (idx + 1) str)
+droppedKind :: Description -> Identifier
+droppedKind description =
+    case description of
+        Part _ _ Interface _ _ _ _ -> "interface"
+        Package{} -> "package"
+        Class{}   -> "class"
+        PackageItem Function{}     -> "function"
+        PackageItem Task    {}     -> "task"
+        PackageItem (Decl Param{}) -> "localparam"
+        _ -> ""
+
+emptyWarnings :: AST -> AST -> IO ()
+emptyWarnings before after =
+    if all isComment before || not (all isComment after) || null kinds then
+        return ()
+    else if elem "interface" kinds then
+        hPutStrLn stderr $ "Warning: Source includes an interface but the"
+            ++ " output is empty because there are no modules without any"
+            ++ " interface ports. Please convert interfaces alongside the"
+            ++ " modules that instantiate them."
+    else
+        hPutStrLn stderr $ "Warning: Source includes a " ++ kind ++ " but no"
+            ++ " modules. Such elements are elaborated into the modules that"
+            ++ " use them. Please convert all sources in one invocation."
+    where
+        kinds = nub $ filter (not . null) $ map droppedKind before
+        kind = head kinds
+
+rewritePath :: FilePath -> IO FilePath
+rewritePath path = do
+    when (end /= ext) $ do
+        hPutStrLn stderr $ "Refusing to write adjacent to " ++ show path
+            ++ " because that path does not end in " ++ show ext
+        exitFailure
+    return $ base ++ ".v"
+    where
+        ext = ".sv"
+        (base, end) = splitExtension path
+
+writeOutput :: Write -> [FilePath] -> [AST] -> IO ()
+writeOutput _ [] [] =
+    hPutStrLn stderr "Warning: No input files specified (try `sv2v --help`)"
+writeOutput Stdout _ asts =
+    hPrint stdout $ concat asts
+writeOutput (File f) _ asts =
+    writeFile f $ show $ concat asts
+writeOutput Adjacent inPaths asts = do
+    outPaths <- mapM rewritePath inPaths
+    let results = map (++ "\n") $ map show asts
+    zipWithM_ writeFile outPaths results
+writeOutput (Directory d) _ asts =
+    zipWithM_ writeFile outPaths outputs
+    where
+        (outPaths, outputs) =
+            unzip $ map prepare $ fst $ splitDescriptions (concat asts) []
+        prepare :: (String, AST) -> (FilePath, String)
+        prepare (name, ast) = (path, output)
+            where
+                path = combine d $ name ++ ".v"
+                output = concatMap (++ "\n") $ map show ast
 
 main :: IO ()
 main = do
     job <- readJob
     -- parse the input files
-    let defines = map splitDefine $ define job
+    let config = Config
-    result <- parseFiles (incdir job) defines (siloed job) (files job)
+            { cfDefines          = define job
+            , cfIncludePaths     = incdir job
+            , cfLibraryPaths     = libdir job
+            , cfSiloed           = siloed job
+            , cfSkipPreprocessor = skipPreprocessor job
+            , cfOversizedNumbers = oversizedNumbers job
+            }
+    result <- runExceptT $ parseFiles config (files job)
     case result of
         Left msg -> do
-            hPutStr stderr $ msg ++ "\n"
+            hPutStrLn stderr msg
             exitFailure
-        Right asts -> do
+        Right inputs -> do
-            -- convert the files
+            let (inPaths, asts) = unzip inputs
-            let asts' = convert (exclude job) asts
+            -- convert the files if requested
-            -- print the converted files out
+            let converter = convert (top job) (dumpPrefix job) (exclude job)
-            hPrint stdout $ concat asts'
+            asts' <-
+                if passThrough job then
+                    return asts
+                else if bugpoint job /= [] then
+                    runBugpoint (bugpoint job) converter asts
+                else
+                    converter asts
+            emptyWarnings (concat asts) (concat asts')
+            -- write the converted files out
+            writeOutput (write job) inPaths asts'
             exitSuccess

stack.yaml

@@ -1,7 +1,7 @@
-resolver: lts-13.17
+resolver: lts-24.18
-
+pvp-bounds: upper
-extra-deps:
+ghc-options:
-    - Unique-0.4.7.6
+    $locals: -j2
 
 packages:
     - .

stack.yaml.lock

@@ -3,17 +3,10 @@
 # For more information, please see the documentation at:
 #   https://docs.haskellstack.org/en/stable/lock_files
 
-packages:
+packages: []
-- completed:
-    hackage: Unique-0.4.7.6@sha256:a1ff411f4d68c756e01e8d532fbe8e57f1ac77f2cc0ee8a999770be2bca185c5,2723
-    pantry-tree:
-      size: 1366
-      sha256: 587d279ff94e8d6f43da3710634ca3611fa4f6886b1e541a73c69303c00297b9
-  original:
-    hackage: Unique-0.4.7.6
 snapshots:
 - completed:
-    size: 497508
+    sha256: 4cb7085bcc4e7d0b58a523df16a25201800a076f643445ec4f8bb78a94be652f
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/17.yaml
+    size: 726109
-    sha256: 3d8fabe77d4f7618554cfb1001c820b9859820b8639bfd6f02a1c41660afb53b
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/18.yaml
-  original: lts-13.17
+  original: lts-24.18