packages feed

sv2v (empty) → 0.0.8

raw patch · 77 files changed

+16748/−0 lines, 77 filesdep +arraydep +basedep +cmdargssetup-changed

Dependencies added: array, base, cmdargs, containers, directory, filepath, githash, hashable, mtl, vector

Files

+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## v0.0.8++Future releases will have complete change logs.
+ LICENSE view
@@ -0,0 +1,31 @@+BSD 3-Clause License++Copyright 2019-2021 Zachary Snow+Copyright 2011-2015 Tom Hawkins++All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   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 copyright holder nor the names of its contributors+   may be used to endorse or promote products derived from this software without+   specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ NOTICE view
@@ -0,0 +1,1113 @@+================================================================================+Dependency: alex-3.2.6+================================================================================++  Copyright (c) 1995-2011, Chris Dornan and Simon Marlow+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are+  met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of the copyright holders, nor the names of the+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++================================================================================+Dependency: array-0.5.4.0+================================================================================++  This library (libraries/base) is derived from code from several+  sources: +  +    * Code from the GHC project which is largely (c) The University of+      Glasgow, and distributable under a BSD-style license (see below),+  +    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+      and freely redistributable (but see the full license for+      restrictions).+  +    * Code from the Haskell Foreign Function Interface specification,+      which is (c) Manuel M. T. Chakravarty and freely redistributable+      (but see the full license for restrictions).+  +  The full text of these licenses is reproduced below.  All of the+  licenses are BSD-style or compatible.+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "Report on the Programming Language+  Haskell 98", is distributed under the following license:+  +    Copyright (c) 2002 Simon Peyton Jones+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Language.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "The Haskell 98 Foreign Function+  Interface, An Addendum to the Haskell 98 Report" is distributed under+  the following license:+  +    Copyright (c) 2002 Manuel M. T. Chakravarty+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Foreign Function Interface.+  +  -----------------------------------------------------------------------------+  ++================================================================================+Dependency: base-4.14.1.0+================================================================================++  This library (libraries/base) is derived from code from several+  sources: +  +    * Code from the GHC project which is largely (c) The University of+      Glasgow, and distributable under a BSD-style license (see below),+  +    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+      and freely redistributable (but see the full license for+      restrictions).+  +    * Code from the Haskell Foreign Function Interface specification,+      which is (c) Manuel M. T. Chakravarty and freely redistributable+      (but see the full license for restrictions).+  +  The full text of these licenses is reproduced below.  All of the+  licenses are BSD-style or compatible.+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "Report on the Programming Language+  Haskell 98", is distributed under the following license:+  +    Copyright (c) 2002 Simon Peyton Jones+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Language.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "The Haskell 98 Foreign Function+  Interface, An Addendum to the Haskell 98 Report" is distributed under+  the following license:+  +    Copyright (c) 2002 Manuel M. T. Chakravarty+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Foreign Function Interface.+  +  -----------------------------------------------------------------------------++================================================================================+Dependency: binary-0.8.8.0+================================================================================++  Copyright (c) Lennart Kolmodin+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:+  +  1. Redistributions of source code must retain the above copyright+     notice, this list of conditions and the following disclaimer.+  +  2. Redistributions in binary form must reproduce the above copyright+     notice, 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 to endorse or promote products derived from this software+     without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+  OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+  DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+  POSSIBILITY OF SUCH DAMAGE.++================================================================================+Dependency: bytestring-0.10.12.0+================================================================================++  Copyright (c) Don Stewart 2005-2009+            (c) Duncan Coutts 2006-2015+            (c) David Roundy 2003-2005+            (c) Simon Meier 2010-2011+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:+  1. Redistributions of source code must retain the above copyright+     notice, this list of conditions and the following disclaimer.+  2. Redistributions in binary form must reproduce the above copyright+     notice, 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 to endorse or promote products derived from this software+     without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+  ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+  SUCH DAMAGE.++================================================================================+Dependency: cmdargs-0.10.21+================================================================================++  Copyright Neil Mitchell 2009-2021.+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are+  met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Neil Mitchell nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++================================================================================+Dependency: containers-0.6.2.1+================================================================================++  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow.+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+  +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+  +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.++================================================================================+Dependency: deepseq-1.4.4.0+================================================================================++  This library (deepseq) is derived from code from the GHC project which+  is largely (c) The University of Glasgow, and distributable under a+  BSD-style license (see below).+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2001-2009, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------++================================================================================+Dependency: directory-1.3.6.0+================================================================================++  This library (libraries/base) is derived from code from two+  sources: +  +    * Code from the GHC project which is largely (c) The University of+      Glasgow, and distributable under a BSD-style license (see below),+  +    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+      and freely redistributable (but see the full license for+      restrictions).+  +  The full text of these licenses is reproduced below.  Both of the+  licenses are BSD-style or compatible.+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "Report on the Programming Language+  Haskell 98", is distributed under the following license:+  +    Copyright (c) 2002 Simon Peyton Jones+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Language.+  +  -----------------------------------------------------------------------------++================================================================================+Dependency: filepath-1.4.2.1+================================================================================++  Copyright Neil Mitchell 2005-2018.+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are+  met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Neil Mitchell nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++================================================================================+Dependency: ghc-prim-0.6.1+================================================================================++  This library (libraries/ghc-prim) is derived from code from several+  sources: +  +    * Code from the GHC project which is largely (c) The University of+      Glasgow, and distributable under a BSD-style license (see below),+  +    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+      and freely redistributable (but see the full license for+      restrictions).+  +  The full text of these licenses is reproduced below.  All of the+  licenses are BSD-style or compatible.+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "Report on the Programming Language+  Haskell 98", is distributed under the following license:+  +    Copyright (c) 2002 Simon Peyton Jones+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Language.+  ++================================================================================+Dependency: githash-0.1.6.1+================================================================================++  Copyright (c) 2018, Michael Snoyman, 2015, Adam C. Foltzer+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  * Redistributions of source code must retain the above copyright notice, this+    list of conditions and the following disclaimer.+  +  * Redistributions in binary form must reproduce the above copyright notice,+    this list of conditions and the following disclaimer in the documentation+    and/or other materials provided with the distribution.+  +  * Neither the name of githash nor the names of its+    contributors may be used to endorse or promote products derived from+    this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+  DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++================================================================================+Dependency: happy-1.20.0+================================================================================++  The Happy License+  -----------------+  +  Copyright 2001, Simon Marlow and Andy Gill.  All rights reserved.+  +  Extensions to implement Tomita's Generalized LR parsing:+    Copyright 2004, University of Durham, Paul Callaghan and Ben Medlock.+    All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY+  EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+  PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR+  BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+  WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+  OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN+  IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++================================================================================+Dependency: hashable-1.3.0.0+================================================================================++  Copyright Milan Straka 2010+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Milan Straka nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++================================================================================+Dependency: integer-gmp-1.0.3.0+================================================================================++  Copyright (c) 2014, Herbert Valerio Riedel+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Herbert Valerio Riedel nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++================================================================================+Dependency: mtl-2.2.2+================================================================================++  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow.+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+  +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+  +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.++================================================================================+Dependency: pretty-1.1.3.6+================================================================================++  This library (libraries/pretty) is derived from code from+  the GHC project which is largely (c) The University of+  Glasgow, and distributable under a BSD-style license (see below).+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------++================================================================================+Dependency: primitive-0.7.1.0+================================================================================++  Copyright (c) 2008-2009, Roman Leshchinskiy+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  ++================================================================================+Dependency: process-1.6.9.0+================================================================================++  This library (libraries/process) is derived from code from two+  sources: +  +    * Code from the GHC project which is largely (c) The University of+      Glasgow, and distributable under a BSD-style license (see below),+  +    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+      and freely redistributable (but see the full license for+      restrictions).+  +  The full text of these licenses is reproduced below.  Both of the+  licenses are BSD-style or compatible.+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "Report on the Programming Language+  Haskell 98", is distributed under the following license:+  +    Copyright (c) 2002 Simon Peyton Jones+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Language.+  +  -----------------------------------------------------------------------------++================================================================================+Dependency: template-haskell-2.16.0.0+================================================================================++  +  The Glasgow Haskell Compiler License+  +  Copyright 2002-2007, The University Court of the University of Glasgow.+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+  +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+  +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  ++================================================================================+Dependency: text-1.2.4.1+================================================================================++  Copyright (c) 2008-2009, Tom Harper+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++================================================================================+Dependency: th-compat-0.1.2+================================================================================++  Copyright (c) 2020, Ryan Scott+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Ryan Scott nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++================================================================================+Dependency: time-1.9.3+================================================================================++  TimeLib is Copyright (c) Ashley Yakeley, 2004-2014. All rights reserved.+  Certain sections are Copyright 2004, The University Court of the University of Glasgow. All rights reserved.+  +  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.+  +  - Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++================================================================================+Dependency: transformers-0.5.6.2+================================================================================++  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow.+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+  +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+  +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.++================================================================================+Dependency: unix-2.7.2.2+================================================================================++  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.++================================================================================+Dependency: vector-0.12.3.0+================================================================================++  Copyright (c) 2008-2012, Roman Leshchinskiy+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +
+ README.md view
@@ -0,0 +1,161 @@+# sv2v: SystemVerilog to Verilog++sv2v converts SystemVerilog ([IEEE 1800-2017]) to Verilog ([IEEE 1364-2005]),+with an emphasis on supporting synthesizable language constructs.++[IEEE 1800-2017]: https://ieeexplore.ieee.org/servlet/opac?punumber=8299593+[IEEE 1364-2005]: https://ieeexplore.ieee.org/servlet/opac?punumber=10779++The primary goal of this project is to create a completely free and open-source+tool for converting SystemVerilog to Verilog. While methods for performing this+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+which Yosys supports].++[Yosys]: http://www.clifford.at/yosys/+[SystemVerilog features which 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++All of sv2v's dependencies are free and open-source.++* Build Dependencies+    * [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+    * [shUnit2](https://github.com/kward/shunit2) - test framework+    * Python (any version) - for generating certain test cases+++## Installation++### Pre-built binaries++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++You must have [Stack] installed to build sv2v. Then you can:++[Stack]: https://www.haskellstack.org/++```+git clone https://github.com/zachjs/sv2v.git+cd sv2v+make+```++This creates the executable at `./bin/sv2v`. Stack takes care of installing+exact (compatible) versions of the compiler and sv2v's build dependencies.++You can install the binary to your local bin path (typically `~/.local/bin`) by+running `stack install`, or copy over the executable manually.+++## Usage++sv2v takes in a list of files and prints the converted Verilog to `stdout`.+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.++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.++```+sv2v [OPTIONS] [FILES]++Preprocessing:+  -I --incdir=DIR           Add directory to include search path+  -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 preprocessor+     --pass-through         Dump input without converting+Conversion:+  -E --exclude=CONV         Exclude a particular conversion (always, assert,+                            interface, or logic)+  -v --verbose              Retain certain conversion artifacts+  -w --write=MODE/FILE      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+Other:+     --help                 Display help message+     --version              Print version information+     --numeric-version      Print just the version number+```+++## Supported Features++sv2v supports most synthesizable SystemVerilog features. Current notable+exceptions include `defparam` on interface instances and certain synthesizable+usages of parameterized classes. 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+will be given to issues which include examples or test cases.+++## SystemVerilog Front End++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+representation to enable more standardized and straightforward conversion+procedures. This could be extended into an independent and more fully-featured+front end if there is significant interest.+++## Testing++Once the [test dependencies](#dependencies) are installed, tests can be run with+`make test`. GitHub Actions is used to automatically test commits.++There is also a [SystemVerilog compliance suite] being created to test+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/SymbiFlow/sv-tests+++## Acknowledgements++This project was originally forked from [Tom Hawkin's Verilog parser]. While the+front end has changed substantially to support the larger SystemVerilog+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+[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+bug reports and feature requests. I greatly appreciate their help in furthering+the project.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple (defaultMain)++main :: IO ()+main = defaultMain
+ src/Convert.hs view
@@ -0,0 +1,130 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - SystemVerilog to Verilog conversion+ -}++module Convert (convert) where++import Language.SystemVerilog.AST+import qualified Job (Exclude(..))++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.DuplicateGenvar+import qualified Convert.EmptyArgs+import qualified Convert.Enum+import qualified Convert.ForAsgn+import qualified Convert.Foreach+import qualified Convert.FuncRet+import qualified Convert.FuncRoutine+import qualified Convert.HierConst+import qualified Convert.ImplicitNet+import qualified Convert.Inside+import qualified Convert.Interface+import qualified Convert.IntTypes+import qualified Convert.Jump+import qualified Convert.KWArgs+import qualified Convert.Logic+import qualified Convert.LogOp+import qualified Convert.MultiplePacked+import qualified Convert.NamedBlock+import qualified Convert.Package+import qualified Convert.ParamNoDefault+import qualified Convert.ParamType+import qualified Convert.RemoveComments+import qualified Convert.ResolveBindings+import qualified Convert.Simplify+import qualified Convert.Stream+import qualified Convert.StringParam+import qualified Convert.Struct+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 Selector = Job.Exclude -> Phase -> Phase++finalPhases :: Selector -> [Phase]+finalPhases _ =+    [ Convert.NamedBlock.convert+    , Convert.DuplicateGenvar.convert+    , Convert.AsgnOp.convert+    , Convert.FuncRet.convert+    , Convert.TFBlock.convert+    ]++mainPhases :: Selector -> [Phase]+mainPhases selectExclude =+    [ Convert.BlockDecl.convert+    , selectExclude Job.Logic Convert.Logic.convert+    , Convert.ImplicitNet.convert+    , Convert.Inside.convert+    , Convert.IntTypes.convert+    , Convert.MultiplePacked.convert+    , Convert.UnbasedUnsized.convert+    , Convert.Cast.convert+    , Convert.ParamType.convert+    , Convert.HierConst.convert+    , Convert.TypeOf.convert+    , Convert.DimensionQuery.convert+    , Convert.Simplify.convert+    , Convert.Stream.convert+    , Convert.Struct.convert+    , Convert.Typedef.convert+    , Convert.UnpackedArray.convert+    , Convert.Unsigned.convert+    , Convert.Wildcard.convert+    , Convert.Enum.convert+    , Convert.StringParam.convert+    , selectExclude Job.Interface Convert.Interface.convert+    , selectExclude Job.Succinct Convert.RemoveComments.convert+    ]++initialPhases :: Selector -> [Phase]+initialPhases selectExclude =+    [ Convert.ForAsgn.convert+    , Convert.Jump.convert+    , Convert.KWArgs.convert+    , Convert.Unique.convert+    , Convert.LogOp.convert+    , Convert.EmptyArgs.convert+    , Convert.Foreach.convert+    , Convert.FuncRoutine.convert+    , selectExclude Job.Assert Convert.Assertion.convert+    , selectExclude Job.Always Convert.AlwaysKW.convert+    , Convert.Package.convert+    , Convert.ParamNoDefault.convert+    , Convert.ResolveBindings.convert+    , Convert.UnnamedGenBlock.convert+    ]++convert :: [Job.Exclude] -> Phase+convert excludes =+    final . loopMain . initial+    where+        final = combine $ finalPhases selectExclude+        main = combine $ mainPhases selectExclude+        initial = combine $ initialPhases selectExclude+        combine = foldr1 (.)+        loopMain :: Phase+        loopMain descriptions =+            if descriptions == descriptions'+                then descriptions+                else loopMain descriptions'+            where descriptions' = main descriptions+        selectExclude :: Selector+        selectExclude exclude phase =+            if elem exclude excludes+                then id+                else phase
+ src/Convert/AlwaysKW.hs view
@@ -0,0 +1,26 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for `always_latch`, `always_comb`, and `always_ff`+ -+ - `always_latch` -> `always @*`+ - `always_comb` -> `always @*`+ - `always_ff` -> `always`+ -}++module Convert.AlwaysKW (convert) where++import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions $ traverseModuleItems replaceAlwaysKW++replaceAlwaysKW :: ModuleItem -> ModuleItem+replaceAlwaysKW (AlwaysC AlwaysLatch stmt) =+    AlwaysC Always $ Timing (Event SenseStar) stmt+replaceAlwaysKW (AlwaysC AlwaysComb stmt) =+    AlwaysC Always $ Timing (Event SenseStar) stmt+replaceAlwaysKW (AlwaysC AlwaysFF stmt) =+    AlwaysC Always stmt+replaceAlwaysKW other = other
+ src/Convert/AsgnOp.hs view
@@ -0,0 +1,42 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for binary assignment operators, which can appear in for loops and+ - as a special case of blocking assignment statements. We simply elaborate them+ - in the obvious manner: a += b -> a = a + b.+ -}++module Convert.AsgnOp (convert) where++import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert =+    map $ traverseDescriptions $ traverseModuleItems $+    ( traverseStmts (traverseNestedStmts convertStmt)+    . traverseGenItems (traverseNestedGenItems convertGenItem)+    )++convertGenItem :: GenItem -> GenItem+convertGenItem (GenFor a b (ident, AsgnOp op, expr) c) =+    GenFor a b (ident, AsgnOpEq, elabBinOp op (Ident ident) expr) c+convertGenItem other = other++convertStmt :: Stmt -> Stmt+convertStmt (For inits cc asgns stmt) =+    For inits cc asgns' stmt+    where+        asgns' = map convertAsgn asgns+        convertAsgn :: (LHS, AsgnOp, Expr) -> (LHS, AsgnOp, Expr)+        convertAsgn (lhs, AsgnOp op, expr) =+            (lhs, AsgnOpEq, elabBinOp op (lhsToExpr lhs) expr)+        convertAsgn other = other+convertStmt (Asgn (AsgnOp op) mt 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 view
@@ -0,0 +1,26 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for removing assertions. Assertions items are "commented out."+ -}++module Convert.Assertion (convert) where++import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem++convertModuleItem :: ModuleItem -> ModuleItem+convertModuleItem (AssertionItem item) =+    Generate $+    map (GenModuleItem . MIPackageItem . Decl . CommentDecl) $+        "removed an assertion item" :+        (lines $ show $ AssertionItem item)+convertModuleItem other =+    traverseStmts (traverseNestedStmts convertStmt) other++convertStmt :: Stmt -> Stmt+convertStmt (Assertion _) = Null+convertStmt other = other
+ src/Convert/BlockDecl.hs view
@@ -0,0 +1,52 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Verilog-2005 forbids block declarations with default values. We convert+ - these assignments to separate statements. If we handle static lifetimes in+ - the future, this conversion may have to change.+ -}++module Convert.BlockDecl (convert) where++import Data.Maybe (mapMaybe)++import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert =+    map $ traverseDescriptions $ traverseModuleItems+    (convertModuleItem . traverseStmts (traverseNestedStmts convertStmt))++convertModuleItem :: ModuleItem -> ModuleItem+convertModuleItem (MIPackageItem (Function ml t f decls stmts)) =+    MIPackageItem $ Function ml t f decls' stmts'+    where+        Block Seq "" decls' stmts' = convertStmt $+            Block Seq "" decls stmts+convertModuleItem (MIPackageItem (Task ml f decls stmts)) =+    MIPackageItem $ Task ml f decls' stmts'+    where+        Block Seq "" decls' stmts' = convertStmt $+            Block Seq "" decls stmts+convertModuleItem other = other++convertStmt :: Stmt -> Stmt+convertStmt (Block Seq name decls stmts) =+    Block Seq name decls' stmts'+    where+        splitDecls = map splitDecl decls+        decls' = map fst splitDecls+        asgns = map asgnStmt $ mapMaybe snd splitDecls+        stmts' = asgns ++ stmts+convertStmt other = other++splitDecl :: Decl -> (Decl, Maybe (LHS, Expr))+splitDecl (decl @ (Variable _ _ _ _ Nil)) =+    (decl, 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 $ Asgn AsgnOpEq Nothing
+ src/Convert/Cast.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE PatternSynonyms #-}+{- 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.Writer.Strict+import Data.List (isPrefixOf)+import Data.Maybe (isJust)++import Convert.ExprUtils+import Convert.Scoper+import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions convertDescription++convertDescription :: Description -> Description+convertDescription description =+    traverseModuleItems dropDuplicateCaster $+    partScoper+        traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM+        description++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' <- 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) (Number value) signed =+    return $ Number $+    case numberToInteger size of+        Just size' -> numberCast signed (fromIntegral size') value+        Nothing -> error $ "size cast width " ++ show size+                        ++ " is not an integer"+convertCastM size value signed = do+    value' <- traverseExprM value+    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 ->+                case numberToInteger n of+                    Just v -> show v+                    _ -> error $ "size cast width " ++ show n+                            ++ " is not an integer"+            _ -> 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 view
@@ -0,0 +1,141 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Elaboration of the "expression size system function" ($bits) and the "array+ - query functions" ($dimensions, $unpacked_dimensions, $left, $right, $low,+ - $high, $increment, and $size).+ -+ - Some tools support $bits and some of the other functions in Verilog, but it+ - is not part of the specification, so we have to convert them ourselves.+ -+ - Functions on types are trivially elaborated based on the dimensions of that+ - type, so long as it has been resolved to a primitive type.+ -+ - Functions on expressions relies on the `type` operator and the `TypeOf`+ - conversion to determine the underlying type of expression. The conversion of+ - `$bits` on expressions recursively breaks the expression into its subtypes+ - and finds their sizes.+ -}++module Convert.DimensionQuery (convert) where++import Convert.ExprUtils+import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions convertDescription++convertDescription :: Description -> Description+convertDescription =+    traverseModuleItems $ traverseExprs $ traverseNestedExprs convertExpr++-- elaborate integer atom types to have explicit dimensions+elaborateType :: Type -> Type+elaborateType (IntegerAtom t sg) =+    IntegerVector TLogic sg [(hi, lo)]+    where+        size = atomSize t+        hi = RawNum $ size - 1+        lo = RawNum 0+        atomSize :: IntegerAtomType -> Integer+        atomSize TByte = 8+        atomSize TShortint = 16+        atomSize TInt = 32+        atomSize TLongint = 64+        atomSize TInteger = 32+        atomSize TTime = 64+elaborateType other = other++convertExpr :: Expr -> Expr++-- conversion for array dimensions functions+convertExpr (DimsFn FnBits v) =+    convertBits v+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))) =+    case t of+        UnpackedType _ rs -> RawNum $ fromIntegral $ length rs+        TypeOf{} -> orig+        _ -> RawNum 0+convertExpr (orig @ (DimsFn FnDimensions (Left t))) =+    case t of+        IntegerAtom{} -> RawNum 1+        Alias{} -> orig+        PSAlias{} -> orig+        CSAlias{} -> orig+        TypeOf{} -> orig+        UnpackedType t' rs ->+            BinOp Add+                (RawNum $ fromIntegral $ length rs)+                (DimsFn FnDimensions $ Left t')+        _ -> RawNum $ fromIntegral $ length $ snd $ typeRanges t++-- conversion for array dimension functions on types+convertExpr (DimFn f (Left t) (Number n)) =+    if isUnresolved t then+        DimFn f (Left t) (Number n)+    else if d <= 0 || d > length rs then+        Number $ UnbasedUnsized BitX+    else case f of+        FnLeft -> fst r+        FnRight -> snd r+        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+    where+        rs = case elaborateType t of+            UnpackedType tInner rsOuter ->+                rsOuter ++ (snd $ typeRanges $ elaborateType tInner)+            _ -> snd $ typeRanges $ elaborateType t+        d = case numberToInteger n of+            Just value -> fromIntegral value+            Nothing -> 0+        r = rs !! (d - 1)+        isUnresolved :: Type -> Bool+        isUnresolved Alias{} = True+        isUnresolved PSAlias{} = True+        isUnresolved CSAlias{} = True+        isUnresolved TypeOf{} = True+        isUnresolved _ = False+convertExpr (DimFn f (Left t) d) =+    DimFn f (Left t) d++convertExpr other = other++-- simplify a bits expression+convertBits :: TypeOrExpr -> Expr+convertBits (Left t) =+    case elaborateType t of+        IntegerVector _ _ rs -> dimensionsSize rs+        Implicit        _ 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)+                (DimsFn FnBits $ Left t')+        _ -> DimsFn FnBits $ Left t+convertBits (Right e) =+    case e of+        Concat exprs ->+            foldl (BinOp Add) (RawNum 0) $+            map (convertBits . Right) $+            exprs+        Stream _ _ exprs -> convertBits $ Right $ Concat exprs+        Number n -> RawNum $ numberBitLength n+        Range expr mode range ->+            BinOp Mul size $ convertBits $ Right $ Bit expr (RawNum 0)+            where+                size = case mode of+                    NonIndexed   -> rangeSize range+                    IndexedPlus  -> snd range+                    IndexedMinus -> snd range+        _ -> DimsFn FnBits $ Left $ TypeOf e
+ src/Convert/DuplicateGenvar.hs view
@@ -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 view
@@ -0,0 +1,55 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Verilog-2005 requires that all functions have at least one input port.+ - SystemVerilog allows functions to have no arguments. This conversion adds a+ - dummy argument to such functions.+ -}++module Convert.EmptyArgs (convert) where++import Control.Monad.Writer.Strict+import qualified Data.Set as Set++import Convert.Traverse+import Language.SystemVerilog.AST++type Idents = Set.Set Identifier++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions convertDescription++convertDescription :: Description -> Description+convertDescription (description @ Part{}) =+    traverseModuleItems+        (traverseExprs $ traverseNestedExprs $ convertExpr functions)+        description'+    where+        (description', functions) =+            runWriter $ traverseModuleItemsM traverseFunctionsM description+convertDescription other = other++traverseFunctionsM :: ModuleItem -> Writer Idents ModuleItem+traverseFunctionsM (MIPackageItem (Function ml t f decls stmts)) = do+    decls' <-+        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+        dummyType = IntegerVector TReg Unspecified []+        dummyDecl = Variable Input dummyType "_sv2v_unused" [] Nil+        isInput :: Decl -> Bool+        isInput (Variable Input _ _ _ _) = True+        isInput _ = False+traverseFunctionsM other = return other++convertExpr :: Idents -> Expr -> Expr+convertExpr functions (Call (Ident func) (Args [] [])) =+    Call (Ident func) (Args args [])+    where args = if Set.member func functions+            then [RawNum 0]+            else []+convertExpr _ other = other
+ src/Convert/Enum.hs view
@@ -0,0 +1,107 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for `enum`+ -+ - This conversion replaces references to enum items with their values. The+ - values are explicitly cast to the enum's base type.+ -+ - 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+ - 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+ - of conflicts.+ -}++module Convert.Enum (convert) where++import Control.Monad (zipWithM_, (>=>))+import Data.List (elemIndices)++import Convert.ExprUtils+import Convert.Scoper+import Convert.Traverse+import Language.SystemVerilog.AST++type SC = Scoper Expr++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions $ partScoper+    traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM++traverseDeclM :: Decl -> SC Decl+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++traverseModuleItemM :: ModuleItem -> SC ModuleItem+traverseModuleItemM (Genvar x) =+    insertElem x Nil >> return (Genvar x)+traverseModuleItemM item =+    traverseNodesM traverseExprM return traverseTypeM traverseLHSM return item+    where traverseLHSM = 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+        -- default to a 32 bit logic+        t' = IntegerVector TLogic sg rl'+        rl' = if null rl+            then [(RawNum 31, RawNum 0)]+            else rl+replaceEnum (Enum t v rs) =+    insertEnumItems t v >> return (tf $ rl ++ rs)+    where (tf, rl) = typeRanges t+replaceEnum other = return other++insertEnumItems :: Type -> [(Identifier, Expr)] -> SC ()+insertEnumItems itemType items =+    -- check for obviously duplicate values+    if noDuplicates+        then zipWithM_ insertEnumItem keys vals+        else error $ "enum conversion has duplicate vals: "+                ++ show (zip keys vals)+    where+        insertEnumItem :: Identifier -> Expr -> SC ()+        insertEnumItem x = scopeExpr . Cast (Left itemType) >=> insertElem x+        (keys, valsRaw) = unzip items+        vals = tail $ scanl step (UniOp UniSub $ RawNum 1) valsRaw+        noDuplicates = all (null . tail . flip elemIndices vals) vals+        step :: Expr -> Expr -> Expr+        step expr Nil = simplify $ BinOp Add expr (RawNum 1)+        step _ expr = expr
+ src/Convert/ExprUtils.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE PatternSynonyms #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Utilities for expressions and ranges+ -}++module Convert.ExprUtils+    ( simplify+    , simplifyStep+    , rangeSize+    , rangeSizeHiLo+    , endianCondExpr+    , endianCondRange+    , dimensionsSize+    ) where++import Data.Bits (shiftL, shiftR)++import Convert.Traverse+import Language.SystemVerilog.AST++simplify :: Expr -> Expr+simplify = simplifyStep . traverseSinglyNestedExprs simplify . simplifyStep++simplifyStep :: Expr -> Expr++simplifyStep (UniOp LogNot (Number n)) =+    case numberToInteger n of+        Just 0 -> bool True+        Just _ -> bool False+        Nothing -> UniOp LogNot $ 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 (UniOp UniSub (UniOp UniSub e)) = e+simplifyStep (UniOp UniSub (BinOp Sub e1 e2)) = BinOp Sub e2 e1++simplifyStep (Concat (Number n1 : Number n2 : rest)) =+    simplifyStep $ Concat $ Number n : rest+    where n = n1 <> n2++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 @ Concat{}]) = e+simplifyStep (Concat [e @ Repeat{}]) = e+simplifyStep (Concat es) = Concat $ filter (/= Concat []) es+simplifyStep (Repeat (Dec 0) _) = Concat []+simplifyStep (Repeat (Dec 1) es) = Concat es+simplifyStep (Mux (Number n) e1 e2) =+    case numberToInteger n of+        Just 0 -> e2+        Just _ -> e1+        Nothing -> Mux (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+++simplifyBinOp :: BinOp -> Expr -> Expr -> Expr++simplifyBinOp Add (Dec 0) e = e+simplifyBinOp Add e (Dec 0) = e+simplifyBinOp Sub e (Dec 0) = e+simplifyBinOp Sub (Dec 0) e = UniOp UniSub e+simplifyBinOp Mul (Dec 0) _ = toDec 0+simplifyBinOp Mul (Dec 1) e = e+simplifyBinOp Mul _ (Dec 0) = toDec 0+simplifyBinOp Mul e (Dec 1) = e+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)++simplifyBinOp ShiftAL (Dec x) (Dec y) = toDec $ shiftL x (fromIntegral y)+simplifyBinOp ShiftAR (Dec x) (Dec y) = toDec $ shiftR x (fromIntegral y)+simplifyBinOp ShiftL  (Dec x) (Dec y) = toDec $ shiftL x (fromIntegral y)+simplifyBinOp ShiftR  (Dec x) (Dec y) = toDec $ shiftR x (fromIntegral y)++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 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 _ _ _ 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))
+ src/Convert/ForAsgn.hs view
@@ -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/Foreach.hs view
@@ -0,0 +1,39 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for `foreach` loops.+ -+ - We simply convert these loops to a series of loops, with the bounds and+ - direction provided by the array dimension query system functions. Omitted+ - indices are skipped.+ -}++module Convert.Foreach (convert) where++import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert =+    map $ traverseDescriptions $ traverseModuleItems $+    traverseStmts $ traverseNestedStmts convertStmt++convertStmt :: Stmt -> Stmt+convertStmt (Foreach x idxs stmt) =+    (foldl (.) id $ map toLoop $ zip [1..] idxs) stmt+    where+        toLoop :: (Integer, Identifier) -> (Stmt -> Stmt)+        toLoop (_, "") = id+        toLoop (d, i) =+            Block Seq "" [idxDecl] . pure .+                For [(LHSIdent i, queryFn FnLeft)] cmp [incr]+            where+                queryFn f = DimFn f (Right $ Ident x) (RawNum d)+                idxType = IntegerAtom TInteger Unspecified+                idxDecl = Variable Local idxType i [] Nil+                cmp =+                    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)+convertStmt other = other
+ src/Convert/FuncRet.hs view
@@ -0,0 +1,25 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion which makes function `logic` and `reg` return types implicit+ -+ - Verilog-2005 restricts function return types to `integer`, `real`,+ - `realtime`, `time`, and implicit signed/dimensioned types.+ -}++module Convert.FuncRet (convert) where++import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions $ traverseModuleItems convertFunction++convertFunction :: ModuleItem -> ModuleItem+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+            _ -> t+convertFunction other = other
+ src/Convert/FuncRoutine.hs view
@@ -0,0 +1,48 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - SystemVerilog allows functions to be called without using their result. For+ - example, if `f` is a function, one may write `f();` or `void'(f());`, causing+ - any side effects of `f` to occur in each case. Verilog-2005 does not allow+ - functions to be called as though they were tasks in this way. This conversion+ - creates a dummy variable to store the result of the function.+ -}++module Convert.FuncRoutine (convert) where++import Control.Monad.Writer.Strict+import qualified Data.Set as Set++import Convert.Traverse+import Language.SystemVerilog.AST++type Idents = Set.Set Identifier++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions convertDescription++convertDescription :: Description -> Description+convertDescription (description @ Part{}) =+    traverseModuleItems traverseModuleItem description+    where+        traverseModuleItem =+            traverseStmts $ traverseNestedStmts $ convertStmt functions+        functions = execWriter $+            collectModuleItemsM collectFunctionsM description+convertDescription other = other++collectFunctionsM :: ModuleItem -> Writer Idents ()+collectFunctionsM (MIPackageItem (Function _ _ f _ _)) =+    tell $ Set.singleton f+collectFunctionsM _ = return ()++convertStmt :: Idents -> Stmt -> Stmt+convertStmt functions (Subroutine (Ident func) args) =+    if Set.member func functions+        then Block Seq "" [decl] []+        else Subroutine (Ident func) args+    where+        t = TypeOf e+        e = Call (Ident func) args+        decl = Variable Local t "sv2v_void" [] e+convertStmt _ other = other
+ src/Convert/HierConst.hs view
@@ -0,0 +1,108 @@+{- 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 Data.Either (fromLeft)+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 traverseDeclM+            (traverseExprsM traverseExprM)+            (traverseGenItemExprsM traverseExprM)+            (traverseStmtExprsM traverseExprM)+            name items+        shadowedParams = Map.keys $ Map.filter (fromLeft False) $+            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_"++type ST = Scoper (Either Bool Expr)++traverseDeclM :: Decl -> ST Decl+traverseDeclM decl = do+    case decl of+        Param Parameter _ x _ ->+            insertElem x (Left False)+        Param Localparam UnknownType x e ->+            scopeExpr e >>= insertElem x . Right+        Param Localparam (Implicit sg rs) x e ->+            scopeExpr (Cast (Left t) e) >>= insertElem x . Right+            where t = IntegerVector TBit sg rs+        Param Localparam (IntegerVector _ sg rs) x e ->+            scopeExpr (Cast (Left t) e) >>= insertElem x . Right+            where t = IntegerVector TBit sg rs+        Param Localparam t x e ->+            scopeExpr (Cast (Left t) e) >>= insertElem x . Right+        _ -> 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 ([_, _], _, Left{}), Just ([_, _], _, Left{})) ->+            return $ Ident x+        (Just (accesses @ [Access _ Nil, _], _, Left False), _) -> do+            details <- lookupElemM $ prefix x+            when (details == Nothing) $+                insertElem accesses (Left True)+            return $ Ident $ prefix x+        (Just ([Access _ Nil, _], _, Left True), _) ->+            return $ Ident $ prefix x+        (Just (aE, replacements, Right value), Just (aX, _, _)) ->+            if aE == aX && Map.null replacements+                then return $ Ident x+                else traverseSinglyNestedExprsM traverseExprM $+                        replaceInExpr replacements value+        (Just (_, replacements, Right value), Nothing) ->+            traverseSinglyNestedExprsM traverseExprM $+                replaceInExpr replacements value+        _ -> traverseSinglyNestedExprsM traverseExprM expr+traverseExprM expr = traverseSinglyNestedExprsM traverseExprM expr
+ src/Convert/ImplicitNet.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE PatternSynonyms #-}+{- 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 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 view
@@ -0,0 +1,76 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for `inside` expressions and cases+ -+ - The expressions are compared to each candidate using `==?`, the wildcard+ - comparison. As required by the specification, the result of each comparison+ - is combined using an OR reduction.+ -+ - `case ... inside` statements are converted to an equivalent if-else cascade.+ -+ - TODO: Add support for array value ranges.+ - TODO: This conversion may cause an expression with side effects to be+ - evaluated more than once.+ -}++module Convert.Inside (convert) where++import Convert.Traverse+import Language.SystemVerilog.AST++import Control.Monad.Writer+import Data.Maybe (fromMaybe)++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem++convertModuleItem :: ModuleItem -> ModuleItem+convertModuleItem item =+    traverseExprs (traverseNestedExprs convertExpr) $+    traverseStmts (traverseNestedStmts convertStmt) $+    item++convertExpr :: Expr -> Expr+convertExpr (Inside expr valueRanges) =+    if length checks == 1+        then head checks+        else UniOp RedOr $ Concat checks+    where+        checks = map toCheck valueRanges+        toCheck :: Expr -> Expr+        toCheck (Range Nil NonIndexed (lo, hi)) =+            BinOp LogAnd+                (BinOp Le lo expr)+                (BinOp Ge hi expr)+        toCheck pattern =+            BinOp WEq expr pattern+convertExpr other = other++convertStmt :: Stmt -> Stmt+convertStmt (Case u CaseInside expr items) =+    if hasSideEffects expr then+        Block Seq "" [decl] [stmt]+    else+        foldr ($) defaultStmt $+        map (uncurry $ If NoCheck) $+        zip comps stmts+    where+        -- 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+        comps = map (Inside expr . 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 view
@@ -0,0 +1,72 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for `bit`, `int`, `shortint`, `longint`, and `byte`+ -}++module Convert.IntTypes (convert) where++import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem++convertModuleItem :: ModuleItem -> ModuleItem+convertModuleItem = traverseNodes+    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/Interface.hs view
@@ -0,0 +1,703 @@+{-# LANGUAGE PatternSynonyms #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for interfaces+ -}++module Convert.Interface (convert) where++import Data.Maybe (isJust, isNothing, mapMaybe)+import Control.Monad.Writer.Strict+import qualified Data.Map.Strict as Map++import Convert.ExprUtils (endianCondExpr)+import Convert.Scoper+import Convert.Traverse+import Language.SystemVerilog.AST++data PartInfo = PartInfo+    { pKind :: PartKW+    , pPorts :: [Identifier]+    , pItems :: [ModuleItem]+    }+type PartInfos = Map.Map Identifier PartInfo++type ModportInstances = [(Identifier, (Identifier, Identifier))]+type ModportBinding = (Identifier, (Substitutions, Expr))+type Substitutions = [(Expr, Expr)]++convert :: [AST] -> [AST]+convert files =+    if needsFlattening+        then files+        else traverseFiles+            (collectDescriptionsM collectPart)+            (map . convertDescription)+            files+    where+        -- we can only collect/map non-extern interfaces and modules+        collectPart :: Description -> Writer PartInfos ()+        collectPart (Part _ False kw _ name ports items) =+            tell $ Map.singleton name $ PartInfo kw ports items+        collectPart _ = return ()+        -- multidimensional instances need to be flattened before this+        -- conversion can proceed+        needsFlattening =+            getAny $ execWriter $ mapM (collectDescriptionsM checkPart) files+        checkPart :: Description -> Writer Any ()+        checkPart (Part _ _ _ _ _ _ items) =+            mapM (collectNestedModuleItemsM checkItem) items >> return ()+        checkPart _ = return ()+        checkItem :: ModuleItem -> Writer Any ()+        checkItem (Instance _ _ _ rs _) = when (length rs > 1) $ tell $ Any True+        checkItem _ = return ()++convertDescription :: PartInfos -> Description -> Description+convertDescription _ (Part _ _ Interface _ name _ _) =+    PackageItem $ Decl $ CommentDecl $ "removed interface: " ++ name+convertDescription parts (Part attrs extern Module lifetime name ports items) =+    if null $ extractModportInstances $ PartInfo Module ports items then+        Part attrs extern Module lifetime name ports items'+    else+        PackageItem $ Decl $ CommentDecl $+            "removed module with interface ports: " ++ name+    where+        items' = evalScoper+            traverseDeclM traverseModuleItemM return return name items++        convertNested =+            scopeModuleItemT traverseDeclM traverseModuleItemM return return++        traverseDeclM :: Decl -> Scoper [ModportDecl] Decl+        traverseDeclM decl = do+            case decl of+                Variable  _ _ x _ _ -> insertElem x DeclVal+                Net   _ _ _ _ x _ _ -> insertElem x DeclVal+                Param     _ _ x _   -> insertElem x DeclVal+                ParamType _   x _   -> insertElem x DeclVal+                CommentDecl{} -> return ()+            return decl++        lookupIntfElem :: Scopes [ModportDecl] -> Expr -> LookupResult [ModportDecl]+        lookupIntfElem modports expr =+            case lookupElem modports expr of+                Just (_, _, DeclVal) -> Nothing+                other -> other++        traverseModuleItemM :: ModuleItem -> Scoper [ModportDecl] ModuleItem+        traverseModuleItemM (Modport modportName modportDecls) =+            insertElem modportName modportDecls >> return (Generate [])+        traverseModuleItemM (instanceItem @ Instance{}) = do+            modports <- embedScopes (\l () -> l) ()+            if isNothing maybePartInfo then+                return instanceItem+            else if partKind == Interface then+                -- inline instantiation of an interface+                convertNested $ Generate $ map GenModuleItem $+                    inlineInstance modports rs []+                    partItems part instanceName paramBindings portBindings+            else if null modportInstances then+                return instanceItem+            else do+                -- inline instantiation of a module+                let modportBindings = getModportBindings modports+                if length modportInstances /= length modportBindings+                    then+                        error $ "instance " ++ instanceName ++ " of " ++ part+                            ++ " has interface ports "+                            ++ showKeys modportInstances ++ ", but only "+                            ++ showKeys modportBindings ++ " are connected"+                    else convertNested $ Generate $ map GenModuleItem $+                            inlineInstance modports rs modportBindings partItems+                            part instanceName paramBindings portBindings+            where+                Instance part paramBindings instanceName rs portBindings =+                    instanceItem+                maybePartInfo = Map.lookup part parts+                Just partInfo = maybePartInfo+                PartInfo partKind _ partItems = partInfo++                modportInstances = extractModportInstances partInfo+                getModportBindings modports = mapMaybe+                    (inferModportBinding modports modportInstances) $+                    map (second $ addImpliedSlice modports) portBindings+                second f = \(a, b) -> (a, f b)+                showKeys = show . map fst++        traverseModuleItemM other = return other++        -- add explicit slices for bindings of entire modport instance arrays+        addImpliedSlice :: Scopes [ModportDecl] -> Expr -> Expr+        addImpliedSlice modports (orig @ (Dot expr modportName)) =+            case lookupIntfElem modports (InstArrKey expr) of+                Just (_, _, InstArrVal l r) ->+                    Dot (Range expr NonIndexed (l, r)) modportName+                _ -> orig+        addImpliedSlice modports expr =+            case lookupIntfElem modports (InstArrKey expr) of+                Just (_, _, InstArrVal l r) ->+                    Range expr NonIndexed (l, r)+                _ -> expr++        -- elaborates and resolves provided modport bindings+        inferModportBinding :: Scopes [ModportDecl] -> ModportInstances ->+            PortBinding -> Maybe ModportBinding+        inferModportBinding modports modportInstances (portName, expr) =+            if maybeInfo == Nothing+                then Nothing+                else Just (portName, modportBinding)+            where+                modportBinding = (substitutions, replaceBit modportE)+                substitutions =+                    genSubstitutions modports base instanceE modportE+                maybeInfo =+                    lookupModportBinding modports modportInstances portName bitd+                Just (instanceE, modportE) = maybeInfo++                (exprUndot, bitd) = case expr of+                    Dot subExpr x -> (subExpr, Dot bitdUndot x)+                    _ -> (expr, bitdUndot)+                bitdUndot = case exprUndot of+                    Range subExpr _ _ -> Bit subExpr taggedOffset+                    Bit subExpr _ -> Bit subExpr untaggedOffset+                    _ -> exprUndot+                bitReplacement = case exprUndot of+                    Range _ mode range -> \e -> Range e mode range+                    Bit _ idx -> flip Bit idx+                    _ -> id+                base = case exprUndot of+                    Range{} -> Bit (Ident portName) Tag+                    _ -> Ident portName++                untaggedOffset = Ident $ modportBaseName portName+                taggedOffset = BinOp Add Tag untaggedOffset++                replaceBit :: Expr -> Expr+                replaceBit (Bit subExpr idx) =+                    if idx == untaggedOffset || idx == taggedOffset+                        then bitReplacement subExpr+                        else Bit subExpr idx+                replaceBit (Dot subExpr x) =+                    Dot (replaceBit subExpr) x+                replaceBit (Ident x) = Ident x+                replaceBit _ = error "replaceBit invariant violated"++        -- determines the underlying modport and interface instances associated+        -- with the given port binding, if it is a modport binding+        lookupModportBinding :: Scopes [ModportDecl] -> ModportInstances+            -> Identifier -> Expr -> Maybe (Expr, Expr)+        lookupModportBinding modports modportInstances portName expr =+            if bindingIsModport then+                -- provided specific instance modport+                foundModport expr+            else if bindingIsBundle && portIsBundle then+                -- bundle bound to a generic bundle+                foundModport expr+            else if bindingIsBundle && not portIsBundle then+                -- given entire interface, but just bound to a modport+                foundModport $ Dot expr modportName+            else if modportInstance /= Nothing then+                error $ "could not resolve modport binding " ++ show expr+                    ++ " for port " ++ portName ++ " of type "+                    ++ showModportType interfaceName modportName+            else+                Nothing+            where+                bindingIsModport = lookupIntfElem modports expr /= Nothing+                bindingIsBundle = lookupIntfElem modports (Dot expr "") /= Nothing+                portIsBundle = null modportName+                modportInstance = lookup portName modportInstances+                (interfaceName, modportName) =+                    case modportInstance of+                        Just x -> x+                        Nothing -> error $ "can't deduce modport for interface "+                            ++ show expr ++ " bound to port " ++ portName++                foundModport modportE =+                    if (null interfaceName || bInterfaceName == interfaceName)+                        && (null modportName || bModportName == modportName)+                        then Just (instanceE, qualifyModport modportE)+                        else error msg+                    where+                        bModportName =+                            case modportE of+                                Dot _ x -> x+                                _ -> ""+                        instanceE = findInstance modportE+                        Just (_, _, InterfaceTypeVal bInterfaceName) =+                            lookupIntfElem modports $ InterfaceTypeKey+                                (findInstance modportE)+                        msg = "port " ++ portName ++ " has type "+                            ++ showModportType interfaceName modportName+                            ++ ", but the binding " ++ show expr ++ " has type "+                            ++ showModportType bInterfaceName bModportName++                findInstance :: Expr -> Expr+                findInstance e =+                    case lookupIntfElem modports (Dot e "") of+                        Nothing -> case e of+                            Bit e' _ -> findInstance e'+                            Dot e' _ -> findInstance e'+                            _ -> error "internal invariant violated"+                        Just (accesses, _, _) -> accessesToExpr $ init accesses+                qualifyModport :: Expr -> Expr+                qualifyModport e =+                    accessesToExpr $+                    case lookupIntfElem modports e of+                        Just (accesses, _, _) -> accesses+                        Nothing ->+                            case lookupIntfElem modports (Dot e "") of+                                Just (accesses, _, _) -> init accesses+                                Nothing ->+                                    error $ "could not find modport " ++ show e++        showModportType :: Identifier -> Identifier -> String+        showModportType "" "" = "generic interface"+        showModportType intf "" = intf+        showModportType intf modp = intf ++ '.' : modp++        -- expand a modport binding into a series of expression substitutions+        genSubstitutions :: Scopes [ModportDecl] -> Expr -> Expr -> Expr+            -> [(Expr, Expr)]+        genSubstitutions modports baseE instanceE modportE =+            (baseE, instanceE) :+            map toPortBinding modportDecls+            where+                a = lookupIntfElem modports modportE+                b = lookupIntfElem modports (Dot modportE "")+                Just (_, replacements, modportDecls) =+                    if a == Nothing then b else a+                toPortBinding (_, x, e) = (x', e')+                    where+                        x' = Dot baseE x+                        e' = replaceInExpr replacements e++        -- association list of modport instances in the given module body+        extractModportInstances :: PartInfo -> ModportInstances+        extractModportInstances partInfo =+            execWriter $ mapM (collectDeclsM collectDecl) (pItems partInfo)+            where+                collectDecl :: Decl -> Writer ModportInstances ()+                collectDecl (Variable _ t x _ _) =+                    if maybeInfo == Nothing then+                        return ()+                    else if elem x (pPorts partInfo) then+                        tell [(x, info)]+                    else+                        error $ "Modport not in port list: " ++ show (t, x)+                            ++ ". Is this an interface missing a port list?"+                    where+                        maybeInfo = extractModportInfo t+                        Just info = maybeInfo+                collectDecl _ = return ()++        extractModportInfo :: Type -> Maybe (Identifier, Identifier)+        extractModportInfo (InterfaceT "" "" _) = Just ("", "")+        extractModportInfo (InterfaceT interfaceName modportName _) =+            if isInterface interfaceName+                then Just (interfaceName, modportName)+                else Nothing+        extractModportInfo (Alias interfaceName _) =+            if isInterface interfaceName+                then Just (interfaceName, "")+                else Nothing+        extractModportInfo _ = Nothing++        isInterface :: Identifier -> Bool+        isInterface partName =+            case Map.lookup partName parts of+                Nothing -> False+                Just info -> pKind info == Interface++convertDescription _ other = other++-- produce the implicit modport decls for an interface bundle+impliedModport :: [ModuleItem] -> [ModportDecl]+impliedModport =+    execWriter . mapM+        (collectNestedModuleItemsM $ collectDeclsM collectModportDecls)+    where+        collectModportDecls :: Decl -> Writer [ModportDecl] ()+        collectModportDecls (Variable _ _ x _ _) =+            tell [(Inout, x, Ident x)]+        collectModportDecls (Net  _ _ _ _ x _ _) =+            tell [(Inout, x, Ident x)]+        collectModportDecls _ = return ()++-- convert an interface-bound module instantiation or an interface instantiation+-- into a series of equivalent inlined module items+inlineInstance :: Scopes [ModportDecl] -> [Range] -> [ModportBinding]+    -> [ModuleItem] -> Identifier -> Identifier -> [ParamBinding]+    -> [PortBinding] -> [ModuleItem]+inlineInstance global ranges modportBindings items partName+    instanceName instanceParams instancePorts =+    comment :+    map (MIPackageItem . Decl) bindingBaseParams +++    map (MIPackageItem . Decl) parameterBinds +++    wrapInstance instanceName items'+    : portBindings+    where+        items' = evalScoper traverseDeclM traverseModuleItemM traverseGenItemM+            traverseStmtM partName $+            map (traverseNestedModuleItems rewriteItem) $+            if null modportBindings+                then items ++ [typeModport, dimensionModport, bundleModport]+                else items++        key = shortHash (partName, instanceName)++        -- synthetic modports to be collected and removed after inlining+        bundleModport = Modport "" (impliedModport items)+        dimensionModport = if not isArray+            then Generate []+            else InstArrEncoded arrayLeft arrayRight+        typeModport = InterfaceTypeEncoded partName++        inlineKind =+            if null modportBindings+                then "interface"+                else "module"++        comment = MIPackageItem $ Decl $ CommentDecl $+            "expanded " ++ inlineKind ++ " instance: " ++ instanceName+        portBindings =+            wrapPortBindings $+            map portBindingItem $+            filter ((/= Nil) . snd) $+            filter notSubstituted instancePorts+        notSubstituted :: PortBinding -> Bool+        notSubstituted (portName, _) =+            lookup portName modportBindings == Nothing+        wrapPortBindings :: [ModuleItem] -> [ModuleItem]+        wrapPortBindings =+            if isArray+                then (\x -> [x]) . wrapInstance blockName+                else id+            where blockName = instanceName ++ "_port_bindings"++        rewriteItem :: ModuleItem -> ModuleItem+        rewriteItem =+            traverseDecls $+            removeModportInstance .+            removeDeclDir .+            overrideParam++        traverseDeclM :: Decl -> Scoper () Decl+        traverseDeclM decl = do+            case decl of+                Variable  _ _ x _ _ -> insertElem x ()+                Net   _ _ _ _ x _ _ -> insertElem x ()+                Param     _ _ x _   -> insertElem x ()+                ParamType _   x _   -> insertElem x ()+                CommentDecl{} -> return ()+            traverseDeclExprsM traverseExprM decl++        traverseModuleItemM :: ModuleItem -> Scoper () ModuleItem+        traverseModuleItemM item@Modport{} =+            traverseExprsM (scopeExpr >=> traverseExprM) item+        traverseModuleItemM item@(Instance _ _ x _ _) =+            insertElem x () >> traverseExprsM traverseExprM item+        traverseModuleItemM item =+            traverseExprsM traverseExprM item >>=+            traverseLHSsM  traverseLHSM++        traverseGenItemM :: GenItem -> Scoper () GenItem+        traverseGenItemM item@(GenFor (x, _) _ _ _) = do+            -- don't want to be scoped in modports+            insertElem x ()+            item' <- traverseGenItemExprsM traverseExprM item+            removeElem x+            return item'+        traverseGenItemM item =+            traverseGenItemExprsM traverseExprM item++        traverseStmtM :: Stmt -> Scoper () Stmt+        traverseStmtM =+            traverseStmtExprsM traverseExprM >=>+            traverseStmtLHSsM  traverseLHSM++        -- used for replacing usages of modports in the module being inlined+        modportSubstitutions = concatMap (fst . snd) modportBindings+        lhsReplacements = map (\(x, y) -> (toLHS x, toLHS y)) exprReplacements+        exprReplacements = filter ((/= Nil) . snd) modportSubstitutions+        -- LHSs are replaced using simple substitutions+        traverseLHSM :: LHS -> Scoper () LHS+        traverseLHSM =+            embedScopes tagLHS >=>+            embedScopes replaceLHS+        tagLHS :: Scopes () -> LHS -> LHS+        tagLHS scopes lhs =+            if lookupElem scopes lhs /= Nothing+                then LHSDot (renamePartLHS lhs) "@"+                else traverseSinglyNestedLHSs (tagLHS scopes) lhs+        renamePartLHS :: LHS -> LHS+        renamePartLHS (LHSDot (LHSIdent x) y) =+            if x == partName+                then LHSDot scopedInstanceLHS y+                else LHSDot (LHSIdent x) y+        renamePartLHS lhs = traverseSinglyNestedLHSs renamePartLHS lhs+        replaceLHS :: Scopes () -> LHS -> LHS+        replaceLHS _ (LHSDot lhs "@") = lhs+        replaceLHS local (LHSDot (LHSBit lhs elt) field) =+            case lookup (LHSDot (LHSBit lhs Tag) field) lhsReplacements of+                Just resolved -> replaceLHSArrTag elt resolved+                Nothing -> LHSDot (replaceLHS local $ LHSBit lhs elt) field+        replaceLHS local lhs =+            case lookup lhs lhsReplacements of+                Just lhs' -> lhs'+                Nothing -> checkExprResolution local (lhsToExpr lhs) $+                    traverseSinglyNestedLHSs (replaceLHS local) lhs+        replaceLHSArrTag :: Expr -> LHS -> LHS+        replaceLHSArrTag =+            traverseNestedLHSs . (traverseLHSExprs . replaceArrTag)+        -- top-level expressions may be modports bound to other modports+        traverseExprM :: Expr -> Scoper () Expr+        traverseExprM =+            embedScopes tagExpr >=>+            embedScopes replaceExpr+        tagExpr :: Scopes () -> Expr -> Expr+        tagExpr scopes expr =+            if lookupElem scopes expr /= Nothing+                then Dot (renamePartExpr expr) "@"+                else traverseSinglyNestedExprs (tagExpr scopes) expr+        renamePartExpr :: Expr -> Expr+        renamePartExpr (Dot (Ident x) y) =+            if x == partName+                then Dot scopedInstanceExpr y+                else Dot (Ident x) y+        renamePartExpr expr = traverseSinglyNestedExprs renamePartExpr expr+        replaceExpr :: Scopes () -> Expr -> Expr+        replaceExpr _ (Dot expr "@") = expr+        replaceExpr local (Ident x) =+            case lookup x modportBindings of+                Just (_, m) -> m+                Nothing -> checkExprResolution local (Ident x) (Ident x)+        replaceExpr local expr =+            replaceExpr' local expr+        replaceExpr' :: Scopes () -> Expr -> Expr+        replaceExpr' _ (Dot expr "@") = expr+        replaceExpr' local (Dot (Bit expr elt) field) =+            case lookup (Dot (Bit expr Tag) field) exprReplacements of+                Just resolved -> replaceArrTag (replaceExpr' local elt) resolved+                Nothing -> Dot (replaceExpr' local $ Bit expr elt) field+        replaceExpr' local (Bit expr elt) =+            case lookup (Bit expr Tag) exprReplacements of+                Just resolved -> replaceArrTag (replaceExpr' local elt) resolved+                Nothing -> Bit (replaceExpr' local expr) (replaceExpr' local elt)+        replaceExpr' local (expr @ (Dot Ident{} _)) =+            case lookup expr exprReplacements of+                Just expr' -> expr'+                Nothing -> checkExprResolution local expr $+                    traverseSinglyNestedExprs (replaceExprAny local) expr+        replaceExpr' local (Ident x) =+            checkExprResolution local (Ident x) (Ident x)+        replaceExpr' local expr = replaceExprAny local expr+        replaceExprAny :: Scopes () -> Expr -> Expr+        replaceExprAny local expr =+            case lookup expr exprReplacements of+                Just expr' -> expr'+                Nothing -> checkExprResolution local expr $+                    traverseSinglyNestedExprs (replaceExpr' local) expr+        replaceArrTag :: Expr -> Expr -> Expr+        replaceArrTag replacement Tag = replacement+        replaceArrTag replacement expr =+            traverseSinglyNestedExprs (replaceArrTag replacement) expr++        checkExprResolution :: Scopes () -> Expr -> a -> a+        checkExprResolution local expr =+            if not (exprResolves local expr) && exprResolves global expr+                then+                    error $ "inlining instance \"" ++ instanceName ++ "\" of "+                        ++ inlineKind ++ " \"" ++ partName+                        ++ "\" would make expression \"" ++ show expr+                        ++ "\" used in \"" ++ instanceName+                        ++ "\" resolvable when it wasn't previously"+                else id++        exprResolves :: Scopes a -> Expr -> Bool+        exprResolves local (Ident x) =+            isJust (lookupElem local x) || isLoopVar local x+        exprResolves local expr =+            isJust (lookupElem local expr)++        -- unambiguous reference to the current instance+        scopedInstanceRaw = accessesToExpr $ localAccesses global instanceName+        scopedInstanceExpr =+            if isArray+                then Bit scopedInstanceRaw (Ident loopVar)+                else scopedInstanceRaw+        Just scopedInstanceLHS = exprToLHS scopedInstanceExpr++        removeModportInstance :: Decl -> Decl+        removeModportInstance (Variable d t x a e) =+            if maybeModportBinding == Nothing then+                Variable d t x a e+            else if makeBindingBaseExpr modportE == Nothing then+                CommentDecl $ "removed modport instance " ++ x+            else if null modportDims then+                localparam (modportBaseName x) bindingBaseExpr+            else+                localparam (modportBaseName x) $+                    BinOp Sub bindingBaseExpr (sliceLo NonIndexed modportDim)+            where+                maybeModportBinding = lookup x modportBindings+                Just (_, modportE) = maybeModportBinding+                bindingBaseExpr = Ident $ bindingBaseName ++ x+                modportDims = a ++ snd (typeRanges t)+                [modportDim] = modportDims+        removeModportInstance other = other++        removeDeclDir :: Decl -> Decl+        removeDeclDir (Variable _ t x a e) =+            Variable Local t' x a e+            where t' = case t of+                    Implicit Unspecified rs ->+                        IntegerVector TLogic Unspecified rs+                    _ -> t+        removeDeclDir decl @ Net{} =+            traverseNetAsVar removeDeclDir decl+        removeDeclDir other = other++        -- capture the lower bound for each modport array binding+        bindingBaseParams = mapMaybe makeBindingBaseParam modportBindings+        makeBindingBaseParam :: ModportBinding -> Maybe Decl+        makeBindingBaseParam (portName, (_, modportE)) =+            fmap (localparam $ bindingBaseName ++ portName) $+                makeBindingBaseExpr modportE+        bindingBaseName = "_bbase_" ++ key ++ "_"+        makeBindingBaseExpr :: Expr -> Maybe Expr+        makeBindingBaseExpr modportE =+            case modportE of+                Dot (Range _ mode range) _ -> Just $ sliceLo mode range+                Range      _ mode range    -> Just $ sliceLo mode range+                Dot (Bit _ idx) _ -> Just idx+                Bit      _ idx    -> Just idx+                _ -> Nothing++        localparam :: Identifier -> Expr -> Decl+        localparam = Param Localparam (Implicit Unspecified [])++        paramTmp = "_param_" ++ key ++ "_"++        parameterBinds = map makeParameterBind instanceParams+        makeParameterBind :: ParamBinding -> Decl+        makeParameterBind (x, Left t) =+            ParamType Localparam (paramTmp ++ x) t+        makeParameterBind (x, Right e) =+            Param Localparam UnknownType (paramTmp ++ x) e++        overrideParam :: Decl -> Decl+        overrideParam (Param Parameter t x e) =+            case lookup x instanceParams of+                Nothing -> Param Localparam t x e+                Just (Right _) -> Param Localparam t x (Ident $ paramTmp ++ x)+                Just (Left t') -> error $ inlineKind ++ " param " ++ x+                        ++ " expected expr, found type: " ++ show t'+        overrideParam (ParamType Parameter x t) =+            case lookup x instanceParams of+                Nothing -> ParamType Localparam x t+                Just (Left _) ->+                    ParamType Localparam x $ Alias (paramTmp ++ x) []+                Just (Right e') -> error $ inlineKind ++ " param " ++ x+                        ++ " expected type, found expr: " ++ show e'+        overrideParam other = other++        portBindingItem :: PortBinding -> ModuleItem+        portBindingItem (ident, expr) =+            if findDeclDir ident == Input+                then bind (LHSDot (inj LHSBit LHSIdent) ident) expr+                else bind (toLHS expr) (Dot (inj Bit Ident) ident)+            where+                bind = Assign AssignOptionNone+                inj bit idn = if null ranges+                    then idn instanceName+                    else bit (idn instanceName) (Ident loopVar)++        declDirs = execWriter $+            mapM (collectDeclsM collectDeclDir) items+        collectDeclDir :: Decl -> Writer (Map.Map Identifier Direction) ()+        collectDeclDir (Variable dir _ ident _ _) =+            when (dir /= Local) $+                tell $ Map.singleton ident dir+        collectDeclDir net @ Net{} =+            collectNetAsVarM collectDeclDir net+        collectDeclDir _ = return ()+        findDeclDir :: Identifier -> Direction+        findDeclDir ident =+            case Map.lookup ident declDirs of+                Nothing -> error $ "could not find decl dir of " ++ ident+                    ++ " among " ++ show declDirs+                Just dir -> dir++        toLHS :: Expr -> LHS+        toLHS expr =+            case exprToLHS expr of+                Just lhs -> lhs+                Nothing  -> error $ "trying to bind an " ++ inlineKind+                    ++ " output to " ++ show expr ++ " but that can't be an LHS"++        -- for instance arrays, a unique identifier to be used as a genvar+        loopVar = "_arr_" ++ key++        isArray = not $ null ranges+        [arrayRange @ (arrayLeft, arrayRight)] = ranges++        -- wrap the given item in a generate loop if necessary+        wrapInstance :: Identifier -> [ModuleItem] -> ModuleItem+        wrapInstance blockName moduleItems =+            Generate $+            if not isArray then+                [item]+            else+                [ GenModuleItem (Genvar loopVar)+                , GenFor inits cond incr item+                ]+            where+                item = GenBlock blockName $ map GenModuleItem moduleItems+                inits = (loopVar, arrayLeft)+                cond = endianCondExpr arrayRange+                    (BinOp Ge (Ident loopVar) arrayRight)+                    (BinOp Le (Ident loopVar) arrayRight)+                incr = (loopVar, AsgnOp Add, step)+                step = endianCondExpr arrayRange+                    (UniOp UniSub $ RawNum 1) (RawNum 1)++-- used for modport array binding offset placeholders+pattern Tag :: Expr+pattern Tag = Ident "%"++modportBaseName :: Identifier -> Identifier+modportBaseName = (++) "_mbase_"++-- the dimensions of interface instance arrays are encoded as synthetic modports+-- during inlining, enabling subsequent modport bindings to implicitly use the+-- bounds of the interface instance array when the bounds are unspecified+pattern InstArrName :: Identifier+pattern InstArrName = "~instance_array_dimensions~"+pattern InstArrVal :: Expr -> Expr -> [ModportDecl]+pattern InstArrVal l r = [(Local, "l", l), (Local, "r", r)]+pattern InstArrKey :: Expr -> Expr+pattern InstArrKey expr = Dot (Bit expr (RawNum 0)) InstArrName+pattern InstArrEncoded :: Expr -> Expr -> ModuleItem+pattern InstArrEncoded l r = Modport InstArrName (InstArrVal l r)++-- encoding for normal declarations in the current module+pattern DeclVal :: [ModportDecl]+pattern DeclVal = [(Local, "~decl~", Nil)]++-- encoding for the interface type of an interface instantiation+pattern InterfaceTypeName :: Identifier+pattern InterfaceTypeName = "~interface_type~"+pattern InterfaceTypeVal :: Identifier -> [ModportDecl]+pattern InterfaceTypeVal x = [(Local, "~interface~type~", Ident x)]+pattern InterfaceTypeKey :: Expr -> Expr+pattern InterfaceTypeKey e = Dot e InterfaceTypeName+pattern InterfaceTypeEncoded :: Identifier -> ModuleItem+pattern InterfaceTypeEncoded x = Modport InterfaceTypeName (InterfaceTypeVal x)++-- determines the lower bound for the given slice+sliceLo :: PartSelectMode -> Range -> Expr+sliceLo NonIndexed (l, r) = endianCondExpr (l, r) r l+sliceLo IndexedPlus (base, _) = base+sliceLo IndexedMinus (base, len) = BinOp Add (BinOp Sub base len) (RawNum 1)
+ src/Convert/Jump.hs view
@@ -0,0 +1,385 @@+{-# LANGUAGE PatternSynonyms #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for `return`, `break`, and `continue`+ -+ - Because Verilog-2005 has no jumping statements, this conversion ends up+ - producing significantly more verbose code to achieve the same control flow.+ -}++module Convert.Jump (convert) where++import Control.Monad.State.Strict+import Control.Monad.Writer.Strict++import Convert.Traverse+import Language.SystemVerilog.AST++data Info = Info+    { sLoopDepth :: Int+    , sHasJump :: Bool+    , sReturnAllowed :: Bool+    , sJumpAllowed :: Bool+    }++initialState :: Info+initialState = Info+    { sLoopDepth = 0+    , sHasJump = False+    , sReturnAllowed = False+    , sJumpAllowed = True+    }++initialStateTF :: Info+initialStateTF = initialState { sReturnAllowed = True }++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem++convertModuleItem :: ModuleItem -> ModuleItem+convertModuleItem (MIPackageItem (Function ml t f decls stmtsOrig)) =+    MIPackageItem $ Function ml t f decls' stmts''+    where+        stmts = map (traverseNestedStmts convertReturn) stmtsOrig+        convertReturn :: Stmt -> Stmt+        convertReturn (Return Nil) = Return Nil+        convertReturn (Return e) =+            Block Seq "" []+            [ asgn f e+            , Return Nil+            ]+        convertReturn other = other+        stmts' = evalState (convertStmts stmts) initialStateTF+        (decls', stmts'') = addJumpStateDeclTF decls stmts'+convertModuleItem (MIPackageItem (Task ml f decls stmts)) =+    MIPackageItem $ Task ml f decls' stmts''+    where+        stmts' = evalState (convertStmts stmts) initialStateTF+        (decls', stmts'') = addJumpStateDeclTF decls stmts'+convertModuleItem (Initial    stmt) = convertMIStmt Initial      stmt+convertModuleItem (Final      stmt) = convertMIStmt Final        stmt+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+        stmt' = evalState (convertStmt stmt) initialState+        stmt'' = addJumpStateDeclStmt stmt'++-- adds a declaration of the jump state variable if it is needed; if the jump+-- state is not used at all, then it is removed from the given statements+-- entirely+addJumpStateDeclTF :: [Decl] -> [Stmt] -> ([Decl], [Stmt])+addJumpStateDeclTF decls stmts =+    if uses && not declares then+        ( decls +++            [Variable Local jumpStateType jumpState [] jsNone]+        , stmts )+    else if uses then+        (decls, stmts)+    else+        (decls, map (traverseNestedStmts removeJumpState) stmts)+    where+        dummyStmt = Block Seq "" decls stmts+        writesJumpState f = elem jumpState $ execWriter $+            collectNestedStmtsM f dummyStmt+        declares = writesJumpState $ collectStmtDeclsM collectVarM+        uses = writesJumpState $+            collectStmtExprsM $ collectNestedExprsM collectExprIdentM+        collectVarM :: Decl -> Writer [String] ()+        collectVarM (Variable Local _ ident _ _) = tell [ident]+        collectVarM _ = return ()+        collectExprIdentM :: Expr -> Writer [String] ()+        collectExprIdentM (Ident ident) = tell [ident]+        collectExprIdentM _ = return ()+addJumpStateDeclStmt :: Stmt -> Stmt+addJumpStateDeclStmt stmt =+    if null decls+        then stmt'+        else Block Seq "" decls [stmt']+    where (decls, [stmt']) = addJumpStateDeclTF [] [stmt]++removeJumpState :: Stmt -> Stmt+removeJumpState (orig @ (Asgn _ _ (LHSIdent ident) _)) =+    if ident == jumpState+        then Null+        else orig+removeJumpState other = other++convertStmts :: [Stmt] -> State Info [Stmt]+convertStmts stmts = do+    res <- convertStmt $ Block Seq "" [] stmts+    let Block Seq "" [] stmts' = res+    return stmts'+++pattern SimpleLoopInits :: Identifier -> [(LHS, Expr)]+pattern SimpleLoopInits var <- [(LHSIdent var, _)]++pattern SimpleLoopGuard :: Identifier -> Expr+pattern SimpleLoopGuard var <- BinOp _ (Ident var) _++pattern SimpleLoopIncrs :: Identifier -> [(LHS, AsgnOp, Expr)]+pattern SimpleLoopIncrs var <- [(LHSIdent var, _, _)]++-- 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+    modify $ \s -> s { sJumpAllowed = False }+    stmts' <- mapM convertStmt stmts+    modify $ \s -> s { sJumpAllowed = jumpAllowed }+    return $ Block Par x decls stmts'++convertStmt (Block Seq ""+    decls@[CommentDecl{}, Variable Local _ var0 [] Nil]+    [ comment@CommentStmt{}+    , For+        inits@(SimpleLoopInits var1)+        comp@(SimpleLoopGuard var2)+        incr@(SimpleLoopIncrs var3)+        stmt+    ]) =+    convertLoop localInfo loop comp incr stmt+        >>= return . Block Seq "" decls . (comment :) . pure+    where+        loop c i s = For inits c i s+        localInfo = if var0 /= var1 || var1 /= var2 || var2 /= var3+                        then Nothing+                        else Just ""++convertStmt (Block Seq x decls stmts) =+    step stmts >>= return . Block Seq x decls+    where+        step :: [Stmt] -> State Info [Stmt]+        step [] = return []+        step (s : ss) = do+            hasJump <- gets sHasJump+            loopDepth <- gets sLoopDepth+            modify $ \st -> st { sHasJump = False }+            s' <- convertStmt s+            currHasJump <- gets sHasJump+            currLoopDepth <- gets sLoopDepth+            assertMsg (loopDepth == currLoopDepth) "loop depth invariant failed"+            modify $ \st -> st { sHasJump = hasJump || currHasJump }+            ss' <- step ss+            if currHasJump && not (null ss)+            then do+                let comp = BinOp Eq (Ident jumpState) jsNone+                let stmt = Block Seq "" [] ss'+                return [s', If NoCheck comp stmt Null]+            else do+                return $ s' : ss'++convertStmt (If unique expr thenStmt elseStmt) = do+    (thenStmt', thenHasJump) <- convertSubStmt thenStmt+    (elseStmt', elseHasJump) <- convertSubStmt elseStmt+    modify $ \s -> s { sHasJump = thenHasJump || elseHasJump }+    return $ If unique expr thenStmt' elseStmt'++convertStmt (Case unique kw expr cases) = do+    results <- mapM convertSubStmt $ map snd cases+    let (stmts', hasJumps) = unzip results+    let cases' = zip (map fst cases) stmts'+    let hasJump = foldl (||) False hasJumps+    modify $ \s -> s { sHasJump = hasJump }+    return $ Case unique kw expr cases'++convertStmt (For+    inits@(SimpleLoopInits var1)+    comp@(SimpleLoopGuard var2)+    incr@(SimpleLoopIncrs var3) stmt) =+    convertLoop localInfo loop comp incr stmt+    where+        loop c i s = For inits c i s+        localInfo = if var1 /= var2 || var2 /= var3+                        then Nothing+                        else Just var1+convertStmt (For inits comp incr stmt) =+    convertLoop Nothing loop comp incr stmt+    where loop c i s = For inits c i s+convertStmt (While comp stmt) =+    convertLoop Nothing loop comp [] stmt+    where loop c _ s = While c s+convertStmt (DoWhile comp stmt) =+    convertLoop Nothing loop comp [] stmt+    where loop c _ s = DoWhile c s++convertStmt (Continue) = do+    loopDepth <- gets sLoopDepth+    jumpAllowed <- gets sJumpAllowed+    assertMsg (loopDepth > 0) "encountered continue outside of loop"+    assertMsg jumpAllowed "encountered continue inside fork-join"+    modify $ \s -> s { sHasJump = True }+    return $ asgn jumpState jsContinue+convertStmt (Break) = do+    loopDepth <- gets sLoopDepth+    jumpAllowed <- gets sJumpAllowed+    assertMsg (loopDepth > 0) "encountered break outside of loop"+    assertMsg jumpAllowed "encountered break inside fork-join"+    modify $ \s -> s { sHasJump = True }+    return $ asgn jumpState jsBreak+convertStmt (Return Nil) = do+    jumpAllowed <- gets sJumpAllowed+    returnAllowed <- gets sReturnAllowed+    assertMsg jumpAllowed "encountered return inside fork-join"+    assertMsg returnAllowed "encountered return outside of task or function"+    modify $ \s -> s { sHasJump = True }+    return $ asgn jumpState jsReturn++convertStmt (RepeatL expr stmt) = do+    loopDepth <- gets sLoopDepth+    modify $ \s -> s { sLoopDepth = loopDepth + 1 }+    stmt' <- convertStmt stmt+    hasJump <- gets sHasJump+    assertMsg (not hasJump) "jumps not supported within repeat loops"+    modify $ \s -> s { sLoopDepth = loopDepth }+    return $ RepeatL expr stmt'+convertStmt (Forever stmt) = do+    loopDepth <- gets sLoopDepth+    modify $ \s -> s { sLoopDepth = loopDepth + 1 }+    stmt' <- convertStmt stmt+    hasJump <- gets sHasJump+    assertMsg (not hasJump) "jumps not supported within forever loops"+    modify $ \s -> s { sLoopDepth = loopDepth }+    return $ Forever stmt'++convertStmt (Timing timing stmt) =+    convertStmt stmt >>= return . Timing timing+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"++convertStmt other = return other++-- convert a statement on its own without changing the state, but returning+-- whether or not the statement contains a jump; used to reconcile across+-- branching statements+convertSubStmt :: Stmt -> State Info (Stmt, Bool)+convertSubStmt stmt = do+    origState <- get+    stmt' <- convertStmt stmt+    hasJump <- gets sHasJump+    put origState+    return (stmt', hasJump)++type Incr = (LHS, AsgnOp, Expr)++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"+    modify $ \s -> s { sLoopDepth = origLoopDepth + 1 }+    -- convert the loop body+    stmt' <- convertStmt stmt+    -- restore the loop state+    Info { sLoopDepth = afterLoopDepth, sHasJump = afterHasJump } <- get+    assertMsg (origLoopDepth + 1 == afterLoopDepth) "loop depth invariant failed"+    modify $ \s -> s { sLoopDepth = origLoopDepth }++    let useBreakVar = local && not (null localVar)+    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 []+                        (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 incr stmt'+        else if origLoopDepth == 0 then+            Block Seq "" [ breakVarDecl ]+                [ loop comp' incr' body'+                , pushBreakVar+                , jsCheckReturn+                ]+        else+            Block Seq ""+                [ breakVarDecl, jsStackDecl ]+                [ 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 [(RawNum 0, RawNum 1)]++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 = jsVal 0+-- skip to the next iteration of the loop (continue)+jsContinue :: Expr+jsContinue = jsVal 1+-- stop running the loop immediately (break)+jsBreak :: Expr+jsBreak = jsVal 2+-- stop running the function immediately (return)+jsReturn :: Expr+jsReturn = jsVal 3+++assertMsg :: Bool -> String -> State Info ()+assertMsg True _ = return ()+assertMsg False msg = error msg++asgn :: Identifier -> Expr -> Stmt+asgn x e = Asgn AsgnOpEq Nothing (LHSIdent x) e
+ src/Convert/KWArgs.hs view
@@ -0,0 +1,66 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for named function and task arguments+ -+ - This conversion takes the named arguments and moves them into their+ - corresponding position in the argument list, with names removed.+ -}++module Convert.KWArgs (convert) where++import Data.List (elemIndex, sortOn)+import Control.Monad.Writer.Strict+import qualified Data.Map.Strict as Map++import Convert.Traverse+import Language.SystemVerilog.AST++type TFs = Map.Map Identifier [Identifier]++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions convertDescription++convertDescription :: Description -> Description+convertDescription description =+    traverseModuleItems (convertModuleItem tfs) description+    where tfs = execWriter $ collectModuleItemsM collectTF description++convertModuleItem :: TFs -> ModuleItem -> ModuleItem+convertModuleItem tfs =+    (traverseExprs $ traverseNestedExprs $ convertExpr tfs) .+    (traverseStmts $ traverseNestedStmts $ convertStmt tfs)++collectTF :: ModuleItem -> Writer TFs ()+collectTF (MIPackageItem (Function _ _ f decls _)) = collectTFDecls f decls+collectTF (MIPackageItem (Task     _   f decls _)) = collectTFDecls f decls+collectTF _ = return ()++collectTFDecls :: Identifier -> [Decl] -> Writer TFs ()+collectTFDecls name decls =+    tell $ Map.singleton name $ filter (not . null) $ map getInput decls+    where+        getInput :: Decl -> Identifier+        getInput (Variable Input _ ident _ _) = ident+        getInput _ = ""++convertExpr :: TFs -> Expr -> Expr+convertExpr tfs (Call expr args) =+    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 -> constructor (Ident func) (Args pnArgs kwArgs)+        Just ordered -> constructor (Ident func) (Args args [])+            where+                args = pnArgs ++ (map snd $ sortOn position kwArgs)+                position (x, _) = elemIndex x ordered+convertInvoke _ constructor expr args =+    constructor expr args
+ src/Convert/LogOp.hs view
@@ -0,0 +1,28 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for logical implication (->) and logical equality (<->) operators.+ -+ - We convert `a -> b` to `!a || b`, as per the definition of implication.+ -+ - We convert `a <-> b` to `!a = !b`. Note that we can't simply use `a = b` as+ - `1 != 2`, but `1 <-> 2`.+ -}++module Convert.LogOp (convert) where++import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert =+    map $+    traverseDescriptions $ traverseModuleItems $+    traverseExprs $ traverseNestedExprs convertExpr++convertExpr :: Expr -> Expr+convertExpr (BinOp LogEq a b) =+    BinOp Eq (UniOp LogNot a) (UniOp LogNot b)+convertExpr (BinOp LogImp a b) =+    BinOp LogOr (UniOp LogNot a) b+convertExpr other = other
+ src/Convert/Logic.hs view
@@ -0,0 +1,208 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion from `logic` to `wire` or `reg`+ -+ - We convert a module-level logic to a reg if it is assigned to in an always or+ - initial block. Other module-level logics become wires. All other logics+ - (i.e., in a function) become regs.+ -+ - Parameters and localparams with integer vector types become implicit.+ -+ - The struct conversion and Verilog-2005's lack of permissive net vs. variable+ - resolution leads to some interesting special cases for this conversion, as+ - parts of a struct may be used as a variable, while other parts may be used as+ - a net.+ -+ - 1) If a reg, or a portion thereof, is assigned by a continuous assignment+ - item, then that assignment is converted to a procedural assignment within an+ - added `always_comb` item.+ -+ - 2) If a reg, or a portion thereof, is bound to an output port, then that+ - binding is replaced by a temporary net declaration, and a procedural+ - assignment is added which updates the reg to the value of the new net.+ -}++module Convert.Logic (convert) where++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 Ports = Map.Map Identifier [(Identifier, Direction)]+type Location = [Identifier]+type Locations = Set.Set Location+type ST = ScoperT Type (Writer Locations)++convert :: [AST] -> [AST]+convert =+    traverseFiles+        (collectDescriptionsM collectPortsM)+        (traverseDescriptions . convertDescription)+    where+        collectPortsM :: Description -> Writer Ports ()+        collectPortsM orig@(Part _ _ _ _ name portNames _) =+            tell $ Map.singleton name ports+            where+                ports = zip portNames (map lookupDir portNames)+                dirs = execWriter $ collectModuleItemsM collectDeclDirsM orig+                lookupDir :: Identifier -> Direction+                lookupDir portName =+                    case lookup portName dirs of+                        Just dir -> dir+                        Nothing -> Inout+        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 description@(Part _ _ Module _ _ _ _) =+    -- rewrite reg continuous assignments and output port connections+    partScoper (rewriteDeclM locations) (traverseModuleItemM ports)+        return return description+    where+        -- write down which vars are procedurally assigned+        locations = execWriter $ partScoperT+            traverseDeclM return return traverseStmtM description+convertDescription _ other = other++traverseModuleItemM :: Ports -> ModuleItem -> Scoper Type ModuleItem+traverseModuleItemM ports = embedScopes $ traverseModuleItem ports++traverseModuleItem :: Ports -> Scopes Type -> ModuleItem -> ModuleItem+traverseModuleItem 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 SenseStar)++        fixModuleItem :: ModuleItem -> ModuleItem+        -- rewrite bad continuous assignments to use procedural assignments+        fixModuleItem (Assign AssignOptionNone lhs expr) =+            if not (isReg lhs)+                then Assign AssignOptionNone lhs expr+                else+                    Generate $ map GenModuleItem+                    [ MIPackageItem $ Decl decl+                    , Assign AssignOptionNone (LHSIdent x) expr+                    , always_comb $ Asgn AsgnOpEq Nothing lhs (Ident x)+                    ]+            where+                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 $+                    comment : 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, expr) =+                    if not outputBound || not usesReg+                        then ((portName, expr), [])+                        else ((portName, tmpExpr), items)+                    where+                        outputBound = portDir == Just Output+                        usesReg = Just True == fmap isReg (exprToLHS expr)+                        portDir = maybeModulePorts >>= lookup portName+                        tmp = "sv2v_tmp_" ++ instanceName ++ "_" ++ portName+                        tmpExpr = Ident tmp+                        decl = Net Local TWire DefaultStrength t tmp [] Nil+                        t = Implicit Unspecified [r]+                        r = (DimsFn FnBits $ Right expr, RawNum 1)+                        items =+                            [ MIPackageItem $ Decl decl+                            , always_comb $ Asgn AsgnOpEq Nothing lhs tmpExpr]+                        lhs = case exprToLHS expr of+                            Just l -> l+                            Nothing ->+                                error $ "bad non-lhs, non-net expr "+                                    ++ show expr ++ " connected to output port "+                                    ++ portName ++ " of " ++ instanceName+                maybeModulePorts = Map.lookup moduleName ports+        fixModuleItem other = other++traverseDeclM :: Decl -> ST Decl+traverseDeclM decl@(Variable _ t x _ _) =+    insertElem x t >> return decl+traverseDeclM decl@(Net _ _ _ t x _ _) =+    insertElem x t >> return decl+traverseDeclM decl = return decl++rewriteDeclM :: Locations -> Decl -> Scoper Type Decl+rewriteDeclM locations (Variable d (IntegerVector TLogic sg rs) x a e) = do+    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 t'+            return $ Variable d' t' x a e+        else do+            let t' = Implicit sg rs+            insertElem accesses t'+            return $ Net d TWire DefaultStrength t' x a e+rewriteDeclM _ decl@(Variable _ t x _ _) =+    insertElem x t >> return decl+rewriteDeclM _ (Net d n s (IntegerVector _ sg rs) x a e) =+    insertElem x t >> return (Net d n s t x a e)+    where t = Implicit sg rs+rewriteDeclM _ decl@(Net _ _ _ t x _ _) =+    insertElem x 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++traverseStmtM :: Stmt -> ST Stmt+traverseStmtM stmt@Timing{} =+    -- ignore the timing LHSs+    return stmt+traverseStmtM stmt@(Subroutine (Ident f) (Args (_ : Ident x : _) [])) =+    when (f == "$readmemh" || f == "$readmemb") (collectLHSM $ LHSIdent x)+        >> return stmt+traverseStmtM stmt =+    collectStmtLHSsM (collectNestedLHSsM collectLHSM) stmt+        >> return stmt++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 view
@@ -0,0 +1,331 @@+{-# LANGUAGE TupleSections #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - 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.+ -+ - We previously had a very complex conversion which used `generate` to make+ - flattened and unflattened versions of the array as necessary. This has now+ - been "simplified" to always flatten the array, and then rewrite all usages of+ - the array as appropriate.+ -+ - A previous iteration of this conversion aggressively flattened all dimensions+ - (even if unpacked) in any multidimensional data declaration. This had the+ - unfortunate side effect of packing memories, which could hinder efficient+ - synthesis. Now this conversion only flattens packed dimensions and leaves the+ - (only potentially necessary) movement of dimensions from unpacked to packed+ - to the separate UnpackedArray conversion.+ -+ - Note that the ranges being combined may not be of the form [hi:lo], and need+ - not even be the same direction! Because of this, we have to flip around the+ - indices of certain accesses.+ -}++module Convert.MultiplePacked (convert) where++import Convert.ExprUtils+import Control.Monad ((>=>))+import Data.Tuple (swap)+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])++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions convertDescription++convertDescription :: Description -> Description+convertDescription (description @ (Part _ _ Module _ _ _ _)) =+    partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM+    description+convertDescription other = other++-- collects and converts declarations with multiple packed dimensions+traverseDeclM :: Decl -> Scoper TypeInfo Decl+traverseDeclM (Variable dir t ident a e) = do+    t' <- traverseTypeM t a ident+    traverseDeclExprsM traverseExprM $ Variable dir t' ident a e+traverseDeclM net @ Net{} =+    traverseNetAsVarM traverseDeclM net+traverseDeclM (Param s t ident e) = do+    t' <- traverseTypeM t [] ident+    traverseDeclExprsM traverseExprM $ Param s t' ident e+traverseDeclM other = traverseDeclExprsM traverseExprM other++traverseTypeM :: Type -> [Range] -> Identifier -> Scoper TypeInfo Type+traverseTypeM t a ident = do+    tScoped <- scopeType t+    insertElem ident (tScoped, a)+    t' <- case t of+        Struct pk fields rs -> do+            fields' <- flattenFields fields+            return $ Struct pk fields' rs+        Union  pk fields rs -> do+            fields' <- flattenFields fields+            return $ Union  pk fields' rs+        _ -> return t+    let (tf, rs) = typeRanges t'+    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+            let (fieldTypes, fieldNames) = unzip fields+            fieldTypes' <- mapM (\x -> traverseTypeM x [] "") fieldTypes+            return $ zip fieldTypes' fieldNames++traverseModuleItemM :: ModuleItem -> Scoper TypeInfo ModuleItem+traverseModuleItemM (Instance m p x rs l) = do+    -- converts multi-dimensional instances+    rs' <- if length rs <= 1+        then return rs+        else do+            let t = Implicit Unspecified rs+            tScoped <- scopeType t+            insertElem x (tScoped, [])+            let r1 : r2 : rest = rs+            return $ (combineRanges r1 r2) : rest+    traverseExprsM traverseExprM $ Instance m p x rs' l+traverseModuleItemM item =+    traverseLHSsM  traverseLHSM  item >>=+    traverseExprsM traverseExprM++-- combines two ranges into one flattened range+combineRanges :: Range -> Range -> Range+combineRanges r1 r2 = r+    where+        rYY = combine r1 r2+        rYN = combine r1 (swap r2)+        rNY = combine (swap r1) r2+        rNN = combine (swap r1) (swap r2)+        rY = endianCondRange r2 rYY rYN+        rN = endianCondRange r2 rNY rNN+        r = endianCondRange r1 rY rN++        combine :: Range -> Range -> Range+        combine (s1, e1) (s2, e2) =+            (simplify upper, simplify lower)+            where+                size1 = rangeSizeHiLo (s1, e1)+                size2 = rangeSizeHiLo (s2, e2)+                lower = BinOp Add e2 (BinOp Mul e1 size2)+                upper = BinOp Add (BinOp Mul size1 size2)+                            (BinOp Sub lower (RawNum 1))++traverseStmtM :: Stmt -> Scoper TypeInfo Stmt+traverseStmtM =+    traverseStmtLHSsM  traverseLHSM  >=>+    traverseStmtExprsM traverseExprM++traverseExprM :: Expr -> Scoper TypeInfo Expr+traverseExprM = traverseNestedExprsM convertExprM++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 -> Scoper TypeInfo LHS+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' <- convertExprM expr+            case exprToLHS expr' of+                Just lhs' -> return lhs'+                Nothing -> error $ "multi-packed conversion created non-LHS from "+                    ++ (show expr) ++ " to " ++ (show expr')++convertExprM :: Expr -> Scoper TypeInfo Expr+convertExprM = embedScopes convertExpr++convertExpr :: Scopes TypeInfo -> Expr -> Expr+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 nest ((t, a), expr) =+            ((tf rs', a'), nest expr)+            where+                (tf, rs) = typeRanges t+                (rs', a') = case (rs, a) of+                    ([], []) -> ([], [])+                    (packed, []) -> (tail packed, [])+                    (packed, unpacked) -> (packed, tail unpacked)++        -- given an expression, returns its type information and a tagged+        -- version of the expression, if possible+        levels :: Expr -> Maybe (TypeInfo, Expr)+        levels (Bit expr a) =+            case levels expr of+                Just info -> Just $ dropLevel (\expr' -> Bit expr' a) info+                Nothing -> fallbackLevels $ Bit expr a+        levels (Range expr a b) =+            fmap (dropLevel $ \expr' -> Range expr' a b) (levels expr)+        levels (Dot expr x) =+            case levels expr of+                Just ((Struct _ fields [], []), expr') -> dropDot fields expr'+                Just ((Union  _ fields [], []), expr') -> dropDot fields expr'+                _ -> fallbackLevels $ Dot expr x+            where+                dropDot :: [Field] -> Expr -> Maybe (TypeInfo, Expr)+                dropDot fields expr' =+                    if Map.member x fieldMap+                        then Just ((fieldType, []), Dot expr' x)+                        else Nothing+                    where+                        fieldMap = Map.fromList $ map swap fields+                        fieldType = fieldMap Map.! x+        levels expr = fallbackLevels expr++        fallbackLevels :: Expr -> Maybe (TypeInfo, Expr)+        fallbackLevels expr =+            fmap ((, expr) . thd3) res+            where+                res = lookupElem scopes expr+                thd3 (_, _, c) = c++        -- given an expression, returns the two most significant (innermost,+        -- leftmost) packed dimensions and a tagged version of the expression,+        -- if possible+        dims :: Expr -> Maybe (Range, Range, Expr)+        dims expr =+            case levels expr of+                Just ((t, []), expr') ->+                    case snd $ typeRanges t of+                        dimInner : dimOuter : _ ->+                            Just (dimInner, dimOuter, expr')+                        _ -> Nothing+                _ -> Nothing++        -- if the given range is flipped, the result will flip around the given+        -- indexing expression+        orientIdx :: Range -> Expr -> Expr+        orientIdx r e =+            endianCondExpr r e eSwapped+            where+                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) =+            if head x == tag+                then Ident $ tail x+                else Ident x+        rewriteExpr (orig @ (Bit (Bit expr idxInner) idxOuter)) =+            if isJust maybeDims && expr == rewriteExpr expr+                then Bit expr' idx'+                else rewriteExprLowPrec orig+            where+                maybeDims = dims expr+                Just (dimInner, dimOuter, expr') = maybeDims+                idxInner' = orientIdx dimInner idxInner+                idxOuter' = orientIdx dimOuter idxOuter+                base = BinOp Mul idxInner' (rangeSize dimOuter)+                idx' = simplify $ BinOp Add base idxOuter'+        rewriteExpr (orig @ (Range (Bit expr idxInner) NonIndexed rangeOuter)) =+            if isJust maybeDims && expr == rewriteExpr expr+                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, expr') = 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 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 expr+                Just (dimInner, dimOuter, expr') = maybeDims+                mode' = IndexedPlus+                idx' = orientIdx dimInner idx+                len = rangeSize dimOuter+                base = BinOp Add (endianCondExpr dimOuter (snd dimOuter) (fst dimOuter)) (BinOp Mul idx' len)+                range' = (simplify base, simplify len)+        rewriteExprLowPrec (orig @ (Range expr NonIndexed range)) =+            if isJust maybeDims && expr == rewriteExpr expr+                then rewriteExpr $ Range expr IndexedMinus range'+                else orig+            where+                maybeDims = dims expr+                baseDec = fst range+                baseInc = BinOp Sub (BinOp Add baseDec len) (RawNum 1)+                base = endianCondExpr range baseDec baseInc+                len = rangeSize range+                range' = (base, len)+        rewriteExprLowPrec (orig @ (Range expr mode range)) =+            if isJust maybeDims && expr == rewriteExpr expr+                then Range expr' mode' range'+                else orig+            where+                maybeDims = dims expr+                Just (dimInner, dimOuter, expr') = maybeDims+                sizeOuter = rangeSize dimOuter+                offsetOuter = uncurry (endianCondExpr dimOuter) $ swap dimOuter+                (baseOrig, lenOrig) = range+                lenOrigMinusOne = BinOp Sub lenOrig (RawNum 1)+                baseSwapped =+                    orientIdx dimInner $+                    if mode == IndexedPlus+                        then+                            endianCondExpr dimInner+                            baseOrig+                            (BinOp Add baseOrig lenOrigMinusOne)+                        else+                            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
+ src/Convert/NamedBlock.hs view
@@ -0,0 +1,39 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for unnamed blocks with contain data declarations+ -+ - SystemVerilog allows data declarations to appear in all blocks, but Verilog+ - allows them to appear only in blocks that are named. This conversion gives+ - such blocks a unique name to placate strict Verilog frontends.+ -}++module Convert.NamedBlock (convert) where++import Control.Monad.State.Strict++import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions convertDescription++convertDescription :: Description -> Description+convertDescription description =+    evalState (traverseModuleItemsM traverseModuleItem description) 1+    where+        traverseModuleItem = traverseStmtsM $ traverseNestedStmtsM traverseStmtM++traverseStmtM :: Stmt -> State Int Stmt+traverseStmtM (Block kw "" [] stmts) =+    return $ Block kw "" [] stmts+traverseStmtM (Block kw "" decls stmts) = do+    x <- uniqueBlockName+    return $ Block kw x decls stmts+traverseStmtM other = return other++uniqueBlockName :: State Int String+uniqueBlockName = do+    cnt <- get+    put $ cnt + 1+    return $ "sv2v_autoblock_" ++ show cnt
+ src/Convert/Package.hs view
@@ -0,0 +1,781 @@+{-# LANGUAGE TupleSections #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for packages and global declarations+ -+ - This conversion first makes a best-effort pass at resolving any simple+ - declaration ordering issues in the input. Many conversions require that+ - declarations precede their first usage.+ -+ - The main phase elaborates packages and resolves imported identifiers. An+ - identifier (perhaps implicitly) referring to `P::X` is rewritten to `P_X`.+ - This conversion assumes such renaming will not cause conflicts. The full+ - semantics of imports and exports are followed.+ -+ - Finally, because Verilog doesn't allow declarations to exist outside of+ - modules, declarations within packages and in the global scope are injected+ - into modules and interfaces as needed.+ -}++module Convert.Package+    ( convert+    , inject+    , prefixItems+    ) where++import Control.Monad.State.Strict+import Control.Monad.Writer.Strict+import Data.List (insert, intercalate)+import Data.Maybe (mapMaybe)+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set++import Convert.ResolveBindings (exprToType, resolveBindings)+import Convert.Scoper+import Convert.Traverse+import Language.SystemVerilog.AST++type Packages = Map.Map Identifier Package+type Classes = Map.Map Identifier Class+type Package = (IdentStateMap, [PackageItem])+type Class = ([Decl], [PackageItem])+type Idents = Set.Set Identifier+type PIs = Map.Map Identifier PackageItem++convert :: [AST] -> [AST]+convert files =+    map (traverseDescriptions $ convertDescription pis) files'+    where+        (files', packages') = convertPackages files+        pis = Map.fromList $+            concatMap (concatMap (toPackageItems . makeLocal) . snd) $+            filter (not . Map.null . fst) $+            Map.elems packages'+        toPackageItems :: PackageItem -> [(Identifier, PackageItem)]+        toPackageItems item = map (, item) (piNames item)++-- convert a parameter to a localparam+makeLocal :: PackageItem -> PackageItem+makeLocal (Decl (Param _ t x e)) = Decl $ Param Localparam t x e+makeLocal (Decl (ParamType _ x t)) = Decl $ ParamType Localparam x t+makeLocal other = other++-- utility for inserting package items into a set of module items as needed+inject :: [PackageItem] -> [ModuleItem] -> [ModuleItem]+inject packageItems items =+    addItems localPIs Set.empty (map addUsedPIs items)+    where+        localPIs = Map.fromList $ concatMap toPIElem packageItems+        toPIElem :: PackageItem -> [(Identifier, PackageItem)]+        toPIElem item = map (, item) (piNames item)++-- utility for appling a prefix to all of the top level items in a module+prefixItems :: Identifier -> [ModuleItem] -> [ModuleItem]+prefixItems prefix items =+    snd $ evalState (processItems "" prefix items) initialState+    where initialState = ([], Map.empty, Map.empty)++-- collect packages and global package items+collectPackageM :: Description -> Writer (Packages, Classes, [PackageItem]) ()+collectPackageM (PackageItem item) =+    when (not $ null $ piNames item) $+        tell (Map.empty, Map.empty, [item])+collectPackageM (Package _ name items) =+    tell (Map.singleton name (Map.empty, items), Map.empty, [])+collectPackageM (Class _ name decls items) =+    tell (Map.empty, Map.singleton name (decls, map unpackClassItem items), [])+    where+        unpackClassItem :: ClassItem -> PackageItem+        unpackClassItem (item @ (_, Task{})) = checkTF item+        unpackClassItem (item @ (_, Function{})) = checkTF item+        unpackClassItem item = checkNonTF item+        checkTF :: ClassItem -> PackageItem+        checkTF (QStatic, item) = item+        checkTF (_, item) =+            error $ "unsupported declaration of non-static method " ++ itemName+            where [itemName] = piNames item+        checkNonTF :: ClassItem -> PackageItem+        checkNonTF (QNone, item) = item+        checkNonTF (qualifier, _) =+            error $ "unexpected qualifier " ++ show qualifier+                ++ " on a class item which is not a task or a function"+collectPackageM _ = return ()++-- elaborate all packages and their usages+convertPackages :: [AST] -> ([AST], Packages)+convertPackages files =+    (files', packages')+    where+        (files', ([], packages', _)) = runState op ([], packages, classes)+        op = mapM (traverseDescriptionsM traverseDescriptionM) files+        packages = Map.insert "" (Map.empty, globalItems) realPackages+        (realPackages, classes, globalItems) =+            execWriter $ mapM (collectDescriptionsM collectPackageM) files++type PackagesState = State ([Identifier], Packages, Classes)++traverseDescriptionM :: Description -> PackagesState Description+traverseDescriptionM (PackageItem item) = do+    return $ PackageItem $ case piNames item of+        [] -> item+        idents -> Decl $ CommentDecl $ "removed " ++ show idents+traverseDescriptionM (Package _ name _) =+    return $ PackageItem $ Decl $ CommentDecl $ "removed package " ++ show name+traverseDescriptionM (Class _ name _ _) =+    return $ PackageItem $ Decl $ CommentDecl $ "removed class " ++ show name+traverseDescriptionM (Part attrs extern kw liftetime name ports items) = do+    (_, items') <- processItems name "" items+    return $ Part attrs extern kw liftetime name ports items'++data IdentState+    = Available [Identifier]+    | Imported Identifier+    | Declared+    deriving Eq++isImported :: IdentState -> Bool+isImported Imported{} = True+isImported _ = False++isDeclared :: IdentState -> Bool+isDeclared Declared{} = True+isDeclared _ = False++type IdentStateMap = Map.Map Identifier IdentState+type Scope = ScoperT IdentState PackagesState++-- produce the partial mapping for a particular export and ensure its validity+resolveExport+    :: IdentStateMap -> Identifier -> Identifier -> PackagesState IdentStateMap+resolveExport mapping "" "" =+    return $ Map.filter isImported mapping+resolveExport mapping pkg "" =+    fmap (Map.mapMaybeWithKey checkExport . fst) (findPackage pkg)+    where+        checkExport :: Identifier -> IdentState -> Maybe IdentState+        checkExport ident exportedIdentState =+            if localIdentState == expectedIdentState+                then localIdentState+                else Nothing+            where+                localIdentState = Map.lookup ident mapping+                expectedIdentState = Just $ Imported $+                    toRootPackage pkg exportedIdentState+resolveExport mapping pkg ident =+    case Map.lookup ident mapping of+        Just (Imported importedPkg) -> do+            exportedPkg <- resolveRootPackage pkg ident+            if importedPkg == exportedPkg+                then return $ Map.singleton ident $ Imported importedPkg+                else error $ "export of " ++ pkg ++ "::" ++ ident+                        ++ " differs from import of " ++ importedPkg+                        ++ "::" ++ ident+        _ -> error $ "export of " ++ pkg ++ "::" ++ ident+                ++ ", but " ++ ident ++ " was never imported"++-- lookup the state of the identifier only within the current scope+lookupLocalIdentState :: Identifier -> Scope (Maybe IdentState)+lookupLocalIdentState =+    fmap (fmap thd3) . lookupLocalIdentM+    where thd3 (_, _, c) = c++-- make a particular identifier within a package available for import+wildcardImport :: Identifier -> Identifier -> Scope ()+wildcardImport pkg ident = do+    rootPkg <- lift $ resolveRootPackage pkg ident+    maybeIdentState <- lookupLocalIdentState ident+    insertElem ident $+        case maybeIdentState of+            Nothing -> Available [rootPkg]+            Just Declared -> Declared+            Just (Imported existingRootPkg) -> Imported existingRootPkg+            Just (Available rootPkgs) ->+                if elem rootPkg rootPkgs+                    then Available rootPkgs+                    else Available $ insert rootPkg rootPkgs++-- make all exported identifiers within a package available for import+wildcardImports :: Identifier -> Scope ()+wildcardImports pkg = do+    (exports, _) <- lift $ findPackage pkg+    _ <- mapM (wildcardImport pkg) (Map.keys exports)+    return ()++-- resolve and store an explicit (non-wildcard) import+explicitImport :: Identifier -> Identifier -> Scope ()+explicitImport pkg ident = do+    rootPkg <- lift $ resolveRootPackage pkg ident+    maybeIdentState <- lookupLocalIdentState ident+    insertElem ident $+        case maybeIdentState of+            Nothing -> Imported rootPkg+            Just Declared ->+                error $ "import of " ++ pkg ++ "::" ++ ident+                    ++ " conflicts with prior declaration of " ++ ident+            Just Available{} -> Imported rootPkg+            Just (Imported otherPkg) ->+                if otherPkg == rootPkg+                    then Imported rootPkg+                    else error $ "import of " ++ pkg ++ "::" ++ ident+                            ++ " conflicts with prior import of "+                            ++ otherPkg ++ "::" ++ ident++-- main logic responsible for translating packages, resolving imports and+-- exports, and rewriting identifiers referring to package declarations+processItems :: Identifier -> Identifier -> [ModuleItem]+    -> PackagesState (IdentStateMap, [ModuleItem])+processItems topName packageName moduleItems = do+    (moduleItems', scopes) <- runScoperT+        traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM+        topName (reorderItems moduleItems)+    let rawIdents = extractMapping scopes+    externalIdentMaps <- mapM (resolveExportMI rawIdents) moduleItems+    let externalIdents = Map.unions externalIdentMaps+    let declaredIdents = Map.filter isDeclared rawIdents+    let exports = Map.union declaredIdents externalIdents+    let exports' = if null packageName+                    then rawIdents+                    else exports+    seq exports return (exports', moduleItems')+    where+        -- produces partial mappings of exported identifiers, while also+        -- checking the validity of the exports+        resolveExportMI :: IdentStateMap -> ModuleItem -> PackagesState IdentStateMap+        resolveExportMI mapping (MIPackageItem (item @ (Export pkg ident))) =+            if null packageName+                then error $ "invalid " ++ (init $ show item)+                        ++ " outside of package"+                else resolveExport mapping pkg ident+        resolveExportMI _ _ = return Map.empty++        -- declare an identifier, prefixing it if within a package+        prefixIdent :: Identifier -> Scope Identifier+        prefixIdent x = do+            inProcedure <- withinProcedureM+            maybeIdentState <- lookupLocalIdentState x+            case maybeIdentState of+                Just (Imported rootPkg) -> error $ "declaration of " ++ x+                    ++ " conflicts with prior import of " ++ rootPkg+                    ++ "::" ++ x+                _ -> do+                    insertElem x Declared+                    if inProcedure || null packageName+                        then return x+                        else return $ packageName ++ '_' : x++        -- check the global scope for declarations or imports+        resolveGlobalIdent :: Identifier -> Scope Identifier+        resolveGlobalIdent x = do+            (exports, _) <- lift $ findPackage ""+            case Map.lookup x exports of+                Nothing -> return x+                Just identState -> do+                    -- inject the exact state outside of the module scope,+                    -- allowing wildcard imports to be handled correctly+                    insertElem [Access x Nil] identState+                    resolveIdent x++        -- remap an identifier if needed based on declarations, explicit+        -- imports, or names available for import+        resolveIdent :: Identifier -> Scope Identifier+        resolveIdent x = do+            details <- lookupElemM x+            case details of+                Nothing ->+                    -- only missing identifiers within parts should be looked up+                    -- in the global scope+                    if null packageName && not (null topName)+                        then resolveGlobalIdent x+                        else return x+                Just ([_, _], _, Declared) ->+                    if null packageName+                        then return x+                        else return $ packageName ++ '_' : x+                Just (_, _, Declared) -> return x+                Just (_, _, Imported rootPkg) ->+                    return $ rootPkg ++ '_' : x+                Just (accesses, _, Available [rootPkg]) -> do+                    insertElem accesses $ Imported rootPkg+                    return $ rootPkg ++ '_' : x+                Just (_, _, Available rootPkgs) ->+                    error $ "identifier " ++ show x+                        ++ " ambiguously refers to the definitions in any of "+                        ++ intercalate ", " rootPkgs++        traversePackageItemM :: PackageItem -> Scope PackageItem+        traversePackageItemM (orig @ (Import pkg ident)) = do+            if null ident+                then wildcardImports pkg+                else explicitImport pkg ident+            return $ Decl $ CommentDecl $ "removed " ++ show orig+        traversePackageItemM (orig @ (Export pkg ident)) = do+            () <- when (not (null pkg || null ident)) $ do+                localName <- resolveIdent ident+                rootPkg <- lift $ resolveRootPackage pkg ident+                localName `seq` rootPkg `seq` return ()+            return $ Decl $ CommentDecl $ "removed " ++ show orig+        traversePackageItemM other = return other++        traverseDeclM :: Decl -> Scope Decl+        traverseDeclM decl = do+            decl' <- traverseDeclNodesM traverseTypeM traverseExprM decl+            case decl' of+                Variable d t x a e -> declHelp x $ \x' -> Variable d t x' a e+                Net  d n s t x a e -> declHelp x $ \x' -> Net  d n s t x' a e+                Param    p t x   e -> declHelp x $ \x' -> Param    p t x'   e+                ParamType  p x   t -> declHelp x $ \x' -> ParamType  p x'   t+                CommentDecl c -> return $ CommentDecl c+            where declHelp x f = prefixIdent x >>= return . f++        traverseRangeM :: Range -> Scope Range+        traverseRangeM = mapBothM traverseExprM++        traverseEnumItemM :: (Identifier, Expr) -> Scope (Identifier, Expr)+        traverseEnumItemM (x, e) = do+            x' <- prefixIdent x+            e' <- traverseExprM e+            return (x', e')++        traverseTypeM :: Type -> Scope Type+        traverseTypeM (CSAlias p b x rs) = do+            x' <- resolveCSIdent' p b x+            rs' <- mapM traverseRangeM rs+            return $ Alias x' rs'+        traverseTypeM (PSAlias p x rs) = do+            x' <- resolvePSIdent' p x+            rs' <- mapM traverseRangeM rs+            return $ Alias x' rs'+        traverseTypeM (Alias x rs) = do+            rs' <- mapM traverseRangeM rs+            x' <- resolveIdent x+            return $ Alias x' rs'+        traverseTypeM (Enum t enumItems rs) = do+            t' <- traverseTypeM t+            enumItems' <- mapM traverseEnumItemM enumItems+            rs' <- mapM traverseRangeM rs+            return $ Enum t' enumItems' rs'+        traverseTypeM other =+            traverseSinglyNestedTypesM traverseTypeM other+            >>= traverseTypeExprsM traverseExprM++        traverseExprM :: Expr -> Scope Expr+        traverseExprM (CSIdent p b x) = do+            x' <- resolveCSIdent' p b x+            return $ Ident x'+        traverseExprM (PSIdent p x) = do+            x' <- resolvePSIdent' p x+            return $ Ident x'+        traverseExprM (Ident x) = resolveIdent x >>= return . Ident+        traverseExprM other =+            traverseSinglyNestedExprsM traverseExprM other+            >>= traverseExprTypesM traverseTypeM++        traverseLHSM :: LHS -> Scope LHS+        traverseLHSM (LHSIdent x) = resolveIdent x >>= return . LHSIdent+        traverseLHSM other = traverseSinglyNestedLHSsM traverseLHSM other++        traverseGenItemM = traverseGenItemExprsM traverseExprM+        traverseModuleItemM (MIPackageItem item) = do+            item' <- traversePackageItemM item+            return $ MIPackageItem item'+        traverseModuleItemM other =+            traverseModuleItemM' other+        traverseModuleItemM' =+            traverseTypesM traverseTypeM >=>+            traverseExprsM traverseExprM >=>+            traverseLHSsM  traverseLHSM+        traverseStmtM =+            traverseStmtExprsM traverseExprM >=>+            traverseStmtLHSsM  traverseLHSM++        traverseParamBindingM :: ParamBinding -> Scope ParamBinding+        traverseParamBindingM (x, Left t) =+            traverseTypeM t >>= return . (x, ) . Left+        traverseParamBindingM (x, Right e) =+            traverseExprM e >>= return . (x, ) . Right++        -- wrapper allowing explicit reference to local package items+        resolvePSIdent' :: Identifier -> Identifier -> Scope Identifier+        resolvePSIdent' p x = do+            if p /= packageName then+                lift $ resolvePSIdent p x+            else do+                details <- lookupElemM $ Dot (Ident p) x+                return $ case details of+                    Just ([_, _], _, Declared) -> p ++ '_' : x+                    Just ([_, _], _, Imported rootPkg) -> rootPkg ++ '_' : x+                    _ -> error $ "package " ++ show p ++ " references"+                            ++ " undeclared local \"" ++ p ++ "::" ++ x ++ "\""++        -- wrapper resolving parameters and locally injecting the necessary+        -- class items into modules and interfaces+        resolveCSIdent'+            :: Identifier -> [ParamBinding] -> Identifier -> Scope Identifier+        resolveCSIdent' p b x = do+            scopeKeys <- bindingsScopeKeys b+            b' <- mapM traverseParamBindingM b+            x' <- lift $ resolveCSIdent p b' scopeKeys x+            let rootPkg = take (length x' - length x - 1) x'+            when (null packageName) (classScopeInject rootPkg x')+            return x'++        -- inject the given class item and its dependencies into the local scope+        classScopeInject :: Identifier -> Identifier -> Scope ()+        classScopeInject rootPkg fullName = do+            (_, packages, _) <- lift get+            let (_, packageItems) = packages Map.! rootPkg+            let localPIs = Map.fromList $ concatMap toPIElem packageItems+            mapM_ injectIfMissing $+                addItems localPIs Set.empty+                [(Generate [], Set.singleton fullName)]+            where+                injectIfMissing :: ModuleItem -> Scope ()+                injectIfMissing (Generate []) = return ()+                injectIfMissing moduleItem = do+                    let MIPackageItem packageItem = moduleItem+                    let itemName : _ = piNames packageItem+                    details <- lookupElemM itemName+                    when (details == Nothing) $ do+                        accesses <- procedureLocM+                        let accesses' = accesses ++ [Access itemName Nil]+                        if null accesses+                            then insertElem itemName Declared+                            else insertElem accesses' Declared+                        injectItem moduleItem+                toPIElem :: PackageItem -> [(Identifier, PackageItem)]+                toPIElem item = map (, makeLocal item) (piNames item)++-- locate a package by name, processing its contents if necessary+findPackage :: Identifier -> PackagesState Package+findPackage packageName = do+    (stack, packages, classes) <- get+    let maybePackage = Map.lookup packageName packages+    assertMsg (maybePackage /= Nothing) $+        "could not find package " ++ show packageName+    -- because this conversion doesn't enforce declaration ordering of packages,+    -- it must check for dependency loops to avoid infinite recursion+    let first : rest = reverse $ packageName : stack+    assertMsg (not $ elem packageName stack) $+        "package dependency loop: " ++ show first ++ " depends on "+            ++ intercalate ", which depends on " (map show rest)+    let Just (package @ (exports, _))= maybePackage+    if Map.null exports+        then do+            -- process and resolve this package+            put (packageName : stack, packages, classes)+            package' <- processPackage packageName $ snd package+            (_, packages', _) <- get+            put (stack, Map.insert packageName package' packages', classes)+            return package'+        else return package++-- helper for elaborating a package when it is first referenced+processPackage :: Identifier -> [PackageItem] -> PackagesState Package+processPackage packageName packageItems = do+    (exports, moduleItems') <- processItems packageName packageName wrapped+    let packageItems' = map unwrap moduleItems'+    let package' = (exports, packageItems')+    return package'+    where+        wrapped = map wrap packageItems+        wrap :: PackageItem -> ModuleItem+        wrap = MIPackageItem+        unwrap :: ModuleItem -> PackageItem+        unwrap packageItem = item+            where MIPackageItem item = packageItem++-- resolve a package scoped identifier to its unique global name+resolvePSIdent :: Identifier -> Identifier -> PackagesState Identifier+resolvePSIdent packageName itemName = do+    (_, _, classes) <- get+    case Map.lookup packageName classes of+        Nothing -> do+            rootPkg <- resolveRootPackage packageName itemName+            return $ rootPkg ++ '_' : itemName+        Just ([], _) -> resolveCSIdent packageName [] Set.empty itemName+        Just _ -> error $ "reference to " ++ show itemName+            ++ " in parameterized class " ++ show packageName+            ++ " requires explicit #()"++-- determines the root package contained the given package scoped identifier+resolveRootPackage :: Identifier -> Identifier -> PackagesState Identifier+resolveRootPackage packageName itemName = do+    (exports, _) <- findPackage packageName+    let maybeIdentState = Map.lookup itemName exports+    assertMsg (maybeIdentState /= Nothing) $+        "could not find " ++ show itemName ++ " in package " ++ show packageName+    let Just identState = maybeIdentState+    return $ toRootPackage packageName identState++-- collect hashes of accessed resolved scopes in class parameters+bindingsScopeKeys :: [ParamBinding] -> Scope Idents+bindingsScopeKeys =+    execWriterT . mapM (traverseTypeOrExprIdentsM identMapper) . map snd+    where+        identMapper :: Identifier -> WriterT Idents Scope Identifier+        identMapper x = do+            details <- lift $ lookupElemM x+            case details of+                Nothing -> return ()+                Just (accesses, _, _) ->+                    tell $ Set.singleton $ shortHash accesses+            return x+        traverseTypeOrExprIdentsM mapper (Left  t) =+            traverseTypeIdentsM mapper t >>= return . Left+        traverseTypeOrExprIdentsM mapper (Right e) =+            traverseExprIdentsM mapper e >>= return . Right++-- resolve a class scoped identifier to its unique global name+resolveCSIdent :: Identifier -> [ParamBinding] -> Idents -> Identifier -> PackagesState Identifier+resolveCSIdent className paramBindings scopeKeys itemName = do+    -- find the specified class+    (_, _, classes) <- get+    let maybeClass = Map.lookup className classes+    assertMsg (maybeClass /= Nothing) $+        "could not find class " ++ show className+    let Just (classParams, classItems) = maybeClass+    -- resolve the provided parameters+    let resolveMsg = "parameters in class specialization of " ++ show className+    let paramNames = mapMaybe extractParameterName classParams+    let paramBindings' = resolveBindings resolveMsg paramNames paramBindings+    -- generate a unique name for this synthetic package+    let packageName = className ++ '_' : shortHash (scopeKeys, paramBindings')+    -- process the synthetic package and inject the given parameters+    (exports, classItems') <- processPackage packageName $+        map Decl classParams ++ classItems+    let overrider = overrideParam packageName paramBindings'+    let classItems'' = map overrider classItems'+    -- add the synthetic package to the state+    let package = (exports, classItems'')+    (stack, packages, _) <- get+    put (stack, Map.insert packageName package packages, classes)+    -- ensure the item actually exists+    let maybeIdentState = Map.lookup itemName exports+    assertMsg (maybeIdentState /= Nothing) $+        "could not find " ++ show itemName ++ " in class " ++ show className+    return $ packageName ++ '_' : itemName+    where+        extractParameterName :: Decl -> Maybe Identifier+        extractParameterName (Param Parameter _ x _) = Just x+        extractParameterName (ParamType Parameter x _) = Just x+        extractParameterName _ = Nothing++        -- replace default parameter values with the given overrides+        overrideParam :: Identifier -> [ParamBinding] -> PackageItem -> PackageItem+        overrideParam packageName bindings (Decl (Param Parameter t x e)) =+            Decl $ Param Parameter t x $+                case lookup x' bindings of+                    Just (Right e') -> e'+                    Just (Left t') ->+                        error $ "cannot override parameter " ++ show x'+                            ++ " in class " ++ show className+                            ++ " with type " ++ show t'+                    Nothing ->+                        if e == Nil+                            then error $ "required parameter " ++ show x'+                                    ++ " in class " ++ show className+                                    ++ " has not been provided"+                            else e+            where x' = drop (1 + length packageName) x+        overrideParam packageName bindings (Decl (ParamType Parameter x t)) =+            Decl $ ParamType Parameter x $+                case lookup x' bindings of+                    Just (Left t') -> t'+                    Just (Right e') ->+                        case exprToType e' of+                            Just t' -> t'+                            Nothing ->+                                error $ "cannot override type parameter "+                                    ++ show x' ++ " in class " ++ show className+                                    ++ " with expression " ++ show e'+                    Nothing ->+                        if t == UnknownType+                            then error $ "required type parameter " ++ show x'+                                    ++ " in class " ++ show className+                                    ++ " has not been provided"+                            else t+            where x' = drop (1 + length packageName) x+        overrideParam _ _ other = other++-- errors with the given message when the check is false+assertMsg :: Monad m => Bool -> String -> m ()+assertMsg check msg = when (not check) $ error msg++-- helper for taking an ident which is either declared or exported form a+-- package and determine its true root source package+toRootPackage :: Identifier -> IdentState -> Identifier+toRootPackage sourcePackage identState =+    if identState == Declared+        then sourcePackage+        else rootPackage+    where Imported rootPackage = identState++-- nests packages items missing from modules+convertDescription :: PIs -> Description -> Description+convertDescription pis (orig @ Part{}) =+    if Map.null pis+        then orig+        else Part attrs extern kw lifetime name ports items'+    where+        Part attrs extern kw lifetime name ports items = orig+        items' = addItems pis Set.empty $ map addUsedPIs $+            foldr breakGenerate [] items -- ensure decls are visible+convertDescription _ other = other++-- attempt to fix simple declaration order issues+reorderItems :: [ModuleItem] -> [ModuleItem]+reorderItems items =+    addItems localPIs Set.empty $ map addUsedPIs $+        map (traverseGenItems $ traverseNestedGenItems reorderGenItem) items+    where+        localPIs = Map.fromList $ concat $ mapMaybe toPIElem items+        toPIElem :: ModuleItem -> Maybe [(Identifier, PackageItem)]+        toPIElem (MIPackageItem item) = Just $ map (, item) (piNames item)+        toPIElem _ = Nothing++-- attempt to declaration order issues within generate blocks+reorderGenItem :: GenItem -> GenItem+reorderGenItem (GenBlock name genItems) =+    GenBlock name $ map unwrap $ reorderItems $ map wrap genItems+    where+        wrap :: GenItem -> ModuleItem+        wrap (GenModuleItem item) = item+        wrap item = Generate [item]+        unwrap :: ModuleItem -> GenItem+        unwrap (Generate [item]) = item+        unwrap item = GenModuleItem item+reorderGenItem item = item++-- iteratively inserts missing package items exactly where they are needed+addItems :: PIs -> Idents -> [(ModuleItem, Idents)] -> [ModuleItem]+addItems pis existingPIs ((item, usedPIs) : items) =+    if not $ Set.disjoint existingPIs thisPI then+        -- this item was re-imported earlier in the module+        addItems pis existingPIs items+    else if Map.null itemsToAdd then+        -- this item has no additional dependencies+        item : addItems pis (Set.union existingPIs thisPI) items+    else+        -- this item has at least one un-met dependency+        addItems remainingPIs existingPIs+            (addUsedPIs chosenItem : (item, usedPIs) : items)+    where+        thisPI = case item of+            MIPackageItem packageItem ->+                Set.fromList $ piNames packageItem+            _ -> Set.empty+        neededPIs = Set.difference (Set.difference usedPIs existingPIs) thisPI+        itemsToAdd = Map.restrictKeys pis neededPIs+        (chosenName, chosenPI) = Map.findMin itemsToAdd+        chosenItem = MIPackageItem chosenPI+        remainingPIs = Map.delete chosenName pis+addItems _ _ [] = []++-- augment a module item with the set of identifiers it uses+addUsedPIs :: ModuleItem -> (ModuleItem, Idents)+addUsedPIs item =+    (item, usedPIs)+    where+        usedPIs = execWriter $ evalScoperT+            writeDeclIdents writeModuleItemIdents writeGenItemIdents writeStmtIdents+            "" [item]++type IdentWriter = ScoperT () (Writer Idents)++writeDeclIdents :: Decl -> IdentWriter Decl+writeDeclIdents decl = do+    case decl of+        Variable _ _ x _ _ -> insertElem x ()+        Net  _ _ _ _ x _ _ -> insertElem x ()+        Param    _ _ x   _ -> insertElem x ()+        ParamType  _ x   _ -> insertElem x ()+        CommentDecl{} -> return ()+    traverseDeclIdentsM writeIdent decl++writeModuleItemIdents :: ModuleItem -> IdentWriter ModuleItem+writeModuleItemIdents = traverseIdentsM writeIdent++writeGenItemIdents :: GenItem -> IdentWriter GenItem+writeGenItemIdents =+    traverseGenItemExprsM $ traverseExprIdentsM writeIdent++writeStmtIdents :: Stmt -> IdentWriter Stmt+writeStmtIdents = traverseStmtIdentsM writeIdent++writeIdent :: Identifier -> IdentWriter Identifier+writeIdent x = do+    details <- lookupElemM x+    when (details == Nothing) $ tell (Set.singleton x)+    return x++-- visits all identifiers in a module item+traverseIdentsM :: Monad m => MapperM m Identifier -> MapperM m ModuleItem+traverseIdentsM identMapper = traverseNodesM+    (traverseExprIdentsM identMapper)+    (traverseDeclIdentsM identMapper)+    (traverseTypeIdentsM identMapper)+    (traverseLHSIdentsM  identMapper)+    (traverseStmtIdentsM identMapper)++-- visits all identifiers in an expression+traverseExprIdentsM :: Monad m => MapperM m Identifier -> MapperM m Expr+traverseExprIdentsM identMapper = fullMapper+    where+        fullMapper = exprMapper >=> traverseSinglyNestedExprsM fullMapper+        exprMapper (Call (Ident x) args) =+            identMapper x >>= \x' -> return $ Call (Ident x') args+        exprMapper (Ident x) = identMapper x >>= return . Ident+        exprMapper other = return other++-- visits all identifiers in a type+traverseTypeIdentsM :: Monad m => MapperM m Identifier -> MapperM m Type+traverseTypeIdentsM identMapper = fullMapper+    where+        fullMapper = typeMapper+            >=> traverseTypeExprsM (traverseExprIdentsM identMapper)+            >=> traverseSinglyNestedTypesM fullMapper+        typeMapper (Alias x t) = identMapper x >>= return . flip Alias t+        typeMapper other = return other++-- visits all identifiers in an LHS+traverseLHSIdentsM :: Monad m => MapperM m Identifier -> MapperM m LHS+traverseLHSIdentsM identMapper = fullMapper+    where+        fullMapper = lhsMapper+            >=> traverseLHSExprsM (traverseExprIdentsM identMapper)+            >=> traverseSinglyNestedLHSsM fullMapper+        lhsMapper (LHSIdent x) = identMapper x >>= return . LHSIdent+        lhsMapper other = return other++-- visits all identifiers in a statement+traverseStmtIdentsM :: Monad m => MapperM m Identifier -> MapperM m Stmt+traverseStmtIdentsM identMapper = fullMapper+    where+        fullMapper = stmtMapper+            >=> traverseStmtExprsM (traverseExprIdentsM identMapper)+            >=> traverseStmtLHSsM  (traverseLHSIdentsM  identMapper)+        stmtMapper (Subroutine (Ident x) args) =+            identMapper x >>= \x' -> return $ Subroutine (Ident x') args+        stmtMapper other = return other++-- visits all identifiers in a declaration+traverseDeclIdentsM :: Monad m => MapperM m Identifier -> MapperM m Decl+traverseDeclIdentsM identMapper = traverseDeclNodesM+    (traverseTypeIdentsM identMapper)+    (traverseExprIdentsM identMapper)++-- returns any names defined by a package item+piNames :: PackageItem -> [Identifier]+piNames (Decl (ParamType _ ident (Enum _ enumItems _))) =+    ident : map fst enumItems+piNames (Function _ _ ident _ _) = [ident]+piNames (Task     _   ident _ _) = [ident]+piNames (Decl (Variable _ _ ident _ _)) = [ident]+piNames (Decl (Net  _ _ _ _ ident _ _)) = [ident]+piNames (Decl (Param    _ _ ident   _)) = [ident]+piNames (Decl (ParamType  _ ident   _)) = [ident]+piNames (Decl (CommentDecl          _)) = []+piNames (Import x y) = [show $ Import x y]+piNames (Export x y) = [show $ Export x y]+piNames (Directive _) = []
+ src/Convert/ParamNoDefault.hs view
@@ -0,0 +1,87 @@+{- 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.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 :: [AST] -> [AST]+convert files =+    map convertFile files'+    where+        (files', parts) = runWriter $+            mapM (traverseDescriptionsM traverseDescriptionM) files+        convertFile = traverseDescriptions $ traverseModuleItems $+            traverseModuleItem parts++traverseDescriptionM :: Description -> Writer Parts Description+traverseDescriptionM (Part attrs extern kw lifetime name ports items) = do+    let (items', params) = runWriter $ mapM traverseModuleItemM items+    tell $ Map.singleton name params+    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 view
@@ -0,0 +1,336 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TupleSections #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for `parameter type` in module instantiations+ -}++module Convert.ParamType (convert) where++import Control.Monad.Writer.Strict+import Data.Either (isRight, lefts)+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 Modules = Map.Map Identifier TypeMap++type Instance = Map.Map Identifier (Type, IdentSet)+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 files =+    files'''+    where+        modules = execWriter $+            mapM (collectDescriptionsM collectDescriptionM) files+        (files', instancesRaw) =+            runWriter $ mapM (mapM convertDescriptionM) files+        instances = Map.elems instancesRaw++        -- add type parameter instantiations+        files'' = map (concatMap explodeDescription) files'+        explodeDescription :: Description -> [Description]+        explodeDescription (part @ (Part _ _ _ _ name _ _)) =+            (part :) $+            filter (not . alreadyExists) $+            map (rewriteModule part) theseInstances+            where+                theseInstances = map snd $ filter ((== name) . fst) instances+                alreadyExists = flip Map.member modules . moduleName+                moduleName :: Description -> Identifier+                moduleName = \(Part _ _ _ _ x _ _) -> x+        explodeDescription other = [other]++        -- remove or reduce source modules that are no longer needed+        files''' = map (map reduceTypeDefaults . filter keepDescription) files''+        -- produce a typed and untyped instantiation graph+        (usedUntypedModules, usedTypedModules) =+            both (Map.fromListWith Set.union) $+            execWriter $ mapM (mapM collectUsageM) files''+        collectUsageM :: Description -> Writer (UsageMap, UsageMap) ()+        collectUsageM (part @ (Part _ _ _ _ name _ _)) =+            tell $ both makeList $ execWriter $+                (collectModuleItemsM collectModuleItemM) part+            where makeList s = zip (Set.toList s) (repeat $ Set.singleton name)+        collectUsageM _ = return ()+        collectModuleItemM :: ModuleItem -> Writer (IdentSet, IdentSet) ()+        collectModuleItemM (Instance m bindings _ _ _) =+            if all (isRight . snd) bindings+                then tell (Set.singleton m, Set.empty)+                else tell (Set.empty, Set.singleton m)+        collectModuleItemM _ = return ()+        both f (x, y) = (f x, f y) -- simple tuple map helper++        -- identify if a module is still in use+        keepDescription :: Description -> Bool+        keepDescription (Part _ _ _ _ name _ _) =+            isNewModule+            || isntTyped+            || isUsedAsUntyped+            || isUsedAsTyped && isInstantiatedViaNonTyped+            || allTypesHaveDefaults && notInstantiated && isntTemplateTagged+            where+                maybeTypeMap = Map.lookup name modules+                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+                isntTemplateTagged = not $ isTemplateTagged name+        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 t) =+                    ParamType Localparam x t+                rewriteDecl other = other+        reduceTypeDefaults other = other++        -- modules can be recursive; this checks if a typed module is not+        -- connected to any modules which are themselves used as typed modules+        untypedUsageSearch :: IdentSet -> Bool+        untypedUsageSearch visited =+            any (flip Map.notMember usedTypedModules) visited+            || Set.size visited /= Set.size visited'+                && untypedUsageSearch visited'+            where+                visited' =+                    Set.union visited $+                    Set.unions $+                    Set.map expandSet visited+                expandSet :: Identifier -> IdentSet+                expandSet ident =+                    Map.findWithDefault Set.empty ident usedTypedModules++        -- substitute in a particular instance's parameter types+        rewriteModule :: Description -> Instance -> Description+        rewriteModule part inst =+            Part attrs extern kw ml m' p (additionalParamItems ++ items')+            where+                Part attrs extern kw ml m p items = part+                m' = moduleInstanceName m inst+                items' = map rewriteModuleItem items+                rewriteModuleItem = traverseNestedModuleItems $ traverseNodes+                    rewriteExpr rewriteDecl rewriteType rewriteLHS rewriteStmt+                rewriteDecl :: Decl -> Decl+                rewriteDecl (ParamType Parameter x t) =+                    ParamType kind x $ rewriteType $+                    case Map.lookup x inst of+                        Nothing -> t+                        Just (t', _) -> t'+                    where kind = if Map.null inst+                                    then Parameter+                                    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 Modules ()+collectDescriptionM (part @ (Part _ _ _ _ name _ _)) =+    tell $ Map.singleton name typeMap+    where+        typeMap = Map.fromList $ execWriter $+            collectModuleItemsM (collectDeclsM collectDeclM) part+        collectDeclM :: Decl -> Writer [(Identifier, Type)] ()+        collectDeclM (ParamType Parameter x v) = tell [(x, v)]+        collectDeclM _ = return ()+collectDescriptionM _ = return ()++-- generate a "unique" name for a particular module type instance+moduleInstanceName :: Identifier -> Instance -> Identifier+moduleInstanceName (TemplateTag m) inst =+    moduleInstanceName m inst+moduleInstanceName m inst =+    if Map.null inst+        then TemplateTag m+        else m ++ "_" ++ shortHash (m, inst)++-- used to tag modules created for delayed type parameter instantiation+pattern TemplateTag :: Identifier -> Identifier+pattern TemplateTag x = '~' : x+isTemplateTagged :: Identifier -> Bool+isTemplateTagged TemplateTag{} = True+isTemplateTagged _ = False++-- checks where a type is sufficiently resolved to be substituted+isSimpleType :: Type -> Bool+isSimpleType typ =+    (not $ typeIsUnresolved typ) &&+    case typ of+        IntegerVector{} -> True+        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 :: ModuleItem -> Writer Instances ModuleItem+convertModuleItemM (orig @ (Instance m bindings x r p)) =+    if hasOnlyExprs then+        return orig+    else if not hasUnresolvedTypes then do+        let m' = moduleInstanceName m resolvedTypes+        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+        hasOnlyExprs = all (isRight . snd) bindings+        hasUnresolvedTypes = any (not . isSimpleType) (lefts $ map snd bindings)++        -- determine the types corresponding to each type parameter+        bindingsMap = Map.fromList bindings+        resolvedTypesWithDecls = Map.mapMaybeWithKey resolveType bindingsMap+        resolvedTypes = Map.map (\(a, (b, _)) -> (a, b)) resolvedTypesWithDecls+        addedDecls = Map.elems $ Map.unions $ map (snd . snd) $+            Map.elems resolvedTypesWithDecls+        resolveType :: Identifier -> TypeOrExpr -> Maybe (Type, (IdentSet, DeclMap))+        resolveType _ Right{} = Nothing+        resolveType paramName (Left t) =+            Just $ prepareTypeExprs x paramName t++        -- leave only the normal expression params behind+        exprBindings = filter (isRight . snd) bindings++        -- 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/RemoveComments.hs view
@@ -0,0 +1,61 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for removing any comments+ -}++module Convert.RemoveComments (convert) where++import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert = map convertFile++convertFile :: AST -> AST+convertFile =+    traverseDescriptions (traverseModuleItems convertModuleItem) .+    filter (not . isTopLevelComment)++isTopLevelComment :: Description -> Bool+isTopLevelComment (PackageItem (Decl CommentDecl{})) = True+isTopLevelComment _ = False++convertModuleItem :: ModuleItem -> ModuleItem+convertModuleItem (MIPackageItem (Decl CommentDecl{})) = Generate []+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 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 = map $ traverseNestedStmts convertStmt
+ src/Convert/ResolveBindings.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE TupleSections #-}+{- 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+    , exprToType+    , resolveBindings+    ) where++import Control.Monad.Writer.Strict+import Data.List (intercalate, (\\))+import qualified Data.Map.Strict as Map++import Convert.ExprUtils (simplify)+import Convert.Traverse+import Language.SystemVerilog.AST++type Parts = Map.Map Identifier ([(Identifier, Bool)], [Identifier])++convert :: [AST] -> [AST]+convert =+    traverseFiles+        (collectDescriptionsM collectPartsM)+        (traverseDescriptions . traverseModuleItems . mapInstance)++collectPartsM :: Description -> Writer Parts ()+collectPartsM (Part _ _ _ _ name ports items) =+    tell $ Map.singleton name (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 maybePartInfo == Nothing+        then Instance m paramBindings x rs portBindings+        else Instance m paramBindings' x rs portBindings'+    where+        maybePartInfo = Map.lookup m parts+        Just (paramInfos, portNames) = maybePartInfo+        paramNames = map fst paramInfos++        msg :: String -> String+        msg = flip (++) $ " in instance " ++ show x ++ " of " ++ show m++        paramBindings' = map checkParam $+            resolveBindings (msg "parameter overrides") paramNames paramBindings+        portBindings' = filter ((/= Nil) . snd) $+            resolveBindings (msg "port connections") portNames $+            concatMap expandStar 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++-- attempt to convert an expression to 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 = (simplify $ BinOp Sub i (RawNum 1), RawNum 0)+    Just $ tf (rs ++ [r])+exprToType _ = Nothing++type Binding t = (Identifier, t)+-- give a set of bindings explicit names+resolveBindings :: String -> [Identifier] -> [Binding t] -> [Binding t]+resolveBindings _ _ [] = []+resolveBindings location available bindings =+    if length available < length bindings then+        error $ "too many bindings specified for " ++ location+    else if null $ fst $ head bindings then+        zip available $ map snd bindings+    else if not $ null unknowns then+        error $ "unknown binding" ++ unknownsPlural ++ " "+            ++ unknownsStr ++ " specified for " ++ location+    else+        bindings+    where+        unknowns = map fst bindings \\ available+        unknownsPlural = if length unknowns == 1 then "" else "s"+        unknownsStr = intercalate ", " $ map show unknowns
+ src/Convert/Scoper.hs view
@@ -0,0 +1,631 @@+{-# LANGUAGE TupleSections #-}+{-# 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+    , partScoperT+    , accessesToExpr+    , replaceInType+    , replaceInExpr+    , scopeExpr+    , scopeType+    , insertElem+    , removeElem+    , injectItem+    , injectTopItem+    , injectDecl+    , lookupElem+    , lookupElemM+    , localAccesses+    , localAccessesM+    , Access(..)+    , ScopeKey+    , Scopes+    , extractMapping+    , embedScopes+    , withinProcedure+    , withinProcedureM+    , procedureLoc+    , procedureLocM+    , isLoopVar+    , isLoopVarM+    , loopVarDepth+    , loopVarDepthM+    , lookupLocalIdent+    , lookupLocalIdentM+    , scopeModuleItemT+    , Replacements+    , LookupResult+    ) where++import Control.Monad.State.Strict+import Data.Functor.Identity (runIdentity)+import Data.List (findIndices, 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]+    } 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+    expr' <- traverseSinglyNestedExprsM scopeExpr expr+                >>= traverseExprTypesM scopeType+    details <- lookupElemM expr'+    case details of+        Just (accesses, _, _) -> return $ accessesToExpr accesses+        _ -> return expr'+scopeType :: Monad m => Type -> ScoperT a m Type+scopeType = traverseNestedTypesM $ traverseTypeExprsM scopeExpr++{-# INLINABLE scopeExpr #-}+{-# INLINABLE 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++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++evalScoper+    :: MapperM (Scoper a) Decl+    -> MapperM (Scoper a) ModuleItem+    -> MapperM (Scoper a) GenItem+    -> MapperM (Scoper a) Stmt+    -> Identifier+    -> [ModuleItem]+    -> [ModuleItem]+evalScoper declMapper moduleItemMapper genItemMapper stmtMapper topName items =+    runIdentity $ evalScoperT+    declMapper moduleItemMapper genItemMapper stmtMapper topName items++evalScoperT+    :: 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+    -> Identifier+    -> [ModuleItem]+    -> m [ModuleItem]+evalScoperT declMapper moduleItemMapper genItemMapper stmtMapper topName items = do+    (items', _) <- runScoperT+        declMapper moduleItemMapper genItemMapper stmtMapper+        topName items+    return items'++runScoper+    :: MapperM (Scoper a) Decl+    -> MapperM (Scoper a) ModuleItem+    -> MapperM (Scoper a) GenItem+    -> MapperM (Scoper a) Stmt+    -> Identifier+    -> [ModuleItem]+    -> ([ModuleItem], Scopes a)+runScoper declMapper moduleItemMapper genItemMapper stmtMapper topName items =+    runIdentity $ runScoperT+    declMapper moduleItemMapper genItemMapper stmtMapper topName items++runScoperT+    :: 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+    -> Identifier+    -> [ModuleItem]+    -> m ([ModuleItem], Scopes a)+runScoperT declMapper moduleItemMapper genItemMapper stmtMapper topName items =+    runStateT operation initialState+    where+        operation :: ScoperT a m [ModuleItem]+        operation = do+            enterScope topName ""+            mapM wrappedModuleItemMapper items+        initialState = Scopes [] Map.empty [] [] []++        wrappedModuleItemMapper = scopeModuleItemT+            declMapper moduleItemMapper genItemMapper stmtMapper++scopeModuleItemT+    :: 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+    -> ModuleItem+    -> ScoperT a m ModuleItem+scopeModuleItemT declMapper moduleItemMapper genItemMapper stmtMapper =+    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']++        -- 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+            let Variable Local newType newName newRanges Nil = res+            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 (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+    -> Description+    -> Description+partScoper declMapper moduleItemMapper genItemMapper stmtMapper part =+    runIdentity $ partScoperT+        declMapper moduleItemMapper genItemMapper stmtMapper part++partScoperT+    :: Monad m+    => MapperM (ScoperT a m) Decl+    -> MapperM (ScoperT a m) ModuleItem+    -> MapperM (ScoperT a m) GenItem+    -> MapperM (ScoperT a m) Stmt+    -> Description+    -> m Description+partScoperT declMapper moduleItemMapper genItemMapper stmtMapper =+    mapper+    where+        operation = evalScoperT+            declMapper moduleItemMapper genItemMapper stmtMapper+        mapper (Part attrs extern kw liftetime name ports items) = do+            items' <- operation name items+            return $ Part attrs extern kw liftetime name ports items'+        mapper description = return description
+ src/Convert/Simplify.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE PatternSynonyms #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Elaboration of size casts, dimension query system functions, and ternary+ - expressions where the condition references a localparam.+ -+ - Our conversions generate a lot of ternary expressions. This conversion+ - attempts to make the code output a bit cleaner. Note that we can only do this+ - simplification on localparams because parameters can be overridden at+ - instantiation.+ -+ - This conversion applies the heuristic that it will only make substitutions+ - into a ternary condition if making substitutions immediately enables the+ - expression to be simplified further.+ -}++module Convert.Simplify (convert) where++import Control.Monad (when)++import Convert.ExprUtils+import Convert.Scoper+import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions convertDescription++convertDescription :: Description -> Description+convertDescription =+    partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM++traverseDeclM :: Decl -> Scoper Expr Decl+traverseDeclM decl = do+    decl' <- traverseDeclExprsM traverseExprM decl+    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+        _ -> return ()+    return decl'++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+    case expr' of+        Cast (Left (SimpleVector sg l r)) (Number n) ->+            insertElem ident $ Number $ numberCast signed size n+            where+                signed = sg == Signed+                size = fromIntegral $ abs $ l - r + 1+        _ -> when (isSimpleExpr expr') $ insertElem ident expr'++isSimpleExpr :: Expr -> Bool+isSimpleExpr Number{}  = True+isSimpleExpr String{}  = True+isSimpleExpr (Cast Left{} e) = isSimpleExpr e+isSimpleExpr _ = False++traverseModuleItemM :: ModuleItem -> Scoper Expr ModuleItem+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++traverseGenItemM :: GenItem -> Scoper Expr GenItem+traverseGenItemM = traverseGenItemExprsM traverseExprM++traverseStmtM :: Stmt -> Scoper Expr Stmt+traverseStmtM stmt = traverseStmtExprsM traverseExprM stmt++traverseExprM :: Expr -> Scoper Expr Expr+traverseExprM = embedScopes convertExpr++substituteExprM :: Expr -> Scoper Expr Expr+substituteExprM = embedScopes substitute++convertExpr :: Scopes Expr -> Expr -> Expr+convertExpr info (Cast (Left t) e) =+    Cast (Left t') e'+    where+        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' = convertExpr info $ substitute info e+        val = Call (Ident "$clog2") (Args [e'] [])+        val' = simplifyStep val+convertExpr info (Mux cc aa bb) =+    if before == after+        then simplifyStep $ Mux cc' aa' bb'+        else simplifyStep $ Mux after aa' bb'+    where+        before = substitute info cc'+        after = convertExpr info before+        aa' = convertExpr info aa+        bb' = convertExpr info bb+        cc' = convertExpr info cc+convertExpr info (BinOp op e1 e2) =+    case simplifyStep $ BinOp op e1'Sub e2'Sub of+        Number n -> Number n+        _ -> simplifyStep $ BinOp op e1' e2'+    where+        e1' = convertExpr info e1+        e2' = convertExpr info e2+        e1'Sub = substituteIdent info e1'+        e2'Sub = substituteIdent info e2'+convertExpr info (UniOp op expr) =+    simplifyStep $ UniOp op $ 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 :: Scopes Expr -> Expr -> Expr+substitute scopes expr =+    substitute' expr+    where+        substitute' :: Expr -> Expr+        substitute' (Ident x) =+            case lookupElem scopes x of+                Nothing -> Ident x+                Just (_, _, e) -> e+        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/Stream.hs view
@@ -0,0 +1,197 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion of streaming concatenations.+ -}++module Convert.Stream (convert) where++import Control.Monad (zipWithM)++import Convert.Scoper+import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions convertDescription++convertDescription :: Description -> Description+convertDescription = partScoper+    traverseDeclM traverseModuleItemM return traverseStmtM++traverseDeclM :: Decl -> Scoper () Decl+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+        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 expr) =+    traverseExprM expr' >>= return . Assign opt lhs'+    where Asgn AsgnOpEq Nothing lhs' expr' =+            traverseAsgn (lhs, expr) (Asgn AsgnOpEq Nothing)+traverseModuleItemM item = return item++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 [] input+    , Variable Local t out [] Nil+    , Variable Local (IntegerAtom TInteger Unspecified) idx [] Nil+    ]+    [ For inits cmp incr stmt+    , If NoCheck cmp2 stmt2 Null+    , asgn output result+    ]+    where+        lo = RawNum 0+        hi = BinOp Sub inSize (RawNum 1)+        t = IntegerVector TLogic Unspecified [(hi, lo)]+        name = streamerBlockName chunk inSize+        inp = name ++ "_inp"+        out = name ++ "_out"+        idx = name ++ "_idx"+        -- main chunk loop+        inits = [(LHSIdent idx, lo)]+        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 = Asgn AsgnOpEq Nothing lhs expr+        -- final chunk loop+        stub = BinOp Mod inSize chunk+        lhs2 = LHSRange (LHSIdent out) IndexedPlus (RawNum 0, stub)+        expr2 = Range (Ident inp) IndexedPlus (Ident idx, stub)+        stmt2 = Asgn AsgnOpEq Nothing 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)++-- pad or truncate the right side of an expression+resize :: Expr -> Expr -> Expr -> Expr+resize inSize outSize expr =+    Mux+        (BinOp Le inSize outSize)+        (BinOp ShiftL expr (BinOp Sub outSize inSize))+        (BinOp ShiftR expr (BinOp Sub inSize outSize))++-- rewrite a given assignment if it uses a streaming concatenation+traverseAsgn :: (LHS, Expr) -> (LHS -> Expr -> Stmt) -> Stmt+traverseAsgn (lhs, Stream StreamR _ exprs) constructor =+    constructor lhs $ resize exprSize lhsSize expr+    where+        expr = Concat exprs+        lhsSize = sizeof $ lhsToExpr lhs+        exprSize = sizeof expr+traverseAsgn (LHSStream StreamR _ lhss, expr) constructor =+    constructor lhs $ resize exprSize lhsSize expr+    where+        lhs = LHSConcat lhss+        lhsSize = sizeof $ lhsToExpr lhs+        exprSize = sizeof 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, expr) constructor =+    constructor lhs expr++sizeof :: Expr -> Expr+sizeof = DimsFn FnBits . Right
+ src/Convert/StringParam.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE PatternSynonyms #-}+{- 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.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/Struct.hs view
@@ -0,0 +1,530 @@+{-# LANGUAGE TupleSections #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for `struct packed` and `union packed`+ -}++module Convert.Struct (convert) where++import Control.Monad ((>=>), when)+import Data.Either (isLeft)+import Data.List (elemIndex, find, partition, (\\))+import Data.Maybe (fromJust)+import Data.Tuple (swap)++import Convert.ExprUtils+import Convert.Scoper+import Convert.Traverse+import Language.SystemVerilog.AST++type StructInfo = (Type, [(Identifier, Range)])++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions convertDescription++convertDescription :: Description -> Description+convertDescription (description @ (Part _ _ Module _ _ _ _)) =+    partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM+    description+convertDescription other = other++convertStruct :: Type -> Maybe StructInfo+convertStruct (Struct Unpacked fields _) =+    convertStruct' True Unspecified fields+convertStruct (Struct (Packed sg) fields _) =+    convertStruct' True sg fields+convertStruct (Union  (Packed sg) fields _) =+    convertStruct' False sg fields+convertStruct _ = Nothing++convertStruct' :: Bool -> Signing -> [Field] -> Maybe StructInfo+convertStruct' isStruct sg fields =+    if canUnstructure+        then Just (unstructType, unstructFields)+        else Nothing+    where+        zero = RawNum 0+        typeRange :: Type -> Range+        typeRange t =+            if null ranges+                then (zero, zero)+                else let [range] = ranges in range+            where ranges = snd $ typeRanges t++        -- extract info about the fields+        fieldTypes = map fst fields+        fieldRanges = map typeRange fieldTypes+        fieldSizes = map rangeSize fieldRanges++        -- layout the fields into the unstructured type; note that `scanr` is+        -- used here because SystemVerilog structs are laid out backwards+        fieldLos =+            if isStruct+                then map simplify $ tail $ scanr (BinOp Add) (RawNum 0) fieldSizes+                else map simplify $ repeat (RawNum 0)+        fieldHis =+            if isStruct+                then map simplify $ init $ scanr (BinOp Add) minusOne fieldSizes+                else map simplify $ map (BinOp Add minusOne) fieldSizes+        minusOne = UniOp UniSub $ RawNum 1++        -- create the mapping structure for the unstructured fields+        keys = map snd fields+        unstructRanges = zip fieldHis fieldLos+        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+        structSize =+            if isStruct+                then foldl1 (BinOp Add) fieldSizes+                else head fieldSizes+        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+        -- pack flat integer vector types; the fields will be flattened and+        -- converted by other phases+        isFlatIntVec :: Type -> Bool+        isFlatIntVec (IntegerVector _ _ rs) = length rs <= 1+        isFlatIntVec _ = False+        canUnstructure = all isFlatIntVec fieldTypes+++-- convert a struct type to its unstructured equivalent+convertType :: Type -> Type+convertType t1 =+    case convertStruct t1 of+        Nothing -> traverseSinglyNestedTypes convertType t1+        Just (t2, _) -> tf2 (rs1 ++ rs2)+            where (tf2, rs2) = typeRanges t2+    where (_, rs1) = typeRanges t1++-- write down the types of declarations+traverseDeclM :: Decl -> Scoper Type Decl+traverseDeclM decl @ Net{} =+    traverseNetAsVarM traverseDeclM decl+traverseDeclM decl = do+    decl' <- case decl of+        Variable d t x a e -> do+            let (tf, rs) = typeRanges t+            when (isRangeable t) $+                scopeType (tf $ a ++ rs) >>= insertElem x+            let e' = convertExpr t e+            let t' = convertType t+            return $ Variable d t' x a e'+        Param s t x e -> do+            scopeType t >>= insertElem x+            let e' = convertExpr t e+            let t' = convertType t+            return $ Param s t' x e'+        _ -> return decl+    traverseDeclExprsM traverseExprM decl'+    where+        isRangeable :: Type -> Bool+        isRangeable IntegerAtom{} = False+        isRangeable NonInteger{}  = False+        isRangeable TypeOf{}      = False+        isRangeable _ = True++traverseGenItemM :: GenItem -> Scoper Type GenItem+traverseGenItemM = traverseGenItemExprsM traverseExprM++traverseModuleItemM :: ModuleItem -> Scoper Type ModuleItem+traverseModuleItemM =+    traverseLHSsM  traverseLHSM  >=>+    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+        (_, []) -> UnknownType+        (tf, rs) -> tf $ tail rs++-- produces the type of the given part select, if possible+replaceInnerTypeRange :: PartSelectMode -> Range -> Type -> Type+replaceInnerTypeRange NonIndexed r t =+    case typeRanges t of+        (_, []) -> UnknownType+        (tf, rs) -> tf $ r : tail rs+replaceInnerTypeRange IndexedPlus r t =+    replaceInnerTypeRange NonIndexed (snd r, RawNum 1) t+replaceInnerTypeRange IndexedMinus r t =+    replaceInnerTypeRange NonIndexed (snd r, RawNum 1) t++traverseAsgnM :: (LHS, Expr) -> Scoper Type (LHS, Expr)+traverseAsgnM (lhs, expr) = do+    -- convert the LHS using the innermost type information+    (typ, lhs') <- convertLHS lhs+    -- convert the RHS using the LHS type information, and then the innermost+    -- type information on the resulting RHS+    (_, expr') <- embedScopes convertSubExpr $ convertExpr typ expr+    return (lhs', expr')++structIsntReady :: Type -> Bool+structIsntReady = (Nothing ==) . convertStruct++-- try expression conversion by looking at the *outermost* type first+convertExpr :: Type -> Expr -> Expr+convertExpr _ Nil = Nil+convertExpr t (Mux c e1 e2) =+    Mux c e1' e2'+    where+        e1' = convertExpr t e1+        e2' = convertExpr t e2++convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) =+    if not (null extraNames) then+        error $ "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 ((/= 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) +++                    " 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 (map (Right . Ident) fieldNames) (map snd itemsOrig)+        (typedItems, untypedItems) =+            partition (isLeft . fst) $ reverse itemsNamed+        (numberedItems, namedItems) =+            partition (isNumbered . fst) untypedItems++        isNumbered :: TypeOrExpr -> Bool+        isNumbered (Right (Number n)) =+            if maybeIndex == Nothing+                then error msgNonInteger+                else index < length fieldNames || error 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++        extraNames = map (getName . right . fst) namedItems \\ fieldNames+        right = \(Right x) -> x+        getName :: Expr -> Identifier+        getName (Ident x) = x+        getName e = error $ "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 $+            -- look up by name+            if valueByName /= Nothing then+                fromJust valueByName+            -- recurse for substructures+            else if isStruct fieldType then+                Pattern typedItems+            -- look up by field type+            else if valueByType /= Nothing then+                fromJust valueByType+            -- fall back on the default value+            else if valueDefault /= Nothing then+                fromJust valueDefault+            else if valueByIndex /= Nothing then+                fromJust valueByIndex+            else+                error $ "couldn't find field '" ++ fieldName +++                    "' from struct definition " ++ show struct +++                    " in struct pattern " ++ show (Pattern itemsOrig)+            where+                valueByName = lookup (Right $ Ident fieldName) namedItems+                valueByType = lookup (Left fieldType) typedItems+                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 _ = False++                indexCheck :: TypeOrExpr -> Bool+                indexCheck item =+                    fromIntegral value == fieldIndex+                    where+                        Just value = numberToInteger n+                        Right (Number n) = item++convertExpr _ (Cast (Left t) expr) =+    Cast (Left t') $ convertExpr t expr+    where t' = convertType t++convertExpr (Implicit _ []) expr =+    traverseSinglyNestedExprs (convertExpr UnknownType) expr+convertExpr (Implicit sg rs) expr =+    convertExpr (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 (t @ IntegerVector{}) (Concat exprs) =+    if all isUnsizedNumber exprs+        then Concat $ map (Cast $ Left t') exprs+        else Concat $ map (convertExpr t') exprs+    where+        t' = dropInnerTypeRange t+        isUnsizedNumber :: Expr -> Bool+        isUnsizedNumber (Number n) = not $ numberIsSized n+        isUnsizedNumber (UniOp _ e) = isUnsizedNumber e+        isUnsizedNumber (BinOp _ 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 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 t' expr+        (_, rs) = typeRanges t+        t' = dropInnerTypeRange t++-- pattern syntax used for simple array literals+convertExpr t (Pattern items) =+    if all (== Right Nil) names+        then convertExpr t $ Concat exprs'+        else Pattern items+    where+        (names, exprs) = unzip items+        t' = dropInnerTypeRange t+        exprs' = map (convertExpr t') exprs++-- propagate types through concatenation expressions+convertExpr t (Concat exprs) =+    Concat exprs'+    where+        t' = dropInnerTypeRange t+        exprs' = map (convertExpr t') exprs++convertExpr _ expr =+    traverseSinglyNestedExprs (convertExpr 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++-- 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+    let Just l' = exprToLHS e'+    return (t, l')++-- try expression conversion by looking at the *innermost* type first+convertSubExpr :: Scopes Type -> Expr -> (Type, Expr)+convertSubExpr scopes (Dot e x) =+    if isntStruct subExprType then+        fallbackType scopes $ Dot e' x+    else if structIsntReady subExprType then+        (fieldType, Dot e' x)+    else+        (fieldType, undotted)+    where+        (subExprType, e') = convertSubExpr scopes e+        (fieldType, bounds, dims) = lookupFieldInfo subExprType x+        base = fst bounds+        len = rangeSize bounds+        undotted = if null dims || rangeSize (head dims) == RawNum 1+            then Bit e' (fst bounds)+            else Range e' IndexedMinus (base, len)+convertSubExpr scopes (Range (Dot e x) NonIndexed rOuter) =+    if isntStruct subExprType then+        (UnknownType, orig')+    else if structIsntReady subExprType then+        (replaceInnerTypeRange NonIndexed rOuter' fieldType, orig')+    else+        (replaceInnerTypeRange NonIndexed rOuter' fieldType, undotted)+    where+        (roLeft, roRight) = rOuter+        (subExprType, e') = convertSubExpr scopes e+        (_, roLeft') = convertSubExpr scopes roLeft+        (_, roRight') = convertSubExpr scopes roRight+        rOuter' = (roLeft', roRight')+        orig' = Range (Dot e' x) NonIndexed rOuter'+        (fieldType, bounds, dims) = lookupFieldInfo subExprType x+        [dim] = dims+        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 then+        (UnknownType, orig')+    else if structIsntReady subExprType then+        (replaceInnerTypeRange mode (baseO', lenO') fieldType, orig')+    else+        (replaceInnerTypeRange mode (baseO', lenO') fieldType, undotted)+    where+        (subExprType, e') = convertSubExpr scopes e+        (_, baseO') = convertSubExpr scopes baseO+        (_, lenO') = convertSubExpr scopes lenO+        orig' = Range (Dot e' x) mode (baseO', lenO')+        (fieldType, bounds, dims) = lookupFieldInfo subExprType 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+        (t, e') = convertSubExpr scopes e+        (_, left') = convertSubExpr scopes left+        (_, right') = convertSubExpr scopes right+        r' = (left', right')+convertSubExpr scopes (Bit (Dot e x) i) =+    if isntStruct subExprType then+        (dropInnerTypeRange backupType, orig')+    else if structIsntReady subExprType then+        (dropInnerTypeRange fieldType, orig')+    else+        (dropInnerTypeRange fieldType, Bit e' iFlat)+    where+        (subExprType, e') = convertSubExpr scopes e+        (_, i') = convertSubExpr scopes i+        (backupType, _) = fallbackType scopes $ Dot e' x+        orig' = Bit (Dot e' x) i'+        (fieldType, bounds, dims) = lookupFieldInfo subExprType x+        [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+        (t, e') = convertSubExpr scopes e+        (_, i') = convertSubExpr scopes i+convertSubExpr scopes (Call e args) =+    (retType, Call e args')+    where+        (retType, _) = fallbackType scopes e+        args' = convertCall scopes e args+convertSubExpr scopes (Cast (Left t) e) =+    (t, Cast (Left t) e')+    where (_, e') = convertSubExpr scopes e+convertSubExpr scopes (Pattern items) =+    if all (== Right Nil) $ map fst items'+        then (UnknownType, Concat $ map snd items')+        else (UnknownType, Pattern items')+    where+        items' = map mapItem items+        mapItem (x, e) = (x, e')+            where (_, e') = convertSubExpr scopes e+convertSubExpr scopes (Mux a b c) =+    (t, Mux a' b' c')+    where+        (_, a') = convertSubExpr scopes a+        (t, b') = convertSubExpr scopes b+        (_, c') = convertSubExpr scopes c+convertSubExpr scopes (Ident x) =+    fallbackType scopes (Ident x)+convertSubExpr scopes e =+    (UnknownType, ) $+        traverseExprTypes typeMapper $+        traverseSinglyNestedExprs exprMapper e+    where+        exprMapper = snd . convertSubExpr scopes+        typeMapper = convertType .+            traverseNestedTypes (traverseTypeExprs exprMapper)++-- 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, flattended bounds, and original type dimensions+lookupFieldInfo :: Type -> Identifier -> (Type, Range, [Range])+lookupFieldInfo struct fieldName =+    if maybeFieldType == Nothing+        then error $ "field '" ++ fieldName ++ "' not found in " ++ show struct+        else (fieldType, bounds, dims)+    where+        Just fields = getFields struct+        maybeFieldType = lookup fieldName $ map swap fields+        Just fieldType = maybeFieldType+        dims = snd $ typeRanges fieldType+        Just (_, unstructRanges) = convertStruct struct+        Just bounds = lookup fieldName unstructRanges++-- attempts to convert based on the assignment-like contexts of TF arguments+convertCall :: Scopes Type -> Expr -> Args -> Args+convertCall scopes fn (Args pnArgs kwArgs) =+    Args (map snd pnArgs') kwArgs'+    where+        Just fnLHS = exprToLHS fn+        pnArgs' = map (convertArg fnLHS) $ zip idxs pnArgs+        kwArgs' = map (convertArg fnLHS) kwArgs+        idxs = map show ([0..] :: [Int])+        convertArg :: LHS -> (Identifier, Expr) -> (Identifier, Expr)+        convertArg lhs (x, e) =+            (x, e')+            where+                details = lookupElem scopes $ LHSDot lhs x+                typ = maybe UnknownType thd3 details+                thd3 (_, _, c) = c+                (_, e') = convertSubExpr scopes $ convertExpr typ e
+ src/Convert/TFBlock.hs view
@@ -0,0 +1,74 @@+{- 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 "" declsA (Block Seq name declsB stmtsA : stmtsB)) =+    if canCombine declsA declsB+        then flattenOuterBlocks $+                Block Seq name (declsA ++ declsB) (stmtsA ++ stmtsB)+        else (declsA, Block Seq name declsB stmtsA : stmtsB)+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/Traverse.hs view
@@ -0,0 +1,1150 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Utilities for traversing AST transformations.+ -}++module Convert.Traverse+( MapperM+, Mapper+, CollectorM+, unmonad+, collectify+, mapBothM+, breakGenerate+, traverseDescriptionsM+, traverseDescriptions+, collectDescriptionsM+, traverseModuleItemsM+, traverseModuleItems+, collectModuleItemsM+, traverseStmtsM+, traverseStmts+, collectStmtsM+, traverseStmtLHSsM+, traverseStmtLHSs+, collectStmtLHSsM+, traverseExprsM+, traverseExprs+, collectExprsM+, traverseNodesM+, traverseNodes+, traverseStmtExprsM+, traverseStmtExprs+, collectStmtExprsM+, traverseLHSsM+, traverseLHSs+, collectLHSsM+, traverseDeclsM+, traverseDecls+, collectDeclsM+, traverseStmtDeclsM+, traverseStmtDecls+, collectStmtDeclsM+, traverseSinglyNestedTypesM+, traverseSinglyNestedTypes+, collectSinglyNestedTypesM+, traverseNestedTypesM+, traverseNestedTypes+, collectNestedTypesM+, traverseExprTypesM+, traverseExprTypes+, collectExprTypesM+, traverseTypeExprsM+, traverseTypeExprs+, collectTypeExprsM+, traverseGenItemExprsM+, traverseGenItemExprs+, collectGenItemExprsM+, traverseDeclNodesM+, traverseDeclNodes+, traverseDeclExprsM+, traverseDeclExprs+, collectDeclExprsM+, traverseDeclTypesM+, traverseDeclTypes+, collectDeclTypesM+, traverseTypesM+, traverseTypes+, collectTypesM+, traverseGenItemsM+, traverseGenItems+, collectGenItemsM+, traverseNestedGenItemsM+, traverseNestedGenItems+, traverseAsgnsM+, traverseAsgns+, collectAsgnsM+, traverseStmtAsgnsM+, traverseStmtAsgns+, collectStmtAsgnsM+, traverseNestedModuleItemsM+, traverseNestedModuleItems+, collectNestedModuleItemsM+, traverseNestedStmtsM+, traverseNestedStmts+, collectNestedStmtsM+, traverseNestedExprsM+, traverseNestedExprs+, collectNestedExprsM+, traverseSinglyNestedExprsM+, traverseSinglyNestedExprs+, collectSinglyNestedExprsM+, traverseLHSExprsM+, traverseLHSExprs+, collectLHSExprsM+, traverseNestedLHSsM+, traverseNestedLHSs+, collectNestedLHSsM+, traverseSinglyNestedLHSsM+, traverseSinglyNestedLHSs+, collectSinglyNestedLHSsM+, traverseFilesM+, traverseFiles+, traverseSinglyNestedGenItemsM+, traverseSinglyNestedStmtsM+, traverseSinglyNestedStmts+, collectSinglyNestedStmtsM+, traverseNetAsVarM+, traverseNetAsVar+, collectNetAsVarM+) where++import Data.Bitraversable (bimapM)+import Data.Functor.Identity (Identity, runIdentity)+import Control.Monad.Writer.Strict+import Language.SystemVerilog.AST++type MapperM m t = t -> m t+type Mapper t = t -> t+type CollectorM m t = t -> m ()++unmonad :: (MapperM Identity a -> MapperM Identity b) -> Mapper a -> Mapper b+unmonad traverser mapper = runIdentity . traverser (return . mapper)++collectify :: Monad m => (MapperM m a -> MapperM m b) -> CollectorM m a -> CollectorM m b+collectify traverser collector =+    traverser mapper >=> \_ -> return ()+    where mapper x = collector x >>= \() -> return x++traverseDescriptionsM :: Monad m => MapperM m Description -> MapperM m AST+traverseDescriptionsM = mapM+traverseDescriptions :: Mapper Description -> Mapper AST+traverseDescriptions = map+collectDescriptionsM :: Monad m => CollectorM m Description -> CollectorM m AST+collectDescriptionsM = mapM_++breakGenerate :: ModuleItem -> [ModuleItem] -> [ModuleItem]+breakGenerate (Generate genItems) items =+    foldr breakGenerateStep items genItems+breakGenerate item items = item : items++breakGenerateStep :: GenItem -> [ModuleItem] -> [ModuleItem]+breakGenerateStep (GenModuleItem item) items = item : items+breakGenerateStep genItem (Generate genItems : items) =+    Generate (genItem : genItems) : items+breakGenerateStep genItem items = Generate [genItem] : items++traverseModuleItemsM :: Monad m => MapperM m ModuleItem -> MapperM m Description+traverseModuleItemsM mapper (Part attrs extern kw lifetime name ports items) = do+    items' <- mapM (traverseNestedModuleItemsM mapper) items+    let items'' = foldr breakGenerate [] items'+    return $ Part attrs extern kw lifetime name ports items''+    where+traverseModuleItemsM mapper (PackageItem packageItem) = do+    let item = MIPackageItem packageItem+    item' <- traverseNestedModuleItemsM mapper item+    return $ case item' of+        MIPackageItem packageItem' -> PackageItem packageItem'+        other -> error $ "encountered bad package module item: " ++ show other+traverseModuleItemsM mapper (Package lifetime name items) = do+    let itemsWrapped = map MIPackageItem items+    itemsWrapped' <- mapM (traverseNestedModuleItemsM mapper) itemsWrapped+    let items' = map (\(MIPackageItem item) -> item) $+                    foldr breakGenerate [] itemsWrapped'+    return $ Package lifetime name items'+traverseModuleItemsM mapper (Class lifetime name decls items) = do+    let declsWrapped = map (MIPackageItem . Decl) decls+    declsWrapped' <- mapM (traverseNestedModuleItemsM mapper) declsWrapped+    let decls' = map (\(MIPackageItem (Decl decl)) -> decl) $+                    foldr breakGenerate [] declsWrapped'+    items' <- fmap concat $ mapM indirect items+    return $ Class lifetime name decls' items'+    where+        indirect (qualifier, item) =+            fmap (map (unwrap qualifier) . flip breakGenerate []) $+            traverseNestedModuleItemsM mapper (MIPackageItem item)+        unwrap qualifier = \(MIPackageItem item) -> (qualifier, item)++traverseModuleItems :: Mapper ModuleItem -> Mapper Description+traverseModuleItems = unmonad traverseModuleItemsM+collectModuleItemsM :: Monad m => CollectorM m ModuleItem -> CollectorM m Description+collectModuleItemsM = collectify traverseModuleItemsM++traverseStmtsM :: Monad m => MapperM m Stmt -> MapperM m ModuleItem+traverseStmtsM mapper = moduleItemMapper+    where+        moduleItemMapper (AlwaysC kw stmt) =+            mapper stmt >>= return . AlwaysC kw+        moduleItemMapper (MIPackageItem (Function lifetime ret name decls stmts)) = do+            stmts' <- mapM mapper stmts+            return $ MIPackageItem $ Function lifetime ret name decls stmts'+        moduleItemMapper (MIPackageItem (Task lifetime name decls stmts)) = do+            stmts' <- mapM mapper stmts+            return $ MIPackageItem $ Task lifetime name decls stmts'+        moduleItemMapper (Initial stmt) =+            mapper stmt >>= return . Initial+        moduleItemMapper (Final stmt) =+            mapper stmt >>= return . Final+        moduleItemMapper other = return $ other++traverseStmts :: Mapper Stmt -> Mapper ModuleItem+traverseStmts = unmonad traverseStmtsM+collectStmtsM :: Monad m => CollectorM m Stmt -> CollectorM m ModuleItem+collectStmtsM = collectify traverseStmtsM++traverseNestedStmtsM :: Monad m => MapperM m Stmt -> MapperM m Stmt+traverseNestedStmtsM mapper = fullMapper+    where fullMapper = mapper >=> traverseSinglyNestedStmtsM fullMapper++traverseNestedStmts :: Mapper Stmt -> Mapper Stmt+traverseNestedStmts = unmonad traverseNestedStmtsM+collectNestedStmtsM :: Monad m => CollectorM m Stmt -> CollectorM m Stmt+collectNestedStmtsM = collectify traverseNestedStmtsM++traverseSinglyNestedStmtsM :: Monad m => MapperM m Stmt -> MapperM m Stmt+traverseSinglyNestedStmtsM fullMapper = cs+    where+        cs (StmtAttr a stmt) = fullMapper stmt >>= return . StmtAttr a+        cs (Block _ "" [] []) = return Null+        cs (Block _ "" [] [stmt]) = fullMapper stmt+        cs (Block Seq name decls stmts) = do+            stmts' <- mapM fullMapper stmts+            return $ Block Seq name decls $ concatMap explode stmts'+            where+                explode :: Stmt -> [Stmt]+                explode (Block Seq "" [] ss) = ss+                explode other = [other]+        cs (Block kw name decls stmts) =+            mapM fullMapper stmts >>= return . Block kw name decls+        cs (Case u kw expr cases) = do+            caseStmts <- mapM fullMapper $ map snd cases+            let cases' = zip (map fst cases) caseStmts+            return $ Case u kw expr cases'+        cs (Asgn op mt lhs expr) = return $ Asgn op mt lhs expr+        cs (For a b c stmt) = fullMapper stmt >>= return . For a b c+        cs (While   e stmt) = fullMapper stmt >>= return . While   e+        cs (RepeatL e stmt) = fullMapper stmt >>= return . RepeatL e+        cs (DoWhile e stmt) = fullMapper stmt >>= return . DoWhile e+        cs (Forever   stmt) = fullMapper stmt >>= return . Forever+        cs (Foreach x vars stmt) = fullMapper stmt >>= return . Foreach x vars+        cs (If NoCheck (Number n) s1 s2) = do+            s1' <- fullMapper s1+            s2' <- fullMapper s2+            return $ case numberToInteger n of+                Nothing -> If NoCheck (Number n) s1' s2'+                Just 0 -> s2'+                Just _ -> s1'+        cs (If u e s1 s2) = do+            s1' <- fullMapper s1+            s2' <- fullMapper s2+            return $ If u e s1' s2'+        cs (Timing event stmt) = fullMapper stmt >>= return . Timing event+        cs (Return expr) = return $ Return expr+        cs (Subroutine expr exprs) = return $ Subroutine expr exprs+        cs (Trigger blocks x) = return $ Trigger blocks x+        cs (Assertion a) =+            traverseAssertionStmtsM fullMapper a >>= return . Assertion+        cs (Continue) = return Continue+        cs (Break) = return Break+        cs (Null) = return Null+        cs (CommentStmt c) = return $ CommentStmt c++traverseSinglyNestedStmts :: Mapper Stmt -> Mapper Stmt+traverseSinglyNestedStmts = unmonad traverseSinglyNestedStmtsM+collectSinglyNestedStmtsM :: Monad m => CollectorM m Stmt -> CollectorM m Stmt+collectSinglyNestedStmtsM = collectify traverseSinglyNestedStmtsM++traverseAssertionStmtsM :: Monad m => MapperM m Stmt -> MapperM m Assertion+traverseAssertionStmtsM mapper = assertionMapper+    where+        actionBlockMapper (ActionBlock s1 s2) = do+            s1' <- mapper s1+            s2' <- mapper s2+            return $ ActionBlock s1' s2'+        assertionMapper (Assert e ab) =+            actionBlockMapper ab >>= return . Assert e+        assertionMapper (Assume e ab) =+            actionBlockMapper ab >>= return . Assume e+        assertionMapper (Cover e stmt) =+            mapper stmt >>= return . Cover e++-- Note that this does not include the expressions without the statements of the+-- actions associated with the assertions.+traverseAssertionExprsM :: Monad m => MapperM m Expr -> MapperM m Assertion+traverseAssertionExprsM mapper = assertionMapper+    where+        seqExprMapper (SeqExpr e) =+            mapper e >>= return . SeqExpr+        seqExprMapper (SeqExprAnd        s1 s2) =+            ssMapper   SeqExprAnd        s1 s2+        seqExprMapper (SeqExprOr         s1 s2) =+            ssMapper   SeqExprOr         s1 s2+        seqExprMapper (SeqExprIntersect  s1 s2) =+            ssMapper   SeqExprIntersect  s1 s2+        seqExprMapper (SeqExprWithin     s1 s2) =+            ssMapper   SeqExprWithin     s1 s2+        seqExprMapper (SeqExprThroughout e s) = do+            e' <- mapper e+            s' <- seqExprMapper s+            return $ SeqExprThroughout e' s'+        seqExprMapper (SeqExprDelay ms e s) = do+            ms' <- case ms of+                Nothing -> return Nothing+                Just x -> seqExprMapper x >>= return . Just+            e' <- mapper e+            s' <- seqExprMapper s+            return $ SeqExprDelay ms' e' s'+        seqExprMapper (SeqExprFirstMatch s items) = do+            s' <- seqExprMapper s+            items' <- mapM seqMatchItemMapper items+            return $ SeqExprFirstMatch s' items'+        seqMatchItemMapper (SeqMatchAsgn (a, b, c)) = do+            c' <- mapper c+            return $ SeqMatchAsgn (a, b, c')+        seqMatchItemMapper (SeqMatchCall x (Args l p)) = do+            l' <- mapM mapper l+            pes <- mapM mapper $ map snd p+            let p' = zip (map fst p) pes+            return $ SeqMatchCall x (Args l' p')+        ppMapper constructor p1 p2 = do+            p1' <- propExprMapper p1+            p2' <- propExprMapper p2+            return $ constructor p1' p2'+        ssMapper constructor s1 s2 = do+            s1' <- seqExprMapper s1+            s2' <- seqExprMapper s2+            return $ constructor s1' s2'+        spMapper constructor se pe = do+            se' <- seqExprMapper se+            pe' <- propExprMapper pe+            return $ constructor se' pe'+        propExprMapper (PropExpr se) =+            seqExprMapper se >>= return . PropExpr+        propExprMapper (PropExprImpliesO se pe) =+            spMapper PropExprImpliesO se pe+        propExprMapper (PropExprImpliesNO se pe) =+            spMapper PropExprImpliesNO se pe+        propExprMapper (PropExprFollowsO se pe) =+            spMapper PropExprFollowsO se pe+        propExprMapper (PropExprFollowsNO se pe) =+            spMapper PropExprFollowsNO se pe+        propExprMapper (PropExprIff p1 p2) =+            ppMapper PropExprIff p1 p2+        propSpecMapper (PropertySpec ms e pe) = do+            e' <- mapper e+            pe' <- propExprMapper pe+            return $ PropertySpec ms e' pe'+        assertionExprMapper (Left e) =+            propSpecMapper e >>= return . Left+        assertionExprMapper (Right e) =+            mapper e >>= return . Right+        assertionMapper (Assert e ab) = do+            e' <- assertionExprMapper e+            return $ Assert e' ab+        assertionMapper (Assume e ab) = do+            e' <- assertionExprMapper e+            return $ Assume e' ab+        assertionMapper (Cover e stmt) = do+            e' <- assertionExprMapper e+            return $ Cover e' stmt++traverseStmtLHSsM :: Monad m => MapperM m LHS -> MapperM m Stmt+traverseStmtLHSsM mapper = stmtMapper+    where+        fullMapper = mapper+        stmtMapper (Timing (Event sense) stmt) = do+            sense' <- senseMapper sense+            return $ Timing (Event sense') stmt+        stmtMapper (Asgn op (Just (Event sense)) lhs expr) = do+            lhs' <- fullMapper lhs+            sense' <- senseMapper sense+            return $ Asgn op (Just $ Event sense') lhs' expr+        stmtMapper (Asgn op mt lhs expr) =+            fullMapper lhs >>= \lhs' -> return $ Asgn op mt lhs' expr+        stmtMapper (For inits me incrs stmt) = do+            inits' <- mapM (bimapM fullMapper return) inits+            let (lhss, asgnOps, exprs) = unzip3 incrs+            lhss' <- mapM fullMapper lhss+            let incrs' = zip3 lhss' asgnOps exprs+            return $ For inits' me incrs' stmt+        stmtMapper (Assertion a) =+            assertionMapper a >>= return . Assertion+        stmtMapper other = return other+        senseMapper (Sense        lhs) = fullMapper lhs >>= return . Sense+        senseMapper (SensePosedge lhs) = fullMapper lhs >>= return . SensePosedge+        senseMapper (SenseNegedge lhs) = fullMapper lhs >>= return . SenseNegedge+        senseMapper (SenseOr    s1 s2) = do+            s1' <- senseMapper s1+            s2' <- senseMapper s2+            return $ SenseOr s1' s2'+        senseMapper (SenseStar       ) = return SenseStar+        assertionExprMapper (Left (PropertySpec (Just sense) me pe)) = do+            sense' <- senseMapper sense+            return $ Left $ PropertySpec (Just sense') me pe+        assertionExprMapper other = return $ other+        assertionMapper (Assert e ab) = do+            e' <- assertionExprMapper e+            return $ Assert e' ab+        assertionMapper (Assume e ab) = do+            e' <- assertionExprMapper e+            return $ Assume e' ab+        assertionMapper (Cover e stmt) = do+            e' <- assertionExprMapper e+            return $ Cover e' stmt++traverseStmtLHSs :: Mapper LHS -> Mapper Stmt+traverseStmtLHSs = unmonad traverseStmtLHSsM+collectStmtLHSsM :: Monad m => CollectorM m LHS -> CollectorM m Stmt+collectStmtLHSsM = collectify traverseStmtLHSsM++traverseNestedExprsM :: Monad m => MapperM m Expr -> MapperM m Expr+traverseNestedExprsM mapper = exprMapper+    where exprMapper = mapper >=> traverseSinglyNestedExprsM exprMapper++traverseNestedExprs :: Mapper Expr -> Mapper Expr+traverseNestedExprs = unmonad traverseNestedExprsM+collectNestedExprsM :: Monad m => CollectorM m Expr -> CollectorM m Expr+collectNestedExprsM = collectify traverseNestedExprsM++traverseSinglyNestedExprsM :: Monad m => MapperM m Expr -> MapperM m Expr+traverseSinglyNestedExprsM exprMapper = em+    where+        typeOrExprMapper (Left t) = return $ Left t+        typeOrExprMapper (Right e) =+            exprMapper e >>= return . Right+        em (String s) = return $ String s+        em (Real   s) = return $ Real   s+        em (Number n) = return $ Number n+        em (Time   s) = return $ Time   s+        em (Ident  i) = return $ Ident  i+        em (PSIdent x y) = return $ PSIdent x y+        em (CSIdent x ps y) = do+            tes' <- mapM typeOrExprMapper $ map snd ps+            let ps' = zip (map fst ps) tes'+            return $ CSIdent x ps' y+        em (Range e m (e1, e2)) = do+            e' <- exprMapper e+            e1' <- exprMapper e1+            e2' <- exprMapper e2+            return $ Range e' m (e1', e2')+        em (Bit   e1 e2) = do+            e1' <- exprMapper e1+            e2' <- exprMapper e2+            return $ Bit e1' e2'+        em (Repeat     e l) = do+            e' <- exprMapper e+            l' <- mapM exprMapper l+            return $ Repeat e' l'+        em (Concat     l) =+            mapM exprMapper l >>= return . Concat+        em (Stream o e l) = do+            e' <- exprMapper e+            l' <- mapM exprMapper l+            return $ Stream o e' l'+        em (Call  e (Args l p)) = do+            e' <- exprMapper e+            l' <- mapM exprMapper l+            pes <- mapM exprMapper $ map snd p+            let p' = zip (map fst p) pes+            return $ Call e' (Args l' p')+        em (UniOp      o e) =+            exprMapper e >>= return . UniOp o+        em (BinOp      o e1 e2) = do+            e1' <- exprMapper e1+            e2' <- exprMapper e2+            return $ BinOp o e1' e2'+        em (Mux        e1 e2 e3) = do+            e1' <- exprMapper e1+            e2' <- exprMapper e2+            e3' <- exprMapper e3+            return $ Mux e1' e2' e3'+        em (Cast tore e) = do+            tore' <- typeOrExprMapper tore+            e' <- exprMapper e+            return $ Cast tore' e'+        em (DimsFn f tore) =+            typeOrExprMapper tore >>= return . DimsFn f+        em (DimFn f tore e) = do+            tore' <- typeOrExprMapper tore+            e' <- exprMapper e+            return $ DimFn f tore' e'+        em (Dot e x) =+            exprMapper e >>= \e' -> return $ Dot e' x+        em (Pattern l) = do+            names <- mapM typeOrExprMapper $ map fst l+            exprs <- mapM exprMapper $ map snd l+            return $ Pattern $ zip names exprs+        em (Inside e l) = do+            e' <- exprMapper e+            l' <- mapM exprMapper l+            return $ Inside e' l'+        em (MinTypMax e1 e2 e3) = do+            e1' <- exprMapper e1+            e2' <- exprMapper e2+            e3' <- exprMapper e3+            return $ MinTypMax e1' e2' e3'+        em (Nil) = return Nil++traverseSinglyNestedExprs :: Mapper Expr -> Mapper Expr+traverseSinglyNestedExprs = unmonad traverseSinglyNestedExprsM+collectSinglyNestedExprsM :: Monad m => CollectorM m Expr -> CollectorM m Expr+collectSinglyNestedExprsM = collectify traverseSinglyNestedExprsM++traverseLHSExprsM :: Monad m => MapperM m Expr -> MapperM m LHS+traverseLHSExprsM exprMapper =+    lhsMapper+    where+        lhsMapper (LHSRange l m r) =+            mapBothM exprMapper r >>= return . LHSRange l m+        lhsMapper (LHSBit l e) =+            exprMapper e >>= return . LHSBit l+        lhsMapper (LHSStream o e ls) = do+            e' <- exprMapper e+            return $ LHSStream o e' ls+        lhsMapper other = return other++traverseLHSExprs :: Mapper Expr -> Mapper LHS+traverseLHSExprs = unmonad traverseLHSExprsM+collectLHSExprsM :: Monad m => CollectorM m Expr -> CollectorM m LHS+collectLHSExprsM = collectify traverseLHSExprsM++mapBothM :: Monad m => MapperM m t -> MapperM m (t, t)+mapBothM mapper (a, b) = do+    a' <- mapper a+    b' <- mapper b+    return (a', b')++traverseExprsM :: Monad m => MapperM m Expr -> MapperM m ModuleItem+traverseExprsM exprMapper =+    traverseNodesM exprMapper declMapper typeMapper lhsMapper stmtMapper+    where+    declMapper = traverseDeclNodesM typeMapper exprMapper+    typeMapper = traverseNestedTypesM (traverseTypeExprsM exprMapper)+    lhsMapper = traverseNestedLHSsM (traverseLHSExprsM exprMapper)+    stmtMapper = traverseNestedStmtsM (traverseStmtExprsM exprMapper)++traverseExprs :: Mapper Expr -> Mapper ModuleItem+traverseExprs = unmonad traverseExprsM+collectExprsM :: Monad m => CollectorM m Expr -> CollectorM m ModuleItem+collectExprsM = collectify traverseExprsM++traverseNodesM+    :: Monad m+    => MapperM m Expr+    -> MapperM m Decl+    -> MapperM m Type+    -> MapperM m LHS+    -> MapperM m Stmt+    -> MapperM m ModuleItem+traverseNodesM exprMapper declMapper typeMapper lhsMapper stmtMapper =+    moduleItemMapper+    where++    portBindingMapper (p, e) =+        exprMapper e >>= \e' -> return (p, e')++    paramBindingMapper (p, Left t) =+        typeMapper t >>= \t' -> return (p, Left t')+    paramBindingMapper (p, Right e) =+        exprMapper e >>= \e' -> return (p, Right e')++    moduleItemMapper (MIAttr attr mi) =+        -- note: we exclude expressions in attributes from conversion+        return $ MIAttr attr mi+    moduleItemMapper (MIPackageItem (Decl decl)) =+        declMapper decl >>= return . MIPackageItem . Decl+    moduleItemMapper (Defparam lhs expr) = do+        lhs' <- lhsMapper lhs+        expr' <- exprMapper expr+        return $ Defparam lhs' expr'+    moduleItemMapper (AlwaysC kw stmt) =+        stmtMapper stmt >>= return . AlwaysC kw+    moduleItemMapper (Initial stmt) =+        stmtMapper stmt >>= return . Initial+    moduleItemMapper (Final stmt) =+        stmtMapper stmt >>= return . Final+    moduleItemMapper (Assign opt lhs expr) = do+        opt' <- case opt of+            AssignOptionNone -> return $ AssignOptionNone+            AssignOptionDrive s0 s1 -> return $ AssignOptionDrive s0 s1+            AssignOptionDelay delay ->+                exprMapper delay >>= return . AssignOptionDelay+        lhs' <- lhsMapper lhs+        expr' <- exprMapper expr+        return $ Assign opt' lhs' expr'+    moduleItemMapper (MIPackageItem (Function lifetime ret f decls stmts)) = do+        ret' <- typeMapper ret+        decls' <- mapM declMapper decls+        stmts' <- mapM stmtMapper stmts+        return $ MIPackageItem $ Function lifetime ret' f decls' stmts'+    moduleItemMapper (MIPackageItem (Task lifetime f decls stmts)) = do+        decls' <- mapM declMapper decls+        stmts' <- mapM stmtMapper stmts+        return $ MIPackageItem $ Task lifetime f decls' stmts'+    moduleItemMapper (Instance m p x rs l) = do+        p' <- mapM paramBindingMapper p+        l' <- mapM portBindingMapper l+        rs' <- mapM (mapBothM exprMapper) rs+        return $ Instance m p' x rs' l'+    moduleItemMapper (Modport x l) =+        mapM modportDeclMapper l >>= return . Modport x+    moduleItemMapper (NInputGate  kw d x lhs exprs) = do+        d' <- exprMapper d+        exprs' <- mapM exprMapper exprs+        lhs' <- lhsMapper lhs+        return $ NInputGate kw d' x lhs' exprs'+    moduleItemMapper (NOutputGate kw d x lhss expr) = do+        d' <- exprMapper d+        lhss' <- mapM lhsMapper lhss+        expr' <- exprMapper expr+        return $ NOutputGate kw d' x lhss' expr'+    moduleItemMapper (Genvar   x) = return $ Genvar   x+    moduleItemMapper (Generate items) = do+        items' <- mapM (traverseNestedGenItemsM genItemMapper) items+        return $ Generate items'+    moduleItemMapper (MIPackageItem (Directive c)) =+        return $ MIPackageItem $ Directive c+    moduleItemMapper (MIPackageItem (Import x y)) =+        return $ MIPackageItem $ Import x y+    moduleItemMapper (MIPackageItem (Export x y)) =+        return $ MIPackageItem $ Export x y+    moduleItemMapper (AssertionItem (mx, a)) = do+        a' <- traverseAssertionStmtsM stmtMapper a+        a'' <- traverseAssertionExprsM exprMapper a'+        return $ AssertionItem (mx, a'')+    moduleItemMapper (ElabTask severity (Args pnArgs kwArgs)) = do+        pnArgs' <- mapM exprMapper pnArgs+        kwArgs' <- fmap (zip kwNames) $ mapM exprMapper kwExprs+        return $ ElabTask severity $ Args pnArgs' kwArgs'+        where (kwNames, kwExprs) = unzip kwArgs++    genItemMapper = traverseGenItemExprsM exprMapper++    modportDeclMapper (dir, ident, e) = do+        e' <- exprMapper e+        return (dir, ident, e')++traverseNodes+    :: Mapper Expr+    -> Mapper Decl+    -> Mapper Type+    -> Mapper LHS+    -> Mapper Stmt+    -> Mapper ModuleItem+traverseNodes exprMapper declMapper typeMapper lhsMapper stmtMapper =+    runIdentity . traverseNodesM+        (return . exprMapper)+        (return . declMapper)+        (return . typeMapper)+        (return . lhsMapper )+        (return . stmtMapper)++traverseStmtExprsM :: Monad m => MapperM m Expr -> MapperM m Stmt+traverseStmtExprsM exprMapper = flatStmtMapper+    where++    declMapper = traverseDeclExprsM exprMapper+    lhsMapper = traverseNestedLHSsM (traverseLHSExprsM exprMapper)++    caseMapper (exprs, stmt) = do+        exprs' <- mapM exprMapper exprs+        return (exprs', stmt)+    stmtMapper = traverseNestedStmtsM flatStmtMapper+    flatStmtMapper (StmtAttr attr stmt) =+        -- note: we exclude expressions in attributes from conversion+        return $ StmtAttr attr stmt+    flatStmtMapper (Block kw name decls stmts) = do+        decls' <- mapM declMapper decls+        return $ Block kw name decls' stmts+    flatStmtMapper (Case u kw e cases) = do+        e' <- exprMapper e+        cases' <- mapM caseMapper cases+        return $ Case u kw e' cases'+    flatStmtMapper (Asgn op mt lhs expr) = do+        lhs' <- lhsMapper lhs+        expr' <- exprMapper expr+        return $ Asgn op mt lhs' expr'+    flatStmtMapper (For inits cc asgns stmt) = do+        inits' <- mapM (bimapM return exprMapper) inits+        cc' <- exprMapper cc+        asgns' <- mapM asgnMapper asgns+        return $ For inits' cc' asgns' stmt+    flatStmtMapper (While   e stmt) =+        exprMapper e >>= \e' -> return $ While   e' stmt+    flatStmtMapper (RepeatL e stmt) =+        exprMapper e >>= \e' -> return $ RepeatL e' stmt+    flatStmtMapper (DoWhile e stmt) =+        exprMapper e >>= \e' -> return $ DoWhile e' stmt+    flatStmtMapper (Forever   stmt) = return $ Forever stmt+    flatStmtMapper (Foreach x vars stmt) = return $ Foreach x vars stmt+    flatStmtMapper (If u cc s1 s2) =+        exprMapper cc >>= \cc' -> return $ If u cc' s1 s2+    flatStmtMapper (Timing event stmt) = return $ Timing event stmt+    flatStmtMapper (Subroutine e (Args l p)) = do+        e' <- exprMapper e+        l' <- mapM exprMapper l+        pes <- mapM exprMapper $ map snd p+        let p' = zip (map fst p) pes+        return $ Subroutine e' (Args l' p')+    flatStmtMapper (Return expr) =+        exprMapper expr >>= return . Return+    flatStmtMapper (Trigger blocks x) = return $ Trigger blocks x+    flatStmtMapper (Assertion a) = do+        a' <- traverseAssertionStmtsM stmtMapper a+        a'' <- traverseAssertionExprsM exprMapper a'+        return $ Assertion a''+    flatStmtMapper (Continue) = return Continue+    flatStmtMapper (Break) = return Break+    flatStmtMapper (Null) = return Null+    flatStmtMapper (CommentStmt c) = return $ CommentStmt c++    asgnMapper (l, op, e) = exprMapper e >>= \e' -> return $ (l, op, e')++traverseStmtExprs :: Mapper Expr -> Mapper Stmt+traverseStmtExprs = unmonad traverseStmtExprsM+collectStmtExprsM :: Monad m => CollectorM m Expr -> CollectorM m Stmt+collectStmtExprsM = collectify traverseStmtExprsM++traverseLHSsM :: Monad m => MapperM m LHS -> MapperM m ModuleItem+traverseLHSsM mapper =+    traverseStmtsM (traverseNestedStmtsM $ traverseStmtLHSsM mapper)+        >=> traverseModuleItemLHSsM+    where+        traverseModuleItemLHSsM (Assign delay lhs expr) = do+            lhs' <- mapper lhs+            return $ Assign delay lhs' expr+        traverseModuleItemLHSsM (Defparam lhs expr) = do+            lhs' <- mapper lhs+            return $ Defparam lhs' expr+        traverseModuleItemLHSsM (NOutputGate kw d x lhss expr) = do+            lhss' <- mapM mapper lhss+            return $ NOutputGate kw d x lhss' expr+        traverseModuleItemLHSsM (NInputGate  kw d x lhs exprs) = do+            lhs' <- mapper lhs+            return $ NInputGate kw d x lhs' exprs+        traverseModuleItemLHSsM (AssertionItem (mx, a)) = do+            converted <-+                traverseNestedStmtsM (traverseStmtLHSsM mapper) (Assertion a)+            return $ case converted of+                Assertion a' -> AssertionItem (mx, a')+                _ -> error $ "redirected AssertionItem traverse failed: "+                        ++ show converted+        traverseModuleItemLHSsM (Generate items) = do+            items' <- mapM (traverseNestedGenItemsM traverGenItemLHSsM) items+            return $ Generate items'+        traverseModuleItemLHSsM other = return other+        traverGenItemLHSsM (GenFor (x1, e1) cc (x2, op2, e2) subItem) = do+            wrapped_x1' <- mapper $ LHSIdent x1+            wrapped_x2' <- mapper $ LHSIdent x2+            let LHSIdent x1' = wrapped_x1'+            let LHSIdent x2' = wrapped_x2'+            return $ GenFor (x1', e1) cc (x2', op2, e2) subItem+        traverGenItemLHSsM other = return other++traverseLHSs :: Mapper LHS -> Mapper ModuleItem+traverseLHSs = unmonad traverseLHSsM+collectLHSsM :: Monad m => CollectorM m LHS -> CollectorM m ModuleItem+collectLHSsM = collectify traverseLHSsM++traverseNestedLHSsM :: Monad m => MapperM m LHS -> MapperM m LHS+traverseNestedLHSsM mapper = fullMapper+    where fullMapper = mapper >=> traverseSinglyNestedLHSsM fullMapper++traverseNestedLHSs :: Mapper LHS -> Mapper LHS+traverseNestedLHSs = unmonad traverseNestedLHSsM+collectNestedLHSsM :: Monad m => CollectorM m LHS -> CollectorM m LHS+collectNestedLHSsM = collectify traverseNestedLHSsM++traverseSinglyNestedLHSsM :: Monad m => MapperM m LHS -> MapperM m LHS+traverseSinglyNestedLHSsM mapper = tl+    where+        tl (LHSIdent  x       ) = return $ LHSIdent x+        tl (LHSBit    l e     ) = mapper l >>= \l' -> return $ LHSBit    l' e+        tl (LHSRange  l m r   ) = mapper l >>= \l' -> return $ LHSRange  l' m r+        tl (LHSDot    l x     ) = mapper l >>= \l' -> return $ LHSDot    l' x+        tl (LHSConcat     lhss) = mapM mapper lhss >>= return . LHSConcat+        tl (LHSStream o e lhss) = mapM mapper lhss >>= return . LHSStream o e++traverseSinglyNestedLHSs :: Mapper LHS -> Mapper LHS+traverseSinglyNestedLHSs = unmonad traverseSinglyNestedLHSsM+collectSinglyNestedLHSsM :: Monad m => CollectorM m LHS -> CollectorM m LHS+collectSinglyNestedLHSsM = collectify traverseSinglyNestedLHSsM++traverseDeclsM :: Monad m => MapperM m Decl -> MapperM m ModuleItem+traverseDeclsM mapper = miMapper+    where+        miMapper (MIPackageItem (Decl decl)) =+            mapper decl >>= return . MIPackageItem . Decl+        miMapper other = return other++traverseDecls :: Mapper Decl -> Mapper ModuleItem+traverseDecls = unmonad traverseDeclsM+collectDeclsM :: Monad m => CollectorM m Decl -> CollectorM m ModuleItem+collectDeclsM = collectify traverseDeclsM++traverseStmtDeclsM :: Monad m => MapperM m Decl -> MapperM m Stmt+traverseStmtDeclsM mapper = stmtMapper+    where+        stmtMapper (Block kw name decls stmts) = do+            decls' <- mapM mapper decls+            return $ Block kw name decls' stmts+        stmtMapper other = return other++traverseStmtDecls :: Mapper Decl -> Mapper Stmt+traverseStmtDecls = unmonad traverseStmtDeclsM+collectStmtDeclsM :: Monad m => CollectorM m Decl -> CollectorM m Stmt+collectStmtDeclsM = collectify traverseStmtDeclsM++traverseSinglyNestedTypesM :: Monad m => MapperM m Type -> MapperM m Type+traverseSinglyNestedTypesM mapper = tm+    where+        typeOrExprMapper (Left t) = mapper t >>= return . Left+        typeOrExprMapper (Right e) = return $ Right e+        tm (Alias         xx    rs) = return $ Alias         xx    rs+        tm (PSAlias ps    xx    rs) = return $ PSAlias ps    xx    rs+        tm (CSAlias ps pm xx    rs) = do+            vals' <- mapM typeOrExprMapper $ map snd pm+            let pm' = zip (map fst pm) vals'+            return $ CSAlias ps pm' xx rs+        tm (Implicit         sg rs) = return $ Implicit         sg rs+        tm (IntegerVector kw sg rs) = return $ IntegerVector kw sg rs+        tm (IntegerAtom   kw sg   ) = return $ IntegerAtom   kw sg+        tm (NonInteger    kw      ) = return $ NonInteger    kw+        tm (TypeOf        expr    ) = return $ TypeOf        expr+        tm (TypedefRef    expr    ) = return $ TypedefRef    expr+        tm (InterfaceT x y r) = return $ InterfaceT x y r+        tm (Enum t vals r) = do+            t' <- mapper t+            return $ Enum t' vals r+        tm (Struct p fields r) = do+            types <- mapM mapper $ map fst fields+            let idents = map snd fields+            return $ Struct p (zip types idents) r+        tm (Union p fields r) = do+            types <- mapM mapper $ map fst fields+            let idents = map snd fields+            return $ Union p (zip types idents) r+        tm (UnpackedType t r) = do+            t' <- mapper t+            return $ UnpackedType t' r++traverseSinglyNestedTypes :: Mapper Type -> Mapper Type+traverseSinglyNestedTypes = unmonad traverseSinglyNestedTypesM+collectSinglyNestedTypesM :: Monad m => CollectorM m Type -> CollectorM m Type+collectSinglyNestedTypesM = collectify traverseSinglyNestedTypesM++traverseNestedTypesM :: Monad m => MapperM m Type -> MapperM m Type+traverseNestedTypesM mapper = fullMapper+    where fullMapper = mapper >=> traverseSinglyNestedTypesM fullMapper++traverseNestedTypes :: Mapper Type -> Mapper Type+traverseNestedTypes = unmonad traverseNestedTypesM+collectNestedTypesM :: Monad m => CollectorM m Type -> CollectorM m Type+collectNestedTypesM = collectify traverseNestedTypesM++traverseExprTypesM :: Monad m => MapperM m Type -> MapperM m Expr+traverseExprTypesM mapper = exprMapper+    where+        typeOrExprMapper (Right e) = return $ Right e+        typeOrExprMapper (Left t) =+            mapper t >>= return . Left+        exprMapper (Cast tore e) =+            typeOrExprMapper tore >>= return . flip Cast e+        exprMapper (DimsFn f tore) =+            typeOrExprMapper tore >>= return . DimsFn f+        exprMapper (DimFn f tore e) = do+            tore' <- typeOrExprMapper tore+            return $ DimFn f tore' e+        exprMapper (Pattern l) = do+            names <- mapM typeOrExprMapper $ map fst l+            let exprs = map snd l+            return $ Pattern $ zip names exprs+        exprMapper other = return other++traverseExprTypes :: Mapper Type -> Mapper Expr+traverseExprTypes = unmonad traverseExprTypesM+collectExprTypesM :: Monad m => CollectorM m Type -> CollectorM m Expr+collectExprTypesM = collectify traverseExprTypesM++traverseTypeExprsM :: Monad m => MapperM m Expr -> MapperM m Type+traverseTypeExprsM exprMapper =+    typeMapper+    where+        typeOrExprMapper (Left t) = return $ Left t+        typeOrExprMapper (Right e) = exprMapper e >>= return . Right+        typeMapper (TypeOf expr) =+            exprMapper expr >>= return . TypeOf+        -- TypedefRef is excluded because it isn't really an expression+        typeMapper (CSAlias ps pm xx rs) = do+            vals' <- mapM typeOrExprMapper $ map snd pm+            let pm' = zip (map fst pm) vals'+            rs' <- mapM (mapBothM exprMapper) rs+            return $ CSAlias ps pm' xx rs'+        typeMapper (Enum t enumItems rs) = do+            enumItems' <- mapM enumItemMapper enumItems+            rs' <- mapM (mapBothM exprMapper) rs+            return $ Enum t enumItems' rs'+            where enumItemMapper (x, e) = exprMapper e >>= \e' -> return (x, e')+        typeMapper t = do+            let (tf, rs) = typeRanges t+            rs' <- mapM (mapBothM exprMapper) rs+            return $ tf rs'++traverseTypeExprs :: Mapper Expr -> Mapper Type+traverseTypeExprs = unmonad traverseTypeExprsM+collectTypeExprsM :: Monad m => CollectorM m Expr -> CollectorM m Type+collectTypeExprsM = collectify traverseTypeExprsM++traverseGenItemExprsM :: Monad m => MapperM m Expr -> MapperM m GenItem+traverseGenItemExprsM exprMapper =+    genItemMapper+    where+        genItemMapper (GenFor (x1, e1) cc (x2, op2, e2) subItem) = do+            e1' <- exprMapper e1+            e2' <- exprMapper e2+            cc' <- exprMapper cc+            return $ GenFor (x1, e1') cc' (x2, op2, e2') subItem+        genItemMapper (GenIf e i1 i2) = do+            e' <- exprMapper e+            return $ GenIf e' i1 i2+        genItemMapper (GenCase e cases) = do+            e' <- exprMapper e+            caseExprs <- mapM (mapM exprMapper . fst) cases+            let cases' = zip caseExprs (map snd cases)+            return $ GenCase e' cases'+        genItemMapper other = return other++traverseGenItemExprs :: Mapper Expr -> Mapper GenItem+traverseGenItemExprs = unmonad traverseGenItemExprsM+collectGenItemExprsM :: Monad m => CollectorM m Expr -> CollectorM m GenItem+collectGenItemExprsM = collectify traverseGenItemExprsM++traverseDeclNodesM+    :: Monad m => MapperM m Type -> MapperM m Expr -> MapperM m Decl+traverseDeclNodesM typeMapper exprMapper =+    declMapper+    where+        declMapper (Param s t x e) = do+            t' <- typeMapper t+            e' <- exprMapper e+            return $ Param s t' x e'+        declMapper (ParamType s x t) = do+            t' <- typeMapper t+            return $ ParamType s x t'+        declMapper (Variable d t x a e) = do+            t' <- typeMapper t+            a' <- mapM (mapBothM exprMapper) a+            e' <- exprMapper e+            return $ Variable d t' x a' e'+        declMapper (Net d n s t x a e) = do+            t' <- typeMapper t+            a' <- mapM (mapBothM exprMapper) a+            e' <- exprMapper e+            return $ Net d n s t' x a' e'+        declMapper (CommentDecl c) =+            return $ CommentDecl c++traverseDeclNodes :: Mapper Type -> Mapper Expr -> Mapper Decl+traverseDeclNodes typeMapper exprMapper =+    runIdentity . traverseDeclNodesM+        (return . typeMapper)+        (return . exprMapper)++traverseDeclExprsM :: Monad m => MapperM m Expr -> MapperM m Decl+traverseDeclExprsM exprMapper = traverseDeclNodesM typeMapper exprMapper+    where typeMapper = traverseNestedTypesM (traverseTypeExprsM exprMapper)++traverseDeclExprs :: Mapper Expr -> Mapper Decl+traverseDeclExprs = unmonad traverseDeclExprsM+collectDeclExprsM :: Monad m => CollectorM m Expr -> CollectorM m Decl+collectDeclExprsM = collectify traverseDeclExprsM++traverseDeclTypesM :: Monad m => MapperM m Type -> MapperM m Decl+traverseDeclTypesM typeMapper = traverseDeclNodesM typeMapper exprMapper+    where exprMapper = traverseNestedExprsM (traverseExprTypesM typeMapper)++traverseDeclTypes :: Mapper Type -> Mapper Decl+traverseDeclTypes = unmonad traverseDeclTypesM+collectDeclTypesM :: Monad m => CollectorM m Type -> CollectorM m Decl+collectDeclTypesM = collectify traverseDeclTypesM++traverseTypesM :: Monad m => MapperM m Type -> MapperM m ModuleItem+traverseTypesM typeMapper =+    traverseNodesM exprMapper declMapper typeMapper lhsMapper stmtMapper+    where+        exprMapper = traverseNestedExprsM (traverseExprTypesM typeMapper)+        lhsMapper = traverseNestedLHSsM (traverseLHSExprsM exprMapper)+        stmtMapper = traverseNestedStmtsM $+            traverseStmtDeclsM declMapper >=> traverseStmtExprsM exprMapper+        declMapper = traverseDeclNodesM typeMapper exprMapper++traverseTypes :: Mapper Type -> Mapper ModuleItem+traverseTypes = unmonad traverseTypesM+collectTypesM :: Monad m => CollectorM m Type -> CollectorM m ModuleItem+collectTypesM = collectify traverseTypesM++traverseGenItemsM :: Monad m => MapperM m GenItem -> MapperM m ModuleItem+traverseGenItemsM mapper = moduleItemMapper+    where+        moduleItemMapper (Generate genItems) =+            mapM mapper genItems >>= return . Generate+        moduleItemMapper other = return other++traverseGenItems :: Mapper GenItem -> Mapper ModuleItem+traverseGenItems = unmonad traverseGenItemsM+collectGenItemsM :: Monad m => CollectorM m GenItem -> CollectorM m ModuleItem+collectGenItemsM = collectify traverseGenItemsM++-- traverses all GenItems within a given GenItem, but doesn't inspect within+-- GenModuleItems+traverseNestedGenItemsM :: Monad m => MapperM m GenItem -> MapperM m GenItem+traverseNestedGenItemsM mapper = fullMapper+    where fullMapper = mapper >=> traverseSinglyNestedGenItemsM fullMapper++traverseNestedGenItems :: Mapper GenItem -> Mapper GenItem+traverseNestedGenItems = unmonad traverseNestedGenItemsM++flattenGenBlocks :: GenItem -> [GenItem]+flattenGenBlocks (GenModuleItem (Generate items)) = items+flattenGenBlocks (GenFor _ _ _ GenNull) = []+flattenGenBlocks GenNull = []+flattenGenBlocks other = [other]++traverseSinglyNestedGenItemsM :: Monad m => MapperM m GenItem -> MapperM m GenItem+traverseSinglyNestedGenItemsM fullMapper = gim+    where+        gim (GenBlock x subItems) = do+            subItems' <- mapM fullMapper subItems+            return $ GenBlock x (concatMap flattenGenBlocks subItems')+        gim (GenFor a b c subItem) = do+            subItem' <- fullMapper subItem+            return $ GenFor a b c subItem'+        gim (GenIf e i1 i2) = do+            i1' <- fullMapper i1+            i2' <- fullMapper i2+            return $ GenIf e i1' i2'+        gim (GenCase e cases) = do+            caseItems <- mapM (fullMapper . snd) cases+            let cases' = zip (map fst cases) caseItems+            return $ GenCase e cases'+        gim (GenModuleItem moduleItem) =+            return $ GenModuleItem moduleItem+        gim (GenNull) = return GenNull++traverseAsgnsM :: Monad m => MapperM m (LHS, Expr) -> MapperM m ModuleItem+traverseAsgnsM mapper = moduleItemMapper+    where+        moduleItemMapper = miMapperA >=> miMapperB++        miMapperA (Assign delay lhs expr) = do+            (lhs', expr') <- mapper (lhs, expr)+            return $ Assign delay lhs' expr'+        miMapperA (Defparam lhs expr) = do+            (lhs', expr') <- mapper (lhs, expr)+            return $ Defparam lhs' expr'+        miMapperA other = return other++        miMapperB = traverseStmtsM $ traverseNestedStmtsM stmtMapper+        stmtMapper = traverseStmtAsgnsM mapper++traverseAsgns :: Mapper (LHS, Expr) -> Mapper ModuleItem+traverseAsgns = unmonad traverseAsgnsM+collectAsgnsM :: Monad m => CollectorM m (LHS, Expr) -> CollectorM m ModuleItem+collectAsgnsM = collectify traverseAsgnsM++traverseStmtAsgnsM :: Monad m => MapperM m (LHS, Expr) -> MapperM m Stmt+traverseStmtAsgnsM mapper = stmtMapper+    where+        stmtMapper (Asgn op mt lhs expr) = do+            (lhs', expr') <- mapper (lhs, expr)+            return $ Asgn op mt lhs' expr'+        stmtMapper other = return other++traverseStmtAsgns :: Mapper (LHS, Expr) -> Mapper Stmt+traverseStmtAsgns = unmonad traverseStmtAsgnsM+collectStmtAsgnsM :: Monad m => CollectorM m (LHS, Expr) -> CollectorM m Stmt+collectStmtAsgnsM = collectify traverseStmtAsgnsM++traverseNestedModuleItemsM :: Monad m => MapperM m ModuleItem -> MapperM m ModuleItem+traverseNestedModuleItemsM mapper = fullMapper+    where+        fullMapper (Generate genItems) = do+            let genItems' = concatMap flattenGenBlocks genItems+            mapM fullGenItemMapper genItems' >>= mapper . Generate+        fullMapper (MIAttr attr mi) =+            fullMapper mi >>= mapper . MIAttr attr+        fullMapper (Initial Null) = return $ Generate []+        fullMapper other = mapper other+        fullGenItemMapper = traverseNestedGenItemsM genItemMapper+        genItemMapper (GenModuleItem moduleItem) =+            fullMapper moduleItem >>= return . GenModuleItem+        genItemMapper (GenIf _ GenNull GenNull) = return GenNull+        genItemMapper (GenIf (Number n) s1 s2) = do+            case numberToInteger n of+                Nothing -> return $ GenIf (Number n) s1 s2+                Just 0 -> genItemMapper s2+                Just _ -> genItemMapper s1+        genItemMapper (GenBlock _ []) = return GenNull+        genItemMapper other = return other++traverseNestedModuleItems :: Mapper ModuleItem -> Mapper ModuleItem+traverseNestedModuleItems = unmonad traverseNestedModuleItemsM+collectNestedModuleItemsM :: Monad m => CollectorM m ModuleItem -> CollectorM m ModuleItem+collectNestedModuleItemsM = collectify traverseNestedModuleItemsM++-- In many conversions, we want to resolve items locally first, and then fall+-- back to looking at other source files, if necessary. This helper captures+-- this behavior, allowing a conversion to fall back to arbitrary global+-- collected item, if one exists. While this isn't foolproof (we could+-- inadvertently resolve a name that doesn't exist in the given file), many+-- projects rely on their toolchain to locate their modules, interfaces,+-- packages, or typenames in other files. Global resolution of modules and+-- interfaces is more commonly expected than global resolution of typenames and+-- packages.+traverseFilesM+    :: (Monoid w, Monad m)+    => CollectorM (Writer w) AST+    -> (w -> MapperM m AST)+    -> MapperM m [AST]+traverseFilesM fileCollectorM fileMapperM files =+    mapM traverseFileM files+    where+        globalNotes = execWriter $ mapM fileCollectorM files+        traverseFileM file =+            fileMapperM notes file+            where+                localNotes = execWriter $ fileCollectorM file+                notes = localNotes <> globalNotes+traverseFiles+    :: Monoid w+    => CollectorM (Writer w) AST+    -> (w -> Mapper AST)+    -> Mapper [AST]+traverseFiles fileCollectorM fileMapper files =+    runIdentity (traverseFilesM fileCollectorM fileMapperM  files)+    where fileMapperM = (\w -> return . fileMapper w)++traverseNetAsVarM :: Monad m => MapperM m Decl -> MapperM m Decl+traverseNetAsVarM func net = do+    let Net d n s t x a e = net+    let var = Variable d t x a e+    var' <- func var+    let Variable d' t' x' a' e' = var'+    let net' = Net d' n s t' x' a' e'+    return net'++traverseNetAsVar :: Mapper Decl -> Mapper Decl+traverseNetAsVar = unmonad traverseNetAsVarM+collectNetAsVarM :: Monad m => CollectorM m Decl -> CollectorM m Decl+collectNetAsVarM = collectify traverseNetAsVarM
+ src/Convert/TypeOf.hs view
@@ -0,0 +1,417 @@+{-# LANGUAGE PatternSynonyms #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for the `type` operator+ -+ - This conversion is responsible for explicit type resolution throughout sv2v.+ - It uses Scoper to resolve hierarchical expressions in a scope-aware manner.+ -+ - 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 Data.Tuple (swap)++import Convert.ExprUtils (dimensionsSize, endianCondRange, simplify)+import Convert.Scoper+import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions $ partScoper+    traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM++-- single bit 4-state `logic` type+pattern UnitType :: Type+pattern UnitType = IntegerVector TLogic Unspecified []++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+    decl' <- traverseDeclNodesM traverseTypeM traverseExprM decl+    case decl' of+        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+            insertType ident t'+            return $ case t' of+                UnpackedType t'' a' -> Variable d t'' ident a' e+                _ ->                   Variable d t'  ident [] e+        Param Parameter UnknownType ident String{} ->+            insertType ident (TypeOf $ Ident ident) >> return decl'+        Param _ UnknownType ident e ->+            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'++-- rewrite and store a non-genvar data declaration's type information+insertType :: Identifier -> Type -> ST ()+insertType ident typ = do+    typ' <- scopeType typ+    insertElem ident typ'++-- convert TypeOf in a ModuleItem+traverseModuleItemM :: ModuleItem -> ST ModuleItem+traverseModuleItemM =+    traverseNodesM traverseExprM return traverseTypeM traverseLHSM return+    where traverseLHSM = traverseLHSExprsM traverseExprM++-- convert TypeOf in a GenItem+traverseGenItemM :: GenItem -> ST GenItem+traverseGenItemM = traverseGenItemExprsM traverseExprM++-- convert TypeOf in a Stmt+traverseStmtM :: Stmt -> ST Stmt+traverseStmtM = traverseStmtExprsM traverseExprM++-- convert TypeOf in an Expr+traverseExprM :: Expr -> ST Expr+traverseExprM (Cast (Left (Implicit sg [])) expr) =+    -- `signed'(foo)` and `unsigned'(foo)` are syntactic sugar for the `$signed`+    -- and `$unsigned` system functions present in Verilog-2005+    traverseExprM $ Call (Ident fn) $ Args [expr] []+    where fn = if sg == Signed then "$signed" else "$unsigned"+traverseExprM (Cast (Left t) (Number (UnbasedUnsized bit))) =+    -- defer until this expression becomes explicit+    return $ Cast (Left t) (Number (UnbasedUnsized bit))+traverseExprM (Cast (Left (t @ (IntegerAtom TInteger _))) expr) =+    -- convert to cast to an integer vector type+    traverseExprM $ Cast (Left t') expr+    where+        (tf, []) = typeRanges t+        t' = tf [(RawNum 1, RawNum 1)]+traverseExprM (Cast (Left t1) expr) = do+    expr' <- traverseExprM expr+    t1' <- traverseTypeM t1+    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 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 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++-- 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+    let t' = popRange t+    case t of+        TypeOf{} -> lookupTypeOf orig+        Alias{} -> return $ TypeOf orig+        _ -> return $ typeSignednessOverride t' Unsigned t'+typeof (orig @ (Range e NonIndexed r)) = do+    t <- typeof e+    let t' = replaceRange r t+    return $ case t of+        TypeOf{} -> TypeOf orig+        Alias{} -> TypeOf orig+        _ -> 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 (UniOp op expr) = typeofUniOp op expr+typeof (BinOp op a b) = typeofBinOp op a b+typeof (Mux   _       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 (Mux _ 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+injectRanges t [] = t+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 (UnpackedType t [_]) = t+popRange (IntegerAtom TInteger sg) =+    IntegerVector TLogic sg []+popRange t =+    tf rs+    where (tf, _ : rs) = typeRanges t++-- replaces the most significant range of the given type+replaceRange :: Range -> Type -> Type+replaceRange r (UnpackedType t (_ : rs)) =+    UnpackedType t (r : rs)+replaceRange r (IntegerAtom TInteger sg) =+    IntegerVector TLogic sg [r]+replaceRange r t =+    tf (r : rs)+    where (tf, _ : rs) = typeRanges t++-- 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 (BinOp op e1 e2) =+    BinOp op (makeExplicit e1) (makeExplicit e2)+makeExplicit (UniOp op e) =+    UniOp op $ makeExplicit e+makeExplicit other = other
+ src/Convert/Typedef.hs view
@@ -0,0 +1,117 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for `typedef`+ -+ - Aliased types can appear in all data declarations, including modules, blocks,+ - and function parameters. They are also found in type cast expressions.+ -}++module Convert.Typedef (convert) where++import Control.Monad ((>=>))++import Convert.Scoper+import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions $ partScoper+    traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM++traverseTypeOrExprM :: TypeOrExpr -> Scoper Type TypeOrExpr+traverseTypeOrExprM (Left (TypeOf (Ident x))) = do+    details <- lookupElemM x+    return $ case details of+        Nothing -> Left $ TypeOf $ Ident x+        Just (_, _, UnknownType) -> Left $ TypeOf $ Ident x+        Just (_, _, typ) -> Left typ+traverseTypeOrExprM (Right (Ident x)) = do+    details <- lookupElemM x+    return $ case details of+        Nothing -> Right $ Ident x+        Just (_, _, UnknownType) -> Right $ Ident x+        Just (_, _, typ) -> Left typ+traverseTypeOrExprM other = return other++traverseExprM :: Expr -> Scoper Type 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 -> Scoper Type Expr+traverseExprM' =+    traverseSinglyNestedExprsM traverseExprM+    >=> traverseExprTypesM traverseTypeM++traverseModuleItemM :: ModuleItem -> Scoper Type 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 -> Scoper Type ModuleItem+traverseModuleItemM' =+    traverseNodesM traverseExprM return traverseTypeM traverseLHSM return+    where traverseLHSM = traverseLHSExprsM traverseExprM++traverseGenItemM :: GenItem -> Scoper Type GenItem+traverseGenItemM = traverseGenItemExprsM traverseExprM++traverseDeclM :: Decl -> Scoper Type Decl+traverseDeclM decl = do+    decl' <- traverseDeclNodesM traverseTypeM traverseExprM decl+    case decl' of+        Variable{} -> return decl'+        Net{} -> return decl'+        Param s (UnpackedType t rs1) x e -> do+            insertElem x UnknownType+            let (tf, rs2) = typeRanges t+            let t' = tf $ rs1 ++ rs2+            return $ Param s t' x e+        Param _ _ x _ ->+            insertElem x UnknownType >> return decl'+        ParamType Localparam x t -> do+            traverseTypeM t >>= scopeType >>= insertElem x+            return $ case t of+                Enum{} -> ParamType Localparam tmpX t+                _ -> CommentDecl $ "removed localparam type " ++ x+            where tmpX = "_sv2v_keep_enum_for_params"+        ParamType{} -> return decl'+        CommentDecl{} -> return decl'++traverseStmtM :: Stmt -> Scoper Type Stmt+traverseStmtM = traverseStmtExprsM traverseExprM++traverseTypeM :: Type -> Scoper Type Type+traverseTypeM (Alias st rs1) = do+    details <- lookupElemM st+    rs1' <- mapM traverseRangeM rs1+    return $ case details of+        Nothing -> Alias st rs1'+        Just (_, _, UnknownType) -> Alias st rs1'+        Just (_, _, typ) -> tf $ rs1' ++ rs2+            where (tf, rs2) = typeRanges typ+traverseTypeM (TypedefRef expr) = do+    details <- lookupElemM expr+    return $ case details of+        Nothing -> TypedefRef expr+        Just (_, _, typ) -> typ+traverseTypeM other =+    traverseSinglyNestedTypesM traverseTypeM other+    >>= traverseTypeExprsM traverseExprM++traverseRangeM :: Range -> Scoper Type Range+traverseRangeM = mapBothM traverseExprM
+ src/Convert/UnbasedUnsized.hs view
@@ -0,0 +1,302 @@+{-# LANGUAGE PatternSynonyms #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for unbased, unsized literals ('0, '1, 'z, 'x)+ -+ - The literals are given a binary base, a size of 1, and are made signed to+ - allow sign extension. For context-determined expressions, the converted+ - 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++import Control.Monad.Writer.Strict+import Data.Either (isLeft)+import Data.Maybe (isNothing, mapMaybe)+import qualified Data.Map.Strict as Map++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 files =+    map (traverseDescriptions convertDescription) files+    where+        parts = execWriter $ mapM (collectDescriptionsM collectPartsM) files+        convertDescription = traverseModuleItems $ convertModuleItem parts++collectPartsM :: Description -> Writer Parts ()+collectPartsM (Part _ _ _ _ name _ items) =+    tell $ Map.singleton name items+collectPartsM _ = return ()++convertModuleItem :: Parts -> ModuleItem -> ModuleItem+convertModuleItem parts (Instance moduleName params instanceName ds bindings) =+    if null extensionDecls || isNothing maybeModuleItems then+        convertModuleItem' $ instanceBase bindings+    else if hasTypeParams || not moduleIsResolved then+        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 selectedStubItems++        -- 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 =+            map (traverseDecls overrideParam) $+            prefixItems blockName selectedStubItems+        selectedStubItems = inject rawStubItems extensionDecls+        rawStubItems = createModuleStub moduleItems+        blockName = "sv2v_uu_" ++ instanceName++        -- 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++convertModuleItem _ other = convertModuleItem' other++-- 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 (Mux cond (e1 @ UU{}) (e2 @ UU{})) =+    Mux+    (convertExpr SelfDetermined cond)+    (convertExpr SelfDetermined e1)+    (convertExpr SelfDetermined e2)+convertExpr SelfDetermined (Mux cond e1 e2) =+    Mux+    (convertExpr SelfDetermined cond)+    (convertExpr (ContextDetermined e2) e1)+    (convertExpr (ContextDetermined e1) e2)+convertExpr (ContextDetermined expr) (Mux cond e1 e2) =+    Mux+    (convertExpr SelfDetermined cond)+    (convertExpr context e1)+    (convertExpr context e2)+    where context = ContextDetermined expr+convertExpr SelfDetermined (BinOp op e1 e2) =+    if isPeerSizedBinOp op || isParentSizedBinOp op+        then BinOp op+            (convertExpr (ContextDetermined e2) e1)+            (convertExpr (ContextDetermined e1) e2)+        else BinOp op+            (convertExpr SelfDetermined e1)+            (convertExpr SelfDetermined e2)+convertExpr (ContextDetermined expr) (BinOp op e1 e2) =+    if isPeerSizedBinOp op then+        BinOp op+            (convertExpr (ContextDetermined e2) e1)+            (convertExpr (ContextDetermined e1) e2)+    else if isParentSizedBinOp op then+        BinOp op+            (convertExpr context e1)+            (convertExpr context e2)+    else+        BinOp op+            (convertExpr SelfDetermined e1)+            (convertExpr SelfDetermined e2)+    where context = ContextDetermined expr+convertExpr context (UniOp op expr) =+    if isSizedUniOp op+        then UniOp op (convertExpr context expr)+        else UniOp op (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 view
@@ -0,0 +1,26 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for `unique`, `unique0`, and `priority` (verification checks)+ -+ - This conversion simply drops these keywords, as they are only used for+ - optimization and verification. There may be ways to communicate these+ - attributes to certain downstream toolchains.+ -}++module Convert.Unique (convert) where++import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert =+    map $ traverseDescriptions $ traverseModuleItems $ traverseStmts $+        traverseNestedStmts convertStmt++convertStmt :: Stmt -> Stmt+convertStmt (If _ cc s1 s2) =+    If NoCheck cc s1 s2+convertStmt (Case _ kw expr cases) =+    Case NoCheck kw expr cases+convertStmt other = other
+ src/Convert/UnnamedGenBlock.hs view
@@ -0,0 +1,122 @@+{- 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.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 view
@@ -0,0 +1,142 @@+{-# 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; C) is assigned a value in a single 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 array explicitly specify some of the unpacked dimensions.+ -}++module Convert.UnpackedArray (convert) where++import Control.Monad.State.Strict+import qualified Data.Map.Strict as Map++import Convert.Scoper+import Convert.Traverse+import Language.SystemVerilog.AST++type Location = [Identifier]+type Locations = Map.Map Location Int+type ST = ScoperT () (State Locations)++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions convertDescription++convertDescription :: Description -> Description+convertDescription description@(Part _ _ Module _ _ ports _) =+    partScoper (rewriteDeclM locations) return return return description+    where+        locations = execState (operation description) Map.empty+        operation = partScoperT+            (traverseDeclM ports) traverseModuleItemM return traverseStmtM+convertDescription other = other++-- tracks multi-dimensional unpacked array declarations+traverseDeclM :: [Identifier] -> Decl -> ST Decl+traverseDeclM _ decl@(Variable _ _ _ [] e) =+    traverseExprArgsM e >> return decl+traverseDeclM ports decl@(Variable dir _ x _ e) = do+    insertElem x ()+    when (dir /= Local || elem x ports || e /= Nil) $+        flatUsageM x+    traverseExprArgsM e >> return decl+traverseDeclM ports decl@Net{} =+    traverseNetAsVarM (traverseDeclM ports) decl+traverseDeclM _ other = return other++-- pack decls marked for packing+rewriteDeclM :: Locations -> Decl -> Scoper () Decl+rewriteDeclM _ decl@(Variable _ _ _ [] _) = return decl+rewriteDeclM locations decl@(Variable d t x a e) = do+    accesses <- localAccessesM x+    let location = map accessName accesses+    case Map.lookup location locations of+        Just depth -> do+            let (tf, rs) = typeRanges t+            let (unpacked, packed) = splitAt depth a+            let t' = tf $ packed ++ rs+            return $ Variable d t' x unpacked e+        Nothing -> return decl+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 =+    traverseLHSsM traverseLHSM item+    >>= traverseExprsM traverseExprM+    >>= traverseAsgnsM traverseAsgnM++traverseStmtM :: Stmt -> ST Stmt+traverseStmtM =+    traverseStmtLHSsM  traverseLHSM  >=>+    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 (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 x = flatUsageM x >> return x++traverseAsgnM :: (LHS, Expr) -> ST (LHS, Expr)+traverseAsgnM (x, Mux cond y z) = do+    flatUsageM x+    flatUsageM y+    flatUsageM z+    return (x, Mux cond y z)+traverseAsgnM (x, y) = do+    flatUsageM x+    flatUsageM y+    return (x, y)++class ScopeKey t => Key t where+    unbit :: t -> (t, Int)++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)++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 = 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 view
@@ -0,0 +1,28 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for `unsigned` types.+ -+ - Verilog-2005 makes `reg`, `wire`, etc. unsigned by default. Further, it does+ - not have the `unsigned` keyword. This conversion ensures we either mark a+ - data type as `signed` or leave the signing unspecified.+ -}++module Convert.Unsigned (convert) where++import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert =+    map $+    traverseDescriptions $+    traverseModuleItems $+    traverseTypes $ traverseNestedTypes convertType++convertType :: Type -> Type+convertType (Implicit        Unsigned rs) = Implicit        Unspecified rs+convertType (IntegerVector t Unsigned rs) = IntegerVector t Unspecified rs+convertType (IntegerAtom TInteger Unsigned) =+    IntegerVector TReg Unspecified [(RawNum 31, RawNum 0)]+convertType other = other
+ src/Convert/Wildcard.hs view
@@ -0,0 +1,103 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - 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. This conversion+ - relies on the fact that works because any value xor'ed with X or Z 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+ -+ - 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 = map $ traverseDescriptions convertDescription++convertDescription :: Description -> Description+convertDescription =+    partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM++traverseDeclM :: Decl -> Scoper Number Decl+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 pattern /= Nothing then+        BinOp Eq l r+    else+        BinOp Eq (BinOp BitOr l mask) pattern'+    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 pattern = maybePattern+        Based size signed base vals knds = pattern+        mask = Number $ Based size signed base knds 0+        pattern' = Number $ Based size signed base (vals .|. knds) 0+convertExpr scopes (BinOp WNe l r) =+    UniOp LogNot $+    convertExpr scopes $+    BinOp WEq l r+convertExpr _ other = other
+ src/Job.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Command line arguments.+ -}++module Job where++import Data.Char (toLower)+import Data.List (isPrefixOf, isSuffixOf)+import Data.Version (showVersion)+import GitHash (giDescribe, tGitInfoCwdTry)+import qualified Paths_sv2v (version)+import System.IO (stderr, hPutStr)+import System.Console.CmdArgs+import System.Environment (getArgs, withArgs)+import System.Exit (exitFailure)++data Exclude+    = Always+    | Assert+    | Interface+    | Logic+    | Succinct+    deriving (Typeable, Data, Eq)++data Write+    = Stdout+    | Adjacent+    | File FilePath+    deriving (Typeable, Data)++data Job = Job+    { files :: [FilePath]+    , incdir :: [FilePath]+    , define :: [String]+    , siloed :: Bool+    , skipPreprocessor :: Bool+    , passThrough :: Bool+    , exclude :: [Exclude]+    , verbose :: Bool+    , write :: Write+    , writeRaw :: String+    } deriving (Typeable, Data)++version :: String+version = either (const backup) giDescribe $$tGitInfoCwdTry+    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"+        &= groupname "Preprocessing"+    , 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")+    , skipPreprocessor = nam_ "skip-preprocessor" &= help "Disable preprocessor"+    , passThrough = nam_ "pass-through" &= help "Dump input without converting"+    , exclude = nam_ "exclude" &= name "E" &= typ "CONV"+        &= help ("Exclude a particular conversion (always, assert, interface,"+            ++ " or logic)")+        &= groupname "Conversion"+    , 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"+        &= 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")+    }+    &= program "sv2v"+    &= summary ("sv2v " ++ version)+    &= details [ "sv2v converts SystemVerilog to Verilog."+               , "More info: https://github.com/zachjs/sv2v"+               , "(C) 2019-2021 Zachary Snow, 2011-2015 Tom Hawkins" ]+    &= helpArg [explicit, name "help", groupname "Other"]+    &= versionArg [explicit, name "version"]+    &= verbosityArgs [ignore] [ignore]+    where+        -- borrowed from: https://github.com/ndmitchell/hlint+        nam xs = nam_ xs &= name [head xs]+        nam_ xs = def &= name xs &= explicit++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+    hPutStr stderr $ "invalid --write " ++ show w+        ++ ", expected stdout, adjacent, or a path ending in .v"+    exitFailure++matches :: String -> String -> Bool+matches = isPrefixOf . map toLower++type DeprecationPhase = [String] -> IO [String]++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+    strs <- getArgs+    strs' <- return strs+        >>= flagRename "-i" "-I"+        >>= flagRename "-d" "-D"+        >>= flagRename "-e" "-E"+    withArgs strs' $ cmdArgs defaultJob+        >>= setWrite . setSuccinct+    where+        setWrite :: Job -> IO Job+        setWrite job = do+            w <- parseWrite $ writeRaw job+            return $ job { write = w }+        setSuccinct :: Job -> Job+        setSuccinct job | verbose job = job { exclude = Succinct : exclude job }+        setSuccinct job | otherwise = job
+ src/Language/SystemVerilog.hs view
@@ -0,0 +1,12 @@+{- sv2v+ - Author: Tom Hawkins <tomahawkins@gmail.com>+ -+ - A parser for SystemVerilog.+ -}+module Language.SystemVerilog+    ( module Language.SystemVerilog.AST+    , module Language.SystemVerilog.Parser+    ) where++import Language.SystemVerilog.AST+import Language.SystemVerilog.Parser
+ src/Language/SystemVerilog/AST.hs view
@@ -0,0 +1,87 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>+ -+ - This AST allows for the representation of many syntactically invalid things,+ - like input regs or modport declarations inside a module. Representing only+ - syntactically valid files would make working with the AST a nightmare. We+ - have placed an emphasis on making the conversion procedures in this project+ - more easier to write, interpret, and maintain.+ -+ - In the future, we may want to have a utility which performs some basic+ - invariant checks. I want to avoid making a full type-checker though, as we+ - should only be given valid SystemVerilog input files.+ -}++module Language.SystemVerilog.AST+    ( AST+    , module Attr+    , module Decl+    , module Description+    , module Expr+    , module GenItem+    , module LHS+    , module ModuleItem+    , module Number+    , module Op+    , module Stmt+    , module Type+    , exprToLHS+    , lhsToExpr+    , shortHash+    ) where++import Text.Printf (printf)+import Data.Bits ((.&.))+import Data.Hashable (hash)++import Language.SystemVerilog.AST.Attr as Attr+import Language.SystemVerilog.AST.Decl as Decl+import Language.SystemVerilog.AST.Description as Description+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++type AST = [Description]++exprToLHS :: Expr -> Maybe LHS+exprToLHS (Ident   x  ) = Just $ LHSIdent x+exprToLHS (Bit   l e  ) = do+    l' <- exprToLHS l+    Just $ LHSBit   l' e+exprToLHS (Range l m r) = do+    l' <- exprToLHS l+    Just $ LHSRange l' m r+exprToLHS (Dot   l x  ) = do+    l' <- exprToLHS l+    Just $ LHSDot   l' x+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'+exprToLHS _ = Nothing++lhsToExpr :: LHS -> Expr+lhsToExpr (LHSIdent    x   ) = Ident x+lhsToExpr (LHSBit    l e   ) = Bit   (lhsToExpr l) e+lhsToExpr (LHSRange  l m r ) = Range (lhsToExpr l) m r+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++shortHash :: (Show a) => a -> String+shortHash x =+    printf "%05X" $ val .&. 0xFFFFF+    where val = hash $ show x
+ src/Language/SystemVerilog/AST/Attr.hs view
@@ -0,0 +1,29 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>+ -+ - SystemVerilog attribute instances+ -}++module Language.SystemVerilog.AST.Attr+    ( Attr (..)+    , AttrSpec+    ) where++import Text.Printf (printf)++import Language.SystemVerilog.AST.ShowHelp (commas)+import Language.SystemVerilog.AST.Expr (Expr, showAssignment)+import Language.SystemVerilog.AST.Type (Identifier)++data Attr+    = Attr [AttrSpec]+    deriving Eq++type AttrSpec = (Identifier, Expr)++instance Show Attr where+    show (Attr specs) = printf "(* %s *)" $ commas $ map showSpec specs++showSpec :: AttrSpec -> String+showSpec (x, e) = x ++ showAssignment e
+ src/Language/SystemVerilog/AST/Decl.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE PatternSynonyms #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>+ -+ - SystemVerilog data, net, and parameter declarations+ -}++module Language.SystemVerilog.AST.Decl+    ( Decl       (..)+    , Direction  (..)+    , ParamScope (..)+    ) where++import Text.Printf (printf)++import Language.SystemVerilog.AST.ShowHelp (showPad, showPadBefore, unlines')+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 Type+    | Variable   Direction Type Identifier [Range] Expr+    | 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 (showAssignment e)+    show (ParamType Localparam x (TypedefRef e)) =+        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++instance Show Direction where+    show Input  = "input"+    show Output = "output"+    show Inout  = "inout"+    show Local  = ""++data ParamScope+    = Parameter+    | Localparam+    deriving Eq++instance Show ParamScope where+    show Parameter  = "parameter"+    show Localparam = "localparam"
+ src/Language/SystemVerilog/AST/Description.hs view
@@ -0,0 +1,139 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>+ -+ - SystemVerilog top-level items (descriptions, package items)+ -}++module Language.SystemVerilog.AST.Description+    ( Description (..)+    , PackageItem (..)+    , PartKW      (..)+    , Lifetime    (..)+    , Qualifier   (..)+    , ClassItem+    ) where++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(CommentDecl))+import Language.SystemVerilog.AST.Stmt (Stmt)+import Language.SystemVerilog.AST.Type (Type, Identifier)+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 l _ = unlines' $ map show l+    show (Part attrs True  kw lifetime name _ items) =+        printf "%sextern %s %s%s %s;"+            (concatMap showPad attrs)+            (show kw) (showPad lifetime) name (indentedParenList itemStrs)+        where itemStrs = map (init . show) items+    show (Part attrs False kw lifetime name ports items) =+        printf "%s%s %s%s%s;\n%s\nend%s"+            (concatMap showPad attrs)+            (show kw) (showPad lifetime) name portsStr bodyStr (show kw)+        where+            portsStr = if null ports+                then ""+                else " " ++ indentedParenList ports+            bodyStr = indent $ unlines' $ map show items+    show (Package lifetime name items) =+        printf "package %s%s;\n%s\nendpackage"+            (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+    = Function Lifetime Type Identifier [Decl] [Stmt]+    | Task     Lifetime      Identifier [Decl] [Stmt]+    | Import Identifier Identifier+    | Export Identifier Identifier+    | Decl Decl+    | Directive String+    deriving Eq++instance Show PackageItem where+    show (Function ml t x i b) =+        printf "function %s%s%s;\n%s\nendfunction" (showPad ml) (showPad t) x+        (showBlock i b)+    show (Task ml x i b) =+        printf "task %s%s;\n%s\nendtask"+            (showPad ml) x (showBlock i b)+    show (Import x y) = printf "import %s::%s;" x (showWildcard y)+    show (Export x y) = printf "export %s::%s;" (showWildcard x) (showWildcard y)+    show (Decl decl) = show decl+    show (Directive str) = str++showWildcard :: Identifier -> String+showWildcard "" = "*"+showWildcard x = x++data PartKW+    = Module+    | Interface+    deriving Eq++instance Show PartKW where+    show Module    = "module"+    show Interface = "interface"++data Lifetime+    = Static+    | Automatic+    | Inherit+    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"
+ src/Language/SystemVerilog/AST/Expr.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE PatternSynonyms #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>+ -+ - SystemVerilog expressions+ -}++module Language.SystemVerilog.AST.Expr+    ( Expr (..)+    , Range+    , TypeOrExpr+    , Args (..)+    , PartSelectMode (..)+    , DimsFn (..)+    , DimFn (..)+    , showAssignment+    , showRanges+    , ParamBinding+    , showParams+    , pattern RawNum+    ) where++import Data.List (intercalate)+import Text.Printf (printf)++import Language.SystemVerilog.AST.Number (Number(..))+import Language.SystemVerilog.AST.Op+import Language.SystemVerilog.AST.ShowHelp+import {-# SOURCE #-} Language.SystemVerilog.AST.Type++type Range = (Expr, Expr)++type TypeOrExpr = Either Type Expr++pattern RawNum :: Integer -> Expr+pattern RawNum n = Number (Decimal (-32) True n)++data Expr+    = String  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+    | BinOp   BinOp Expr Expr+    | Mux     Expr Expr Expr+    | Cast    TypeOrExpr Expr+    | DimsFn  DimsFn TypeOrExpr+    | DimFn   DimFn  TypeOrExpr Expr+    | Dot     Expr Identifier+    | Pattern [(TypeOrExpr, Expr)]+    | Inside  Expr [Expr]+    | MinTypMax Expr Expr Expr+    | Nil+    deriving Eq++instance Show Expr where+    show (Nil          ) = ""+    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 (Cast tore e  ) = printf "%s'(%s)"    toreStr  (show e)+        where toreStr = either show (flip showBinOpPrec []) tore+    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 ", " $ map show l)+    show (Pattern l    ) =+        printf "'{\n%s\n}" (indent $ intercalate ",\n" $ map showPatternItem l)+        where+            showPatternItem :: (TypeOrExpr, Expr) -> String+            showPatternItem (Right Nil, v) = show v+            showPatternItem (Right e, v) = printf "%s: %s" (show e) (show v)+            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 (e @ UniOp{}) = showsPrec 0 e ""+    show (e @ BinOp{}) = showsPrec 0 e ""+    show (e @ Dot  {}) = showsPrec 0 e ""+    show (e @ Mux  {}) = showsPrec 0 e ""+    show (e @ Call {}) = showsPrec 0 e ""++    showsPrec _ (UniOp   o e  ) =+        shows o .+        showUniOpPrec e+    showsPrec _ (BinOp   o a b) =+        showBinOpPrec a .+        showChar ' ' .+        shows o .+        showChar ' ' .+        showBinOpPrec b+    showsPrec _ (Dot     e n  ) =+        shows e .+        showChar '.' .+        showString n+    showsPrec _ (Mux     c a b) =+        showChar '(' .+        shows c .+        showString " ? " .+        shows a .+        showString " : " .+        shows b .+        showChar ')'+    showsPrec _ (Call    e l  ) =+        shows e .+        shows l+    showsPrec _ e = \s -> show e ++ s++data Args+    = Args [Expr] [(Identifier, Expr)]+    deriving Eq++instance Show Args where+    show (Args pnArgs kwArgs) = '(' : commas strs ++ ")"+        where+            strs = (map show pnArgs) ++ (map showKwArg kwArgs)+            showKwArg (x, e) = printf ".%s(%s)" x (show e)++data PartSelectMode+    = NonIndexed+    | IndexedPlus+    | IndexedMinus+    deriving Eq++instance Show PartSelectMode where+    show NonIndexed   = ":"+    show IndexedPlus  = "+:"+    show IndexedMinus = "-:"++data DimsFn+    = FnBits+    | FnDimensions+    | FnUnpackedDimensions+    deriving Eq++data DimFn+    = FnLeft+    | FnRight+    | FnLow+    | FnHigh+    | FnIncrement+    | FnSize+    deriving Eq++instance Show DimsFn where+    show FnBits               = "$bits"+    show FnDimensions         = "$dimensions"+    show FnUnpackedDimensions = "$unpacked_dimensions"++instance Show DimFn where+    show FnLeft               = "$left"+    show FnRight              = "$right"+    show FnLow                = "$low"+    show FnHigh               = "$high"+    show FnIncrement          = "$increment"+    show FnSize               = "$size"+++showAssignment :: Expr -> String+showAssignment Nil = ""+showAssignment val = " = " ++ show val++showRanges :: [Range] -> String+showRanges [] = ""+showRanges l = ' ' : concatMap showRange l++showRange :: Range -> String+showRange (h, l) = '[' : show h ++ ':' : show l ++ "]"++showUniOpPrec :: Expr -> ShowS+showUniOpPrec (e @ UniOp{}) = (showParen True . shows) e+showUniOpPrec (e @ BinOp{}) = (showParen True . shows) e+showUniOpPrec e = shows e++showBinOpPrec :: Expr -> ShowS+showBinOpPrec (e @ BinOp{}) = (showParen True . shows) e+showBinOpPrec e = shows e++type ParamBinding = (Identifier, TypeOrExpr)++showParams :: [ParamBinding] -> String+showParams params = indentedParenList $ map showParam params++showParam :: ParamBinding -> String+showParam ("", arg) = showEither arg+showParam (i, arg) = printf ".%s(%s)" i (showEither arg)
+ src/Language/SystemVerilog/AST/GenItem.hs view
@@ -0,0 +1,64 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>+ -+ - SystemVerilog `generate` items+ -}++module Language.SystemVerilog.AST.GenItem+    ( GenItem (..)+    , GenCase+    ) where++import Text.Printf (printf)++import Language.SystemVerilog.AST.ShowHelp++import Language.SystemVerilog.AST.Expr (Expr)+import Language.SystemVerilog.AST.Op (AsgnOp)+import Language.SystemVerilog.AST.Type (Identifier)+import {-# SOURCE #-} Language.SystemVerilog.AST.ModuleItem (ModuleItem)++data GenItem+    = GenBlock Identifier [GenItem]+    | GenCase  Expr [GenCase]+    | GenFor   (Identifier, Expr) Expr (Identifier, AsgnOp, Expr) GenItem+    | GenIf    Expr GenItem GenItem+    | GenNull+    | GenModuleItem ModuleItem+    deriving Eq++instance Show GenItem where+    showList i _ = unlines' $ map show i+    show (GenBlock x i) =+        "if (1) " ++ showBareBlock (GenBlock x 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) (showBareBlock a)+    show (GenIf e a b      ) = printf "if (%s) %s\nelse %s" (show e) (showBlockedBranch a) (showBareBlock b)+    show (GenFor (x1, e1) c (x2, o2, e2) s) =+        printf "for (%s = %s; %s; %s %s %s) %s"+            x1 (show e1)+            (show c)+            x2 (show o2) (show e2)+            (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 (showBareBlock b)+    where exprStr = if null a then "default" else commas $ map show a
+ src/Language/SystemVerilog/AST/LHS.hs view
@@ -0,0 +1,34 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>+ -+ - SystemVerilog left-hand sides (aka lvals)+ -}++module Language.SystemVerilog.AST.LHS+    ( LHS (..)+    ) where++import Text.Printf (printf)++import Language.SystemVerilog.AST.ShowHelp (commas)+import Language.SystemVerilog.AST.Type (Identifier)+import Language.SystemVerilog.AST.Expr (Expr, PartSelectMode, Range)+import Language.SystemVerilog.AST.Op (StreamOp)++data LHS+    = LHSIdent  Identifier+    | LHSBit    LHS Expr+    | LHSRange  LHS PartSelectMode Range+    | LHSDot    LHS Identifier+    | LHSConcat [LHS]+    | LHSStream StreamOp Expr [LHS]+    deriving Eq++instance Show LHS where+    show (LHSIdent x         ) = x+    show (LHSBit   l e       ) = printf "%s[%s]"     (show l) (show e)+    show (LHSRange l m (a, b)) = printf "%s[%s%s%s]" (show l) (show a) (show m) (show b)+    show (LHSDot   l x       ) = printf "%s.%s"      (show l) x+    show (LHSConcat      lhss) = printf "{%s}"       (commas $ map show lhss)+    show (LHSStream  o e lhss) = printf "{%s %s%s}"  (show o) (show e) (show $ LHSConcat lhss)
+ src/Language/SystemVerilog/AST/ModuleItem.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE PatternSynonyms #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>+ -+ - SystemVerilog `module` items+ -}++module Language.SystemVerilog.AST.ModuleItem+    ( ModuleItem    (..)+    , PortBinding+    , ModportDecl+    , AlwaysKW      (..)+    , NInputGateKW  (..)+    , NOutputGateKW (..)+    , AssignOption  (..)+    , Severity      (..)+    ) where++import Data.List (intercalate)+import Text.Printf (printf)++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(Nil), pattern Ident, Range, showRanges, ParamBinding, showParams, Args)+import Language.SystemVerilog.AST.GenItem (GenItem)+import Language.SystemVerilog.AST.LHS (LHS)+import Language.SystemVerilog.AST.Stmt (Stmt, AssertionItem, Timing(Delay))+import Language.SystemVerilog.AST.Type (Identifier, Strength0, Strength1)++data ModuleItem+    = MIAttr     Attr ModuleItem+    | AlwaysC    AlwaysKW Stmt+    | Assign     AssignOption LHS Expr+    | Defparam   LHS Expr+    | Instance   Identifier [ParamBinding] Identifier [Range] [PortBinding]+    | Genvar     Identifier+    | Generate   [GenItem]+    | Modport    Identifier [ModportDecl]+    | Initial    Stmt+    | Final      Stmt+    | ElabTask   Severity Args+    | MIPackageItem PackageItem+    | NInputGate  NInputGateKW  Expr Identifier  LHS [Expr]+    | NOutputGate NOutputGateKW Expr Identifier [LHS] Expr+    | AssertionItem AssertionItem+    deriving Eq++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 $ 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 (ElabTask    s a) = printf "%s%s;" (show s) (show a)+    show (NInputGate  kw d x lhs exprs) =+        showGate kw d x $ show lhs : map show exprs+    show (NOutputGate kw d x lhss expr) =+        showGate kw d x $ (map show lhss) ++ [show expr]+    show (AssertionItem (x, a)) =+        if null x+            then show a+            else printf "%s : %s" x (show a)+    show (Instance   m params i rs ports) =+        if null params+            then printf "%s %s%s%s;"     m                     i rsStr (showPorts ports)+            else printf "%s #%s %s%s%s;" m (showParams params) i rsStr (showPorts ports)+        where rsStr = if null rs then "" else tail $ showRanges rs++showPorts :: [PortBinding] -> String+showPorts ports = indentedParenList $ map showPort ports++showPort :: PortBinding -> String+showPort ("*", Nil) = ".*"+showPort (i, arg) =+    if i == ""+        then show arg+        else printf ".%s(%s)" i (show arg)++showGate :: Show k => k -> Expr -> Identifier -> [String] -> String+showGate kw d x args =+    printf "%s %s%s(%s);" (show kw) delayStr nameStr (commas args)+    where+        delayStr = if d == Nil then "" else showPad $ Delay d+        nameStr = showPad $ Ident x++showModportDecl :: ModportDecl -> String+showModportDecl (dir, ident, e) =+    if e == Ident ident+        then printf "%s %s" (show dir) ident+        else printf "%s .%s(%s)" (show dir) ident (show e)++type PortBinding = (Identifier, Expr)++type ModportDecl = (Direction, Identifier, Expr)++data AlwaysKW+    = Always+    | AlwaysComb+    | AlwaysFF+    | AlwaysLatch+    deriving Eq++instance Show AlwaysKW where+    show Always      = "always"+    show AlwaysComb  = "always_comb"+    show AlwaysFF    = "always_ff"+    show AlwaysLatch = "always_latch"++data NInputGateKW+    = GateAnd+    | GateNand+    | GateOr+    | GateNor+    | GateXor+    | GateXnor+    deriving Eq++instance Show NInputGateKW where+    show GateAnd  = "and"+    show GateNand = "nand"+    show GateOr   = "or"+    show GateNor  = "nor"+    show GateXor  = "xor"+    show GateXnor = "xnor"++data NOutputGateKW+    = GateBuf+    | GateNot+    deriving Eq++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 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/ModuleItem.hs-boot view
@@ -0,0 +1,7 @@+module Language.SystemVerilog.AST.ModuleItem+    ( ModuleItem+    ) where++data ModuleItem+instance Eq ModuleItem+instance Show ModuleItem
+ src/Language/SystemVerilog/AST/Number.hs view
@@ -0,0 +1,415 @@+{- 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)+import Data.Char (digitToInt, intToDigit, toLower)+import Data.List (elemIndex)+import Text.Read (readMaybe)++-- normalize the number first, making everything lowercase and removing+-- visual niceties like spaces and underscores+parseNumber :: String -> Number+parseNumber = parseNumber' . map toLower . filter (not . isPad)+    where isPad = flip elem "_ \n\t"++parseNumber' :: String -> Number+parseNumber' "'0" = UnbasedUnsized Bit0+parseNumber' "'1" = UnbasedUnsized Bit1+parseNumber' "'x" = UnbasedUnsized BitX+parseNumber' "'z" = UnbasedUnsized BitZ+parseNumber' str =+    -- simple decimal number+    if maybeIdx == Nothing then+        let n = readDecimal str+        in Decimal (negate $ decimalSize True n) True n+    -- non-decimal based integral number+    else if maybeBase /= Nothing then+        let (values, kinds) = parseBasedDigits (baseSize base) digitsExtended+        in Based size signed base values kinds+    -- decimal X or Z literal+    else if numDigits == 1 && elem leadDigit xzDigits then+        let (vals, knds) = parseBasedDigits 2 $ replicate (abs size) leadDigit+        in Based size signed Binary vals knds+    -- explicitly-based decimal number+    else+        let num = readDecimal digits+        in if rawSize == 0+            then Decimal (negate $ decimalSize signed num) signed num+            else Decimal size 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+        digitsExtended =+            if elem leadDigit xzDigits+                then replicate (sizeDigits - numDigits) leadDigit ++ digits+                else digits++        -- 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 then+                negate $ bitsPerDigit * numDigits+            else+                -32+        bitsPerDigit = bits $ baseSize base - 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)++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 _ _ num) = Just num+numberToInteger (Based _ _ _ num 0) = Just 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 (min 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 view
@@ -0,0 +1,119 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>+ -+ - SystemVerilog operators (unary, binary, assignment, and stream)+ -}++module Language.SystemVerilog.AST.Op+    ( UniOp    (..)+    , BinOp    (..)+    , AsgnOp   (..)+    , StreamOp (..)+    ) where++data UniOp+    = LogNot+    | BitNot+    | UniAdd+    | UniSub+    | RedAnd+    | RedNand+    | RedOr+    | RedNor+    | RedXor+    | RedXnor+    deriving Eq++instance Show UniOp where+    show LogNot  = "!"+    show BitNot  = "~"+    show UniAdd  = "+"+    show UniSub  = "-"+    show RedAnd  = "&"+    show RedNand = "~&"+    show RedOr   = "|"+    show RedNor  = "~|"+    show RedXor  = "^"+    show RedXnor = "~^"++data BinOp+    = LogAnd+    | LogOr+    | LogImp+    | LogEq+    | BitAnd+    | BitXor+    | BitXnor+    | BitOr+    | Mul+    | Div+    | Mod+    | Add+    | Sub+    | Pow+    | ShiftL+    | ShiftR+    | ShiftAL+    | ShiftAR+    | Eq+    | Ne+    | TEq+    | TNe+    | WEq+    | WNe+    | Lt+    | Le+    | Gt+    | Ge+    deriving Eq++instance Show BinOp where+    show LogAnd  = "&&"+    show LogOr   = "||"+    show LogImp  = "->"+    show LogEq   = "<->"+    show BitAnd  = "&"+    show BitXor  = "^"+    show BitXnor = "~^"+    show BitOr   = "|"+    show Mul     = "*"+    show Div     = "/"+    show Mod     = "%"+    show Add     = "+"+    show Sub     = "-"+    show Pow     = "**"+    show ShiftL  = "<<"+    show ShiftR  = ">>"+    show ShiftAL = "<<<"+    show ShiftAR = ">>>"+    show Eq      = "=="+    show Ne      = "!="+    show TEq     = "==="+    show TNe     = "!=="+    show WEq     = "==?"+    show WNe     = "!=?"+    show Lt      = "<"+    show Le      = "<="+    show Gt      = ">"+    show Ge      = ">="++data AsgnOp+    = AsgnOpEq+    | AsgnOpNonBlocking+    | AsgnOp BinOp+    deriving Eq++instance Show AsgnOp where+    show AsgnOpEq = "="+    show AsgnOpNonBlocking = "<="+    show (AsgnOp op) = (show op) ++ "="++data StreamOp+    = StreamL+    | StreamR+    deriving Eq++instance Show StreamOp where+    show StreamL  = "<<"+    show StreamR  = ">>"
+ src/Language/SystemVerilog/AST/ShowHelp.hs view
@@ -0,0 +1,60 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>+ -+ - Helpers for printing AST items+ -}++module Language.SystemVerilog.AST.ShowHelp+    ( showPad+    , showPadBefore+    , indent+    , unlines'+    , commas+    , indentedParenList+    , showEither+    , showBlock+    ) where++import Data.List (intercalate)++showPad :: Show t => t -> String+showPad x =+    if null str+        then ""+        else str ++ " "+    where str = show x++showPadBefore :: Show t => t -> String+showPadBefore x =+    if str == ""+        then ""+        else ' ' : str+    where str = show x++indent :: String -> String+indent = (:) '\t' . f+    where+        f [] = []+        f ('\n' : xs) = '\n' : '\t' : f xs+        f (x : xs) = x : f xs++unlines' :: [String] -> String+unlines' = intercalate "\n"++commas :: [String] -> String+commas = intercalate ", "++indentedParenList :: [String] -> String+indentedParenList [] = "()"+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 view
@@ -0,0 +1,291 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>+ -+ - SystemVerilog procedural statements+ -}++module Language.SystemVerilog.AST.Stmt+    ( Stmt   (..)+    , Timing (..)+    , Sense  (..)+    , CaseKW (..)+    , Case+    , ActionBlock  (..)+    , PropExpr     (..)+    , SeqMatchItem (..)+    , SeqExpr      (..)+    , AssertionItem+    , AssertionExpr+    , Assertion    (..)+    , PropertySpec (..)+    , ViolationCheck (..)+    , BlockKW (..)+    ) where++import Text.Printf (printf)++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(Call, Ident, Nil), Args(..))+import Language.SystemVerilog.AST.LHS (LHS)+import Language.SystemVerilog.AST.Op (AsgnOp(AsgnOpEq))+import Language.SystemVerilog.AST.Type (Identifier)++data Stmt+    = StmtAttr Attr Stmt+    | Block   BlockKW Identifier [Decl] [Stmt]+    | Case    ViolationCheck CaseKW Expr [Case]+    | For     [(LHS, Expr)] Expr [(LHS, AsgnOp, Expr)] Stmt+    | Asgn    AsgnOp (Maybe Timing) LHS Expr+    | While   Expr Stmt+    | RepeatL Expr Stmt+    | DoWhile Expr Stmt+    | Forever Stmt+    | Foreach Identifier [Identifier] Stmt+    | If      ViolationCheck Expr Stmt Stmt+    | Timing  Timing Stmt+    | Return  Expr+    | Subroutine Expr Args+    | Trigger Bool Identifier+    | Assertion Assertion+    | 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+            body = showBlock decls stmts+    show (Case u kw e cs) =+        printf "%s%s (%s)%s\n%s\nendcase" (showPad u) (show kw) (show e)+            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)+            (show cond)+            (commas $ map showAssign assigns)+            (indent $ show stmt)+        where+            showInits :: [(LHS, Expr)] -> String+            showInits = commas . map showInit+                where showInit (l, e) = showAssign (l, AsgnOpEq, e)+    show (Subroutine e a) = printf "%s%s;" (show e) aStr+        where aStr = if a == Args [] [] then "" else show a+    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 s Null) = printf "%sif (%s)%s"         (showPad u) (show c) (showBranch s)+    show (If u c s1 s2 ) = printf "%sif (%s)%s\nelse%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 i) (show s)+    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 (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 Seq "" [] (stmts @ [CommentStmt{}, _])) =+    '\n' : (indent $ show stmts)+showBranch (block @ Block{}) = ' ' : show block+showBranch stmt = '\n' : (indent $ show stmt)++showBlockedBranch :: Stmt -> String+showBlockedBranch stmt =+    showBranch $+    if isControl stmt+        then Block Seq "" [] [stmt]+        else stmt+    where+        isControl s = case s of+            If{} -> True+            For{} -> True+            While{} -> True+            RepeatL{} -> True+            DoWhile{} -> True+            Forever{} -> True+            Foreach{} -> True+            Timing _ subStmt -> isControl subStmt+            Block Seq "" [] [CommentStmt{}, subStmt] -> isControl subStmt+            _ -> False++showElseBranch :: Stmt -> String+showElseBranch (stmt @ If{}) = ' ' : show stmt+showElseBranch stmt = showBranch stmt++showShortBranch :: Stmt -> String+showShortBranch (stmt @ Asgn{}) = ' ' : show stmt+showShortBranch stmt = showBranch stmt++showCase :: Case -> String+showCase (a, b) = printf "%s:%s" exprStr (showShortBranch b)+    where+        exprStr = case a of+            [] -> "default"+            _ -> 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+    | Delay Expr+    | Cycle Expr+    deriving Eq++instance Show Timing where+    show (Event s) = printf  "@(%s)" (show s)+    show (Delay e) = printf  "#(%s)" (show e)+    show (Cycle e) = printf "##(%s)" (show e)++data Sense+    = Sense        LHS+    | SenseOr      Sense Sense+    | SensePosedge LHS+    | SenseNegedge LHS+    | SenseStar+    deriving Eq++instance Show Sense where+    show (Sense        a  ) = show a+    show (SenseOr      a b) = printf "%s or %s" (show a) (show b)+    show (SensePosedge a  ) = printf "posedge %s" (show a)+    show (SenseNegedge a  ) = printf "negedge %s" (show a)+    show (SenseStar       ) = "*"++data ActionBlock+    = ActionBlock Stmt Stmt+    deriving Eq+instance Show ActionBlock where+    show (ActionBlock s Null) = printf " %s" (show s)+    show (ActionBlock Null s) = printf " else %s" (show s)+    show (ActionBlock s1  s2) = printf " %s else %s" (show s1) (show s2)++data PropExpr+    = PropExpr SeqExpr+    | PropExprImpliesO  SeqExpr PropExpr+    | PropExprImpliesNO SeqExpr PropExpr+    | PropExprFollowsO  SeqExpr PropExpr+    | PropExprFollowsNO SeqExpr PropExpr+    | PropExprIff PropExpr PropExpr+    deriving Eq+instance Show PropExpr where+    show (PropExpr se) = show se+    show (PropExprImpliesO  a b) = printf "(%s |-> %s)" (show a) (show b)+    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 iff %s)" (show a) (show b)+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+    | SeqExprOr         SeqExpr SeqExpr+    | SeqExprIntersect  SeqExpr SeqExpr+    | SeqExprThroughout Expr    SeqExpr+    | SeqExprWithin     SeqExpr SeqExpr+    | SeqExprDelay (Maybe SeqExpr) Expr SeqExpr+    | SeqExprFirstMatch SeqExpr [SeqMatchItem]+    deriving Eq+instance Show SeqExpr where+    show (SeqExpr           a  ) = show a+    show (SeqExprAnd        a b) = printf "(%s %s %s)" (show a) "and"        (show b)+    show (SeqExprOr         a b) = printf "(%s %s %s)" (show a) "or"         (show b)+    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 (SeqExprFirstMatch e a) = printf "first_match(%s, %s)" (show e) (commas $ map show a)++type AssertionItem = (Identifier, Assertion)+type AssertionExpr = Either PropertySpec Expr+data Assertion+    = Assert AssertionExpr ActionBlock+    | Assume AssertionExpr ActionBlock+    | Cover  AssertionExpr Stmt+    deriving Eq+instance Show Assertion where+    show (Assert e a) = printf "assert %s%s" (showAssertionExpr e) (show a)+    show (Assume e a) = printf "assume %s%s" (showAssertionExpr e) (show a)+    show (Cover  e a) = printf  "cover %s%s" (showAssertionExpr e) (show a)++showAssertionExpr :: AssertionExpr -> String+showAssertionExpr (Left e) = printf "property (%s\n)" (show e)+showAssertionExpr (Right e) = printf "(%s)" (show e)++data PropertySpec+    = PropertySpec (Maybe Sense) Expr PropExpr+    deriving Eq+instance Show PropertySpec where+    show (PropertySpec ms e pe) =+        printf "%s%s\n\t%s" msStr eStr (show pe)+        where+            msStr = case ms of+                Nothing -> ""+                Just s -> printf "@(%s) " (show s)+            eStr = case e of+                Nil -> ""+                _ -> printf "disable iff (%s)" (show e)++data ViolationCheck+    = Unique+    | Unique0+    | Priority+    | NoCheck+    deriving Eq++instance Show ViolationCheck where+    show Unique   = "unique"+    show Unique0  = "unique0"+    show Priority = "priority"+    show NoCheck  = ""++data BlockKW+    = Seq+    | Par+    deriving Eq++instance Show BlockKW where+    show Seq = "begin"+    show Par = "fork"++blockEndToken :: BlockKW -> Identifier+blockEndToken Seq = "end"+blockEndToken Par = "join"
+ src/Language/SystemVerilog/AST/Type.hs view
@@ -0,0 +1,275 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PatternSynonyms #-}+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>+ -+ - SystemVerilog types+ -}++module Language.SystemVerilog.AST.Type+    ( Identifier+    , Field+    , Type               (..)+    , Signing            (..)+    , Packing            (..)+    , NetType            (..)+    , IntegerVectorType  (..)+    , IntegerAtomType    (..)+    , NonIntegerType     (..)+    , Strength           (..)+    , Strength0          (..)+    , Strength1          (..)+    , ChargeStrength     (..)+    , pattern UnknownType+    , typeRanges+    , elaborateIntegerAtom+    ) where++import Text.Printf (printf)++import Language.SystemVerilog.AST.Expr+import Language.SystemVerilog.AST.ShowHelp++type Identifier = String++type Item = (Identifier, Expr)+type Field = (Type, Identifier)++data Type+    = IntegerVector IntegerVectorType  Signing [Range]+    | IntegerAtom   IntegerAtomType    Signing+    | NonInteger    NonIntegerType+    | Implicit                         Signing [Range]+    | Alias               Identifier           [Range]+    | PSAlias  Identifier Identifier           [Range]+    | CSAlias  Identifier [ParamBinding] Identifier [Range]+    | Enum     Type         [Item]             [Range]+    | Struct   Packing      [Field]            [Range]+    | Union    Packing      [Field]            [Range]+    | InterfaceT Identifier Identifier         [Range]+    | TypeOf Expr+    | TypedefRef Expr+    | UnpackedType Type [Range] -- used internally+    deriving Eq++instance Show Type where+    show (Alias         xx    rs) = printf "%s%s" xx (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 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    "" "" rs) = printf "interface%s" ( showRanges rs)+    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 = showPad t+            showVal :: (Identifier, Expr) -> 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++showFields :: [Field] -> String+showFields items = itemsStr+    where+        itemsStr = indent $ unlines' $ map showItem items+        showItem (t, x) = printf "%s %s;" (show t) x++-- internal representation of a fully implicit or unknown type+pattern UnknownType :: Type+pattern UnknownType = Implicit Unspecified []++typeRanges :: Type -> ([Range] -> Type, [Range])+typeRanges typ =+    case typ of+        Implicit         sg rs -> (Implicit         sg, rs)+        IntegerVector kw sg rs -> (IntegerVector kw sg, rs)+        Enum            t v rs -> (Enum            t v, rs)+        Struct          p l rs -> (Struct          p l, rs)+        Union           p l rs -> (Union           p l, rs)+        InterfaceT      x y rs -> (InterfaceT      x y, rs)+        Alias            xx rs -> (Alias            xx, rs)+        PSAlias    ps    xx rs -> (PSAlias    ps    xx, rs)+        CSAlias    ps pm xx rs -> (CSAlias    ps pm xx, 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, [])++nullRange :: Type -> ([Range] -> Type)+nullRange t [] = 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 ++ [(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 +++                " cannot have packed dimesions:" ++ show rs1+        else tf $ rs1 ++ rs2+    where+        t' = elaborateIntegerAtom t+        (tf, rs2) = typeRanges t'++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 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 TLogic sg [(RawNum hi, RawNum 0)]+    where+        hi = fromIntegral $ size - 1+        sg = if sgOverride /= Unspecified+                then sgOverride+                else sgBase++data Signing+    = Unspecified+    | Signed+    | Unsigned+    deriving Eq++instance Show Signing where+    show Unspecified = ""+    show Signed = "signed"+    show Unsigned = "unsigned"++data NetType+    = TSupply0+    | TSupply1+    | TTri+    | TTriand+    | TTrior+    | TTrireg+    | TTri0+    | TTri1+    | TUwire+    | TWire+    | TWand+    | TWor+    deriving Eq+data IntegerVectorType+    = TBit+    | TLogic+    | TReg+    deriving Eq+data IntegerAtomType+    = TByte+    | TShortint+    | TInt+    | TLongint+    | TInteger+    | TTime+    deriving Eq+data NonIntegerType+    = TShortreal+    | TReal+    | TRealtime+    | TString+    | TEvent+    deriving Eq++instance Show NetType where+    show TSupply0   = "supply0"+    show TSupply1   = "supply1"+    show TTri       = "tri"+    show TTriand    = "triand"+    show TTrior     = "trior"+    show TTrireg    = "trireg"+    show TTri0      = "tri0"+    show TTri1      = "tri1"+    show TUwire     = "uwire"+    show TWire      = "wire"+    show TWand      = "wand"+    show TWor       = "wor"+instance Show IntegerVectorType where+    show TBit       = "bit"+    show TLogic     = "logic"+    show TReg       = "reg"+instance Show IntegerAtomType where+    show TByte      = "byte"+    show TShortint  = "shortint"+    show TInt       = "int"+    show TLongint   = "longint"+    show TInteger   = "integer"+    show TTime      = "time"+instance Show NonIntegerType where+    show TShortreal = "shortreal"+    show TReal      = "real"+    show TRealtime  = "realtime"+    show TString    = "string"+    show TEvent     = "event"++data Packing+    = Unpacked+    | Packed Signing+    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 view
@@ -0,0 +1,10 @@+module Language.SystemVerilog.AST.Type+    ( Identifier+    , Type+    ) where++type Identifier = String++data Type+instance Eq Type+instance Show Type
+ src/Language/SystemVerilog/Parser.hs view
@@ -0,0 +1,39 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -}+module Language.SystemVerilog.Parser+    ( parseFiles+    ) where++import Control.Monad.Except+import qualified Data.Map.Strict as Map+import Language.SystemVerilog.AST (AST)+import Language.SystemVerilog.Parser.Lex (lexStr)+import Language.SystemVerilog.Parser.Parse (parse)+import Language.SystemVerilog.Parser.Preprocess (preprocess, annotate, Env)++-- parses a compilation unit given include search paths and predefined macros+parseFiles :: [FilePath] -> [(String, String)] -> Bool -> Bool -> [FilePath] -> IO (Either String [AST])+parseFiles includePaths defines siloed skipPreprocessor paths = do+    let env = Map.map (\a -> (a, [])) $ Map.fromList defines+    runExceptT (parseFiles' includePaths env siloed skipPreprocessor paths)++-- parses a compilation unit given include search paths and predefined macros+parseFiles' :: [FilePath] -> Env -> Bool -> Bool -> [FilePath] -> ExceptT String IO [AST]+parseFiles' _ _ _ _ [] = return []+parseFiles' includePaths env siloed skipPreprocessor (path : paths) = do+    (ast, envEnd) <- parseFile' includePaths env skipPreprocessor path+    let envNext = if siloed then env else envEnd+    asts <- parseFiles' includePaths envNext siloed skipPreprocessor paths+    return $ ast : asts++-- parses a file given include search paths, a table of predefined macros, and+-- the file path+parseFile' :: [String] -> Env -> Bool -> FilePath -> ExceptT String IO (AST, Env)+parseFile' includePaths env skipPreprocessor path = do+    let runner = if skipPreprocessor then annotate else preprocess+    preResult <- liftIO $ runner includePaths env path+    (contents, env') <- liftEither preResult+    tokens <- liftEither $ uncurry lexStr $ unzip contents+    ast <- parse tokens+    return (ast, env')
+ src/Language/SystemVerilog/Parser/Keywords.hs view
@@ -0,0 +1,84 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - To implement the `begin_keywords` directive, this module defines which IEEE+ - 1800-2017 keywords are not keywords in preceding specifications.+ -}+module Language.SystemVerilog.Parser.Keywords+    ( specMap+    ) where++import qualified Data.Map.Strict as Map+import qualified Data.Set as Set++import Language.SystemVerilog.Parser.Tokens++newKeywords :: [(String, [TokenName])]+newKeywords = [++    ("1364-1995", [KW_always, KW_and, KW_assign, KW_begin, KW_buf, KW_bufif0,+    KW_bufif1, KW_case, KW_casex, KW_casez, KW_cmos, KW_deassign, KW_default,+    KW_defparam, KW_disable, KW_edge, KW_else, KW_end, KW_endcase,+    KW_endfunction, KW_endmodule, KW_endprimitive, KW_endspecify, KW_endtable,+    KW_endtask, KW_event, KW_for, KW_force, KW_forever, KW_fork, KW_function,+    KW_highz0, KW_highz1, KW_if, KW_ifnone, KW_initial, KW_inout, KW_input,+    KW_integer, KW_join, KW_large, KW_macromodule, KW_medium, KW_module,+    KW_nand, KW_negedge, KW_nmos, KW_nor, KW_not, KW_notif0, KW_notif1, KW_or,+    KW_output, KW_parameter, KW_pmos, KW_posedge, KW_primitive, KW_pull0,+    KW_pull1, KW_pulldown, KW_pullup, KW_rcmos, KW_real, KW_realtime, KW_reg,+    KW_release, KW_repeat, KW_rnmos, KW_rpmos, KW_rtran, KW_rtranif0,+    KW_rtranif1, KW_scalared, KW_small, KW_specify, KW_specparam, KW_strong0,+    KW_strong1, KW_supply0, KW_supply1, KW_table, KW_task, KW_time, KW_tran,+    KW_tranif0, KW_tranif1, KW_tri, KW_tri0, KW_tri1, KW_triand, KW_trior,+    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,+    KW_incdir, KW_include, KW_instance, KW_liblist, KW_library, KW_use]),++    ("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-2005", [KW_uwire]),++    ("1800-2005", [KW_alias, KW_always_comb, KW_always_ff, KW_always_latch,+    KW_assert, KW_assume, KW_before, KW_bind, KW_bins, KW_binsof, KW_bit,+    KW_break, KW_byte, KW_chandle, KW_class, KW_clocking, KW_const,+    KW_constraint, KW_context, KW_continue, KW_cover, KW_covergroup,+    KW_coverpoint, KW_cross, KW_dist, KW_do, KW_endclass, KW_endclocking,+    KW_endgroup, KW_endinterface, KW_endpackage, KW_endprogram, KW_endproperty,+    KW_endsequence, KW_enum, KW_expect, KW_export, KW_extends, KW_extern,+    KW_final, KW_first_match, KW_foreach, KW_forkjoin, KW_iff, KW_ignore_bins,+    KW_illegal_bins, KW_import, KW_inside, KW_int, KW_interface, KW_intersect,+    KW_join_any, KW_join_none, KW_local, KW_logic, KW_longint, KW_matches,+    KW_modport, KW_new, KW_null, KW_package, KW_packed, KW_priority, KW_program,+    KW_property, KW_protected, KW_pure, KW_rand, KW_randc, KW_randcase,+    KW_randsequence, KW_ref, KW_return, KW_sequence, KW_shortint, KW_shortreal,+    KW_solve, KW_static, KW_string, KW_struct, KW_super, KW_tagged, KW_this,+    KW_throughout, KW_timeprecision, KW_timeunit, KW_type, KW_typedef, KW_union,+    KW_unique, KW_var, KW_virtual, KW_void, KW_wait_order, KW_wildcard, KW_with,+    KW_within]),++    ("1800-2009", [KW_accept_on, KW_checker, KW_endchecker, KW_eventually,+    KW_global, KW_implies, KW_let, KW_nexttime, KW_reject_on, KW_restrict,+    KW_s_always, KW_s_eventually, KW_s_nexttime, KW_s_until, KW_s_until_with,+    KW_strong, KW_sync_accept_on, KW_sync_reject_on, KW_unique0, KW_until,+    KW_until_with, KW_untyped, KW_weak]),++    ("1800-2012", [KW_implements, KW_nettype, KW_interconnect, KW_soft]),++    ("1800-2017", [])++    ]++specMap :: Map.Map String (Set.Set TokenName)+specMap =+    Map.fromList $ zip keys vals+    where+        keys = map fst newKeywords+        sets = map (Set.fromList . snd) newKeywords+        allKeywords = Set.unions sets+        vals =+            map (Set.difference allKeywords) $+            scanl1 Set.union sets
+ src/Language/SystemVerilog/Parser/Lex.x view
@@ -0,0 +1,522 @@+{+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ - Original Lexer Author: Tom Hawkins <tomahawkins@gmail.com>+ - vim: filetype=haskell+ -+ - SystemVerilog Lexer+ -+ - All preprocessor directives are handled separately by the preprocessor. The+ - `begin_keywords` and `end_keywords` lexer directives are handled here.+ -}++module Language.SystemVerilog.Parser.Lex+    ( lexStr+    ) where++import Control.Monad.Except+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import qualified Data.Vector as Vector++import Language.SystemVerilog.Parser.Keywords (specMap)+import Language.SystemVerilog.Parser.Tokens+}++%wrapper "posn"++-- Numbers++@nonZeroDecimalDigit = [1-9]+@decimalDigit = [0-9]+@xDigit       = [xX]+@zDigit       = [zZ\?]+@binaryDigit  = @xDigit | @zDigit | [0-1]+@octalDigit   = @xDigit | @zDigit | [0-7]+@hexDigit     = @xDigit | @zDigit | [0-9a-fA-F]++@decimalBase = "'" [sS]? [dD]+@binaryBase  = "'" [sS]? [bB]+@octalBase   = "'" [sS]? [oO]+@hexBase     = "'" [sS]? [hH]++@nonZeroUnsignedNumber = @nonZeroDecimalDigit ("_" | @decimalDigit)*+@unsignedNumber        = @decimalDigit        ("_" | @decimalDigit)*+@binaryValue           = @binaryDigit         ("_" | @binaryDigit )*+@octalValue            = @octalDigit          ("_" | @octalDigit  )*+@hexValue              = @hexDigit            ("_" | @hexDigit    )*++@exp = [eE]+@sign = [\-\+]+@fixedPointNumber = @unsignedNumber "." @unsignedNumber+@realNumber+    = @fixedPointNumber+    | @unsignedNumber ("." @unsignedNumber)? @exp @sign? @unsignedNumber++@size = @nonZeroUnsignedNumber $white*++@binaryNumber = @size? @binaryBase $white* @binaryValue+@octalNumber  = @size? @octalBase  $white* @octalValue+@hexNumber    = @size? @hexBase    $white* @hexValue++@unbasedUnsizedLiteral = "'" ( 0 | 1 | x | X | z | Z )++@decimalNumber+    = @unsignedNumber+    | @size? @decimalBase $white* @unsignedNumber+    | @size? @decimalBase $white* @xDigit "_"*+    | @size? @decimalBase $white* @zDigit "_"*+@integralNumber+    = @decimalNumber+    | @octalNumber+    | @binaryNumber+    | @hexNumber+    | @unbasedUnsizedLiteral++-- Strings++@string = \" (\\\"|\\\r?\n|[^\"\r\n])* \"++-- Times++@timeUnit = s | ms | us | ns | ps | fs+@time+    = @unsignedNumber @timeUnit+    | @fixedPointNumber @timeUnit++-- Identifiers++@escapedIdentifier = "\" ($printable # $white)+ $white+@simpleIdentifier  = [a-zA-Z_] [a-zA-Z0-9_\$]*+@systemIdentifier = "$" [a-zA-Z0-9_\$]+++-- Whitespace++@newline = \n+@escapedNewline = \\\n+@whitespace = ($white # \n) | @escapedNewline++tokens :-++    "$bits"                { tok KW_dollar_bits                }+    "$dimensions"          { tok KW_dollar_dimensions          }+    "$unpacked_dimensions" { tok KW_dollar_unpacked_dimensions }+    "$left"                { tok KW_dollar_left                }+    "$right"               { tok KW_dollar_right               }+    "$low"                 { tok KW_dollar_low                 }+    "$high"                { tok KW_dollar_high                }+    "$increment"           { tok KW_dollar_increment           }+    "$size"                { tok KW_dollar_size                }++    "accept_on"        { tok KW_accept_on    }+    "alias"            { tok KW_alias        }+    "always"           { tok KW_always       }+    "always_comb"      { tok KW_always_comb  }+    "always_ff"        { tok KW_always_ff    }+    "always_latch"     { tok KW_always_latch }+    "and"              { tok KW_and          }+    "assert"           { tok KW_assert       }+    "assign"           { tok KW_assign       }+    "assume"           { tok KW_assume       }+    "automatic"        { tok KW_automatic    }+    "before"           { tok KW_before       }+    "begin"            { tok KW_begin        }+    "bind"             { tok KW_bind         }+    "bins"             { tok KW_bins         }+    "binsof"           { tok KW_binsof       }+    "bit"              { tok KW_bit          }+    "break"            { tok KW_break        }+    "buf"              { tok KW_buf          }+    "bufif0"           { tok KW_bufif0       }+    "bufif1"           { tok KW_bufif1       }+    "byte"             { tok KW_byte         }+    "case"             { tok KW_case         }+    "casex"            { tok KW_casex        }+    "casez"            { tok KW_casez        }+    "cell"             { tok KW_cell         }+    "chandle"          { tok KW_chandle      }+    "checker"          { tok KW_checker      }+    "class"            { tok KW_class        }+    "clocking"         { tok KW_clocking     }+    "cmos"             { tok KW_cmos         }+    "config"           { tok KW_config       }+    "const"            { tok KW_const        }+    "constraint"       { tok KW_constraint   }+    "context"          { tok KW_context      }+    "continue"         { tok KW_continue     }+    "cover"            { tok KW_cover        }+    "covergroup"       { tok KW_covergroup   }+    "coverpoint"       { tok KW_coverpoint   }+    "cross"            { tok KW_cross        }+    "deassign"         { tok KW_deassign     }+    "default"          { tok KW_default      }+    "defparam"         { tok KW_defparam     }+    "design"           { tok KW_design       }+    "disable"          { tok KW_disable      }+    "dist"             { tok KW_dist         }+    "do"               { tok KW_do           }+    "edge"             { tok KW_edge         }+    "else"             { tok KW_else         }+    "end"              { tok KW_end          }+    "endcase"          { tok KW_endcase      }+    "endchecker"       { tok KW_endchecker   }+    "endclass"         { tok KW_endclass     }+    "endclocking"      { tok KW_endclocking  }+    "endconfig"        { tok KW_endconfig    }+    "endfunction"      { tok KW_endfunction  }+    "endgenerate"      { tok KW_endgenerate  }+    "endgroup"         { tok KW_endgroup     }+    "endinterface"     { tok KW_endinterface }+    "endmodule"        { tok KW_endmodule    }+    "endpackage"       { tok KW_endpackage   }+    "endprimitive"     { tok KW_endprimitive }+    "endprogram"       { tok KW_endprogram   }+    "endproperty"      { tok KW_endproperty  }+    "endspecify"       { tok KW_endspecify   }+    "endsequence"      { tok KW_endsequence  }+    "endtable"         { tok KW_endtable     }+    "endtask"          { tok KW_endtask      }+    "enum"             { tok KW_enum         }+    "event"            { tok KW_event        }+    "eventually"       { tok KW_eventually   }+    "expect"           { tok KW_expect       }+    "export"           { tok KW_export       }+    "extends"          { tok KW_extends      }+    "extern"           { tok KW_extern       }+    "final"            { tok KW_final        }+    "first_match"      { tok KW_first_match  }+    "for"              { tok KW_for          }+    "force"            { tok KW_force        }+    "foreach"          { tok KW_foreach      }+    "forever"          { tok KW_forever      }+    "fork"             { tok KW_fork         }+    "forkjoin"         { tok KW_forkjoin     }+    "function"         { tok KW_function     }+    "generate"         { tok KW_generate     }+    "genvar"           { tok KW_genvar       }+    "global"           { tok KW_global       }+    "highz0"           { tok KW_highz0       }+    "highz1"           { tok KW_highz1       }+    "if"               { tok KW_if           }+    "iff"              { tok KW_iff          }+    "ifnone"           { tok KW_ifnone       }+    "ignore_bins"      { tok KW_ignore_bins  }+    "illegal_bins"     { tok KW_illegal_bins }+    "implements"       { tok KW_implements   }+    "implies"          { tok KW_implies      }+    "import"           { tok KW_import       }+    "incdir"           { tok KW_incdir       }+    "include"          { tok KW_include      }+    "initial"          { tok KW_initial      }+    "inout"            { tok KW_inout        }+    "input"            { tok KW_input        }+    "inside"           { tok KW_inside       }+    "instance"         { tok KW_instance     }+    "int"              { tok KW_int          }+    "integer"          { tok KW_integer      }+    "interconnect"     { tok KW_interconnect }+    "interface"        { tok KW_interface    }+    "intersect"        { tok KW_intersect    }+    "join"             { tok KW_join         }+    "join_any"         { tok KW_join_any     }+    "join_none"        { tok KW_join_none    }+    "large"            { tok KW_large        }+    "let"              { tok KW_let          }+    "liblist"          { tok KW_liblist      }+    "library"          { tok KW_library      }+    "local"            { tok KW_local        }+    "localparam"       { tok KW_localparam   }+    "logic"            { tok KW_logic        }+    "longint"          { tok KW_longint      }+    "macromodule"      { tok KW_macromodule  }+    "matches"          { tok KW_matches      }+    "medium"           { tok KW_medium       }+    "modport"          { tok KW_modport      }+    "module"           { tok KW_module       }+    "nand"             { tok KW_nand         }+    "negedge"          { tok KW_negedge      }+    "nettype"          { tok KW_nettype      }+    "new"              { tok KW_new          }+    "nexttime"         { tok KW_nexttime     }+    "nmos"             { tok KW_nmos         }+    "nor"              { tok KW_nor          }+    "noshowcancelled"  { tok KW_noshowcancelled }+    "not"              { tok KW_not          }+    "notif0"           { tok KW_notif0       }+    "notif1"           { tok KW_notif1       }+    "null"             { tok KW_null         }+    "or"               { tok KW_or           }+    "output"           { tok KW_output       }+    "package"          { tok KW_package      }+    "packed"           { tok KW_packed       }+    "parameter"        { tok KW_parameter    }+    "pmos"             { tok KW_pmos         }+    "posedge"          { tok KW_posedge      }+    "primitive"        { tok KW_primitive    }+    "priority"         { tok KW_priority     }+    "program"          { tok KW_program      }+    "property"         { tok KW_property     }+    "protected"        { tok KW_protected    }+    "pull0"            { tok KW_pull0        }+    "pull1"            { tok KW_pull1        }+    "pulldown"         { tok KW_pulldown     }+    "pullup"           { tok KW_pullup       }+    "pulsestyle_ondetect" { tok KW_pulsestyle_ondetect }+    "pulsestyle_onevent"  { tok KW_pulsestyle_onevent }+    "pure"             { tok KW_pure         }+    "rand"             { tok KW_rand         }+    "randc"            { tok KW_randc        }+    "randcase"         { tok KW_randcase     }+    "randsequence"     { tok KW_randsequence }+    "rcmos"            { tok KW_rcmos        }+    "real"             { tok KW_real         }+    "realtime"         { tok KW_realtime     }+    "ref"              { tok KW_ref          }+    "reg"              { tok KW_reg          }+    "reject_on"        { tok KW_reject_on    }+    "release"          { tok KW_release      }+    "repeat"           { tok KW_repeat       }+    "restrict"         { tok KW_restrict     }+    "return"           { tok KW_return       }+    "rnmos"            { tok KW_rnmos        }+    "rpmos"            { tok KW_rpmos        }+    "rtran"            { tok KW_rtran        }+    "rtranif0"         { tok KW_rtranif0     }+    "rtranif1"         { tok KW_rtranif1     }+    "s_always"         { tok KW_s_always     }+    "s_eventually"     { tok KW_s_eventually }+    "s_nexttime"       { tok KW_s_nexttime   }+    "s_until"          { tok KW_s_until      }+    "s_until_with"     { tok KW_s_until_with }+    "scalared"         { tok KW_scalared     }+    "sequence"         { tok KW_sequence     }+    "shortint"         { tok KW_shortint     }+    "shortreal"        { tok KW_shortreal    }+    "showcancelled"    { tok KW_showcancelled }+    "signed"           { tok KW_signed       }+    "small"            { tok KW_small        }+    "soft"             { tok KW_soft         }+    "solve"            { tok KW_solve        }+    "specify"          { tok KW_specify      }+    "specparam"        { tok KW_specparam    }+    "static"           { tok KW_static       }+    "string"           { tok KW_string       }+    "strong"           { tok KW_strong       }+    "strong0"          { tok KW_strong0      }+    "strong1"          { tok KW_strong1      }+    "struct"           { tok KW_struct       }+    "super"            { tok KW_super        }+    "supply0"          { tok KW_supply0      }+    "supply1"          { tok KW_supply1      }+    "sync_accept_on"   { tok KW_sync_accept_on }+    "sync_reject_on"   { tok KW_sync_reject_on }+    "table"            { tok KW_table        }+    "tagged"           { tok KW_tagged       }+    "task"             { tok KW_task         }+    "this"             { tok KW_this         }+    "throughout"       { tok KW_throughout   }+    "time"             { tok KW_time         }+    "timeprecision"    { tok KW_timeprecision }+    "timeunit"         { tok KW_timeunit     }+    "tran"             { tok KW_tran         }+    "tranif0"          { tok KW_tranif0      }+    "tranif1"          { tok KW_tranif1      }+    "tri"              { tok KW_tri          }+    "tri0"             { tok KW_tri0         }+    "tri1"             { tok KW_tri1         }+    "triand"           { tok KW_triand       }+    "trior"            { tok KW_trior        }+    "trireg"           { tok KW_trireg       }+    "type"             { tok KW_type         }+    "typedef"          { tok KW_typedef      }+    "union"            { tok KW_union        }+    "unique"           { tok KW_unique       }+    "unique0"          { tok KW_unique0      }+    "unsigned"         { tok KW_unsigned     }+    "until"            { tok KW_until        }+    "until_with"       { tok KW_until_with   }+    "untyped"          { tok KW_untyped      }+    "use"              { tok KW_use          }+    "uwire"            { tok KW_uwire        }+    "var"              { tok KW_var          }+    "vectored"         { tok KW_vectored     }+    "virtual"          { tok KW_virtual      }+    "void"             { tok KW_void         }+    "wait"             { tok KW_wait         }+    "wait_order"       { tok KW_wait_order   }+    "wand"             { tok KW_wand         }+    "weak"             { tok KW_weak         }+    "weak0"            { tok KW_weak0        }+    "weak1"            { tok KW_weak1        }+    "while"            { tok KW_while        }+    "wildcard"         { tok KW_wildcard     }+    "wire"             { tok KW_wire         }+    "with"             { tok KW_with         }+    "within"           { tok KW_within       }+    "wor"              { tok KW_wor          }+    "xnor"             { tok KW_xnor         }+    "xor"              { tok KW_xor          }++    @simpleIdentifier  { tok Id_simple  }+    @escapedIdentifier { tok Id_escaped }+    @systemIdentifier  { tok Id_system  }++    @realNumber        { tok Lit_real }+    @integralNumber    { tok Lit_number }+    @string            { tok Lit_string }+    @time              { tok Lit_time }++    "("                { tok Sym_paren_l }+    ")"                { tok Sym_paren_r }+    "["                { tok Sym_brack_l }+    "]"                { tok Sym_brack_r }+    "{"                { tok Sym_brace_l }+    "}"                { tok Sym_brace_r }+    "~"                { tok Sym_tildy }+    "!"                { tok Sym_bang }+    "@"                { tok Sym_at }+    "#"                { tok Sym_pound }+    "%"                { tok Sym_percent }+    "^"                { tok Sym_hat }+    "&"                { tok Sym_amp }+    "|"                { tok Sym_bar }+    "*"                { tok Sym_aster }+    "."                { tok Sym_dot }+    ","                { tok Sym_comma }+    ":"                { tok Sym_colon }+    ";"                { tok Sym_semi }+    "="                { tok Sym_eq }+    "<"                { tok Sym_lt }+    ">"                { tok Sym_gt }+    "+"                { tok Sym_plus }+    "-"                { tok Sym_dash }+    "?"                { tok Sym_question }+    "/"                { tok Sym_slash }+    "$"                { tok Sym_dollar }+    "'"                { tok Sym_s_quote }++    "~&"               { tok Sym_tildy_amp }+    "~|"               { tok Sym_tildy_bar }+    "~^"               { tok Sym_tildy_hat }+    "^~"               { tok Sym_hat_tildy }+    "=="               { tok Sym_eq_eq }+    "!="               { tok Sym_bang_eq }+    "&&"               { tok Sym_amp_amp }+    "||"               { tok Sym_bar_bar }+    "**"               { tok Sym_aster_aster }+    "<="               { tok Sym_lt_eq }+    ">="               { tok Sym_gt_eq }+    ">>"               { tok Sym_gt_gt }+    "<<"               { tok Sym_lt_lt }+    "++"               { tok Sym_plus_plus }+    "--"               { tok Sym_dash_dash }+    "+="               { tok Sym_plus_eq }+    "-="               { tok Sym_dash_eq }+    "*="               { tok Sym_aster_eq }+    "/="               { tok Sym_slash_eq }+    "%="               { tok Sym_percent_eq }+    "&="               { tok Sym_amp_eq }+    "|="               { tok Sym_bar_eq }+    "^="               { tok Sym_hat_eq }+    "+:"               { tok Sym_plus_colon }+    "-:"               { tok Sym_dash_colon }+    "::"               { tok Sym_colon_colon }+    ".*"               { tok Sym_dot_aster }+    "->"               { tok Sym_dash_gt }+    ":="               { tok Sym_colon_eq }+    ":/"               { tok Sym_colon_slash }+    "##"               { tok Sym_pound_pound }+    "[*"               { tok Sym_brack_l_aster }+    "[="               { tok Sym_brack_l_eq }+    "=>"               { tok Sym_eq_gt }+    "@*"               { tok Sym_at_aster }+    "(*"               { tok Sym_paren_l_aster }+    "*)"               { tok Sym_aster_paren_r }+    "*>"               { tok Sym_aster_gt }++    "==="              { tok Sym_eq_eq_eq }+    "!=="              { tok Sym_bang_eq_eq }+    "==?"              { tok Sym_eq_eq_question }+    "!=?"              { tok Sym_bang_eq_question }+    ">>>"              { tok Sym_gt_gt_gt }+    "<<<"              { tok Sym_lt_lt_lt }+    "<<="              { tok Sym_lt_lt_eq }+    ">>="              { tok Sym_gt_gt_eq }+    "<->"              { tok Sym_lt_dash_gt }+    "|->"              { tok Sym_bar_dash_gt }+    "|=>"              { tok Sym_bar_eq_gt }+    "[->"              { tok Sym_brack_l_dash_gt }+    "#-#"              { tok Sym_pound_dash_pound }+    "#=#"              { tok Sym_pound_eq_pound }+    "@@("              { tok Sym_at_at_paren_l }+    "(*)"              { tok Sym_paren_l_aster_paren_r }+    "->>"              { tok Sym_dash_gt_gt }+    "&&&"              { tok Sym_amp_amp_amp }++    "<<<="             { tok Sym_lt_lt_lt_eq }+    ">>>="             { tok Sym_gt_gt_gt_eq }++    "`celldefine"          { tok Dir_celldefine }+    "`endcelldefine"       { tok Dir_endcelldefine }+    "`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+lexStr :: String -> [Position] -> Either String [Token]+lexStr chars positions =+    runExcept $ postProcess [] tokens+    where+        tokensRaw = alexScanTokens chars+        positionsVec = Vector.fromList positions+        tokens = map (\tkf -> tkf positionsVec) tokensRaw++-- process begin/end keywords directives+postProcess :: [Set.Set TokenName] -> [Token] -> Except String [Token]+postProcess stack [] =+    if null stack+        then return []+        else throwError $ "unterminated begin_keywords blocks: " ++ show stack+postProcess stack (Token Dir_begin_keywords _ pos : ts) =+    case ts of+        Token Lit_string quotedSpec _ : ts' ->+            case Map.lookup spec specMap of+                Nothing -> throwError $ show pos+                    ++ ": invalid keyword set name: " ++ show spec+                Just set -> postProcess (set : stack) ts'+            where spec = tail $ init quotedSpec+        _ -> throwError $ show pos ++ ": begin_keywords not followed by string"+postProcess stack (Token Dir_end_keywords _ pos : ts) =+    case stack of+        (_ : stack') -> postProcess stack' ts+        [] -> throwError $ show pos ++ ": unmatched end_keywords"+postProcess stack (Token Id_escaped str pos : ts) =+    postProcess stack ts >>= return . (t' :)+    where+        t' = Token Id_escaped str' pos+        str' = (++ " ") $ init str+postProcess [] (t : ts) = do+    ts' <- postProcess [] ts+    return $ t : ts'+postProcess stack (t : ts) = do+    ts' <- postProcess stack ts+    return $ t' : ts'+    where+        Token tokId str pos = t+        t' = if Set.member tokId (head stack)+                then Token Id_simple ('_' : str) pos+                else t++tok :: TokenName -> AlexPosn -> String -> Vector.Vector Position -> Token+tok tokId (AlexPn charPos _ _) tokStr positions =+    Token tokId tokStr tokPos+    where tokPos = positions Vector.! charPos+}
+ src/Language/SystemVerilog/Parser/Parse.y view
@@ -0,0 +1,1675 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ - Original Parser Author: Tom Hawkins <tomahawkins@gmail.com>+ - vim: filetype=haskell+ -+ - This file has been *heavily* modified and extended from the original version+ - in tomahawkins/verilog. I have added support for numerous SystemVerilog+ - constructs, which has necessitated rewriting nearly all of this.+ -+ - This file is the only remaining one that still uses 2-space indentation. I've+ - decided to leave it this way because I think it is too important to preserve+ - the ability to easily blame/diff this file.+ -}+{+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE TupleSections #-}+module Language.SystemVerilog.Parser.Parse (parse) where++import Control.Monad.Except+import Control.Monad.State.Strict+import Data.Maybe (catMaybes, fromMaybe)+import Language.SystemVerilog.AST+import Language.SystemVerilog.Parser.ParseDecl+import Language.SystemVerilog.Parser.Tokens+}++%monad { ParseState }+%lexer { positionKeep } { TokenEOF }+%name parseMain+%tokentype { Token }+%error { parseErrorTok }++%expect 0++%token++"$bits"                { Token KW_dollar_bits                _ _ }+"$dimensions"          { Token KW_dollar_dimensions          _ _ }+"$unpacked_dimensions" { Token KW_dollar_unpacked_dimensions _ _ }+"$left"                { Token KW_dollar_left                _ _ }+"$right"               { Token KW_dollar_right               _ _ }+"$low"                 { Token KW_dollar_low                 _ _ }+"$high"                { Token KW_dollar_high                _ _ }+"$increment"           { Token KW_dollar_increment           _ _ }+"$size"                { Token KW_dollar_size                _ _ }++"accept_on"        { Token KW_accept_on    _ _ }+"alias"            { Token KW_alias        _ _ }+"always"           { Token KW_always       _ _ }+"always_comb"      { Token KW_always_comb  _ _ }+"always_ff"        { Token KW_always_ff    _ _ }+"always_latch"     { Token KW_always_latch _ _ }+"and"              { Token KW_and          _ _ }+"assert"           { Token KW_assert       _ _ }+"assign"           { Token KW_assign       _ _ }+"assume"           { Token KW_assume       _ _ }+"automatic"        { Token KW_automatic    _ _ }+"before"           { Token KW_before       _ _ }+"begin"            { Token KW_begin        _ _ }+"bind"             { Token KW_bind         _ _ }+"bins"             { Token KW_bins         _ _ }+"binsof"           { Token KW_binsof       _ _ }+"bit"              { Token KW_bit          _ _ }+"break"            { Token KW_break        _ _ }+"buf"              { Token KW_buf          _ _ }+"bufif0"           { Token KW_bufif0       _ _ }+"bufif1"           { Token KW_bufif1       _ _ }+"byte"             { Token KW_byte         _ _ }+"case"             { Token KW_case         _ _ }+"casex"            { Token KW_casex        _ _ }+"casez"            { Token KW_casez        _ _ }+"cell"             { Token KW_cell         _ _ }+"chandle"          { Token KW_chandle      _ _ }+"checker"          { Token KW_checker      _ _ }+"class"            { Token KW_class        _ _ }+"clocking"         { Token KW_clocking     _ _ }+"cmos"             { Token KW_cmos         _ _ }+"config"           { Token KW_config       _ _ }+"const"            { Token KW_const        _ _ }+"constraint"       { Token KW_constraint   _ _ }+"context"          { Token KW_context      _ _ }+"continue"         { Token KW_continue     _ _ }+"cover"            { Token KW_cover        _ _ }+"covergroup"       { Token KW_covergroup   _ _ }+"coverpoint"       { Token KW_coverpoint   _ _ }+"cross"            { Token KW_cross        _ _ }+"deassign"         { Token KW_deassign     _ _ }+"default"          { Token KW_default      _ _ }+"defparam"         { Token KW_defparam     _ _ }+"design"           { Token KW_design       _ _ }+"disable"          { Token KW_disable      _ _ }+"dist"             { Token KW_dist         _ _ }+"do"               { Token KW_do           _ _ }+"edge"             { Token KW_edge         _ _ }+"else"             { Token KW_else         _ _ }+"end"              { Token KW_end          _ _ }+"endcase"          { Token KW_endcase      _ _ }+"endchecker"       { Token KW_endchecker   _ _ }+"endclass"         { Token KW_endclass     _ _ }+"endclocking"      { Token KW_endclocking  _ _ }+"endconfig"        { Token KW_endconfig    _ _ }+"endfunction"      { Token KW_endfunction  _ _ }+"endgenerate"      { Token KW_endgenerate  _ _ }+"endgroup"         { Token KW_endgroup     _ _ }+"endinterface"     { Token KW_endinterface _ _ }+"endmodule"        { Token KW_endmodule    _ _ }+"endpackage"       { Token KW_endpackage   _ _ }+"endprimitive"     { Token KW_endprimitive _ _ }+"endprogram"       { Token KW_endprogram   _ _ }+"endproperty"      { Token KW_endproperty  _ _ }+"endspecify"       { Token KW_endspecify   _ _ }+"endsequence"      { Token KW_endsequence  _ _ }+"endtable"         { Token KW_endtable     _ _ }+"endtask"          { Token KW_endtask      _ _ }+"enum"             { Token KW_enum         _ _ }+"event"            { Token KW_event        _ _ }+"eventually"       { Token KW_eventually   _ _ }+"expect"           { Token KW_expect       _ _ }+"export"           { Token KW_export       _ _ }+"extends"          { Token KW_extends      _ _ }+"extern"           { Token KW_extern       _ _ }+"final"            { Token KW_final        _ _ }+"first_match"      { Token KW_first_match  _ _ }+"for"              { Token KW_for          _ _ }+"force"            { Token KW_force        _ _ }+"foreach"          { Token KW_foreach      _ _ }+"forever"          { Token KW_forever      _ _ }+"fork"             { Token KW_fork         _ _ }+"forkjoin"         { Token KW_forkjoin     _ _ }+"function"         { Token KW_function     _ _ }+"generate"         { Token KW_generate     _ _ }+"genvar"           { Token KW_genvar       _ _ }+"global"           { Token KW_global       _ _ }+"highz0"           { Token KW_highz0       _ _ }+"highz1"           { Token KW_highz1       _ _ }+"if"               { Token KW_if           _ _ }+"iff"              { Token KW_iff          _ _ }+"ifnone"           { Token KW_ifnone       _ _ }+"ignore_bins"      { Token KW_ignore_bins  _ _ }+"illegal_bins"     { Token KW_illegal_bins _ _ }+"implements"       { Token KW_implements   _ _ }+"implies"          { Token KW_implies      _ _ }+"import"           { Token KW_import       _ _ }+"incdir"           { Token KW_incdir       _ _ }+"include"          { Token KW_include      _ _ }+"initial"          { Token KW_initial      _ _ }+"inout"            { Token KW_inout        _ _ }+"input"            { Token KW_input        _ _ }+"inside"           { Token KW_inside       _ _ }+"instance"         { Token KW_instance     _ _ }+"int"              { Token KW_int          _ _ }+"integer"          { Token KW_integer      _ _ }+"interconnect"     { Token KW_interconnect _ _ }+"interface"        { Token KW_interface    _ _ }+"intersect"        { Token KW_intersect    _ _ }+"join"             { Token KW_join         _ _ }+"join_any"         { Token KW_join_any     _ _ }+"join_none"        { Token KW_join_none    _ _ }+"large"            { Token KW_large        _ _ }+"let"              { Token KW_let          _ _ }+"liblist"          { Token KW_liblist      _ _ }+"library"          { Token KW_library      _ _ }+"local"            { Token KW_local        _ _ }+"localparam"       { Token KW_localparam   _ _ }+"logic"            { Token KW_logic        _ _ }+"longint"          { Token KW_longint      _ _ }+"macromodule"      { Token KW_macromodule  _ _ }+"matches"          { Token KW_matches      _ _ }+"medium"           { Token KW_medium       _ _ }+"modport"          { Token KW_modport      _ _ }+"module"           { Token KW_module       _ _ }+"nand"             { Token KW_nand         _ _ }+"negedge"          { Token KW_negedge      _ _ }+"nettype"          { Token KW_nettype      _ _ }+"new"              { Token KW_new          _ _ }+"nexttime"         { Token KW_nexttime     _ _ }+"nmos"             { Token KW_nmos         _ _ }+"nor"              { Token KW_nor          _ _ }+"noshowcancelled"  { Token KW_noshowcancelled _ _ }+"not"              { Token KW_not          _ _ }+"notif0"           { Token KW_notif0       _ _ }+"notif1"           { Token KW_notif1       _ _ }+"null"             { Token KW_null         _ _ }+"or"               { Token KW_or           _ _ }+"output"           { Token KW_output       _ _ }+"package"          { Token KW_package      _ _ }+"packed"           { Token KW_packed       _ _ }+"parameter"        { Token KW_parameter    _ _ }+"pmos"             { Token KW_pmos         _ _ }+"posedge"          { Token KW_posedge      _ _ }+"primitive"        { Token KW_primitive    _ _ }+"priority"         { Token KW_priority     _ _ }+"program"          { Token KW_program      _ _ }+"property"         { Token KW_property     _ _ }+"protected"        { Token KW_protected    _ _ }+"pull0"            { Token KW_pull0        _ _ }+"pull1"            { Token KW_pull1        _ _ }+"pulldown"         { Token KW_pulldown     _ _ }+"pullup"           { Token KW_pullup       _ _ }+"pulsestyle_ondetect" { Token KW_pulsestyle_ondetect _ _ }+"pulsestyle_onevent"  { Token KW_pulsestyle_onevent _ _ }+"pure"             { Token KW_pure         _ _ }+"rand"             { Token KW_rand         _ _ }+"randc"            { Token KW_randc        _ _ }+"randcase"         { Token KW_randcase     _ _ }+"randsequence"     { Token KW_randsequence _ _ }+"rcmos"            { Token KW_rcmos        _ _ }+"real"             { Token KW_real         _ _ }+"realtime"         { Token KW_realtime     _ _ }+"ref"              { Token KW_ref          _ _ }+"reg"              { Token KW_reg          _ _ }+"reject_on"        { Token KW_reject_on    _ _ }+"release"          { Token KW_release      _ _ }+"repeat"           { Token KW_repeat       _ _ }+"restrict"         { Token KW_restrict     _ _ }+"return"           { Token KW_return       _ _ }+"rnmos"            { Token KW_rnmos        _ _ }+"rpmos"            { Token KW_rpmos        _ _ }+"rtran"            { Token KW_rtran        _ _ }+"rtranif0"         { Token KW_rtranif0     _ _ }+"rtranif1"         { Token KW_rtranif1     _ _ }+"s_always"         { Token KW_s_always     _ _ }+"s_eventually"     { Token KW_s_eventually _ _ }+"s_nexttime"       { Token KW_s_nexttime   _ _ }+"s_until"          { Token KW_s_until      _ _ }+"s_until_with"     { Token KW_s_until_with _ _ }+"scalared"         { Token KW_scalared     _ _ }+"sequence"         { Token KW_sequence     _ _ }+"shortint"         { Token KW_shortint     _ _ }+"shortreal"        { Token KW_shortreal    _ _ }+"showcancelled"    { Token KW_showcancelled _ _ }+"signed"           { Token KW_signed       _ _ }+"small"            { Token KW_small        _ _ }+"soft"             { Token KW_soft         _ _ }+"solve"            { Token KW_solve        _ _ }+"specify"          { Token KW_specify      _ _ }+"specparam"        { Token KW_specparam    _ _ }+"static"           { Token KW_static       _ _ }+"string"           { Token KW_string       _ _ }+"strong"           { Token KW_strong       _ _ }+"strong0"          { Token KW_strong0      _ _ }+"strong1"          { Token KW_strong1      _ _ }+"struct"           { Token KW_struct       _ _ }+"super"            { Token KW_super        _ _ }+"supply0"          { Token KW_supply0      _ _ }+"supply1"          { Token KW_supply1      _ _ }+"sync_accept_on"   { Token KW_sync_accept_on _ _ }+"sync_reject_on"   { Token KW_sync_reject_on _ _ }+"table"            { Token KW_table        _ _ }+"tagged"           { Token KW_tagged       _ _ }+"task"             { Token KW_task         _ _ }+"this"             { Token KW_this         _ _ }+"throughout"       { Token KW_throughout   _ _ }+"time"             { Token KW_time         _ _ }+"timeprecision"    { Token KW_timeprecision _ _ }+"timeunit"         { Token KW_timeunit     _ _ }+"tran"             { Token KW_tran         _ _ }+"tranif0"          { Token KW_tranif0      _ _ }+"tranif1"          { Token KW_tranif1      _ _ }+"tri"              { Token KW_tri          _ _ }+"tri0"             { Token KW_tri0         _ _ }+"tri1"             { Token KW_tri1         _ _ }+"triand"           { Token KW_triand       _ _ }+"trior"            { Token KW_trior        _ _ }+"trireg"           { Token KW_trireg       _ _ }+"type"             { Token KW_type         _ _ }+"typedef"          { Token KW_typedef      _ _ }+"union"            { Token KW_union        _ _ }+"unique"           { Token KW_unique       _ _ }+"unique0"          { Token KW_unique0      _ _ }+"unsigned"         { Token KW_unsigned     _ _ }+"until"            { Token KW_until        _ _ }+"until_with"       { Token KW_until_with   _ _ }+"untyped"          { Token KW_untyped      _ _ }+"use"              { Token KW_use          _ _ }+"uwire"            { Token KW_uwire        _ _ }+"var"              { Token KW_var          _ _ }+"vectored"         { Token KW_vectored     _ _ }+"virtual"          { Token KW_virtual      _ _ }+"void"             { Token KW_void         _ _ }+"wait"             { Token KW_wait         _ _ }+"wait_order"       { Token KW_wait_order   _ _ }+"wand"             { Token KW_wand         _ _ }+"weak"             { Token KW_weak         _ _ }+"weak0"            { Token KW_weak0        _ _ }+"weak1"            { Token KW_weak1        _ _ }+"while"            { Token KW_while        _ _ }+"wildcard"         { Token KW_wildcard     _ _ }+"wire"             { Token KW_wire         _ _ }+"with"             { Token KW_with         _ _ }+"within"           { Token KW_within       _ _ }+"wor"              { Token KW_wor          _ _ }+"xnor"             { Token KW_xnor         _ _ }+"xor"              { Token KW_xor          _ _ }++simpleIdentifier   { Token Id_simple       _ _ }+escapedIdentifier  { Token Id_escaped      _ _ }+systemIdentifier   { Token Id_system       _ _ }+real               { Token Lit_real        _ _ }+number             { Token Lit_number      _ _ }+string             { Token Lit_string      _ _ }+time               { Token Lit_time        _ _ }++"`celldefine"          { Token Dir_celldefine _ _ }+"`endcelldefine"       { Token Dir_endcelldefine _ _ }+"`unconnected_drive"   { Token Dir_unconnected_drive _ _ }+"`nounconnected_drive" { Token Dir_nounconnected_drive _ _ }+"`default_nettype"     { Token Dir_default_nettype _ _ }+"`resetall"            { Token Dir_resetall _ _ }+"`begin_keywords"      { Token Dir_begin_keywords _ _ }+"`end_keywords"        { Token Dir_end_keywords _ _ }++"("                { Token Sym_paren_l _ _ }+")"                { Token Sym_paren_r _ _ }+"["                { Token Sym_brack_l _ _ }+"]"                { Token Sym_brack_r _ _ }+"{"                { Token Sym_brace_l _ _ }+"}"                { Token Sym_brace_r _ _ }+"~"                { Token Sym_tildy _ _ }+"!"                { Token Sym_bang _ _ }+"@"                { Token Sym_at _ _ }+"#"                { Token Sym_pound _ _ }+"%"                { Token Sym_percent _ _ }+"^"                { Token Sym_hat _ _ }+"&"                { Token Sym_amp _ _ }+"|"                { Token Sym_bar _ _ }+"*"                { Token Sym_aster _ _ }+"."                { Token Sym_dot _ _ }+","                { Token Sym_comma _ _ }+":"                { Token Sym_colon _ _ }+";"                { Token Sym_semi _ _ }+"="                { Token Sym_eq _ _ }+"<"                { Token Sym_lt _ _ }+">"                { Token Sym_gt _ _ }+"+"                { Token Sym_plus _ _ }+"-"                { Token Sym_dash _ _ }+"?"                { Token Sym_question _ _ }+"/"                { Token Sym_slash _ _ }+"$"                { Token Sym_dollar _ _ }+"'"                { Token Sym_s_quote _ _ }+"~&"               { Token Sym_tildy_amp _ _ }+"~|"               { Token Sym_tildy_bar _ _ }+"~^"               { Token Sym_tildy_hat _ _ }+"^~"               { Token Sym_hat_tildy _ _ }+"=="               { Token Sym_eq_eq _ _ }+"!="               { Token Sym_bang_eq _ _ }+"&&"               { Token Sym_amp_amp _ _ }+"||"               { Token Sym_bar_bar _ _ }+"**"               { Token Sym_aster_aster _ _ }+"<="               { Token Sym_lt_eq _ _ }+">="               { Token Sym_gt_eq _ _ }+">>"               { Token Sym_gt_gt _ _ }+"<<"               { Token Sym_lt_lt _ _ }+"++"               { Token Sym_plus_plus _ _ }+"--"               { Token Sym_dash_dash _ _ }+"+="               { Token Sym_plus_eq _ _ }+"-="               { Token Sym_dash_eq _ _ }+"*="               { Token Sym_aster_eq _ _ }+"/="               { Token Sym_slash_eq _ _ }+"%="               { Token Sym_percent_eq _ _ }+"&="               { Token Sym_amp_eq _ _ }+"|="               { Token Sym_bar_eq _ _ }+"^="               { Token Sym_hat_eq _ _ }+"+:"               { Token Sym_plus_colon _ _ }+"-:"               { Token Sym_dash_colon _ _ }+"::"               { Token Sym_colon_colon _ _ }+".*"               { Token Sym_dot_aster _ _ }+"->"               { Token Sym_dash_gt _ _ }+":="               { Token Sym_colon_eq _ _ }+":/"               { Token Sym_colon_slash _ _ }+"##"               { Token Sym_pound_pound _ _ }+"[*"               { Token Sym_brack_l_aster _ _ }+"[="               { Token Sym_brack_l_eq _ _ }+"=>"               { Token Sym_eq_gt _ _ }+"@*"               { Token Sym_at_aster _ _ }+"(*"               { Token Sym_paren_l_aster _ _ }+"*)"               { Token Sym_aster_paren_r _ _ }+"*>"               { Token Sym_aster_gt _ _ }+"==="              { Token Sym_eq_eq_eq _ _ }+"!=="              { Token Sym_bang_eq_eq _ _ }+"==?"              { Token Sym_eq_eq_question _ _ }+"!=?"              { Token Sym_bang_eq_question _ _ }+">>>"              { Token Sym_gt_gt_gt _ _ }+"<<<"              { Token Sym_lt_lt_lt _ _ }+"<<="              { Token Sym_lt_lt_eq _ _ }+">>="              { Token Sym_gt_gt_eq _ _ }+"<->"              { Token Sym_lt_dash_gt _ _ }+"|->"              { Token Sym_bar_dash_gt _ _ }+"|=>"              { Token Sym_bar_eq_gt _ _ }+"[->"              { Token Sym_brack_l_dash_gt _ _ }+"#-#"              { Token Sym_pound_dash_pound _ _ }+"#=#"              { Token Sym_pound_eq_pound _ _ }+"@@("              { Token Sym_at_at_paren_l _ _ }+"(*)"              { Token Sym_paren_l_aster_paren_r _ _ }+"->>"              { Token Sym_dash_gt_gt _ _ }+"&&&"              { Token Sym_amp_amp_amp _ _ }+"<<<="             { Token Sym_lt_lt_lt_eq _ _ }+">>>="             { Token Sym_gt_gt_gt_eq _ _ }+++-- operator precedences, from *lowest* to *highest*+%nonassoc DefaultStrength+%nonassoc DriveStrength ChargeStrength+%nonassoc NoElse+%nonassoc "else"+%right  "|->" "|=>" "#-#" "#=#"+%right "iff"+%left "or"+%left "and"+%left "intersect"+%left "within"+%right "throughout"+%left "##"+%nonassoc "[*]" "[=]" "[->]"+%right "->" "<->"+%right "?" ":"+%left  "||"+%left  "&&"+%left  "|" "~|"+%left  "^" "^~" "~^"+%left  "&" "~&"+%left  "==" "!=" "===" "!==" "==?" "!=?"+%left  "<" "<=" ">" ">=" "inside" "dist"+%left  "<<" ">>" "<<<" ">>>"+%left  "+" "-"+%left  "*" "/" "%"+%left  "**"+%right REDUCE_OP "!" "~" "++" "--"+%left "'"+%left  "(" ")" "[" "]" "." "::" "#"++%%++opt(p)+  : p { Just $1 }+  |   { Nothing }++Descriptions :: { [Description] }+  : {- empty -}              { [] }+  | Descriptions ";"         { $1 }+  | Descriptions Description { $1 ++ $2 }++Description :: { [Description] }+  : Part(ModuleKW   , endmodule   ) { [$1] }+  | Part(InterfaceKW, endinterface) { [$1] }+  | PackageDeclaration              { [$1] }+  | PITrace PackageItem { map PackageItem $ addPITrace $1 $2 }++OptAsgn :: { Expr }+  : {- empty -} { Nil }+  | "=" Expr    { $2  }++Type :: { Type }+  : TypeNonIdent { $1 }+  | TypeAlias    { $1 }+TypeAlias :: { Type }+  :                               Identifier Dimensions { Alias   $1       $2 }+  | Identifier               "::" Identifier Dimensions { PSAlias $1    $3 $4 }+  | Identifier ParamBindings "::" Identifier Dimensions { CSAlias $1 $2 $4 $5 }+TypeNonIdent :: { Type }+  : PartialType OptSigning Dimensions { $1 $2 $3 }+  | "type" "(" Expr ")" { TypeOf $3 }+PartialType :: { Signing -> [Range] -> Type }+  : PartialTypeP { snd $1 }+PartialTypeP :: { (Position, Signing -> [Range] -> Type) }+  : IntegerVectorTypeP { (fst $1, makeIntegerVector $1) }+  | IntegerAtomTypeP   { (fst $1, makeIntegerAtom   $1) }+  | NonIntegerTypeP    { (fst $1, makeNonInteger    $1) }+  | "enum" EnumBaseType "{" EnumItems   "}" { makeComplex $1 $ Enum   $2 $4 }+  | "struct" Packing    "{" StructItems "}" { makeComplex $1 $ Struct $2 $4 }+  | "union"  Packing    "{" StructItems "}" { makeComplex $1 $ Union  $2 $4 }+CastingType :: { Type }+  : IntegerVectorTypeP { IntegerVector (snd $1) Unspecified [] }+  | IntegerAtomTypeP   { IntegerAtom   (snd $1) Unspecified    }+  | NonIntegerTypeP    { NonInteger    (snd $1)                }+  | SigningP           { Implicit      (snd $1)             [] }+EnumBaseType :: { Type }+  : Type       { $1 }+  | Dimensions { Implicit Unspecified $1 }++Signing :: { Signing }+  : SigningP { snd $1 }+SigningP :: { (Position, Signing) }+  : "signed"   { withPos $1 Signed   }+  | "unsigned" { withPos $1 Unsigned }+OptSigning :: { Signing }+  : Signing { $1 }+  | {- empty -} { Unspecified }++NetTypeP :: { (Position, NetType) }+  : "supply0"   { withPos $1 TSupply0   }+  | "supply1"   { withPos $1 TSupply1   }+  | "tri"       { withPos $1 TTri       }+  | "triand"    { withPos $1 TTriand    }+  | "trior"     { withPos $1 TTrior     }+  | "trireg"    { withPos $1 TTrireg    }+  | "tri0"      { withPos $1 TTri0      }+  | "tri1"      { withPos $1 TTri1      }+  | "uwire"     { withPos $1 TUwire     }+  | "wire"      { withPos $1 TWire      }+  | "wand"      { withPos $1 TWand      }+  | "wor"       { withPos $1 TWor       }+IntegerVectorTypeP :: { (Position, IntegerVectorType) }+  : "bit"       { withPos $1 TBit       }+  | "logic"     { withPos $1 TLogic     }+  | "reg"       { withPos $1 TReg       }+IntegerAtomTypeP :: { (Position, IntegerAtomType) }+  : "byte"      { withPos $1 TByte      }+  | "shortint"  { withPos $1 TShortint  }+  | "int"       { withPos $1 TInt       }+  | "longint"   { withPos $1 TLongint   }+  | "integer"   { withPos $1 TInteger   }+  | "time"      { withPos $1 TTime      }+NonIntegerTypeP :: { (Position, NonIntegerType) }+  : "shortreal" { withPos $1 TShortreal }+  | "real"      { withPos $1 TReal      }+  | "realtime"  { withPos $1 TRealtime  }+  | "string"    { withPos $1 TString    }+  | "event"     { withPos $1 TEvent     }++EnumItems :: { [(Identifier, Expr)] }+  : VariablePortIdentifiers { $1 }++StructItems :: { [(Type, Identifier)] }+  : StructItem             { $1 }+  | StructItems StructItem { $1 ++ $2 }+StructItem :: { [(Type, Identifier)] }+  : Type FieldDecls ";" { map (fieldDecl $1) $2 }++FieldDecls :: { [(Identifier, [Range])] }+  : FieldDecl                 { [$1] }+  | FieldDecls "," FieldDecl  { $1 ++ [$3] }+FieldDecl :: { (Identifier, [Range]) }+  : Identifier Dimensions { ($1, $2) }++Packing :: { Packing }+  : "packed" OptSigning { Packed $2 }+  | {- empty -}         { Unpacked }++Part(begin, end) :: { Description }+  : AttributeInstances          begin PartHeader ModuleItems end StrTag {% $3 $1 False $2 $4 $6 }+  | AttributeInstances "extern" begin PartHeader                        {% $4 $1 True  $3 [] "" }++PartHeader :: { [Attr] -> Bool -> PartKW -> [ModuleItem] -> Identifier -> ParseState Description }+  : Lifetime Identifier PackageImportDeclarations Params PortDecls ";"+    { \attrs extern kw items label -> checkTag $2 label $ Part attrs extern kw $1 $2 (fst $5) ($3 ++ $4 ++ (snd $5) ++ items) }++ModuleKW :: { PartKW }+  : "module" { Module }+  | "macromodule" { Module }+InterfaceKW :: { PartKW }+  : "interface" { Interface }++PackageDeclaration :: { Description }+  : "package" Lifetime Identifier        ";" PackageItems endpackage StrTag {% checkTag $3 $7 $ Package $2 $3 $5 }+  | "class" Lifetime Identifier PIParams ";" ClassItems   endclass   StrTag {% checkTag $3 $8 $ Class $2 $3 $4 $6 }++StrTag :: { Identifier }+  : {- empty -}    { "" }+  | ":" Identifier { $2 }++PackageImportDeclarations :: { [ModuleItem] }+  : PackageImportDeclaration PackageImportDeclarations { $1 ++ $2 }+  | {- empty -}                                        { [] }++PackageImportDeclaration :: { [ModuleItem] }+  : "import" PackageImportItems ";" { map (MIPackageItem . uncurry Import) $2 }++Params :: { [ModuleItem] }+  : PIParams { map (MIPackageItem . Decl) $1 }+PIParams :: { [Decl] }+  : {- empty -}          { [] }+  | "#" "(" ")"          { [] }+  | "#" "(" ParamsFollow { $3 }+ParamsFollow :: { [Decl] }+  : ParamAsgn ParamsEnd        { $1 }+  | ParamAsgn "," ParamsFollow { $1 ++ $3 }+  |               ParamsDecl   { $1 }+ParamsDecl :: { [Decl] }+  : ModuleParameterDecl(ParamsEnd)      { $1 }+  | ModuleParameterDecl(",") ParamsDecl { $1 ++ $2 }+ParamAsgn :: { [Decl] }+  : DeclTrace Identifier "=" Expr { [$1, Param Parameter (Implicit Unspecified []) $2 $4] }+ParamsEnd+  :     ")" {}+  | "," ")" {}++PortDecls :: { ([Identifier], [ModuleItem]) }+  : "(" PortDeclTokens(")") { parseDTsAsPortDecls $2 }+  | "("                ")"  { ([], []) }+  | {- empty -}             { ([], []) }++ModportItems :: { [(Identifier, [ModportDecl])] }+  : ModportItem                  { [$1] }+  | ModportItems "," ModportItem { $1 ++ [$3] }+ModportItem :: { (Identifier, [ModportDecl]) }+  : Identifier "(" ModportPortsDeclarations { ($1, $3) }+ModportPortsDeclarations :: { [ModportDecl] }+  : ModportPortsDeclaration(")")                          { $1 }+  | ModportPortsDeclaration(",") ModportPortsDeclarations { $1 ++ $2 }+ModportPortsDeclaration(delim) :: { [ModportDecl] }+  : ModportSimplePortsDeclaration(delim) { $1 }+ModportSimplePortsDeclaration(delim) :: { [ModportDecl] }+  : Direction ModportSimplePorts delim { map (\(a, b) -> ($1, a, b)) $2 }+ModportSimplePorts :: { [(Identifier, Expr)] }+  : ModportSimplePort                        { [$1] }+  | ModportSimplePorts "," ModportSimplePort { $1 ++ [$3] }+ModportSimplePort :: { (Identifier, Expr) }+  : "." Identifier "(" ExprOrNil ")" { ($2, $4) }+  | Identifier                       { ($1, Ident $1) }++Identifier :: { Identifier }+  : IdentifierP { snd $1 }+IdentifierP :: { (Position, Identifier) }+  : simpleIdentifier  { withPos $1 $ tokenString $1 }+  | escapedIdentifier { withPos $1 $ tokenString $1 }+  | systemIdentifier  { withPos $1 $ tokenString $1 }++Identifiers :: { [Identifier] }+  :                 Identifier { [$1] }+  | Identifiers "," Identifier { $1 ++ [$3] }++Strength :: { Strength }+  : {- empty -}    %prec DefaultStrength { DefaultStrength }+  | DriveStrength  %prec DriveStrength   { uncurry DriveStrength $1 }+  | ChargeStrength %prec ChargeStrength  { ChargeStrength $1 }++-- uses delimiter propagation hack to avoid conflicts+DeclTokens(delim) :: { [DeclToken] }+  : DeclTokensBase(DeclTokens(delim), delim) { $1 }+DeclTokensBase(repeat, delim) :: { [DeclToken] }+  : DeclToken         DTDelim(delim) { [$1, $2] }+  | DeclToken                 repeat { [$1] ++ $2 }+  | IdentifierP ParamBindings repeat { [uncurry DTIdent $1, DTParams (fst $1) $2] ++ $3 }+  | DeclTokenAsgn ","         repeat { [$1, DTComma (tokenPosition $2)] ++ $3 }+  | DeclTokenAsgn     DTDelim(delim) { [$1, $2] }+DeclToken :: { DeclToken }+  : ","                                { DTComma   $ tokenPosition $1 }+  | "[" "]"                            { DTAutoDim $ tokenPosition $1 }+  | "const"                            { DTConst   $ tokenPosition $1 }+  | "var"                              { DTVar     $ tokenPosition $1 }+  | PartSelectP                        { uncurry (DTRange $ fst $1) (snd $1) }+  | IdentifierP                        { uncurry DTIdent $1 }+  | DirectionP                         { uncurry DTDir $1 }+  | LHSConcatP                         { uncurry DTLHSBase $1 }+  | LHSStreamP                         { uncurry DTLHSBase $1 }+  | PartialTypeP                       { uncurry DTType $1 }+  | NetTypeP Strength                  { uncurry DTNet $1 $2 }+  | PortBindingsP                      { uncurry DTPorts $1 }+  | SigningP                           { uncurry DTSigning $1 }+  | "[" Expr "]"                       { DTBit      (tokenPosition $1) $2 }+  | "." Identifier                     { DTDot      (tokenPosition $1) $2 }+  | "automatic"                        { DTLifetime (tokenPosition $1) Automatic }+  | "type" "(" Expr ")"                { uncurry DTType $ makeTypeOf $1 $3 }+  | IncOrDecOperatorP                  { DTAsgn     (fst $1) (AsgnOp $ snd $1) Nothing (RawNum 1) }+  | IdentifierP               "::" Identifier { uncurry DTPSIdent $1    $3 }+  | IdentifierP ParamBindings "::" Identifier { uncurry DTCSIdent $1 $2 $4 }+DTDelim(delim) :: { DeclToken }+  : delim { DTEnd (tokenPosition $1) (head $ tokenString $1) }+DeclTokenAsgn :: { DeclToken }+  : "=" opt(DelayOrEvent) Expr { DTAsgn (tokenPosition $1) AsgnOpEq $2 $3 }+  | AsgnBinOpP Expr            { uncurry DTAsgn $1 Nothing $2 }+  | "<=" opt(DelayOrEvent) Expr { DTAsgn (tokenPosition $1) AsgnOpNonBlocking $2 $3 }+PortDeclTokens(delim) :: { [DeclToken] }+  : DeclTokensBase(PortDeclTokens(delim), delim) { $1 }+  | GenericInterfaceDecl   PortDeclTokens(delim) { $1 ++ $2}+  | GenericInterfaceDecl          DTDelim(delim) { $1 ++ [$2] }+  | AttributeInstanceP     PortDeclTokens(delim) { uncurry DTAttr $1 : $2 }+ModuleDeclTokens(delim) :: { [DeclToken] }+  : DeclTokensBase(ModuleDeclTokens(delim), delim) { $1 }+  | GenericInterfaceDecl   ModuleDeclTokens(delim) { $1 ++ $2}+  | GenericInterfaceDecl            DTDelim(delim) { $1 ++ [$2] }+GenericInterfaceDecl :: { [DeclToken] }+  : "interface" IdentifierP { [DTType (tokenPosition $1) (\Unspecified -> InterfaceT "" ""), uncurry DTIdent $2] }++VariablePortIdentifiers :: { [(Identifier, Expr)] }+  : VariablePortIdentifier                             { [$1] }+  | VariablePortIdentifiers "," VariablePortIdentifier { $1 ++ [$3] }+VariablePortIdentifier :: { (Identifier, Expr) }+  : Identifier OptAsgn { ($1,$2) }++Direction :: { Direction }+  : DirectionP { snd $1 }+DirectionP :: { (Position, Direction) }+  : "inout"  { (tokenPosition $1, Inout ) }+  | "input"  { (tokenPosition $1, Input ) }+  | "output" { (tokenPosition $1, Output) }++ModuleItems :: { [ModuleItem] }+  : {- empty -}                    { [] }+  | ";" ModuleItems                { $2 }+  | MITrace ModuleItem ModuleItems { addMITrace $1 ($2 ++ $3) }++ModuleItem :: { [ModuleItem] }+  : NonGenerateModuleItem { $1 }+  | ConditionalGenerateConstruct    { [Generate [$1]] }+  | LoopGenerateConstruct           { [Generate [$1]] }+  | "generate" GenItems endgenerate { [Generate $2] }+NonGenerateModuleItem :: { [ModuleItem] }+  -- This item covers module instantiations and all declarations+  : ModuleDeclTokens(";")                { parseDTsAsModuleItems $1 }+  | ParameterDecl(";")                   { map (MIPackageItem . Decl) $1 }+  | "defparam" LHSAsgns ";"              { map (uncurry Defparam) $2 }+  | "assign" AssignOption LHSAsgns ";"   { map (uncurry $ Assign $2) $3 }+  | AlwaysKW Stmt                        { [AlwaysC $1 $2] }+  | "initial" Stmt                       { [Initial $2] }+  | "final"   Stmt                       { [Final   $2] }+  | "genvar" Identifiers ";"             { map Genvar $2 }+  | "modport" ModportItems ";"           { map (uncurry Modport) $2 }+  | NonDeclPackageItem                   { map MIPackageItem $1 }+  | TaskOrFunction                       { [MIPackageItem $1] }+  | NInputGateKW  NInputGates  ";"       { map (\(a, b, c, d) -> NInputGate  $1 a b c d) $2 }+  | NOutputGateKW NOutputGates ";"       { map (\(a, b, c, d) -> NOutputGate $1 a b c d) $2 }+  | AttributeInstance ModuleItem         { map (addMIAttr $1) $2 }+  | AssertionItem                        { [AssertionItem $1] }++AssignOption :: { AssignOption }+  : {- empty -}   { AssignOptionNone }+  | DelayControl  { AssignOptionDelay $1 }+  | DriveStrength { uncurry AssignOptionDrive $1 }++-- for ModuleItem, for now+AssertionItem :: { AssertionItem }+  : ConcurrentAssertionItem { $1 }++-- for Stmt, for now+ProceduralAssertionStatement :: { Assertion }+  : ConcurrentAssertionStatement { $1 }+  | ImmediateAssertionStatement  { $1 }++ConcurrentAssertionItem :: { AssertionItem }+  : Identifier ":" ConcurrentAssertionStatement { ($1, $3) }+  |                ConcurrentAssertionStatement { ("", $1) }+ConcurrentAssertionStatement :: { Assertion }+  : "assert" "property" "(" PropertySpec ")" ActionBlock { Assert (Left $4) $6 }+  | "assume" "property" "(" PropertySpec ")" ActionBlock { Assume (Left $4) $6 }+  | "cover"  "property" "(" PropertySpec ")" Stmt        { Cover  (Left $4) $6 }++ImmediateAssertionStatement :: { Assertion }+  : SimpleImmediateAssertionStatement { $1 }+SimpleImmediateAssertionStatement :: { Assertion }+  : "assert" "(" Expr ")" ActionBlock { Assert (Right $3) $5 }+  | "assume" "(" Expr ")" ActionBlock { Assume (Right $3) $5 }+  | "cover"  "(" Expr ")" Stmt        { Cover  (Right $3) $5 }++PropertySpec :: { PropertySpec }+  : opt(ClockingEvent) "disable" "iff" "(" Expr ")" PropExpr { PropertySpec $1 $5  $7 }+  | opt(ClockingEvent)                              PropExpr { PropertySpec $1 Nil $2 }++PropExpr :: { PropExpr }+  : SeqExpr { PropExpr $1 }+  | PropExprParens { $1 }+PropExprParens :: { PropExpr }+  : "(" PropExprParens ")" { $2 }+  | SeqExpr "|->" PropExpr { PropExprImpliesO  $1 $3 }+  | SeqExpr "|=>" PropExpr { PropExprImpliesNO $1 $3 }+  | SeqExpr "#-#" PropExpr { PropExprFollowsO  $1 $3 }+  | SeqExpr "#=#" PropExpr { PropExprFollowsNO $1 $3 }+  | PropExpr "iff" PropExpr { PropExprIff $1 $3 }+SeqExpr :: { SeqExpr }+  : Expr { SeqExpr $1 }+  | SeqExprParens { $1 }+SeqExprParens :: { SeqExpr }+  : "(" SeqExprParens ")" { $2 }+  | SeqExpr "and"        SeqExpr { SeqExprAnd        $1 $3 }+  | SeqExpr "or"         SeqExpr { SeqExprOr         $1 $3 }+  | SeqExpr "intersect"  SeqExpr { SeqExprIntersect  $1 $3 }+  | Expr    "throughout" SeqExpr { SeqExprThroughout $1 $3 }+  | SeqExpr "within"     SeqExpr { SeqExprWithin     $1 $3 }+  | SeqExpr "##" Number  SeqExpr { SeqExprDelay (Just $1) (Number $3) $4 }+  |         "##" Number  SeqExpr { SeqExprDelay (Nothing) (Number $2) $3 }+  | "first_match" "(" SeqExpr SeqMatchItems ")" { SeqExprFirstMatch $3 $4 }+SeqMatchItems :: { [SeqMatchItem] }+  : "," SeqMatchItem               { [$2] }+  | SeqMatchItems "," SeqMatchItem { $1 ++ [$3] }+SeqMatchItem :: { SeqMatchItem }+  : ForStepAssignment   { SeqMatchAsgn $1 }+  | Identifier CallArgs { SeqMatchCall $1 $2 }++ActionBlock :: { ActionBlock }+  : Stmt %prec NoElse { ActionBlock $1 Null }+  |      "else" Stmt  { ActionBlock Null $2 }+  | Stmt "else" Stmt  { ActionBlock $1   $3 }++AttributeInstances :: { [Attr] }+  : {- empty -}                          { [] }+  | AttributeInstance AttributeInstances { $1 : $2 }+AttributeInstance :: { Attr }+  : AttributeInstanceP { snd $1 }+AttributeInstanceP :: { (Position, Attr) }+  : "(*" AttrSpecs "*)" { withPos $1 $ Attr $2 }+AttrSpecs :: { [AttrSpec] }+  : AttrSpec               { [$1] }+  | AttrSpecs "," AttrSpec { $1 ++ [$3] }+AttrSpec :: { AttrSpec }+  : Identifier OptAsgn { ($1, $2) }++NInputGates :: { [(Expr, Identifier, LHS, [Expr])] }+  : NInputGate                 { [$1] }+  | NInputGates "," NInputGate { $1 ++ [$3]}+NOutputGates :: { [(Expr, Identifier, [LHS], Expr)] }+  : NOutputGate                  { [$1] }+  | NOutputGates "," NOutputGate { $1 ++ [$3]}++NInputGate :: { (Expr, Identifier, LHS, [Expr]) }+  : DelayControlOrNil opt(Identifier) "(" LHS "," Exprs ")" { ($1, fromMaybe "" $2, $4, $6) }+NOutputGate :: { (Expr, Identifier, [LHS], Expr) }+  : DelayControlOrNil opt(Identifier) "(" NOutputGateItems { ($1, fromMaybe "" $2, fst $4, snd $4) }+NOutputGateItems :: { ([LHS], Expr) }+  : Expr ")" { ([], $1) }+  | Expr "," NOutputGateItems { (toLHS $1 : fst $3, snd $3) }+DelayControlOrNil :: { Expr }+  : DelayControl { $1 }+  | {- empty -} { Nil }++NInputGateKW :: { NInputGateKW }+  : "and"  { GateAnd  }+  | "nand" { GateNand }+  | "or"   { GateOr   }+  | "nor"  { GateNor  }+  | "xor"  { GateXor  }+  | "xnor" { GateXnor }+NOutputGateKW :: { NOutputGateKW }+  : "buf"  { GateBuf  }+  | "not"  { GateNot  }++DriveStrength :: { (Strength0, Strength1) }+  : "(" Strength0 "," Strength1 ")" { ($2    , $4    ) }+  | "(" Strength1 "," Strength0 ")" { ($4    , $2    ) }+  | "(" Strength0 "," "highz1"  ")" { ($2    , Highz1) }+  | "(" Strength1 "," "highz0"  ")" { (Highz0, $2    ) }+  | "(" "highz0"  "," Strength1 ")" { (Highz0, $4    ) }+  | "(" "highz1"  "," Strength0 ")" { ($4    , Highz1) }+Strength0 :: { Strength0 }+  : "supply0" { Supply0 }+  | "strong0" { Strong0 }+  | "pull0"   { Pull0   }+  | "weak0"   { Weak0   }+Strength1 :: { Strength1 }+  : "supply1" { Supply1 }+  | "strong1" { Strong1 }+  | "pull1"   { Pull1   }+  | "weak1"   { Weak1   }+ChargeStrength :: { ChargeStrength }+  : "(" "small"  ")" { Small  }+  | "(" "medium" ")" { Medium }+  | "(" "large"  ")" { Large  }++LHSAsgns :: { [(LHS, Expr)] }+  : LHSAsgn                   { [$1] }+  | LHSAsgns "," LHSAsgn { $1 ++ [$3] }+LHSAsgn :: { (LHS, Expr) }+  : LHS "=" Expr { ($1, $3) }++PackageItems :: { [PackageItem] }+  : {- empty -}                      { [] }+  | ";" PackageItems                 { $2 }+  | PITrace PackageItem PackageItems { addPITrace $1 ($2 ++ $3) }+PackageItem :: { [PackageItem] }+  : PackageOrClassItem { $1}+  | TaskOrFunction { [$1] }++ClassItems :: { [ClassItem] }+  : {- empty -}                  { [] }+  | ";" ClassItems               { $2 }+  | CITrace ClassItem ClassItems { addCITrace $1 ($2 ++ $3) }+ClassItem :: { [ClassItem] }+  : ClassItemQualifier PackageOrClassItem { map ($1, ) $2 }+  | ClassItemQualifier TaskOrFunction     { [($1, $2)] }+ClassItemQualifier :: { Qualifier }+  : {- empty -} { QNone }+  | "static"    { QStatic }+  | "local"     { QLocal }+  | "protected" { QProtected }++PackageOrClassItem :: { [PackageItem] }+  : DeclTokens(";")    { map Decl $ parseDTsAsDecl $1 }+  | ParameterDecl(";") { map Decl $1 }+  | NonDeclPackageItem { $1 }+NonDeclPackageItem :: { [PackageItem] }+  : Typedef              { [Decl $1] }+  | ImportOrExport       { $1 }+  | ForwardTypedef ";"   { $1 }+  | TimeunitsDeclaration { $1 }+  | Directive            { [Directive $1] }++ImportOrExport :: { [PackageItem] }+  : "import" PackageImportItems ";" { map (uncurry Import) $2 }+  | "export" PackageImportItems ";" { map (uncurry Export) $2 }+  | "export" "*" "::" "*" ";"       { [Export "" ""] }+TaskOrFunction :: { PackageItem }+  : "function" Lifetime FuncRetAndName    TFItems DeclsAndStmts endfunction StrTag {% checkTag (snd $3) $7 $ Function $2 (fst $3) (snd $3) (map makeInput $4 ++ fst $5) (snd $5) }+  | "function" Lifetime "void" Identifier TFItems DeclsAndStmts endfunction StrTag {% checkTag $4       $8 $ Task     $2 $4                ($5 ++ fst $6) (snd $6) }+  | "task"     Lifetime Identifier        TFItems DeclsAndStmts endtask     StrTag {% checkTag $3       $7 $ Task     $2 $3                ($4 ++ fst $5) (snd $5) }+Typedef :: { Decl }+  : "typedef" Type Identifier ";" { ParamType Localparam $3 $2 }+  | "typedef" Type Identifier DimensionsNonEmpty ";" { ParamType Localparam $3 (UnpackedType $2 $4) }+  | "typedef" TypedefRef Identifier ";" { ParamType Localparam $3 $2 }+TypedefRef :: { Type }+  : Identifier              "." Identifier { TypedefRef $ Dot      (Ident $1)     $3 }+  | Identifier "[" Expr "]" "." Identifier { TypedefRef $ Dot (Bit (Ident $1) $3) $6 }+ForwardTypedef :: { [PackageItem] }+  : "typedef"          Identifier { [] }+  | "typedef" "enum"   Identifier { [] }+  | "typedef" "struct" Identifier { [] }+  | "typedef" "union"  Identifier { [] }+TimeunitsDeclaration :: { [PackageItem] }+  : "timeunit" Time          ";" { [] }+  | "timeunit" Time "/" Time ";" { [] }+  | "timeprecision" Time     ";" { [] }++Directive :: { String }+  : "`celldefine"          { tokenString $1 }+  | "`endcelldefine"       { tokenString $1 }+  | "`unconnected_drive" Drive { tokenString $1 ++ " " ++ $2 }+  | "`nounconnected_drive" { tokenString $1 }+  | "`default_nettype" DefaultNetType { tokenString $1 ++ " " ++ $2 }+  | "`resetall"            { tokenString $1 }+Drive :: { String }+  : "pull0" { tokenString $1 }+  | "pull1" { tokenString $1 }+DefaultNetType :: { String }+  : NetTypeP { show $ snd $1 }+  | Identifier { $1 }++PackageImportItems :: { [(Identifier, Identifier)] }+  : PackageImportItem                        { [$1] }+  | PackageImportItems "," PackageImportItem { $1 ++ [$3] }+PackageImportItem :: { (Identifier, Identifier) }+  : Identifier "::" Identifier { ($1, $3) }+  | Identifier "::" "*"        { ($1, "") }++FuncRetAndName :: { (Type, Identifier) }+  : Type                       Identifier { ($1                     , $2) }+  |                            Identifier { (Implicit Unspecified [], $1) }+  | Signing                    Identifier { (Implicit $1          [], $2) }+  |         DimensionsNonEmpty Identifier { (Implicit Unspecified $1, $2) }+  | Signing DimensionsNonEmpty Identifier { (Implicit $1          $2, $3) }++AlwaysKW :: { AlwaysKW }+  : "always"       { Always      }+  | "always_comb"  { AlwaysComb  }+  | "always_ff"    { AlwaysFF    }+  | "always_latch" { AlwaysLatch }++Lifetime :: { Lifetime }+  : {- empty -} { Inherit }+  | ExplicitLifetime { $1 }+ExplicitLifetime :: { Lifetime }+  : "static"    { Static    }+  | "automatic" { Automatic }++TFItems :: { [Decl] }+  : "(" DeclTokens(")") ";" { parseDTsAsTFDecls $2 }+  | "("            ")"  ";" { [] }+  |                     ";" { [] }++ParamType :: { Type }+  : PartialType OptSigning Dimensions { $1 $2 $3 }+  | DimensionsNonEmpty { Implicit Unspecified $1 }+  | Signing Dimensions { Implicit $1          $2 }++Dimensions :: { [Range] }+  : {- empty -}        { [] }+  | DimensionsNonEmpty { $1 }+DimensionsNonEmpty :: { [Range] }+  : Dimension                    { [$1] }+  | DimensionsNonEmpty Dimension { $1 ++ [$2] }+Dimension :: { Range }+  : Range        { $1 }+  | "[" Expr "]" { (RawNum 0, BinOp Sub $2 (RawNum 1)) }++DeclAsgns :: { [(Identifier, Expr, [Range])] }+  : DeclAsgn               { [$1] }+  | DeclAsgns "," DeclAsgn { $1 ++ [$3] }+DeclAsgn :: { (Identifier, Expr, [Range]) }+  : Identifier Dimensions OptAsgn { ($1, $3, $2) }++Range :: { Range }+  : "[" Expr ":"  Expr "]" { ($2, $4) }++PartSelectP :: { (Position, (PartSelectMode, Range)) }+  : "[" Expr ":"  Expr "]" { (tokenPosition $1, (NonIndexed  , ($2, $4))) }+  | "[" Expr "+:" Expr "]" { (tokenPosition $1, (IndexedPlus , ($2, $4))) }+  | "[" Expr "-:" Expr "]" { (tokenPosition $1, (IndexedMinus, ($2, $4))) }++LHS :: { LHS }+  : Identifier         { LHSIdent  $1    }+  | LHS PartSelectP    { uncurry (LHSRange $1) (snd $2) }+  | LHS "[" Expr "]"   { LHSBit    $1 $3 }+  | LHS "." Identifier { LHSDot    $1 $3 }+  | LHSConcatP         { snd $1 }+  | LHSStreamP         { snd $1 }++LHSStreamP :: { (Position, LHS) }+  : "{" StreamOp StreamSize Concat "}" { withPos $1 $ LHSStream $2 $3         (map toLHS $4) }+  | "{" StreamOp            Concat "}" { withPos $1 $ LHSStream $2 (RawNum 1) (map toLHS $3) }++LHSConcatP :: { (Position, LHS) }+  : "{" LHSs "}" { withPos $1 $ LHSConcat $2 }+LHSs :: { [LHS] }+  : LHS           { [$1] }+  | LHSs "," LHS  { $1 ++ [$3] }++PortBindingsP:: { (Position, [PortBinding]) }+  : "(" PortBindingsInside ")" {% checkPortBindings $2 >>= return . withPos $1 }+PortBindingsInside :: { [PortBinding] }+  : OptPortBinding                        { [$1] }+  | OptPortBinding "," PortBindingsInside { $1 : $3}+OptPortBinding :: { PortBinding }+  : {- empty -} { ("", Nil) }+  | PortBinding { $1 }++PortBinding :: { PortBinding }+  : "." Identifier "(" ExprOrNil ")" { ($2, $4) }+  | "." Identifier                   { ($2, Ident $2) }+  | Expr                             { ("", $1) }+  | ".*"                             { ("*", Nil) }++ParamBindings :: { [ParamBinding] }+  : "#" "("                     ")" { [] }+  | "#" "(" ParamBindingsInside ")" {% checkParamBindings $3 }+ParamBindingsInside :: { [ParamBinding] }+  : ParamBinding opt(",")                { [$1] }+  | ParamBinding "," ParamBindingsInside { $1 : $3}+ParamBinding :: { ParamBinding }+  : "." Identifier "(" TypeOrExpr ")" { ($2, $4) }+  | "." Identifier "("            ")" { ($2, Right Nil) }+  | TypeOrExpr                        { ("", $1) }++Stmts :: { [Stmt] }+  : {- empty -} { [] }+  | Stmts Stmt  { $1 ++ [$2] }++Stmt :: { Stmt }+  : StmtTrace StmtAsgn    { Block Seq "" [] [$1, $2] }+  | StmtTrace StmtNonAsgn { $2 }++StmtAsgn :: { Stmt }+  : LHS "="  opt(DelayOrEvent) Expr ";" { Asgn AsgnOpEq $3 $1 $4 }+  | LHS "<=" opt(DelayOrEvent) Expr ";" { Asgn AsgnOpNonBlocking $3 $1 $4 }+  | LHS AsgnBinOp              Expr ";" { Asgn $2  Nothing $1 $3 }+  | LHS IncOrDecOperator ";" { Asgn (AsgnOp $2) Nothing $1 (RawNum 1) }+  | IncOrDecOperator LHS ";" { Asgn (AsgnOp $1) Nothing $2 (RawNum 1) }+  | LHS          ";" { Subroutine (lhsToExpr $1) (Args [] []) }+  | LHS CallArgs ";" { Subroutine (lhsToExpr $1) $2 }+  | Identifier "::" Identifier          ";" { Subroutine (PSIdent $1 $3) (Args [] []) }+  | Identifier "::" Identifier CallArgs ";" { Subroutine (PSIdent $1 $3) $4 }+  | Identifier ParamBindings "::" Identifier          ";" { Subroutine (CSIdent $1 $2 $4) (Args [] []) }+  | Identifier ParamBindings "::" Identifier CallArgs ";" { Subroutine (CSIdent $1 $2 $4) $5 }+StmtNonAsgn :: { Stmt }+  : StmtBlock(BlockKWSeq, end ) { $1 }+  | StmtBlock(BlockKWPar, join) { $1 }+  |                StmtNonBlock { $1 }+  | Identifier ":" StmtNonBlock { Block Seq $1 [] [$3] }+StmtBlock(begin, end) :: { Stmt }+  :                begin StrTag DeclsAndStmts end StrTag {% checkTag $2 $5 $ uncurry (Block $1 $2) $3 }+  | Identifier ":" begin        DeclsAndStmts end StrTag {% checkTag $1 $6 $ uncurry (Block $3 $1) $4 }+StmtNonBlock :: { Stmt }+  : ";" { Null }+  | Unique "if" "(" Expr ")" Stmt "else" Stmt  { If $1 $4 $6 $8   }+  | Unique "if" "(" Expr ")" Stmt %prec NoElse { If $1 $4 $6 Null }+  | "for" "(" ForInit ForCond ForStep ")" Stmt { makeFor $3 $4 $5 $7 }+  | CaseStmt                                   { $1 }+  | TimingControl Stmt                         { Timing $1 $2 }+  | "return" ExprOrNil ";"                     { Return $2 }+  | "break"       ";"                          { Break }+  | "continue"    ";"                          { Continue }+  | "while"  "(" Expr ")" Stmt                 { While   $3 $5 }+  | "repeat" "(" Expr ")" Stmt                 { RepeatL $3 $5 }+  | "do"      Stmt "while" "(" Expr ")" ";"    { DoWhile $5 $2 }+  | "forever" Stmt                             { Forever $2 }+  | "foreach" "(" Identifier IdxVars ")" Stmt  { Foreach $3 $4 $6 }+  | "->"  Identifier ";"                       { Trigger True  $2 }+  | "->>" Identifier ";"                       { Trigger False $2 }+  | AttributeInstance Stmt                     { StmtAttr $1 $2 }+  | ProceduralAssertionStatement               { Assertion $1 }+  | "void" "'" "(" Expr CallArgs ")" ";"       { Subroutine $4 $5 }++CaseStmt :: { Stmt }+  : Unique CaseKW "(" Expr ")"          Cases       "endcase" { Case $1 $2                   $4 $ validateCases $5 $6 }+  | Unique CaseKW "(" Expr ")" "inside" InsideCases "endcase" { Case $1 (caseInsideKW $3 $2) $4 $ validateCases $5 $7 }++BlockKWPar :: { BlockKW }+  : "fork" { Par }+BlockKWSeq :: { BlockKW }+  : "begin" { Seq }++Unique :: { ViolationCheck }+  : {- empty -} { NoCheck  }+  | "unique"    { Unique   }+  | "unique0"   { Unique0  }+  | "priority"  { Priority }++ForInit :: { Either [Decl] [(LHS, Expr)] }+  :            ";"  { Right [] }+  | DeclTokens(";") { parseDTsAsDeclsOrAsgns $1 }++ForCond :: { Expr }+  :      ";" { RawNum 1 }+  | Expr ";" { $1 }++ForStep :: { [(LHS, AsgnOp, Expr)] }+  : {- empty -}     { [] }+  | ForStepNonEmpty { $1 }+ForStepNonEmpty :: { [(LHS, AsgnOp, Expr)] }+  : ForStepAssignment                     { [$1] }+  | ForStepNonEmpty "," ForStepAssignment { $1 ++ [$3] }+ForStepAssignment :: { (LHS, AsgnOp, Expr) }+  : LHS AsgnOp Expr { ($1, $2, $3) }+  | IncOrDecOperator LHS { ($2, AsgnOp $1, RawNum 1) }+  | LHS IncOrDecOperator { ($1, AsgnOp $2, RawNum 1) }++IdxVars :: { [Identifier] }+  : "[" IdxVarsInside "]" { $2 }+IdxVarsInside :: { [Identifier] }+  : IdxVar                   { [$1] }+  | IdxVar "," IdxVarsInside { $1 : $3 }+IdxVar :: { Identifier }+  : {- empty -} { "" }+  | Identifier  { $1 }++DeclsAndStmts :: { ([Decl], [Stmt]) }+  : StmtTrace DeclOrStmt DeclsAndStmts {% combineDeclsAndStmts $2 $3 }+  | StmtTrace StmtNonAsgn Stmts        { ([], $1 : $2 : $3) }+  | StmtTrace {- empty -}              { ([], []) }+DeclOrStmt :: { ([Decl], [Stmt]) }+  : DeclTokens(";")    { parseDTsAsDeclOrStmt $1 }+  | ParameterDecl(";") { ($1, []) }++ModuleParameterDecl(delim) :: { [Decl] }+  : ParameterDecl(delim) { $1 }+  | DeclTrace "type" TypeAsgns delim { $1 : map (uncurry $ ParamType Parameter) $3 }+ParameterDecl(delim) :: { [Decl] }+  : ParameterDeclKW           DeclAsgns delim { makeParamDecls $1 (Implicit Unspecified []) $2 }+  | ParameterDeclKW ParamType DeclAsgns delim { makeParamDecls $1 $2 $3 }+  | ParameterDeclKW TypeAlias DeclAsgns delim { makeParamDecls $1 $2 $3 }+  | ParameterDeclKW "type"    TypeAsgns delim { makeParamTypeDecls $1 $3 }+ParameterDeclKW :: { (Position, ParamScope) }+  : "parameter"  { withPos $1 Parameter  }+  | "localparam" { withPos $1 Localparam }++TypeAsgns :: { [(Identifier, Type)] }+  : TypeAsgn               { [$1] }+  | TypeAsgns "," TypeAsgn { $1 ++ [$3] }+TypeAsgn :: { (Identifier, Type) }+  : Identifier "=" Type { ($1, $3) }+  | Identifier          { ($1, UnknownType) }++-- TODO: This does not allow for @identifier+ClockingEvent :: { Sense }+  : "@" "(" Senses ")" { $3 }++TimingControl :: { Timing }+  : DelayOrEvent { $1 }+  | CycleDelay   { Cycle $1 }+DelayOrEvent :: { Timing }+  : DelayControl { Delay $1 }+  | EventControl { Event $1 }+DelayControl :: { Expr }+  : "#" Number { Number $2 }+  | "#" Time   { Time   $2 }+  | "#" "(" Expr ")"  { $3 }+  | "#" "(" Expr ":" Expr ":" Expr ")" { MinTypMax $3 $5 $7 }+  | "#"                               Identifier { Ident         $2 }+  | "#" Identifier               "::" Identifier { PSIdent $2    $4 }+  | "#" Identifier ParamBindings "::" Identifier { CSIdent $2 $3 $5 }+CycleDelay :: { Expr }+  : "##" Expr { $2 }+EventControl :: { Sense }+  : "@" "(" Senses ")" { $3 }+  | "@" "(*)"          { SenseStar }+  | "@*"               { SenseStar }+  | "@" Identifier     { Sense $ LHSIdent $2 }+Senses :: { Sense }+  : Sense             { $1 }+  | Senses "or" Sense { SenseOr $1 $3 }+  | Senses ","  Sense { SenseOr $1 $3 }+Sense :: { Sense }+  : "(" Sense ")"         {              $2 }+  |               LHS     { Sense        $1 }+  | "posedge"     LHS     { SensePosedge $2 }+  | "negedge"     LHS     { SenseNegedge $2 }+  | "posedge" "(" LHS ")" { SensePosedge $3 }+  | "negedge" "(" LHS ")" { SenseNegedge $3 }++CaseKW :: { CaseKW }+  : "case"  { CaseN }+  | "casex" { CaseX }+  | "casez" { CaseZ }++Cases :: { [Case] }+  : Case       { [$1] }+  | Case Cases { $1 : $2 }+Case :: { Case }+  : Exprs ":"  Stmt { ($1, $3) }+  | "default" opt(":") Stmt { ([], $3) }+InsideCases :: { [Case] }+  : InsideCase             { [$1] }+  | InsideCase InsideCases { $1 : $2 }+InsideCase :: { Case }+  : OpenRangeList ":"  Stmt { ($1, $3) }+  | "default" opt(":") Stmt { ([], $3) }++Real :: { String }+  : real { tokenString $1 }++Number :: { Number }+  : number { parseNumber $ tokenString $1 }++String :: { String }+  : string { tail $ init $ tokenString $1 }++Time :: { String }+  : time { tokenString $1 }++CallArgs :: { Args }+  : "(" CallArgsInside ")" { $2 }+CallArgsInside :: { Args }+  : {- empty -}                        { Args [        ] [] }+  |                NamedCallArgsFollow { Args [        ] $1 }+  | Expr                 NamedCallArgs { Args [$1      ] $2 }+  |      UnnamedCallArgs NamedCallArgs { Args (Nil : $1) $2 }+  | Expr UnnamedCallArgs NamedCallArgs { Args ($1  : $2) $3 }+UnnamedCallArgs :: { [Expr] }+  : "," ExprOrNil                 { [$2] }+  | UnnamedCallArgs "," ExprOrNil { $1 ++ [$3] }+NamedCallArgs :: { [(Identifier, Expr)] }+  : {- empty -}        { [] }+  | "," NamedCallArgsFollow  { $2 }+NamedCallArgsFollow :: { [(Identifier, Expr)] }+  : NamedCallArg                         { [$1] }+  | NamedCallArgsFollow "," NamedCallArg { $1 ++ [$3] }+NamedCallArg :: { (Identifier, Expr) }+  : "." Identifier "(" ExprOrNil ")" { ($2, $4) }++Exprs :: { [Expr] }+  :           Expr  { [$1] }+  | Exprs "," Expr  { $1 ++ [$3] }++TypeOrExpr :: { TypeOrExpr }+  : TypeNonIdent { Left $1 }+  | Expr         { Right $1 }++OpenRangeList :: { [Expr] }+  : ValueRange                   { [$1] }+  | OpenRangeList "," ValueRange { $1 ++ [$3] }+ValueRange :: { Expr }+  : Expr  { $1 }+  | Range { Range Nil NonIndexed $1 }++Expr :: { Expr }+  : "(" Expr ")"                { $2 }+  | String                      { String $1 }+  | Real                        { Real   $1 }+  | Number                      { Number $1 }+  | Time                        { Time   $1 }+  | Expr CallArgs               { Call $1 $2 }+  | DimsFn "(" TypeOrExpr ")"   { DimsFn $1 $3 }+  | DimFn  "(" TypeOrExpr ")"   { DimFn  $1 $3 (RawNum 1) }+  | DimFn  "(" TypeOrExpr "," Expr ")" { DimFn $1 $3 $5 }+  | Expr PartSelectP            { uncurry (Range $1) (snd $2) }+  | Expr "[" Expr "]"           { Bit   $1 $3 }+  | "{" Expr Concat "}"         { Repeat $2 $3 }+  | Concat                      { Concat $1 }+  | Expr "?" Expr ":" Expr      { Mux $1 $3 $5 }+  | Expr "." Identifier         { Dot $1 $3 }+  | "'" "{" PatternItems "}"    { Pattern $3 }+  | Expr "'" "{" PatternItems "}"{ Cast (Right $1) (Pattern $4) }+  | CastingType "'" "(" Expr ")" { Cast (Left  $1) $4 }+  | Expr        "'" "(" Expr ")" { Cast (Right $1) $4 }+  | "{" StreamOp StreamSize Concat "}" { Stream $2 $3         $4 }+  | "{" StreamOp            Concat "}" { Stream $2 (RawNum 1) $3 }+  | Expr "inside" "{" OpenRangeList "}" { Inside $1 $4 }+  | "(" Expr ":" Expr ":" Expr ")" { MinTypMax $2 $4 $6 }+  | Identifier %prec REDUCE_OP {- defer -}   { Ident         $1 }+  | Identifier               "::" Identifier { PSIdent $1    $3 }+  | Identifier ParamBindings "::" Identifier { CSIdent $1 $2 $4 }+  -- binary expressions+  | Expr "||"  Expr { BinOp LogOr  $1 $3 }+  | Expr "&&"  Expr { BinOp LogAnd $1 $3 }+  | Expr "->"  Expr { BinOp LogImp $1 $3 }+  | Expr "<->" Expr { BinOp LogEq  $1 $3 }+  | Expr "|"   Expr { BinOp BitOr  $1 $3 }+  | Expr "^"   Expr { BinOp BitXor $1 $3 }+  | Expr "&"   Expr { BinOp BitAnd $1 $3 }+  | Expr "~^"  Expr { BinOp BitXnor $1 $3 }+  | Expr "^~"  Expr { BinOp BitXnor $1 $3 }+  | Expr "+"   Expr { BinOp Add $1 $3 }+  | Expr "-"   Expr { BinOp Sub $1 $3 }+  | Expr "*"   Expr { BinOp Mul $1 $3 }+  | Expr "/"   Expr { BinOp Div $1 $3 }+  | Expr "%"   Expr { BinOp Mod $1 $3 }+  | Expr "**"  Expr { BinOp Pow $1 $3 }+  | Expr "=="  Expr { BinOp Eq $1 $3 }+  | Expr "!="  Expr { BinOp Ne $1 $3 }+  | Expr "<"   Expr { BinOp Lt $1 $3 }+  | Expr "<="  Expr { BinOp Le $1 $3 }+  | Expr ">"   Expr { BinOp Gt $1 $3 }+  | Expr ">="  Expr { BinOp Ge $1 $3 }+  | Expr "===" Expr { BinOp TEq $1 $3 }+  | Expr "!==" Expr { BinOp TNe $1 $3 }+  | Expr "==?" Expr { BinOp WEq $1 $3 }+  | Expr "!=?" Expr { BinOp WNe $1 $3 }+  | Expr "<<"  Expr { BinOp ShiftL $1 $3 }+  | Expr ">>"  Expr { BinOp ShiftR $1 $3 }+  | Expr "<<<" Expr { BinOp ShiftAL $1 $3 }+  | Expr ">>>" Expr { BinOp ShiftAR $1 $3 }+  -- unary expressions+  | "!"  Expr                 { UniOp LogNot $2 }+  | "~"  Expr                 { UniOp BitNot $2 }+  | "+"  Expr %prec REDUCE_OP { UniOp UniAdd $2 }+  | "-"  Expr %prec REDUCE_OP { UniOp UniSub $2 }+  | "&"  Expr %prec REDUCE_OP { UniOp RedAnd  $2 }+  | "~&" Expr %prec REDUCE_OP { UniOp RedNand $2 }+  | "|"  Expr %prec REDUCE_OP { UniOp RedOr   $2 }+  | "~|" Expr %prec REDUCE_OP { UniOp RedNor  $2 }+  | "^"  Expr %prec REDUCE_OP { UniOp RedXor  $2 }+  | "~^" Expr %prec REDUCE_OP { UniOp RedXnor $2 }+  | "^~" Expr %prec REDUCE_OP { UniOp RedXnor $2 }++ExprOrNil :: { Expr }+  : Expr        { $1 }+  | {- empty -} { Nil }++PatternItems :: { [(TypeOrExpr, Expr)] }+  : PatternNamedItems   { $1 }+  | PatternUnnamedItems { zip (repeat $ Right Nil) $1 }+PatternNamedItems :: { [(TypeOrExpr, Expr)] }+  : PatternNamedItem                       { [$1] }+  | PatternNamedItems "," PatternNamedItem { $1 ++ [$3] }+PatternNamedItem :: { (TypeOrExpr, Expr) }+  : PatternName ":" Expr { ($1, $3) }+PatternName :: { TypeOrExpr }+  : Expr        { Right $1 }+  | PartialType { Left $ $1 Unspecified [] }+  | "default"   { Left UnknownType }+PatternUnnamedItems :: { [Expr] }+  :                         PatternUnnamedItem { [$1] }+  | PatternUnnamedItems "," PatternUnnamedItem { $1 ++ [$3] }+PatternUnnamedItem :: { Expr }+  : Expr        { $1 }+  | Expr Concat { Repeat $1 $2 }++Concat :: { [Expr] }+  : "{" Exprs "}" { $2 }++StreamOp :: { StreamOp }+  : "<<" { StreamL }+  | ">>" { StreamR }+StreamSize :: { Expr }+  : TypeNonIdent { DimsFn FnBits (Left $1) }+  | Expr         { $1 }++GenItemOrNull :: { GenItem }+  : GenItem { $1 }+  | ";"     { GenNull }++GenItems :: { [GenItem] }+  : {- empty -}      { [] }+  | GenItems ";"     { $1 }+  | GenItems GenItem { $1 ++ [$2] }++GenItem :: { GenItem }+  : MITrace GenBlock              { uncurry GenBlock $2 }+  | MITrace NonGenerateModuleItem { genItemsToGenItem $ map GenModuleItem $ addMITrace $1 $2 }+  | MITrace "generate" GenItems "endgenerate" { genItemsToGenItem $3 }+  | MITrace ConditionalGenerateConstruct { $2 }+  | MITrace LoopGenerateConstruct        { $2 }+ConditionalGenerateConstruct :: { GenItem }+  : "if" "(" Expr ")" GenItemOrNull "else" GenItemOrNull { GenIf $3 $5 $7      }+  | "if" "(" Expr ")" GenItemOrNull %prec NoElse         { GenIf $3 $5 GenNull }+  | "case" "(" Expr ")" GenCases "endcase" { GenCase $3 $ validateCases $4 $5 }+LoopGenerateConstruct :: { GenItem }+  : "for" "(" GenvarInitialization ";" Expr ";" GenvarIteration ")" GenItem { $3 $5 $7 $9 }++GenBlock :: { (Identifier, [GenItem]) }+  : GenBlockBegin GenItems end StrTag {% checkTag $1 $4 ($1, $2) }+GenBlockBegin :: { Identifier }+  : "begin" StrTag         { $2 }+  | Identifier ":" "begin" { $1 }++GenCases :: { [GenCase] }+  : GenCase          { [$1] }+  | GenCase GenCases { $1 : $2 }+GenCase :: { GenCase }+  : Exprs         ":"  GenItemOrNull { ($1, $3) }+  | "default" opt(":") GenItemOrNull { ([], $3) }++GenvarInitialization :: { Expr -> (Identifier, AsgnOp, Expr) -> GenItem -> GenItem }+  : "genvar" Identifier "=" Expr { \a b c -> genItemsToGenItem [GenModuleItem (Genvar $2), GenFor ($2, $4) a b c] }+  |          Identifier "=" Expr { GenFor ($1, $3) }++GenvarIteration :: { (Identifier, AsgnOp, Expr) }+  : Identifier AsgnOp Expr { ($1, $2, $3) }+  | IncOrDecOperator Identifier { ($2, AsgnOp $1, RawNum 1) }+  | Identifier IncOrDecOperator { ($1, AsgnOp $2, RawNum 1) }++AsgnOp :: { AsgnOp }+  : "=" { AsgnOpEq }+  | AsgnBinOp { $1 }+AsgnBinOp :: { AsgnOp }+  : AsgnBinOpP { snd $1 }+AsgnBinOpP :: { (Position, AsgnOp) }+  : "+="   { withPos $1 $ AsgnOp Add }+  | "-="   { withPos $1 $ AsgnOp Sub }+  | "*="   { withPos $1 $ AsgnOp Mul }+  | "/="   { withPos $1 $ AsgnOp Div }+  | "%="   { withPos $1 $ AsgnOp Mod }+  | "&="   { withPos $1 $ AsgnOp BitAnd }+  | "|="   { withPos $1 $ AsgnOp BitOr  }+  | "^="   { withPos $1 $ AsgnOp BitXor }+  | "<<="  { withPos $1 $ AsgnOp ShiftL }+  | ">>="  { withPos $1 $ AsgnOp ShiftR }+  | "<<<=" { withPos $1 $ AsgnOp ShiftAL }+  | ">>>=" { withPos $1 $ AsgnOp ShiftAR }++IncOrDecOperator :: { BinOp }+  : IncOrDecOperatorP { snd $1 }+IncOrDecOperatorP :: { (Position, BinOp) }+  : "++" { withPos $1 Add }+  | "--" { withPos $1 Sub }++DimsFn :: { DimsFn }+  : "$bits"                { FnBits               }+  | "$dimensions"          { FnDimensions         }+  | "$unpacked_dimensions" { FnUnpackedDimensions }+DimFn :: { DimFn }+  : "$left"                { FnLeft               }+  | "$right"               { FnRight              }+  | "$low"                 { FnLow                }+  | "$high"                { FnHigh               }+  | "$increment"           { FnIncrement          }+  | "$size"                { FnSize               }++MITrace :: { ModuleItem }+  : PITrace { MIPackageItem $1 }+PITrace :: { PackageItem }+  : DeclTrace { Decl $1 }+CITrace :: { ClassItem }+  : PITrace { (QNone, $1) }+DeclTrace :: { Decl }+  : Trace { CommentDecl $1 }+StmtTrace :: { Stmt }+  : Trace { CommentStmt $1 }+Trace :: { String }+  : position { "Trace: " ++ show $1 }+position :: { Position }+  : {- empty -} {% gets pPosition }++end          : "end"          {} | error {% missingToken "end"          }+endclass     : "endclass"     {} | error {% missingToken "endclass"     }+endfunction  : "endfunction"  {} | error {% missingToken "endfunction"  }+endgenerate  : "endgenerate"  {} | error {% missingToken "endgenerate"  }+endinterface : "endinterface" {} | error {% missingToken "endinterface" }+endmodule    : "endmodule"    {} | error {% missingToken "endmodule"    }+endpackage   : "endpackage"   {} | error {% missingToken "endpackage"   }+endtask      : "endtask"      {} | error {% missingToken "endtask"      }+join         : "join"         {} | error {% missingToken "join"         }++{++data ParseData = ParseData+  { pPosition :: Position+  , pTokens :: [Token]+  }++type ParseState = StateT ParseData (ExceptT String IO)++parse :: [Token] -> ExceptT String IO AST+parse [] = return []+parse tokens =+  evalStateT parseMain initialState+  where+    position = tokenPosition $ head tokens+    initialState = ParseData position tokens++positionKeep :: (Token -> ParseState a) -> ParseState a+positionKeep cont = do+  tokens <- gets pTokens+  case tokens of+    [] -> cont TokenEOF+    tok : toks -> do+      put $ ParseData (tokenPosition tok) toks+      cont tok++parseErrorTok :: Token -> ParseState a+parseErrorTok a = case a of+  TokenEOF    -> do+    p <- gets pPosition+    parseErrorM p "unexpected end of file"+  Token t s p ->+    parseErrorM p $ "unexpected token '" ++ s ++ "' (" ++ show t ++ ")"++parseErrorM :: Position -> String -> ParseState a+parseErrorM pos msg = throwError $ show pos ++ ": Parse error: " ++ msg++parseError :: Position -> String -> a+parseError pos msg = error $ show pos ++ ": Parse error: " ++ msg++genItemsToGenItem :: [GenItem] -> GenItem+genItemsToGenItem [x] = x+genItemsToGenItem xs = GenModuleItem $ Generate xs++combineDeclsAndStmts :: ([Decl], [Stmt]) -> ([Decl], [Stmt]) ->+  ParseState ([Decl], [Stmt])+combineDeclsAndStmts (a1, b1) (a2, b2) =+  if not (null b1) && not (null a2)+    then do+      p <- gets pPosition+      parseErrorM p+        "procedural block contains a declaration after a statement"+    else return (a1 ++ a2, b1 ++ b2)++makeInput :: Decl -> Decl+makeInput (Variable Local t x a e) = Variable Input t x a e+makeInput (Variable Input t x a e) = Variable Input t x a e+makeInput (CommentDecl c) = CommentDecl c+makeInput other =+  error $ "unexpected non-var or non-input decl: " ++ (show other)++checkTag :: String -> String -> a -> ParseState a+checkTag _ "" x = return x+checkTag "" b _ = do+  p <- gets pPosition+  parseErrorM p $ "block has only end label " ++ show b+checkTag a b x =+  if a == b+    then return x+    else do+      p <- gets pPosition+      parseErrorM p $ "element " ++ show a+        ++ " has mismatched end label " ++ show b++toLHS :: Expr -> LHS+toLHS expr =+  case exprToLHS expr of+    Just lhs -> lhs+    Nothing -> error $ "Parse error: cannot convert expression to LHS: "+                ++ show expr++traceCommentDecl :: Position -> Decl+traceCommentDecl = CommentDecl . ("Trace: " ++) . show++makeParamDecls+  :: (Position, ParamScope)+  -> Type+  -> [(Identifier, Expr, [Range])]+  -> [Decl]+makeParamDecls (p, s) t items =+  traceCommentDecl p :+  map mapper items+  where+    (tf, rs) = typeRanges t+    mapper (x, e, a) = Param s (tf $ a ++ rs) x e++makeParamTypeDecls :: (Position, ParamScope) -> [(Identifier, Type)] -> [Decl]+makeParamTypeDecls (p, s) items =+  traceCommentDecl p :+  map (uncurry $ ParamType s) items++fieldDecl :: Type -> (Identifier, [Range]) -> (Type, Identifier)+fieldDecl t (x, rs2) =+  (tf $ rs2 ++ rs1, x)+  where (tf, rs1) = typeRanges t++validateCases :: Token -> [([Expr], a)] -> [([Expr], a)]+validateCases tok items =+  if length (filter (null . fst) items) <= 1+    then items+    else parseError (tokenPosition tok) "case has multiple defaults"++caseInsideKW :: Token -> CaseKW -> CaseKW+caseInsideKW _ CaseN = CaseInside+caseInsideKW tok kw =+  parseError (tokenPosition tok) $ "cannot use inside with " ++ show kw++addMIAttr :: Attr -> ModuleItem -> ModuleItem+addMIAttr _ (item @ (MIPackageItem (Decl CommentDecl{}))) = item+addMIAttr attr item = MIAttr attr item++missingToken :: String -> ParseState a+missingToken expected = do+  p <- gets pPosition+  parseErrorM p $ "missing expected `" ++ expected ++ "`"++checkPortBindings :: [PortBinding] -> ParseState [PortBinding]+checkPortBindings [] = return []+checkPortBindings bindings =+  checkBindings "port connections" $+  if last bindings == ("", Nil)+    then init bindings+    else bindings++checkParamBindings :: [ParamBinding] -> ParseState [ParamBinding]+checkParamBindings = checkBindings "parameter overrides"++checkBindings :: String -> [(Identifier, a)] -> ParseState [(Identifier, a)]+checkBindings kind bindings =+  if all null bindingNames || all (not . null) bindingNames then+    return bindings+  else do+    p <- gets pPosition+    parseErrorM p $ "illegal mix of ordered and named " ++ kind+  where bindingNames = map fst bindings++withPos :: Token -> a -> (Position, a)+withPos tok = (tokenPosition tok, )++type PartialType = Signing -> [Range] -> Type++unexpectedPackedRanges :: Position -> String -> a+unexpectedPackedRanges pos typ =+  parseError pos $ "unexpected packed range(s) applied to " ++ typ++unexpectedSigning :: Position -> Signing -> String -> a+unexpectedSigning pos sg typ =+  parseError pos $ "unexpected " ++ show sg ++ " applied to " ++ typ++makeIntegerVector :: (Position, IntegerVectorType) -> PartialType+makeIntegerVector (_, typ) = IntegerVector typ++makeIntegerAtom :: (Position, IntegerAtomType) -> PartialType+makeIntegerAtom (_, typ) sg [] = IntegerAtom typ sg+makeIntegerAtom (pos, typ) _ _ = unexpectedPackedRanges pos (show typ)++makeNonInteger :: (Position, NonIntegerType) -> PartialType+makeNonInteger (_, typ) Unspecified [] = NonInteger typ+makeNonInteger (pos, typ) sg [] = unexpectedSigning pos sg (show typ)+makeNonInteger (pos, typ) Unspecified _ = unexpectedPackedRanges pos (show typ)++makeComplex :: Token -> ([Range] -> Type) -> (Position, PartialType)+makeComplex (Token _ str pos) tf = (pos, check)+  where+    check Unspecified = tf+    check sg = unexpectedSigning pos sg str++makeTypeOf :: Token -> Expr -> (Position, PartialType)+makeTypeOf (Token _ _ pos) expr = (pos, check)+  where+    typ = TypeOf expr+    check Unspecified [] = typ+    check Unspecified _  = unexpectedPackedRanges pos (show typ)+    check sg [] = unexpectedSigning pos sg (show typ)++addMITrace :: ModuleItem -> [ModuleItem] -> [ModuleItem]+addMITrace _ items @ (MIPackageItem (Decl CommentDecl{}) : _) = items+addMITrace trace items = trace : items++addPITrace :: PackageItem -> [PackageItem] -> [PackageItem]+addPITrace _ items @ (Decl CommentDecl{} : _) = items+addPITrace trace items = trace : items++addCITrace :: ClassItem -> [ClassItem] -> [ClassItem]+addCITrace _ items @ ((_, Decl CommentDecl{}) : _) = items+addCITrace trace items = trace : items++makeFor :: Either [Decl] [(LHS, Expr)] -> Expr -> [(LHS, AsgnOp, Expr)] -> Stmt -> Stmt+makeFor (Left inits) cond incr stmt =+  Block Seq "" decls+    [ CommentStmt msg+    , For (catMaybes maybeAsgns) cond incr stmt+    ]+  where+    (decls, maybeAsgns) = unzip $ map splitInit inits+    CommentDecl msg : _ = inits+makeFor (Right asgns) cond incr stmt = For asgns cond incr stmt++splitInit :: Decl -> (Decl, Maybe (LHS, Expr))+splitInit decl@CommentDecl{} = (decl, Nothing)+splitInit decl =+  (Variable d t ident a Nil, Just (LHSIdent ident, e))+  where Variable d t ident a e = decl++}
+ src/Language/SystemVerilog/Parser/ParseDecl.hs view
@@ -0,0 +1,602 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Advanced parser for declarations, module instantiations, and some statements.+ -+ - This module exists because the SystemVerilog grammar is not LALR(1), and+ - Happy can only produce LALR(1) parsers. This module provides an interface for+ - parsing a list of "DeclTokens" into `Decl`s, `ModuleItem`s, or `Stmt`s. This+ - works through a series of functions which have use a greater lookahead for+ - resolving the conflicts.+ -+ - Consider the following two module declarations:+ -  module Test(one two, three [1:0], four);+ -  module Test(one two, three [1:0]  four);+ -+ - 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.+ -+ - 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.+ -+ - 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+ - their code with a commercial simulator before running it through our tool.+ -}++module Language.SystemVerilog.Parser.ParseDecl+( DeclToken (..)+, parseDTsAsPortDecls+, parseDTsAsModuleItems+, parseDTsAsTFDecls+, parseDTsAsDecl+, parseDTsAsDeclOrStmt+, parseDTsAsDeclsOrAsgns+) where++import Data.List (findIndex, partition, uncons)++import Language.SystemVerilog.AST+import Language.SystemVerilog.Parser.Tokens (Position(..))++-- [PUBLIC]: combined (irregular) tokens for declarations+data DeclToken+    = DTComma    Position+    | DTAutoDim  Position+    | DTConst    Position+    | DTVar      Position+    | DTAsgn     Position AsgnOp (Maybe Timing) Expr+    | DTRange    Position PartSelectMode Range+    | DTIdent    Position Identifier+    | DTPSIdent  Position Identifier Identifier+    | DTCSIdent  Position Identifier [ParamBinding] Identifier+    | DTDir      Position Direction+    | DTType     Position (Signing -> [Range] -> Type)+    | DTNet      Position NetType Strength+    | DTParams   Position [ParamBinding]+    | DTPorts    Position [PortBinding]+    | DTBit      Position Expr+    | DTLHSBase  Position LHS+    | DTDot      Position Identifier+    | DTSigning  Position Signing+    | DTLifetime Position Lifetime+    | DTAttr     Position Attr+    | DTEnd      Position Char+++-- [PUBLIC]: parser for module port declarations, including interface ports+-- Example: `input foo, bar, One inst`+parseDTsAsPortDecls :: [DeclToken] -> ([Identifier], [ModuleItem])+parseDTsAsPortDecls = parseDTsAsPortDecls' . dropTrailingComma+    where+        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, applyAttrs [] pieces declarations)+    where+        maybeSimpleIdents = parseDTsAsIdents pieces+        Just simpleIdents = maybeSimpleIdents+        isSimpleList = maybeSimpleIdents /= Nothing++        declarations = propagateDirections Input $+            parseDTsAsDecls ModeDefault pieces'++        pieces' = filter (not . isAttr) pieces++        propagateDirections :: Direction -> [Decl] -> [Decl]+        propagateDirections dir (decl @ (Variable _ InterfaceT{} _ _ _) : decls) =+            decl : propagateDirections dir decls+        propagateDirections lastDir (Variable currDir t x a e : decls) =+            decl : propagateDirections dir decls+            where+                decl = Variable dir t x a e+                dir = if currDir == Local then lastDir else currDir+        propagateDirections lastDir (Net currDir n s t x a e : decls) =+            decl : propagateDirections dir decls+            where+                decl = Net dir n s t x a e+                dir = if currDir == Local then lastDir else currDir+        propagateDirections dir (decl : decls) =+            decl : propagateDirections dir decls+        propagateDirections _ [] = []++        portNames :: [Decl] -> [Identifier]+        portNames = filter (not . null) . map portName+        portName :: Decl -> Identifier+        portName (Variable _ _ ident _ _) = ident+        portName (Net  _ _ _ _ ident _ _) = ident+        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 =+    if maybeElabTask /= Nothing then+        [elabTask]+    else if any isPorts tokens then+        parseDTsAsIntantiations tokens+    else+        map (MIPackageItem . Decl) $ parseDTsAsDecl tokens+    where+        Just elabTask = maybeElabTask+        maybeElabTask = asElabTask tokens++-- internal; attempt to parse an elaboration system task+asElabTask :: [DeclToken] -> Maybe ModuleItem+asElabTask tokens = do+    DTIdent _ x @ ('$' : _) <- return $ head tokens+    severity <- lookup x elabTasks+    Just $ ElabTask severity args+    where+        args =+            case tail tokens of+                [DTEnd{}] -> Args [] []+                [DTPorts _ ports, DTEnd{}] -> portsToArgs ports+                DTPorts{} : tok : _ -> parseError tok msg+                toks -> parseError (head toks) msg+        msg = "unexpected token after elaboration system task"++-- lookup table for elaboration system task severities+elabTasks :: [(String, Severity)]+elabTasks = map (\x -> (show x, x))+    [SeverityInfo, SeverityWarning, SeverityError, SeverityFatal]++-- internal; parser for module instantiations+parseDTsAsIntantiations :: [DeclToken] -> [ModuleItem]+parseDTsAsIntantiations (DTIdent _ name : DTParams _ params : tokens) =+    step tokens+    where+        step :: [DeclToken] -> [ModuleItem]+        step [] = []+        step toks = inst : step restToks+            where+                inst = Instance name params x rs p+                (x, rs, p) = parseDTsAsIntantiation instToks delimTok+                (instToks, delimTok : restToks) = break isCommaOrEnd toks+parseDTsAsIntantiations (DTIdent pos name : tokens) =+    parseDTsAsIntantiations $ DTIdent pos name : DTParams pos [] : tokens+parseDTsAsIntantiations tokens =+    parseError (head tokens)+        "expected module or interface name at beginning of instantiation list"++-- 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 comma-separated task/function port declarations+parseDTsAsTFDecls :: [DeclToken] -> [Decl]+parseDTsAsTFDecls = parseDTsAsDecls ModeDefault+++-- [PUBLIC]; used for "single" declarations, i.e., declarations appearing+-- outside of a port list+parseDTsAsDecl :: [DeclToken] -> [Decl]+parseDTsAsDecl = parseDTsAsDecls ModeSingle+++-- [PUBLIC]: parser for single block item declarations or assign or arg-less+-- subroutine call statements+parseDTsAsDeclOrStmt :: [DeclToken] -> ([Decl], [Stmt])+parseDTsAsDeclOrStmt tokens =+    if declLookahead tokens+        then (parseDTsAsDecl tokens, [])+        else ([], parseDTsAsStmt $ shiftIncOrDec 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+        (_, l1) = takeDir      l0+        (_, l2) = takeLifetime l1+        (_, l3) = takeConst    l2+        (_, l4) = takeVarOrNet l3+        (_, l5) = takeType     l4+        (_, l6) = takeRanges   l5++-- internal; parser for leading statements in a procedural block+parseDTsAsStmt :: [DeclToken] -> [Stmt]+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+portsToArgs :: [PortBinding] -> Args+portsToArgs bindings =+    Args pnArgs kwArgs+    where+        (pnBindings, kwBindings) = partition (null . fst) bindings+        pnArgs = map snd pnBindings+        kwArgs = kwBindings++-- [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 =+    if declLookahead tokens+        then Left $ parseDTsAsDecls ModeForLoop tokens+        else Right $ parseDTsAsAsgns $ shiftIncOrDec tokens++-- internal parser for basic assignment lists+parseDTsAsAsgns :: [DeclToken] -> [(LHS, Expr)]+parseDTsAsAsgns tokens =+    if not (isAsgn asgnTok) then+        parseError asgnTok "expected assignment operator"+    else if mt /= Nothing then+        unexpected "timing modifier"+    else (lhs, expr) : case head remaining of+        DTEnd{} -> []+        DTComma{} -> parseDTsAsAsgns $ tail remaining+        tok -> parseError tok "expected ',' or ';'"+    where+        (lhs, asgnTok : remaining) = takeLHS tokens+        DTAsgn _ op mt rhs = asgnTok+        expr = case op of+            AsgnOpEq -> rhs+            AsgnOpNonBlocking -> unexpected "non-blocking assignment"+            AsgnOp binop -> BinOp binop (lhsToExpr lhs) rhs++        unexpected surprise = parseError asgnTok $+            "unexpected " ++ surprise ++ " in for loop initialization"++shiftIncOrDec :: [DeclToken] -> [DeclToken]+shiftIncOrDec (tok @ (DTAsgn _ AsgnOp{} _ _) : toks) =+    before ++ tok : delim : shiftIncOrDec after+    where (before, delim : after) = break isCommaOrEnd toks+shiftIncOrDec [] = []+shiftIncOrDec toks =+    before ++ delim : shiftIncOrDec after+    where (before, delim : after) = break isCommaOrEnd toks++takeLHS :: [DeclToken] -> (LHS, [DeclToken])+takeLHS tokens = takeLHSStep (takeLHSStart tok) toks+    where tok : toks = tokens++takeLHSStart :: DeclToken -> LHS+takeLHSStart (DTLHSBase _ lhs) = lhs+takeLHSStart (DTIdent _ x) = LHSIdent x+takeLHSStart tok = parseError tok "expected primary token or type"++takeLHSStep :: LHS -> [DeclToken] -> (LHS, [DeclToken])+takeLHSStep curr (DTBit   _ e   : toks) = takeLHSStep (LHSBit   curr e  ) toks+takeLHSStep curr (DTRange _ m r : toks) = takeLHSStep (LHSRange curr m r) toks+takeLHSStep curr (DTDot   _ x   : toks) = takeLHSStep (LHSDot   curr x  ) toks+takeLHSStep lhs toks = (lhs, toks)+++type DeclBase = Identifier -> [Range] -> Expr -> Decl+type Triplet = (Identifier, [Range], Expr)++data Mode+    = ModeForLoop -- initialization always required+    | ModeSingle -- single declaration (not port list)+    | ModeDefault -- comma separated, multiple declarations+    deriving Eq++-- internal; entrypoint of the critical portion of our parser+parseDTsAsDecls :: Mode -> [DeclToken] -> [Decl]+parseDTsAsDecls mode l0 =+    if l /= Nothing && l /= Just Automatic then+        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 mode l7+    where+        initReason+            | hasDriveStrength (head l3) = "net with drive strength"+            | mode == ModeForLoop = "for loop"+            | con = "const"+            | otherwise = ""+        (dir, l1) = takeDir      l0+        (l  , l2) = takeLifetime l1+        (con, l3) = takeConst    l2+        (von, l4) = takeVarOrNet l3+        (tf , l5) = takeType     l4+        (rs , l6) = takeRanges   l5+        (tps, l7) = takeTrips    l6 initReason+        pos = tokPos $ head l0+        base = von dir t+        t = case (dir, tf rs) of+                (Output, Implicit sg _) -> IntegerVector TLogic sg rs+                (_, typ) -> typ+        decls =+            CommentDecl ("Trace: " ++ show pos) :+            map (\(x, a, e) -> base x a e) tps++hasDriveStrength :: DeclToken -> Bool+hasDriveStrength (DTNet _ _ DriveStrength{}) = True+hasDriveStrength _ = False++isImplicit :: Type -> Bool+isImplicit Implicit{} = True+isImplicit _ = False++takeTrips :: [DeclToken] -> String -> ([Triplet], [DeclToken])+takeTrips l0 initReason =+    (trip : trips, l5)+    where+        (x, l1) = takeIdent  l0+        (a, l2) = takeRanges l1+        (e, l3) = takeAsgn   l2 initReason+        l4 = takeCommaOrEnd  l3+        trip = (x, a, e)+        (trips, l5) =+            if tripLookahead l4+                then takeTrips l4 initReason+                else ([], l4)++tripLookahead :: [DeclToken] -> Bool+tripLookahead l0 =+    not (null l0) &&+    -- every triplet *must* begin with an identifier+    isIdent (head l0) &&+    -- expecting to see a comma or the ending token after the identifier and+    -- optional ranges and/or assignment+    isCommaOrEnd (head l3)+    where+        (_, l1) = takeIdent  l0+        (_, l2) = takeRanges l1+        (_, l3) = takeAsgn   l2 ""++takeDir :: [DeclToken] -> (Direction, [DeclToken])+takeDir (DTDir _ dir : rest) = (dir  , rest)+takeDir                rest  = (Local, rest)++takeLifetime :: [DeclToken] -> (Maybe Lifetime, [DeclToken])+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  b      , rest)+takeType (DTType  _ tf : DTSigning _ sg : rest) = (tf       sg          , rest)+takeType (DTType  _ tf                  : rest) = (tf       Unspecified , rest)+takeType (DTSigning _ sg                : rest) = (Implicit sg          , rest)+takeType (DTPSIdent _ ps    tn          : rest) = (PSAlias ps    tn     , rest)+takeType (DTCSIdent _ ps pm tn          : rest) = (CSAlias ps pm tn     , rest)+takeType (DTIdent pos tn                : rest) =+    if couldBeTypename+        then (Alias tn            ,                  rest)+        else (Implicit Unspecified, DTIdent pos tn : rest)+    where+        couldBeTypename =+            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 tokens =+    case head tokens of+        DTRange _ NonIndexed r -> (r         : rs, rest)+        DTBit   _ s            -> (asRange s : rs, rest)+        DTAutoDim _            ->+            case head $ tail tokens of+                DTAsgn _ AsgnOpEq Nothing (Pattern l) -> autoDim l+                DTAsgn _ AsgnOpEq Nothing (Concat  l) -> autoDim l+                _ -> ([], tokens)+        _ -> ([], tokens)+    where+        (rs, rest) = takeRanges $ tail tokens+        asRange s = (RawNum 0, BinOp Sub s (RawNum 1))+        autoDim :: [a] -> ([Range], [DeclToken])+        autoDim l =+            ((lo, hi) : rs, rest)+            where+                n = length l+                lo = RawNum 0+                hi = RawNum $ fromIntegral $ n - 1++takeAsgn :: [DeclToken] -> String -> (Expr, [DeclToken])+takeAsgn (DTAsgn pos op mt e : rest) _ =+    if op == AsgnOpNonBlocking then+        unexpected "non-blocking assignment operator"+    else if op /= AsgnOpEq then+        unexpected "binary assignment operator"+    else if mt /= Nothing then+        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"++takeCommaOrEnd :: [DeclToken] -> [DeclToken]+takeCommaOrEnd tokens =+    if isCommaOrEnd tok+        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 tokens = parseError (head tokens) "expected identifier"+++isAttr :: DeclToken -> Bool+isAttr DTAttr{} = True+isAttr _ = False++isAsgn :: DeclToken -> Bool+isAsgn DTAsgn{} = True+isAsgn _ = False++isIdent :: DeclToken -> Bool+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 (DTLifetime p _) = p+tokPos (DTAttr     p _) = p+tokPos (DTEnd      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 view
@@ -0,0 +1,941 @@+{- 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+    ) where++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 System.Directory (findFile)+import System.FilePath (dropFileName)+import qualified Data.Map.Strict as Map++import Language.SystemVerilog.Parser.Tokens (Position(..))++type Env = Map.Map String (String, [(String, Maybe String)])++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    :: [Cond] -- 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+    }++-- 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 -> IO (Either String ([(Char, Position)], Env))+preprocess includePaths env path = do+    contents <-+        if path == "-"+            then getContents+            else loadFile path+    let initialState = PP contents [] (Position path 1 1) path env [] includePaths [] [(path, env)]+    result <- runExceptT $ execStateT preprocessInput initialState+    return $ case result of+        Left msg -> Left msg+        Right finalState ->+            if not $ null $ ppCondStack finalState then+                Left $ path ++ ": unfinished conditional directives: " +++                    (show $ length $ ppCondStack finalState)+            else+                Right (output, env')+                where+                    output = reverse $ ppOutput finalState+                    env' = ppEnv finalState++-- position annotator entrypoint used for files that don't need any+-- preprocessing+annotate :: [String] -> Env -> FilePath -> IO (Either String ([(Char, Position)], Env))+annotate _ env path = do+    contents <-+        if path == "-"+            then getContents+            else loadFile path+    let positions = scanl advance (Position path 1 1) contents+    return $ Right (zip contents positions, env)++-- read in the given file+loadFile :: FilePath -> IO String+loadFile path = do+    contents <- readFile path+    return $ normalize contents+    where+        -- 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 [Cond]+getCondStack = gets ppCondStack+setCondStack :: [Cond] -> 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 :: Cond -> PPS ()+pushCondStack c = getCondStack >>= setCondStack . (c :)++-- Pop the top from the preprocessor condition stack+popCondStack :: String -> PPS Cond+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"+        '/' : '*' : _ -> removeThrough "*/"+        '`' : '"' : _ -> handleBacktickString+        '"' : _ -> handleString+        '`' : '`' : _ -> do+            if null macroStack+                then do+                    consume+                    consume+                else do+                    '`' <- takeChar+                    '`' <- takeChar+                    return ()+        '`' : _ -> handleDirective False+        _ : _ -> do+            condStack <- 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 <- 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 $ ifCond $ Map.member name env+        "ifndef" -> do+            dropSpaces+            name <- takeIdentifier+            pushCondStack $ ifCond $ Map.notMember name env+        "else" -> do+            c <- popCondStack "else"+            pushCondStack $ elseCond c+        "elsif" -> do+            dropSpaces+            name <- takeIdentifier+            c <- popCondStack "elsif"+            pushCondStack $ 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 <- 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 pattern = do+    str <- getInput+    case findIndex (isPrefixOf pattern) (tails str) of+        Nothing ->+            if pattern == "\n"+                then setInput ""+                else lexicalError $ "Reached EOF while looking for: "+                        ++ show pattern+        Just patternIdx -> do+            let chars = patternIdx + length pattern+            let (dropped, rest) = splitAt chars str+            advancePositions dropped+            setInput rest
+ src/Language/SystemVerilog/Parser/Tokens.hs view
@@ -0,0 +1,393 @@+{-# LANGUAGE PatternSynonyms #-}+{- sv2v+ - Author: Tom Hawkins <tomahawkins@gmail.com>+ - Modified by: Zachary Snow <zach@zachjs.com>+ -+ - This file is largely the same as when we forked from tomahawkins/verilog. Of+ - course, some additional token names have been added.+ -}+module Language.SystemVerilog.Parser.Tokens+    ( Token     (..)+    , TokenName (..)+    , Position  (..)+    , pattern TokenEOF+    ) where++import Text.Printf++pattern TokenEOF :: Token+pattern TokenEOF = Token Unknown "" (Position "" 0 0)++data Position+    = Position String Int Int++instance Show Position where+    show (Position f l c) = printf "%s:%d:%d" f l c++data Token = Token+    { tokenName :: TokenName+    , tokenString :: String+    , tokenPosition :: Position+    }++data TokenName+    = KW_dollar_bits+    | KW_dollar_dimensions+    | KW_dollar_unpacked_dimensions+    | KW_dollar_left+    | KW_dollar_right+    | KW_dollar_low+    | KW_dollar_high+    | KW_dollar_increment+    | KW_dollar_size+    | KW_accept_on+    | KW_alias+    | KW_always+    | KW_always_comb+    | KW_always_ff+    | KW_always_latch+    | KW_and+    | KW_assert+    | KW_assign+    | KW_assume+    | KW_automatic+    | KW_before+    | KW_begin+    | KW_bind+    | KW_bins+    | KW_binsof+    | KW_bit+    | KW_break+    | KW_buf+    | KW_bufif0+    | KW_bufif1+    | KW_byte+    | KW_case+    | KW_casex+    | KW_casez+    | KW_cell+    | KW_chandle+    | KW_checker+    | KW_class+    | KW_clocking+    | KW_cmos+    | KW_config+    | KW_const+    | KW_constraint+    | KW_context+    | KW_continue+    | KW_cover+    | KW_covergroup+    | KW_coverpoint+    | KW_cross+    | KW_deassign+    | KW_default+    | KW_defparam+    | KW_design+    | KW_disable+    | KW_dist+    | KW_do+    | KW_edge+    | KW_else+    | KW_end+    | KW_endcase+    | KW_endchecker+    | KW_endclass+    | KW_endclocking+    | KW_endconfig+    | KW_endfunction+    | KW_endgenerate+    | KW_endgroup+    | KW_endinterface+    | KW_endmodule+    | KW_endpackage+    | KW_endprimitive+    | KW_endprogram+    | KW_endproperty+    | KW_endspecify+    | KW_endsequence+    | KW_endtable+    | KW_endtask+    | KW_enum+    | KW_event+    | KW_eventually+    | KW_expect+    | KW_export+    | KW_extends+    | KW_extern+    | KW_final+    | KW_first_match+    | KW_for+    | KW_force+    | KW_foreach+    | KW_forever+    | KW_fork+    | KW_forkjoin+    | KW_function+    | KW_generate+    | KW_genvar+    | KW_global+    | KW_highz0+    | KW_highz1+    | KW_if+    | KW_iff+    | KW_ifnone+    | KW_ignore_bins+    | KW_illegal_bins+    | KW_implements+    | KW_implies+    | KW_import+    | KW_incdir+    | KW_include+    | KW_initial+    | KW_inout+    | KW_input+    | KW_inside+    | KW_instance+    | KW_int+    | KW_integer+    | KW_interconnect+    | KW_interface+    | KW_intersect+    | KW_join+    | KW_join_any+    | KW_join_none+    | KW_large+    | KW_let+    | KW_liblist+    | KW_library+    | KW_local+    | KW_localparam+    | KW_logic+    | KW_longint+    | KW_macromodule+    | KW_matches+    | KW_medium+    | KW_modport+    | KW_module+    | KW_nand+    | KW_negedge+    | KW_nettype+    | KW_new+    | KW_nexttime+    | KW_nmos+    | KW_nor+    | KW_noshowcancelled+    | KW_not+    | KW_notif0+    | KW_notif1+    | KW_null+    | KW_or+    | KW_output+    | KW_package+    | KW_packed+    | KW_parameter+    | KW_pmos+    | KW_posedge+    | KW_primitive+    | KW_priority+    | KW_program+    | KW_property+    | KW_protected+    | KW_pull0+    | KW_pull1+    | KW_pulldown+    | KW_pullup+    | KW_pulsestyle_ondetect+    | KW_pulsestyle_onevent+    | KW_pure+    | KW_rand+    | KW_randc+    | KW_randcase+    | KW_randsequence+    | KW_rcmos+    | KW_real+    | KW_realtime+    | KW_ref+    | KW_reg+    | KW_reject_on+    | KW_release+    | KW_repeat+    | KW_restrict+    | KW_return+    | KW_rnmos+    | KW_rpmos+    | KW_rtran+    | KW_rtranif0+    | KW_rtranif1+    | KW_s_always+    | KW_s_eventually+    | KW_s_nexttime+    | KW_s_until+    | KW_s_until_with+    | KW_scalared+    | KW_sequence+    | KW_shortint+    | KW_shortreal+    | KW_showcancelled+    | KW_signed+    | KW_small+    | KW_soft+    | KW_solve+    | KW_specify+    | KW_specparam+    | KW_static+    | KW_string+    | KW_strong+    | KW_strong0+    | KW_strong1+    | KW_struct+    | KW_super+    | KW_supply0+    | KW_supply1+    | KW_sync_accept_on+    | KW_sync_reject_on+    | KW_table+    | KW_tagged+    | KW_task+    | KW_this+    | KW_throughout+    | KW_time+    | KW_timeprecision+    | KW_timeunit+    | KW_tran+    | KW_tranif0+    | KW_tranif1+    | KW_tri+    | KW_tri0+    | KW_tri1+    | KW_triand+    | KW_trior+    | KW_trireg+    | KW_type+    | KW_typedef+    | KW_union+    | KW_unique+    | KW_unique0+    | KW_unsigned+    | KW_until+    | KW_until_with+    | KW_untyped+    | KW_use+    | KW_uwire+    | KW_var+    | KW_vectored+    | KW_virtual+    | KW_void+    | KW_wait+    | KW_wait_order+    | KW_wand+    | KW_weak+    | KW_weak0+    | KW_weak1+    | KW_while+    | KW_wildcard+    | KW_wire+    | KW_with+    | KW_within+    | KW_wor+    | KW_xnor+    | KW_xor+    | Id_simple+    | Id_escaped+    | Id_system+    | Lit_real+    | Lit_number+    | Lit_string+    | Lit_time+    | Sym_paren_l+    | Sym_paren_r+    | Sym_brack_l+    | Sym_brack_r+    | Sym_brace_l+    | Sym_brace_r+    | Sym_tildy+    | Sym_bang+    | Sym_at+    | Sym_pound+    | Sym_percent+    | Sym_hat+    | Sym_amp+    | Sym_bar+    | Sym_aster+    | Sym_dot+    | Sym_comma+    | Sym_colon+    | Sym_semi+    | Sym_eq+    | Sym_lt+    | Sym_gt+    | Sym_plus+    | Sym_dash+    | Sym_question+    | Sym_slash+    | Sym_dollar+    | Sym_s_quote+    | Sym_tildy_amp+    | Sym_tildy_bar+    | Sym_tildy_hat+    | Sym_hat_tildy+    | Sym_eq_eq+    | Sym_bang_eq+    | Sym_amp_amp+    | Sym_bar_bar+    | Sym_aster_aster+    | Sym_lt_eq+    | Sym_gt_eq+    | Sym_gt_gt+    | Sym_lt_lt+    | Sym_plus_plus+    | Sym_dash_dash+    | Sym_plus_eq+    | Sym_dash_eq+    | Sym_aster_eq+    | Sym_slash_eq+    | Sym_percent_eq+    | Sym_amp_eq+    | Sym_bar_eq+    | Sym_hat_eq+    | Sym_plus_colon+    | Sym_dash_colon+    | Sym_colon_colon+    | Sym_dot_aster+    | Sym_dash_gt+    | Sym_colon_eq+    | Sym_colon_slash+    | Sym_pound_pound+    | Sym_brack_l_aster+    | Sym_brack_l_eq+    | Sym_eq_gt+    | Sym_at_aster+    | Sym_paren_l_aster+    | Sym_aster_paren_r+    | Sym_aster_gt+    | Sym_eq_eq_eq+    | Sym_bang_eq_eq+    | Sym_eq_eq_question+    | Sym_bang_eq_question+    | Sym_gt_gt_gt+    | Sym_lt_lt_lt+    | Sym_lt_lt_eq+    | Sym_gt_gt_eq+    | Sym_lt_dash_gt+    | Sym_bar_dash_gt+    | Sym_bar_eq_gt+    | Sym_pound_dash_pound+    | Sym_pound_eq_pound+    | Sym_brack_l_dash_gt+    | Sym_at_at_paren_l+    | Sym_paren_l_aster_paren_r+    | Sym_dash_gt_gt+    | Sym_amp_amp_amp+    | Sym_lt_lt_lt_eq+    | Sym_gt_gt_gt_eq+    | Dir_celldefine+    | Dir_endcelldefine+    | Dir_unconnected_drive+    | Dir_nounconnected_drive+    | Dir_default_nettype+    | Dir_resetall+    | Dir_begin_keywords+    | Dir_end_keywords+    | Unknown+    deriving (Show, Eq, Ord)
+ src/sv2v.hs view
@@ -0,0 +1,98 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - conversion entry point+ -}++import System.Directory (doesFileExist)+import System.IO (hPrint, hPutStrLn, stderr, stdout)+import System.Exit (exitFailure, exitSuccess)++import Control.Monad (filterM, when, zipWithM_)+import Data.List (elemIndex, intercalate)++import Convert (convert)+import Job (readJob, Job(..), Write(..))+import Language.SystemVerilog.AST+import Language.SystemVerilog.Parser (parseFiles)++splitDefine :: String -> (String, String)+splitDefine str =+    case elemIndex '=' str of+        Nothing -> (str, "")+        Just idx -> (take idx str, drop (idx + 1) str)++isInterface :: Description -> Bool+isInterface (Part _ _ Interface _ _ _ _ ) = True+isInterface _ = False++isPackage :: Description -> Bool+isPackage Package{} = True+isPackage _ = False++isComment :: Description -> Bool+isComment (PackageItem (Decl CommentDecl{})) = True+isComment _ = False++emptyWarnings :: AST -> AST -> IO ()+emptyWarnings before after =+    if all isComment before || not (all isComment after) then+        return ()+    else if any isInterface before then+        hPutStrLn stderr $ "Warning: Source includes an interface but output is"+            ++ " empty because there is no top-level module which has no ports"+            ++ " which are interfaces."+    else if any isPackage before then+        hPutStrLn stderr $ "Warning: Source includes packages but no modules."+            ++ " Please convert packages alongside the modules that use them."+    else+        return ()++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) = splitAt (length path - length ext) 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+    badPaths <- filterM doesFileExist outPaths+    when (not $ null badPaths) $ do+        hPutStrLn stderr $ "Refusing to write output because the following"+            ++ " files would be overwritten: " ++ intercalate ", " badPaths+        exitFailure+    let results = map (++ "\n") $ map show asts+    zipWithM_ writeFile outPaths results++main :: IO ()+main = do+    job <- readJob+    -- parse the input files+    let defines = map splitDefine $ define job+    result <- parseFiles (incdir job) defines (siloed job)+        (skipPreprocessor job) (files job)+    case result of+        Left msg -> do+            hPutStrLn stderr msg+            exitFailure+        Right asts -> do+            -- convert the files if requested+            let asts' = if passThrough job+                            then asts+                            else convert (exclude job) asts+            emptyWarnings (concat asts) (concat asts')+            -- write the converted files out+            writeOutput (write job) (files job) asts'+            exitSuccess
+ sv2v.cabal view
@@ -0,0 +1,116 @@+cabal-version:   2.4+name:            sv2v+version:         0.0.8+license:         BSD-3-Clause+license-file:    LICENSE NOTICE+maintainer:      Zachary Snow <zach@zachjs.com>+author:+    Zachary Snow <zach@zachjs.com>, Tom Hawkins <tomahawkins@gmail.com>++homepage:        https://github.com/zachjs/sv2v+synopsis:        SystemVerilog to Verilog conversion+description:+    A tool for coverting SystemVerilog to Verilog. Originally forked from the+    Verilog parser found at https://github.com/tomahawkins/verilog++category:        Language, Hardware, Embedded, Development+extra-doc-files:+    README.md+    CHANGELOG.md++source-repository head+    type:     git+    location: git://github.com/zachjs/sv2v.git++executable sv2v+    main-is:            sv2v.hs+    build-tool-depends: alex:alex >=3.2.5 && <4, happy:happy >=1.20 && <2+    hs-source-dirs:     src+    other-modules:+        Language.SystemVerilog+        Language.SystemVerilog.AST+        Language.SystemVerilog.AST.Attr+        Language.SystemVerilog.AST.Decl+        Language.SystemVerilog.AST.Description+        Language.SystemVerilog.AST.Expr+        Language.SystemVerilog.AST.GenItem+        Language.SystemVerilog.AST.LHS+        Language.SystemVerilog.AST.ModuleItem+        Language.SystemVerilog.AST.Number+        Language.SystemVerilog.AST.Op+        Language.SystemVerilog.AST.ShowHelp+        Language.SystemVerilog.AST.Stmt+        Language.SystemVerilog.AST.Type+        Language.SystemVerilog.Parser+        Language.SystemVerilog.Parser.Keywords+        Language.SystemVerilog.Parser.Lex+        Language.SystemVerilog.Parser.Parse+        Language.SystemVerilog.Parser.ParseDecl+        Language.SystemVerilog.Parser.Preprocess+        Language.SystemVerilog.Parser.Tokens+        Convert+        Convert.AlwaysKW+        Convert.AsgnOp+        Convert.Assertion+        Convert.BlockDecl+        Convert.Cast+        Convert.DimensionQuery+        Convert.DuplicateGenvar+        Convert.EmptyArgs+        Convert.Enum+        Convert.ExprUtils+        Convert.ForAsgn+        Convert.Foreach+        Convert.FuncRet+        Convert.FuncRoutine+        Convert.HierConst+        Convert.ImplicitNet+        Convert.Inside+        Convert.Interface+        Convert.IntTypes+        Convert.Jump+        Convert.KWArgs+        Convert.Logic+        Convert.LogOp+        Convert.MultiplePacked+        Convert.NamedBlock+        Convert.Package+        Convert.ParamNoDefault+        Convert.ParamType+        Convert.RemoveComments+        Convert.ResolveBindings+        Convert.Scoper+        Convert.Simplify+        Convert.Stream+        Convert.StringParam+        Convert.Struct+        Convert.TFBlock+        Convert.Traverse+        Convert.Typedef+        Convert.TypeOf+        Convert.UnbasedUnsized+        Convert.Unique+        Convert.UnnamedGenBlock+        Convert.UnpackedArray+        Convert.Unsigned+        Convert.Wildcard+        Job+        Paths_sv2v++    autogen-modules:    Paths_sv2v+    default-language:   Haskell2010+    ghc-options:+        -O3 -threaded -rtsopts "-with-rtsopts=-N -A32m"+        -funbox-strict-fields -Wall++    build-depends:+        array >=0.5.4.0 && <0.6,+        base >=4.14.1.0 && <4.15,+        cmdargs >=0.10.21 && <0.11,+        containers >=0.6.2.1 && <0.7,+        directory >=1.3.6.0 && <1.4,+        filepath >=1.4.2.1 && <1.5,+        githash >=0.1.6.1 && <0.2,+        hashable >=1.3.0.0 && <1.4,+        mtl >=2.2.2 && <2.3,+        vector >=0.12.3.0 && <0.13