<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>src/ForSyDe/Backend/VHDL/Traverse/VHDLM.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>{-# LANGUAGE FlexibleContexts #-}</span>
<a name="line-2"></a><span class='hs-comment'>-----------------------------------------------------------------------------</span>
<a name="line-3"></a><span class='hs-comment'>-- |</span>
<a name="line-4"></a><span class='hs-comment'>-- Module : ForSyDe.Backend.VHDL.Traverse.VHDLM</span>
<a name="line-5"></a><span class='hs-comment'>-- Copyright : (c) SAM Group, KTH/ICT/ECS 2007-2008</span>
<a name="line-6"></a><span class='hs-comment'>-- License : BSD-style (see the file LICENSE)</span>
<a name="line-7"></a><span class='hs-comment'>-- </span>
<a name="line-8"></a><span class='hs-comment'>-- Maintainer : forsyde-dev@ict.kth.se</span>
<a name="line-9"></a><span class='hs-comment'>-- Stability : experimental</span>
<a name="line-10"></a><span class='hs-comment'>-- Portability : portable</span>
<a name="line-11"></a><span class='hs-comment'>--</span>
<a name="line-12"></a><span class='hs-comment'>-- 'VHDM' (VHDL Monad), related types and functions</span>
<a name="line-13"></a><span class='hs-comment'>--</span>
<a name="line-14"></a><span class='hs-comment'>-----------------------------------------------------------------------------</span>
<a name="line-15"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>ForSyDe</span><span class='hs-varop'>.</span><span class='hs-conid'>Backend</span><span class='hs-varop'>.</span><span class='hs-conid'>VHDL</span><span class='hs-varop'>.</span><span class='hs-conid'>Traverse</span><span class='hs-varop'>.</span><span class='hs-conid'>VHDLM</span> <span class='hs-keyword'>where</span>
<a name="line-16"></a>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>ForSyDe</span><span class='hs-varop'>.</span><span class='hs-conid'>Backend</span><span class='hs-varop'>.</span><span class='hs-conid'>VHDL</span><span class='hs-varop'>.</span><span class='hs-conid'>AST</span>
<a name="line-18"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>ForSyDe</span><span class='hs-varop'>.</span><span class='hs-conid'>Backend</span><span class='hs-varop'>.</span><span class='hs-conid'>VHDL</span><span class='hs-varop'>.</span><span class='hs-conid'>AST</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>VHDL</span>
<a name="line-19"></a><span class='hs-keyword'>import</span> <span class='hs-comment'>{-# SOURCE #-}</span> <span class='hs-conid'>ForSyDe</span><span class='hs-varop'>.</span><span class='hs-conid'>Backend</span><span class='hs-varop'>.</span><span class='hs-conid'>VHDL</span><span class='hs-varop'>.</span><span class='hs-conid'>GlobalNameTable</span> <span class='hs-layout'>(</span><span class='hs-varid'>globalNameTable</span><span class='hs-layout'>)</span>
<a name="line-20"></a>
<a name="line-21"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>ForSyDe</span><span class='hs-varop'>.</span><span class='hs-conid'>Ids</span>
<a name="line-22"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>ForSyDe</span><span class='hs-varop'>.</span><span class='hs-conid'>ForSyDeErr</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>ForSyDe</span><span class='hs-varop'>.</span><span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>SysDef</span> <span class='hs-layout'>(</span><span class='hs-conid'>SysDefVal</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-24"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>ForSyDe</span><span class='hs-varop'>.</span><span class='hs-conid'>Netlist</span><span class='hs-varop'>.</span><span class='hs-conid'>Traverse</span> <span class='hs-layout'>(</span><span class='hs-conid'>TravSEIO</span><span class='hs-layout'>)</span>
<a name="line-25"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>ForSyDe</span><span class='hs-varop'>.</span><span class='hs-conid'>Process</span><span class='hs-varop'>.</span><span class='hs-conid'>ProcType</span> <span class='hs-layout'>(</span><span class='hs-conid'>EnumAlgTy</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-26"></a>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Data</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyconModule</span><span class='hs-layout'>)</span>
<a name="line-28"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Maybe</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromJust</span><span class='hs-layout'>)</span>
<a name="line-29"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Set</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>S</span> <span class='hs-layout'>(</span><span class='hs-varid'>filter</span><span class='hs-layout'>)</span>
<a name="line-30"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Set</span> <span class='hs-layout'>(</span><span class='hs-conid'>Set</span><span class='hs-layout'>,</span> <span class='hs-varid'>union</span><span class='hs-layout'>,</span> <span class='hs-varid'>empty</span><span class='hs-layout'>,</span> <span class='hs-varid'>toList</span><span class='hs-layout'>)</span>
<a name="line-31"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span>
<a name="line-32"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Language</span><span class='hs-varop'>.</span><span class='hs-conid'>Haskell</span><span class='hs-varop'>.</span><span class='hs-conid'>TH</span> <span class='hs-layout'>(</span><span class='hs-varid'>nameBase</span><span class='hs-layout'>,</span> <span class='hs-varid'>nameModule</span><span class='hs-layout'>,</span> <span class='hs-conid'>Name</span><span class='hs-layout'>,</span> <span class='hs-conid'>Exp</span><span class='hs-layout'>)</span>
<a name="line-33"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Typeable</span> <span class='hs-layout'>(</span><span class='hs-conid'>TypeRep</span><span class='hs-layout'>)</span>
<a name="line-34"></a>
<a name="line-35"></a><span class='hs-comment'>-------------------------------------</span>
<a name="line-36"></a><span class='hs-comment'>-- How does the VHDL Backend work? --</span>
<a name="line-37"></a><span class='hs-comment'>-------------------------------------</span>
<a name="line-38"></a><span class='hs-comment'>-- FIXME: This documentation is a bit outated</span>
<a name="line-39"></a><span class='hs-comment'>-- All the types used in the the System Defintion are translated to VHDL</span>
<a name="line-40"></a><span class='hs-comment'>-- put into Package, the into a Design File and written to disk.</span>
<a name="line-41"></a><span class='hs-comment'>--</span>
<a name="line-42"></a><span class='hs-comment'>-- The System Definition itself is translated to another VHDL Design File and </span>
<a name="line-43"></a><span class='hs-comment'>-- written to disk.</span>
<a name="line-44"></a><span class='hs-comment'>--</span>
<a name="line-45"></a><span class='hs-comment'>-- This Design File will contain only two library units;</span>
<a name="line-46"></a><span class='hs-comment'>-- an Entity Declaration and an Architecture.</span>
<a name="line-47"></a><span class='hs-comment'>-- 1) The Entity Declaration can be obtained from the SysDef directly (without</span>
<a name="line-48"></a><span class='hs-comment'>-- traversing the netlist)</span>
<a name="line-49"></a><span class='hs-comment'>-- 2) The Architecture (or more specifically, its declarations and</span>
<a name="line-50"></a><span class='hs-comment'>-- the statements) is obtained from the netlist by traversing it. </span>
<a name="line-51"></a><span class='hs-comment'>--</span>
<a name="line-52"></a><span class='hs-comment'>-- The state of the traversal is composed by </span>
<a name="line-53"></a><span class='hs-comment'>-- * list of type defintions translated during the traversal</span>
<a name="line-54"></a><span class='hs-comment'>-- * table of equivalence between Haskell types and the VHDL identifier</span>
<a name="line-55"></a><span class='hs-comment'>-- of its translated type (used to avoid translating the same type</span>
<a name="line-56"></a><span class='hs-comment'>-- multiple times)</span>
<a name="line-57"></a><span class='hs-comment'>-- * the list of declarations of the architecture</span>
<a name="line-58"></a><span class='hs-comment'>-- * the list of statements of the architecture </span>
<a name="line-59"></a><span class='hs-comment'>-- * a table of System Definition references, used to keep track of the</span>
<a name="line-60"></a><span class='hs-comment'>-- system definitions (corresponding to one or more instances in the </span>
<a name="line-61"></a><span class='hs-comment'>-- netlist) whose code was already generated.</span>
<a name="line-62"></a><span class='hs-comment'>--</span>
<a name="line-63"></a><span class='hs-comment'>-- For each process (netlist node) found during the traversal:</span>
<a name="line-64"></a><span class='hs-comment'>-- * A signal declaration is generated for each output and added to</span>
<a name="line-65"></a><span class='hs-comment'>-- the list of architecture declarations.</span>
<a name="line-66"></a><span class='hs-comment'>-- * A VHDL block including the translation of the process is generated</span>
<a name="line-67"></a><span class='hs-comment'>-- and added to the list of architecture statements.</span>
<a name="line-68"></a><span class='hs-comment'>--</span>
<a name="line-69"></a><span class='hs-comment'>-- In the special case of finding a System Instance</span>
<a name="line-70"></a><span class='hs-comment'>-- 1) a port map statement is generated and added to the list of </span>
<a name="line-71"></a><span class='hs-comment'>-- architecture statements.</span>
<a name="line-72"></a><span class='hs-comment'>-- 2) the System Definition table is used to check if the Design File of</span>
<a name="line-73"></a><span class='hs-comment'>-- the System Definition associated with the instance was written to </span>
<a name="line-74"></a><span class='hs-comment'>-- disk.</span>
<a name="line-75"></a><span class='hs-comment'>-- 3) if the the associated System Definition wasn't in the table</span>
<a name="line-76"></a><span class='hs-comment'>-- 1) generate and write to disk the corresponding Design File</span>
<a name="line-77"></a><span class='hs-comment'>-- 2) add the System Definition to the table</span>
<a name="line-78"></a>
<a name="line-79"></a><span class='hs-comment'>-------------</span>
<a name="line-80"></a><span class='hs-comment'>-- FunTransST</span>
<a name="line-81"></a><span class='hs-comment'>-------------</span>
<a name="line-82"></a>
<a name="line-83"></a><a name="FunTransST"></a><span class='hs-comment'>-- | Function translation state. State used during the translation of</span>
<a name="line-84"></a><a name="FunTransST"></a><span class='hs-comment'>-- ProcFuns to VHDL.</span>
<a name="line-85"></a><a name="FunTransST"></a><span class='hs-comment'>--</span>
<a name="line-86"></a><a name="FunTransST"></a><span class='hs-comment'>-- This type provides the number of fresh names already generated,</span>
<a name="line-87"></a><a name="FunTransST"></a><span class='hs-comment'>-- a translation table from Template Haskell Names to VHDL Expressions </span>
<a name="line-88"></a><a name="FunTransST"></a><span class='hs-comment'>-- (a symbol table) and auxiliary VHDL declarations.</span>
<a name="line-89"></a><a name="FunTransST"></a><span class='hs-comment'>-- </span>
<a name="line-90"></a><a name="FunTransST"></a><span class='hs-comment'>-- It only makes sense in a process-function context.</span>
<a name="line-91"></a><a name="FunTransST"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>FunTransST</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>FunTransST</span>
<a name="line-92"></a> <span class='hs-layout'>{</span><span class='hs-varid'>freshNameCount</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span><span class='hs-layout'>,</span>
<a name="line-93"></a> <span class='hs-varid'>nameTable</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Name</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-conid'>Int</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>VHDL</span><span class='hs-varop'>.</span><span class='hs-conid'>Expr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDL</span><span class='hs-varop'>.</span><span class='hs-conid'>Expr</span> <span class='hs-layout'>)</span> <span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span>
<a name="line-94"></a> <span class='hs-comment'>-- The table entries work as follows:</span>
<a name="line-95"></a> <span class='hs-comment'>-- (Template Haskell Name (table key), </span>
<a name="line-96"></a> <span class='hs-comment'>-- (Arity, function with which to construct the translated VHDL expression </span>
<a name="line-97"></a> <span class='hs-comment'>-- given itsarguments already translated to VHDL -- )</span>
<a name="line-98"></a> <span class='hs-comment'>-- )</span>
<a name="line-99"></a> <span class='hs-varid'>auxDecs</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>SubProgDecItem</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>}</span>
<a name="line-100"></a> <span class='hs-comment'>-- Auxiliary VHDL declarations generated during the translation of </span>
<a name="line-101"></a> <span class='hs-comment'>-- the ProcFun to be put in the declaration block of the translated VHDL</span>
<a name="line-102"></a> <span class='hs-comment'>-- function.</span>
<a name="line-103"></a>
<a name="line-104"></a><a name="initFunTransST"></a><span class='hs-comment'>-- | Initial translation state for functions</span>
<a name="line-105"></a><span class='hs-definition'>initFunTransST</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FunTransST</span>
<a name="line-106"></a><span class='hs-definition'>initFunTransST</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>FunTransST</span> <span class='hs-num'>0</span> <span class='hs-varid'>globalNameTable</span> <span class='hs-conid'>[]</span>
<a name="line-107"></a>
<a name="line-108"></a><span class='hs-comment'>-----------</span>
<a name="line-109"></a><span class='hs-comment'>-- VHDLM --</span>
<a name="line-110"></a><span class='hs-comment'>-----------</span>
<a name="line-111"></a>
<a name="line-112"></a><a name="VHDLM"></a><span class='hs-comment'>-- | VHDL backend monad</span>
<a name="line-113"></a><a name="VHDLM"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>VHDLM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>TravSEIO</span> <span class='hs-conid'>VHDLTravST</span> <span class='hs-conid'>ContextErr</span> <span class='hs-varid'>a</span>
<a name="line-114"></a>
<a name="line-115"></a><span class='hs-comment'>----------------</span>
<a name="line-116"></a><span class='hs-comment'>-- VHDLTravST --</span>
<a name="line-117"></a><span class='hs-comment'>----------------</span>
<a name="line-118"></a>
<a name="line-119"></a><a name="VHDLTravST"></a><span class='hs-comment'>-- | VHDL traversing State. (see 'ForSyDe.Netlist.Traverse.traverseSIO')</span>
<a name="line-120"></a><a name="VHDLTravST"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>VHDLTravST</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>VHDLTravST</span>
<a name="line-121"></a> <span class='hs-layout'>{</span><span class='hs-varid'>local</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LocalVHDLST</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Local State (related to the system currently </span>
<a name="line-122"></a> <span class='hs-comment'>-- compiled)</span>
<a name="line-123"></a> <span class='hs-varid'>global</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GlobalVHDLST</span><span class='hs-layout'>}</span> <span class='hs-comment'>-- Global state (related to all systems being </span>
<a name="line-124"></a> <span class='hs-comment'>-- recursively compiled) </span>
<a name="line-125"></a>
<a name="line-126"></a><a name="LocalVHDLST"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>LocalVHDLST</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>LocalVHDLST</span>
<a name="line-127"></a> <span class='hs-layout'>{</span><span class='hs-varid'>currSysDef</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SysDefVal</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- System definition which is currently </span>
<a name="line-128"></a> <span class='hs-comment'>-- being compiled</span>
<a name="line-129"></a> <span class='hs-varid'>context</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Context</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Error Context</span>
<a name="line-130"></a> <span class='hs-varid'>funTransST</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FunTransST</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Translation state for functions (ProcFuns)</span>
<a name="line-131"></a> <span class='hs-comment'>-- It only makes sense</span>
<a name="line-132"></a> <span class='hs-comment'>-- in a process-function context </span>
<a name="line-133"></a> <span class='hs-varid'>localRes</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LocalTravResult</span><span class='hs-layout'>}</span> <span class='hs-comment'>-- Result accumulated during the </span>
<a name="line-134"></a> <span class='hs-comment'>-- traversal of current System Definition </span>
<a name="line-135"></a> <span class='hs-comment'>-- netlist</span>
<a name="line-136"></a>
<a name="line-137"></a>
<a name="line-138"></a>
<a name="line-139"></a>
<a name="line-140"></a><a name="initLocalST"></a><span class='hs-comment'>-- | initialize the local state</span>
<a name="line-141"></a><span class='hs-definition'>initLocalST</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SysDefVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>LocalVHDLST</span>
<a name="line-142"></a><span class='hs-definition'>initLocalST</span> <span class='hs-varid'>sysDefVal</span> <span class='hs-keyglyph'>=</span>
<a name="line-143"></a> <span class='hs-conid'>LocalVHDLST</span> <span class='hs-varid'>sysDefVal</span> <span class='hs-layout'>(</span><span class='hs-conid'>SysDefC</span> <span class='hs-layout'>(</span><span class='hs-varid'>sid</span> <span class='hs-varid'>sysDefVal</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>loc</span> <span class='hs-varid'>sysDefVal</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-144"></a> <span class='hs-varid'>initFunTransST</span> <span class='hs-varid'>emptyLocalTravResult</span>
<a name="line-145"></a>
<a name="line-146"></a><a name="withLocalST"></a><span class='hs-comment'>-- | Execute certain operation with a concrete local state.</span>
<a name="line-147"></a><span class='hs-comment'>-- The initial local state is restored after the operation is executed</span>
<a name="line-148"></a><span class='hs-definition'>withLocalST</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LocalVHDLST</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-varid'>a</span>
<a name="line-149"></a><span class='hs-definition'>withLocalST</span> <span class='hs-varid'>l'</span> <span class='hs-varid'>action</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-150"></a> <span class='hs-comment'>-- get the initial local state</span>
<a name="line-151"></a> <span class='hs-varid'>st</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-152"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>local</span> <span class='hs-varid'>st</span>
<a name="line-153"></a> <span class='hs-comment'>-- set the modified state</span>
<a name="line-154"></a> <span class='hs-varid'>put</span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>l'</span><span class='hs-layout'>}</span>
<a name="line-155"></a> <span class='hs-comment'>-- execute the action</span>
<a name="line-156"></a> <span class='hs-varid'>res</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>action</span>
<a name="line-157"></a> <span class='hs-comment'>-- restore the initial local state</span>
<a name="line-158"></a> <span class='hs-varid'>st'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-159"></a> <span class='hs-varid'>put</span> <span class='hs-varid'>st'</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>l</span><span class='hs-layout'>}</span>
<a name="line-160"></a> <span class='hs-comment'>-- return the result</span>
<a name="line-161"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>res</span>
<a name="line-162"></a>
<a name="line-163"></a><a name="withInitFunTransST"></a><span class='hs-comment'>-- | Execute certain operation with the initial function translation state</span>
<a name="line-164"></a><span class='hs-comment'>-- The initial state is restored after the operation is executed</span>
<a name="line-165"></a><span class='hs-definition'>withInitFunTransST</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VHDLM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-varid'>a</span>
<a name="line-166"></a><span class='hs-definition'>withInitFunTransST</span> <span class='hs-varid'>action</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-167"></a> <span class='hs-comment'>-- get the initial name space</span>
<a name="line-168"></a> <span class='hs-varid'>st</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-169"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>local</span> <span class='hs-varid'>st</span>
<a name="line-170"></a> <span class='hs-varid'>ns</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>funTransST</span> <span class='hs-varid'>l</span>
<a name="line-171"></a> <span class='hs-comment'>-- set the empty name space</span>
<a name="line-172"></a> <span class='hs-varid'>put</span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>l</span><span class='hs-layout'>{</span><span class='hs-varid'>funTransST</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>initFunTransST</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-173"></a> <span class='hs-comment'>-- execute the action</span>
<a name="line-174"></a> <span class='hs-varid'>res</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>action</span>
<a name="line-175"></a> <span class='hs-comment'>-- restore the initial name table</span>
<a name="line-176"></a> <span class='hs-varid'>st'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-177"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>l'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>local</span> <span class='hs-varid'>st'</span>
<a name="line-178"></a> <span class='hs-varid'>put</span> <span class='hs-varid'>st'</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>l'</span><span class='hs-layout'>{</span><span class='hs-varid'>funTransST</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>ns</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-179"></a> <span class='hs-comment'>-- return the result</span>
<a name="line-180"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>res</span>
<a name="line-181"></a>
<a name="line-182"></a>
<a name="line-183"></a>
<a name="line-184"></a><a name="GlobalVHDLST"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>GlobalVHDLST</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>GlobalVHDLST</span>
<a name="line-185"></a> <span class='hs-layout'>{</span><span class='hs-varid'>globalSysDef</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SysDefVal</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- global system definition </span>
<a name="line-186"></a> <span class='hs-comment'>-- (the first-level system being compiled)</span>
<a name="line-187"></a> <span class='hs-varid'>ops</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VHDLOps</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Compilation options</span>
<a name="line-188"></a> <span class='hs-varid'>globalRes</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GlobalTravResult</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Result accumulated during the </span>
<a name="line-189"></a> <span class='hs-comment'>-- whole compilation</span>
<a name="line-190"></a> <span class='hs-varid'>enumTypes</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Set</span> <span class='hs-conid'>EnumAlgTy</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Set of the enumerated</span>
<a name="line-191"></a> <span class='hs-comment'>-- algebraic types accumulated</span>
<a name="line-192"></a> <span class='hs-comment'>-- by all ProcFuns and ProcVals</span>
<a name="line-193"></a> <span class='hs-comment'>-- in the system </span>
<a name="line-194"></a> <span class='hs-varid'>typeTable</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>TypeRep</span><span class='hs-layout'>,</span> <span class='hs-conid'>TypeMark</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Type translation table</span>
<a name="line-195"></a> <span class='hs-varid'>transUnconsFSVecs</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TypeRep</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>}</span> <span class='hs-comment'>-- Unconstrained FSVecs previously translated.</span>
<a name="line-196"></a> <span class='hs-comment'>-- Each unconstrained FSVec is represented by </span>
<a name="line-197"></a> <span class='hs-comment'>-- the 'TypeRep' of its elements</span>
<a name="line-198"></a>
<a name="line-199"></a>
<a name="line-200"></a><a name="initGlobalVHDLST"></a><span class='hs-comment'>-- | Empty initial traversing state</span>
<a name="line-201"></a><span class='hs-definition'>initGlobalVHDLST</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SysDefVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>GlobalVHDLST</span>
<a name="line-202"></a><span class='hs-definition'>initGlobalVHDLST</span> <span class='hs-varid'>sysDefVal</span> <span class='hs-keyglyph'>=</span>
<a name="line-203"></a> <span class='hs-conid'>GlobalVHDLST</span> <span class='hs-varid'>sysDefVal</span> <span class='hs-varid'>defaultVHDLOps</span> <span class='hs-varid'>emptyGlobalTravResult</span> <span class='hs-varid'>empty</span> <span class='hs-conid'>[]</span> <span class='hs-conid'>[]</span>
<a name="line-204"></a>
<a name="line-205"></a><a name="initVHDLTravST"></a><span class='hs-comment'>-- | Empty initial traversing state </span>
<a name="line-206"></a><span class='hs-definition'>initVHDLTravST</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SysDefVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLTravST</span>
<a name="line-207"></a><span class='hs-definition'>initVHDLTravST</span> <span class='hs-varid'>sysDefVal</span> <span class='hs-keyglyph'>=</span>
<a name="line-208"></a> <span class='hs-conid'>VHDLTravST</span> <span class='hs-layout'>(</span><span class='hs-varid'>initLocalST</span> <span class='hs-varid'>sysDefVal</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>initGlobalVHDLST</span> <span class='hs-varid'>sysDefVal</span><span class='hs-layout'>)</span>
<a name="line-209"></a>
<a name="line-210"></a><span class='hs-comment'>-------------</span>
<a name="line-211"></a><span class='hs-comment'>-- TravResult</span>
<a name="line-212"></a><span class='hs-comment'>-------------</span>
<a name="line-213"></a>
<a name="line-214"></a><a name="LocalTravResult"></a><span class='hs-comment'>-- | Local result accumulated during the traversal of a netlist</span>
<a name="line-215"></a><a name="LocalTravResult"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>LocalTravResult</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>LocalTravResult</span>
<a name="line-216"></a> <span class='hs-layout'>{</span><span class='hs-varid'>archDecs</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>BlockDecItem</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- generated architecture declarations </span>
<a name="line-217"></a> <span class='hs-varid'>archSms</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>ConcSm</span><span class='hs-keyglyph'>]</span> <span class='hs-layout'>}</span> <span class='hs-comment'>-- generated architecture statements</span>
<a name="line-218"></a>
<a name="line-219"></a>
<a name="line-220"></a>
<a name="line-221"></a><a name="emptyLocalTravResult"></a><span class='hs-comment'>-- | empty local VHDL compilation result</span>
<a name="line-222"></a><span class='hs-definition'>emptyLocalTravResult</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>LocalTravResult</span>
<a name="line-223"></a><span class='hs-definition'>emptyLocalTravResult</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>LocalTravResult</span> <span class='hs-conid'>[]</span> <span class='hs-conid'>[]</span>
<a name="line-224"></a>
<a name="line-225"></a>
<a name="line-226"></a><a name="GlobalTravResult"></a><span class='hs-comment'>-- | Global Results accumulated throughout the whole compilation</span>
<a name="line-227"></a><a name="GlobalTravResult"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>GlobalTravResult</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>GlobalTravResult</span>
<a name="line-228"></a> <span class='hs-layout'>{</span><span class='hs-varid'>typeDecs</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TypeDec</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Types translated during the traversal</span>
<a name="line-229"></a> <span class='hs-varid'>subtypeDecs</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>SubtypeDec</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Subtypes translated during the traversal</span>
<a name="line-230"></a> <span class='hs-varid'>subProgBodies</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>SubProgBody</span><span class='hs-keyglyph'>]</span> <span class='hs-layout'>}</span> <span class='hs-comment'>-- Functions or procedures generated during</span>
<a name="line-231"></a> <span class='hs-comment'>-- the traversal</span>
<a name="line-232"></a>
<a name="line-233"></a>
<a name="line-234"></a>
<a name="line-235"></a><a name="emptyGlobalTravResult"></a><span class='hs-comment'>-- | empty global VHDL compilation result</span>
<a name="line-236"></a><span class='hs-definition'>emptyGlobalTravResult</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GlobalTravResult</span>
<a name="line-237"></a><span class='hs-definition'>emptyGlobalTravResult</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>GlobalTravResult</span> <span class='hs-conid'>[]</span> <span class='hs-conid'>[]</span> <span class='hs-conid'>[]</span>
<a name="line-238"></a>
<a name="line-239"></a>
<a name="line-240"></a><span class='hs-comment'>----------</span>
<a name="line-241"></a><span class='hs-comment'>-- VHDLOps</span>
<a name="line-242"></a><span class='hs-comment'>----------</span>
<a name="line-243"></a>
<a name="line-244"></a><a name="VHDLOps"></a><span class='hs-comment'>-- | VHDL Compilation options</span>
<a name="line-245"></a><a name="VHDLOps"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>VHDLOps</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>VHDLOps</span> <span class='hs-layout'>{</span><span class='hs-varid'>debugVHDL</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VHDLDebugLevel</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- ^ Debug mode</span>
<a name="line-246"></a> <span class='hs-varid'>recursivityVHDL</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VHDLRecursivity</span><span class='hs-layout'>,</span>
<a name="line-247"></a> <span class='hs-varid'>execQuartus</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>QuartusOps</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- ^ Analyze the generated code with Quartus</span>
<a name="line-248"></a> <span class='hs-varid'>compileModelsim</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- ^ Compile the generated code with Modelsim</span>
<a name="line-249"></a> <span class='hs-layout'>}</span>
<a name="line-250"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eq</span><span class='hs-layout'>,</span> <span class='hs-conid'>Show</span><span class='hs-layout'>)</span>
<a name="line-251"></a>
<a name="line-252"></a><a name="VHDLDebugLevel"></a><span class='hs-comment'>-- | Debug level</span>
<a name="line-253"></a><a name="VHDLDebugLevel"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>VHDLDebugLevel</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>VHDLNormal</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>VHDLVerbose</span>
<a name="line-254"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eq</span><span class='hs-layout'>,</span> <span class='hs-conid'>Ord</span><span class='hs-layout'>,</span> <span class='hs-conid'>Show</span><span class='hs-layout'>)</span>
<a name="line-255"></a>
<a name="line-256"></a><a name="debugMsg"></a><span class='hs-comment'>-- | Print a message to stdout if in verbose mode</span>
<a name="line-257"></a><span class='hs-definition'>debugMsg</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>()</span>
<a name="line-258"></a><span class='hs-definition'>debugMsg</span> <span class='hs-varid'>str</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-259"></a> <span class='hs-varid'>debugLevel</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>gets</span> <span class='hs-layout'>(</span><span class='hs-varid'>debugVHDL</span><span class='hs-varop'>.</span><span class='hs-varid'>ops</span><span class='hs-varop'>.</span><span class='hs-varid'>global</span><span class='hs-layout'>)</span>
<a name="line-260"></a> <span class='hs-varid'>when</span> <span class='hs-layout'>(</span><span class='hs-varid'>debugLevel</span> <span class='hs-varop'>></span> <span class='hs-conid'>VHDLNormal</span><span class='hs-layout'>)</span>
<a name="line-261"></a> <span class='hs-layout'>(</span><span class='hs-varid'>liftIO</span> <span class='hs-varop'>$</span> <span class='hs-varid'>putStr</span> <span class='hs-layout'>(</span><span class='hs-str'>"DEBUG: "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>str</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-262"></a>
<a name="line-263"></a><a name="VHDLRecursivity"></a><span class='hs-comment'>-- | Recursivity, should the parent systems of system instances be compiled as </span>
<a name="line-264"></a><a name="VHDLRecursivity"></a><span class='hs-comment'>-- well?</span>
<a name="line-265"></a><a name="VHDLRecursivity"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>VHDLRecursivity</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>VHDLRecursive</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>VHDLNonRecursive</span>
<a name="line-266"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eq</span><span class='hs-layout'>,</span> <span class='hs-conid'>Show</span><span class='hs-layout'>)</span>
<a name="line-267"></a>
<a name="line-268"></a><span class='hs-comment'>-------------</span>
<a name="line-269"></a><span class='hs-comment'>-- QuartusOps</span>
<a name="line-270"></a><span class='hs-comment'>-------------</span>
<a name="line-271"></a>
<a name="line-272"></a><span class='hs-comment'>-- Quartus options</span>
<a name="line-273"></a>
<a name="line-274"></a><a name="QuartusOps"></a><span class='hs-comment'>-- | Options passed to Quartus II by the VHDL Backend. Most of them are optional</span>
<a name="line-275"></a><a name="QuartusOps"></a><span class='hs-comment'>-- and Quartus will use a default value.</span>
<a name="line-276"></a><a name="QuartusOps"></a><span class='hs-comment'>--</span>
<a name="line-277"></a><a name="QuartusOps"></a><span class='hs-comment'>-- It contains:</span>
<a name="line-278"></a><a name="QuartusOps"></a><span class='hs-comment'>-- </span>
<a name="line-279"></a><a name="QuartusOps"></a><span class='hs-comment'>-- * What action to perform</span>
<a name="line-280"></a><a name="QuartusOps"></a><span class='hs-comment'>--</span>
<a name="line-281"></a><a name="QuartusOps"></a><span class='hs-comment'>-- * Optinally, the minimum acceptable clock frequency (fMax) expressed in MHz</span>
<a name="line-282"></a><a name="QuartusOps"></a><span class='hs-comment'>--</span>
<a name="line-283"></a><a name="QuartusOps"></a><span class='hs-comment'>-- * FPGA family and specific device model (both are independently optional).</span>
<a name="line-284"></a><a name="QuartusOps"></a><span class='hs-comment'>--</span>
<a name="line-285"></a><a name="QuartusOps"></a><span class='hs-comment'>-- * Pin assignments, in the form (VHDL Pin, FPGA Pin). Note</span>
<a name="line-286"></a><a name="QuartusOps"></a><span class='hs-comment'>-- that Quartus will automatically split composite VHDL ports </span>
<a name="line-287"></a><a name="QuartusOps"></a><span class='hs-comment'>--- (arrays and records) in various pins with different logical names. </span>
<a name="line-288"></a><a name="QuartusOps"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>QuartusOps</span> <span class='hs-keyglyph'>=</span>
<a name="line-289"></a> <span class='hs-conid'>QuartusOps</span> <span class='hs-layout'>{</span><span class='hs-varid'>action</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>QuartusAction</span><span class='hs-layout'>,</span>
<a name="line-290"></a> <span class='hs-varid'>fMax</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Int</span><span class='hs-layout'>,</span>
<a name="line-291"></a> <span class='hs-varid'>fpgaFamiliyDevice</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Maybe</span> <span class='hs-layout'>(</span><span class='hs-conid'>String</span><span class='hs-layout'>,</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>String</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-292"></a> <span class='hs-varid'>pinAssigs</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>String</span><span class='hs-layout'>,</span><span class='hs-conid'>String</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-layout'>}</span>
<a name="line-293"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eq</span><span class='hs-layout'>,</span> <span class='hs-conid'>Show</span><span class='hs-layout'>)</span>
<a name="line-294"></a>
<a name="line-295"></a><a name="QuartusAction"></a><span class='hs-comment'>-- | Action to perform by Quartus</span>
<a name="line-296"></a><a name="QuartusAction"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>QuartusAction</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AnalysisAndElaboration</span> <span class='hs-comment'>-- ^ Analysis and eleboration flow</span>
<a name="line-297"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>AnalysisAndSynthesis</span> <span class='hs-comment'>-- ^ Call map executable </span>
<a name="line-298"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>FullCompilation</span> <span class='hs-comment'>-- ^ Compile flow</span>
<a name="line-299"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eq</span><span class='hs-layout'>,</span> <span class='hs-conid'>Show</span><span class='hs-layout'>)</span>
<a name="line-300"></a>
<a name="line-301"></a><a name="checkSynthesisQuartus"></a><span class='hs-comment'>-- | Options to check if the model is synthesizable, all options except</span>
<a name="line-302"></a><span class='hs-comment'>-- the action to take are set to default. </span>
<a name="line-303"></a><span class='hs-definition'>checkSynthesisQuartus</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>QuartusOps</span>
<a name="line-304"></a><span class='hs-definition'>checkSynthesisQuartus</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>QuartusOps</span> <span class='hs-conid'>AnalysisAndSynthesis</span> <span class='hs-conid'>Nothing</span> <span class='hs-conid'>Nothing</span> <span class='hs-conid'>[]</span>
<a name="line-305"></a>
<a name="line-306"></a>
<a name="line-307"></a><a name="isRecursiveSet"></a><span class='hs-comment'>-- | Check if we are in recursive mode</span>
<a name="line-308"></a><span class='hs-definition'>isRecursiveSet</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>Bool</span>
<a name="line-309"></a><span class='hs-definition'>isRecursiveSet</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-310"></a> <span class='hs-varid'>recOp</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>gets</span> <span class='hs-layout'>(</span><span class='hs-varid'>recursivityVHDL</span><span class='hs-varop'>.</span><span class='hs-varid'>ops</span><span class='hs-varop'>.</span><span class='hs-varid'>global</span><span class='hs-layout'>)</span>
<a name="line-311"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>recOp</span> <span class='hs-varop'>==</span> <span class='hs-conid'>VHDLRecursive</span>
<a name="line-312"></a>
<a name="line-313"></a><a name="isCompileModelsimSet"></a><span class='hs-comment'>-- | Check if we want to compile the results with modelsim</span>
<a name="line-314"></a><span class='hs-definition'>isCompileModelsimSet</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>Bool</span>
<a name="line-315"></a><span class='hs-definition'>isCompileModelsimSet</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>gets</span> <span class='hs-layout'>(</span><span class='hs-varid'>compileModelsim</span><span class='hs-varop'>.</span><span class='hs-varid'>ops</span><span class='hs-varop'>.</span><span class='hs-varid'>global</span><span class='hs-layout'>)</span>
<a name="line-316"></a>
<a name="line-317"></a><a name="defaultVHDLOps"></a><span class='hs-comment'>-- | Default traversing options</span>
<a name="line-318"></a><span class='hs-definition'>defaultVHDLOps</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VHDLOps</span>
<a name="line-319"></a><span class='hs-definition'>defaultVHDLOps</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>VHDLOps</span> <span class='hs-conid'>VHDLNormal</span> <span class='hs-conid'>VHDLRecursive</span> <span class='hs-conid'>Nothing</span> <span class='hs-conid'>False</span>
<a name="line-320"></a>
<a name="line-321"></a>
<a name="line-322"></a><a name="setVHDLOps"></a><span class='hs-comment'>-- | Set VHDL options inside the VHDL monad</span>
<a name="line-323"></a><span class='hs-definition'>setVHDLOps</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VHDLOps</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>()</span>
<a name="line-324"></a><span class='hs-definition'>setVHDLOps</span> <span class='hs-varid'>options</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>modify</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>st</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>global</span><span class='hs-keyglyph'>=</span><span class='hs-layout'>(</span><span class='hs-varid'>global</span> <span class='hs-varid'>st</span><span class='hs-layout'>)</span><span class='hs-layout'>{</span><span class='hs-varid'>ops</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>options</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-325"></a>
<a name="line-326"></a>
<a name="line-327"></a><span class='hs-comment'>-------------------------------------</span>
<a name="line-328"></a><span class='hs-comment'>-- Useful functions in the VHDL Monad</span>
<a name="line-329"></a><span class='hs-comment'>-------------------------------------</span>
<a name="line-330"></a>
<a name="line-331"></a>
<a name="line-332"></a><a name="addSigDec"></a><span class='hs-comment'>-- | Add a signal declaration to the 'LocalTravResult' in the State</span>
<a name="line-333"></a><span class='hs-definition'>addSigDec</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SigDec</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>()</span>
<a name="line-334"></a><span class='hs-definition'>addSigDec</span> <span class='hs-varid'>dec</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>modify</span> <span class='hs-varid'>addFun</span>
<a name="line-335"></a> <span class='hs-comment'>-- FIXME: use a queue for the declarations</span>
<a name="line-336"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>addFun</span> <span class='hs-varid'>st</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>l</span><span class='hs-layout'>{</span><span class='hs-varid'>localRes</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>r</span><span class='hs-layout'>{</span><span class='hs-varid'>archDecs</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>ads</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>BDISD</span> <span class='hs-varid'>dec</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-337"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>local</span> <span class='hs-varid'>st</span>
<a name="line-338"></a> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>localRes</span> <span class='hs-varid'>l</span>
<a name="line-339"></a> <span class='hs-varid'>ads</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>archDecs</span> <span class='hs-varid'>r</span>
<a name="line-340"></a>
<a name="line-341"></a>
<a name="line-342"></a><a name="addStm"></a><span class='hs-comment'>-- | Add a statement to the 'LocalTravResult' in the State</span>
<a name="line-343"></a><span class='hs-definition'>addStm</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ConcSm</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>()</span>
<a name="line-344"></a><span class='hs-definition'>addStm</span> <span class='hs-varid'>sm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>modify</span> <span class='hs-varid'>addFun</span>
<a name="line-345"></a> <span class='hs-comment'>-- FIXME: use a queue for the statements</span>
<a name="line-346"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>addFun</span> <span class='hs-varid'>st</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>l</span><span class='hs-layout'>{</span><span class='hs-varid'>localRes</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>r</span><span class='hs-layout'>{</span><span class='hs-varid'>archSms</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>aSms</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>sm</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-347"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>local</span> <span class='hs-varid'>st</span>
<a name="line-348"></a> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>localRes</span> <span class='hs-varid'>l</span>
<a name="line-349"></a> <span class='hs-varid'>aSms</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>archSms</span> <span class='hs-varid'>r</span>
<a name="line-350"></a>
<a name="line-351"></a>
<a name="line-352"></a><a name="lookupCustomType"></a><span class='hs-comment'>-- | Find a previously translated custom type</span>
<a name="line-353"></a><span class='hs-definition'>lookupCustomType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TypeRep</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>SimpleName</span><span class='hs-layout'>)</span>
<a name="line-354"></a><span class='hs-definition'>lookupCustomType</span> <span class='hs-varid'>rep</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-355"></a> <span class='hs-varid'>transTable</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>gets</span> <span class='hs-layout'>(</span><span class='hs-varid'>typeTable</span><span class='hs-varop'>.</span><span class='hs-varid'>global</span><span class='hs-layout'>)</span>
<a name="line-356"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>lookup</span> <span class='hs-varid'>rep</span> <span class='hs-varid'>transTable</span>
<a name="line-357"></a>
<a name="line-358"></a>
<a name="line-359"></a><a name="addEnumTypes"></a><span class='hs-comment'>-- | Add enumerated types to the global state</span>
<a name="line-360"></a><span class='hs-definition'>addEnumTypes</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Set</span> <span class='hs-conid'>EnumAlgTy</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>()</span>
<a name="line-361"></a><span class='hs-definition'>addEnumTypes</span> <span class='hs-varid'>newETs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-362"></a> <span class='hs-varid'>globalST</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>gets</span> <span class='hs-varid'>global</span>
<a name="line-363"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>oldETs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>enumTypes</span> <span class='hs-varid'>globalST</span>
<a name="line-364"></a> <span class='hs-varid'>modify</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>st</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>global</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>globalST</span> <span class='hs-layout'>{</span><span class='hs-varid'>enumTypes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>oldETs</span> <span class='hs-varop'>`union`</span> <span class='hs-varid'>newETs</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-365"></a>
<a name="line-366"></a><a name="getEnumConsId"></a><span class='hs-comment'>-- | Check if a Template haskell 'Name' corresponding to</span>
<a name="line-367"></a><span class='hs-comment'>-- a Enumerated-type data constructor is present in the enumerated</span>
<a name="line-368"></a><span class='hs-comment'>-- types accumulated in the global state and return the corresponding</span>
<a name="line-369"></a><span class='hs-comment'>-- VHDL identifier.</span>
<a name="line-370"></a><span class='hs-definition'>getEnumConsId</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>VHDLId</span><span class='hs-layout'>)</span>
<a name="line-371"></a><span class='hs-definition'>getEnumConsId</span> <span class='hs-varid'>consName</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-372"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>consModule</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromJust</span><span class='hs-varop'>.</span><span class='hs-varid'>nameModule</span><span class='hs-layout'>)</span> <span class='hs-varid'>consName</span>
<a name="line-373"></a> <span class='hs-varid'>consBase</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nameBase</span> <span class='hs-varid'>consName</span>
<a name="line-374"></a> <span class='hs-varid'>enums</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>gets</span> <span class='hs-layout'>(</span><span class='hs-varid'>enumTypes</span><span class='hs-varop'>.</span><span class='hs-varid'>global</span><span class='hs-layout'>)</span>
<a name="line-375"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>matchesName</span> <span class='hs-layout'>(</span><span class='hs-conid'>EnumAlgTy</span> <span class='hs-varid'>dataName</span> <span class='hs-varid'>enums</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-376"></a> <span class='hs-varid'>tyconModule</span> <span class='hs-varid'>dataName</span> <span class='hs-varop'>==</span> <span class='hs-varid'>consModule</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>elem</span> <span class='hs-varid'>consBase</span> <span class='hs-varid'>enums</span>
<a name="line-377"></a> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>toList</span><span class='hs-varop'>.</span><span class='hs-layout'>(</span><span class='hs-conid'>S</span><span class='hs-varop'>.</span><span class='hs-varid'>filter</span> <span class='hs-varid'>matchesName</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>enums</span> <span class='hs-keyword'>of</span>
<a name="line-378"></a> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span>
<a name="line-379"></a> <span class='hs-keyglyph'>[</span><span class='hs-keyword'>_</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>liftM</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>liftEProne</span> <span class='hs-varop'>$</span> <span class='hs-varid'>mkVHDLExtId</span> <span class='hs-varid'>consBase</span><span class='hs-layout'>)</span>
<a name="line-380"></a> <span class='hs-comment'>-- _ -> this shouldn't happen since the enumerated types stored are unique</span>
<a name="line-381"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>intError</span> <span class='hs-str'>"ForSyDe.Backend.VHDL.Traverse.VHDLM.getEnum"</span>
<a name="line-382"></a> <span class='hs-layout'>(</span><span class='hs-conid'>UntranslatableVHDLFun</span> <span class='hs-varop'>$</span> <span class='hs-conid'>GeneralErr</span> <span class='hs-layout'>(</span><span class='hs-conid'>Other</span> <span class='hs-str'>"pattern match inconsistency"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-383"></a>
<a name="line-384"></a>
<a name="line-385"></a><a name="addCustomType"></a><span class='hs-comment'>-- | Add a cutom type to the global results and type translation table</span>
<a name="line-386"></a><span class='hs-definition'>addCustomType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TypeRep</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Either</span> <span class='hs-conid'>TypeDec</span> <span class='hs-conid'>SubtypeDec</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>()</span>
<a name="line-387"></a><span class='hs-definition'>addCustomType</span> <span class='hs-varid'>rep</span> <span class='hs-varid'>eTD</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-388"></a> <span class='hs-varid'>globalST</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>gets</span> <span class='hs-varid'>global</span>
<a name="line-389"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>transTable</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>typeTable</span> <span class='hs-varid'>globalST</span>
<a name="line-390"></a> <span class='hs-varid'>gRes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>globalRes</span> <span class='hs-varid'>globalST</span>
<a name="line-391"></a> <span class='hs-varid'>tDecs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>typeDecs</span> <span class='hs-varid'>gRes</span>
<a name="line-392"></a> <span class='hs-varid'>stDecs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>subtypeDecs</span> <span class='hs-varid'>gRes</span>
<a name="line-393"></a> <span class='hs-comment'>-- FIXME: use queues</span>
<a name="line-394"></a> <span class='hs-varid'>modify</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>st</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>global</span> <span class='hs-keyglyph'>=</span>
<a name="line-395"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>eTD</span> <span class='hs-keyword'>of</span>
<a name="line-396"></a> <span class='hs-conid'>Left</span> <span class='hs-varid'>td</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>TypeDec</span> <span class='hs-varid'>id</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-397"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>id</span> <span class='hs-varop'>`notElem`</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>snd</span> <span class='hs-varid'>transTable</span><span class='hs-layout'>)</span> <span class='hs-keyword'>then</span>
<a name="line-398"></a> <span class='hs-varid'>globalST</span>
<a name="line-399"></a> <span class='hs-layout'>{</span><span class='hs-varid'>typeTable</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transTable</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>rep</span><span class='hs-layout'>,</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span>
<a name="line-400"></a> <span class='hs-varid'>globalRes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>gRes</span><span class='hs-layout'>{</span><span class='hs-varid'>typeDecs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tDecs</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>td</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-401"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>globalST</span>
<a name="line-402"></a> <span class='hs-conid'>Right</span> <span class='hs-varid'>std</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>SubtypeDec</span> <span class='hs-varid'>id</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-403"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>id</span> <span class='hs-varop'>`notElem`</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>snd</span> <span class='hs-varid'>transTable</span><span class='hs-layout'>)</span> <span class='hs-keyword'>then</span>
<a name="line-404"></a> <span class='hs-varid'>globalST</span>
<a name="line-405"></a> <span class='hs-layout'>{</span><span class='hs-varid'>typeTable</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transTable</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>rep</span><span class='hs-layout'>,</span> <span class='hs-varid'>id</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span>
<a name="line-406"></a> <span class='hs-varid'>globalRes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>gRes</span><span class='hs-layout'>{</span><span class='hs-varid'>subtypeDecs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>stDecs</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>std</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-407"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>globalST</span>
<a name="line-408"></a> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-409"></a>
<a name="line-410"></a><a name="addTypeDec"></a><span class='hs-comment'>-- | Add type declaration to the global results</span>
<a name="line-411"></a><span class='hs-definition'>addTypeDec</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TypeDec</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>()</span>
<a name="line-412"></a><span class='hs-definition'>addTypeDec</span> <span class='hs-varid'>td</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-413"></a> <span class='hs-varid'>globalST</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>gets</span> <span class='hs-varid'>global</span>
<a name="line-414"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>gRes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>globalRes</span> <span class='hs-varid'>globalST</span>
<a name="line-415"></a> <span class='hs-varid'>tDecs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>typeDecs</span> <span class='hs-varid'>gRes</span>
<a name="line-416"></a> <span class='hs-comment'>-- FIXME: use queues</span>
<a name="line-417"></a> <span class='hs-varid'>modify</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>st</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>global</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>globalST</span><span class='hs-layout'>{</span><span class='hs-varid'>globalRes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>gRes</span><span class='hs-layout'>{</span><span class='hs-varid'>typeDecs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tDecs</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>td</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-418"></a>
<a name="line-419"></a>
<a name="line-420"></a><a name="addSubtypeDec"></a><span class='hs-comment'>-- | Add subtype declaration to the global results</span>
<a name="line-421"></a><span class='hs-definition'>addSubtypeDec</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SubtypeDec</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>()</span>
<a name="line-422"></a><span class='hs-definition'>addSubtypeDec</span> <span class='hs-varid'>std</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-423"></a> <span class='hs-varid'>globalST</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>gets</span> <span class='hs-varid'>global</span>
<a name="line-424"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>gRes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>globalRes</span> <span class='hs-varid'>globalST</span>
<a name="line-425"></a> <span class='hs-varid'>stDecs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>subtypeDecs</span> <span class='hs-varid'>gRes</span>
<a name="line-426"></a> <span class='hs-comment'>-- FIXME: use queues</span>
<a name="line-427"></a> <span class='hs-varid'>modify</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>st</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>global</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>globalST</span><span class='hs-layout'>{</span>
<a name="line-428"></a> <span class='hs-varid'>globalRes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>gRes</span><span class='hs-layout'>{</span><span class='hs-varid'>subtypeDecs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>stDecs</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>std</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-429"></a>
<a name="line-430"></a>
<a name="line-431"></a><a name="addUnconsFSVec"></a><span class='hs-comment'>-- | Add an unconstrained FSVec to the global results</span>
<a name="line-432"></a><span class='hs-definition'>addUnconsFSVec</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TypeRep</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>()</span>
<a name="line-433"></a><span class='hs-definition'>addUnconsFSVec</span> <span class='hs-varid'>trep</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-434"></a> <span class='hs-varid'>globalST</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>gets</span> <span class='hs-varid'>global</span>
<a name="line-435"></a> <span class='hs-comment'>-- FIXME: use queues</span>
<a name="line-436"></a> <span class='hs-varid'>modify</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>st</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>global</span> <span class='hs-keyglyph'>=</span>
<a name="line-437"></a> <span class='hs-varid'>globalST</span><span class='hs-layout'>{</span>
<a name="line-438"></a> <span class='hs-varid'>transUnconsFSVecs</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>transUnconsFSVecs</span> <span class='hs-varid'>globalST</span><span class='hs-layout'>)</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>trep</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-439"></a>
<a name="line-440"></a><a name="addSubProgBody"></a><span class='hs-comment'>-- | Add a subprogram to the global results</span>
<a name="line-441"></a><span class='hs-definition'>addSubProgBody</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>SubProgBody</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>()</span>
<a name="line-442"></a><span class='hs-definition'>addSubProgBody</span> <span class='hs-varid'>newBody</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-443"></a> <span class='hs-varid'>globalST</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>gets</span> <span class='hs-varid'>global</span>
<a name="line-444"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>gRes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>globalRes</span> <span class='hs-varid'>globalST</span>
<a name="line-445"></a> <span class='hs-varid'>bodies</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>subProgBodies</span> <span class='hs-varid'>gRes</span>
<a name="line-446"></a> <span class='hs-comment'>-- FIXME: use queues</span>
<a name="line-447"></a> <span class='hs-varid'>modify</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>st</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>global</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>globalST</span>
<a name="line-448"></a> <span class='hs-layout'>{</span><span class='hs-varid'>globalRes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>gRes</span><span class='hs-layout'>{</span><span class='hs-varid'>subProgBodies</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bodies</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>newBody</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-449"></a>
<a name="line-450"></a>
<a name="line-451"></a><a name="addTransNamePair"></a><span class='hs-comment'>-- | Add a TH-name (arity, VHDL expression construtor function) pair to the translation namespace table</span>
<a name="line-452"></a><span class='hs-definition'>addTransNamePair</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Expr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Expr</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>()</span>
<a name="line-453"></a><span class='hs-definition'>addTransNamePair</span> <span class='hs-varid'>thName</span> <span class='hs-varid'>arity</span> <span class='hs-varid'>vHDLFun</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-454"></a> <span class='hs-varid'>lState</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>gets</span> <span class='hs-varid'>local</span>
<a name="line-455"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>funTransST</span> <span class='hs-varid'>lState</span>
<a name="line-456"></a> <span class='hs-varid'>table</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nameTable</span> <span class='hs-varid'>s</span>
<a name="line-457"></a> <span class='hs-varid'>modify</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>st</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>lState</span><span class='hs-layout'>{</span><span class='hs-varid'>funTransST</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>s</span><span class='hs-layout'>{</span>
<a name="line-458"></a> <span class='hs-varid'>nameTable</span><span class='hs-keyglyph'>=</span><span class='hs-layout'>(</span><span class='hs-varid'>thName</span><span class='hs-layout'>,</span><span class='hs-layout'>(</span><span class='hs-varid'>arity</span><span class='hs-layout'>,</span><span class='hs-varid'>vHDLFun</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>table</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-459"></a>
<a name="line-460"></a><a name="addDecsToFunTransST"></a><span class='hs-comment'>-- | Add a declarations to Auxiliary VHDL declarations of the Function</span>
<a name="line-461"></a><span class='hs-comment'>-- translation state</span>
<a name="line-462"></a><span class='hs-definition'>addDecsToFunTransST</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>SubProgDecItem</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>()</span>
<a name="line-463"></a><span class='hs-definition'>addDecsToFunTransST</span> <span class='hs-varid'>decs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-464"></a> <span class='hs-varid'>lState</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>gets</span> <span class='hs-varid'>local</span>
<a name="line-465"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>funTransST</span> <span class='hs-varid'>lState</span>
<a name="line-466"></a> <span class='hs-varid'>auxs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>auxDecs</span> <span class='hs-varid'>s</span>
<a name="line-467"></a> <span class='hs-varid'>modify</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>st</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>lState</span><span class='hs-layout'>{</span><span class='hs-varid'>funTransST</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>s</span><span class='hs-layout'>{</span>
<a name="line-468"></a> <span class='hs-varid'>auxDecs</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>decs</span><span class='hs-varop'>++</span><span class='hs-varid'>auxs</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-469"></a>
<a name="line-470"></a>
<a name="line-471"></a>
<a name="line-472"></a><a name="genFreshVHDLId"></a><span class='hs-comment'>-- | Get a fresh VHDL Identifier and increment the</span>
<a name="line-473"></a><span class='hs-comment'>-- tranlation-namespace-count of freshly generated identifiers.</span>
<a name="line-474"></a><span class='hs-comment'>--</span>
<a name="line-475"></a><span class='hs-comment'>-- Note that all user-supplied identifiers (process ids, port ids,</span>
<a name="line-476"></a><span class='hs-comment'>-- and function parameters) are translated to extended VHDL</span>
<a name="line-477"></a><span class='hs-comment'>-- identifiers. That, together with the fact that basic and extended</span>
<a name="line-478"></a><span class='hs-comment'>-- VHDL identifers live in different namespaces, guarantees that</span>
<a name="line-479"></a><span class='hs-comment'>-- freshly generated basic VHDL identifiers cannot clash with the</span>
<a name="line-480"></a><span class='hs-comment'>-- ones supplied by the frontend.</span>
<a name="line-481"></a><span class='hs-definition'>genFreshVHDLId</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VHDLM</span> <span class='hs-conid'>VHDLId</span>
<a name="line-482"></a><span class='hs-definition'>genFreshVHDLId</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-483"></a> <span class='hs-varid'>lState</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>gets</span> <span class='hs-varid'>local</span>
<a name="line-484"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>ns</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>funTransST</span> <span class='hs-varid'>lState</span>
<a name="line-485"></a> <span class='hs-varid'>count</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>freshNameCount</span> <span class='hs-varid'>ns</span>
<a name="line-486"></a> <span class='hs-varid'>modify</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>st</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>lState</span><span class='hs-layout'>{</span><span class='hs-varid'>funTransST</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>ns</span><span class='hs-layout'>{</span><span class='hs-varid'>freshNameCount</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>count</span><span class='hs-varop'>+</span><span class='hs-num'>1</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-487"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>unsafeVHDLBasicId</span> <span class='hs-layout'>(</span><span class='hs-str'>"fresh_"</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-varid'>count</span><span class='hs-layout'>)</span>
<a name="line-488"></a>
<a name="line-489"></a><a name="liftEProne"></a><span class='hs-comment'>-- | Lift an 'EProne' value to the VHDL monad setting current error context</span>
<a name="line-490"></a><span class='hs-comment'>-- for the error</span>
<a name="line-491"></a><span class='hs-comment'>-- liftEProne :: EProne a -> VHDLM a</span>
<a name="line-492"></a><span class='hs-definition'>liftEProne</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>EProne</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-varid'>a</span>
<a name="line-493"></a><span class='hs-definition'>liftEProne</span> <span class='hs-varid'>ep</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-494"></a> <span class='hs-varid'>cxt</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>gets</span> <span class='hs-layout'>(</span><span class='hs-varid'>context</span><span class='hs-varop'>.</span><span class='hs-varid'>local</span><span class='hs-layout'>)</span>
<a name="line-495"></a> <span class='hs-varid'>either</span> <span class='hs-layout'>(</span><span class='hs-varid'>throwError</span><span class='hs-varop'>.</span><span class='hs-layout'>(</span><span class='hs-conid'>ContextErr</span> <span class='hs-varid'>cxt</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>return</span> <span class='hs-varid'>ep</span>
<a name="line-496"></a>
<a name="line-497"></a><a name="throwFError"></a><span class='hs-comment'>-- | Throw a ForSyDe error, setting current error context</span>
<a name="line-498"></a><span class='hs-definition'>throwFError</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ForSyDeErr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-varid'>a</span>
<a name="line-499"></a><span class='hs-definition'>throwFError</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>liftEProne</span><span class='hs-varop'>.</span><span class='hs-conid'>Left</span>
<a name="line-500"></a>
<a name="line-501"></a>
<a name="line-502"></a>
<a name="line-503"></a><a name="withProcC"></a><span class='hs-comment'>-- | Execute certain operation with a concrete process context.</span>
<a name="line-504"></a><span class='hs-comment'>-- The initial context is restored after the operation is executed</span>
<a name="line-505"></a><span class='hs-comment'>-- Note: the initial context must be a system context or 'InconsistenContexts'</span>
<a name="line-506"></a><span class='hs-comment'>-- will be raised.</span>
<a name="line-507"></a><span class='hs-definition'>withProcC</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProcId</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-varid'>a</span>
<a name="line-508"></a><span class='hs-definition'>withProcC</span> <span class='hs-varid'>pid</span> <span class='hs-varid'>action</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-509"></a> <span class='hs-comment'>-- get the initial context</span>
<a name="line-510"></a> <span class='hs-varid'>st</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-511"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>local</span> <span class='hs-varid'>st</span>
<a name="line-512"></a> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>context</span> <span class='hs-varid'>l</span>
<a name="line-513"></a> <span class='hs-comment'>-- set the modified name context</span>
<a name="line-514"></a> <span class='hs-varid'>put</span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>l</span><span class='hs-layout'>{</span><span class='hs-varid'>context</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>setProcC</span> <span class='hs-varid'>pid</span> <span class='hs-varid'>c</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-515"></a> <span class='hs-comment'>-- execute the action</span>
<a name="line-516"></a> <span class='hs-varid'>res</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>action</span>
<a name="line-517"></a> <span class='hs-comment'>-- restore the initial name context</span>
<a name="line-518"></a> <span class='hs-varid'>st'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-519"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>l'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>local</span> <span class='hs-varid'>st'</span>
<a name="line-520"></a> <span class='hs-varid'>put</span> <span class='hs-varid'>st'</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>l'</span><span class='hs-layout'>{</span><span class='hs-varid'>context</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>c</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-521"></a> <span class='hs-comment'>-- return the result</span>
<a name="line-522"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>res</span>
<a name="line-523"></a>
<a name="line-524"></a>
<a name="line-525"></a>
<a name="line-526"></a><a name="withProcFunC"></a><span class='hs-comment'>-- | Execute certain operation with a concrete process function context.</span>
<a name="line-527"></a><span class='hs-comment'>-- The initial context is restored after the operation is executed</span>
<a name="line-528"></a><span class='hs-comment'>-- Note: the initial context must be a process context or </span>
<a name="line-529"></a><span class='hs-comment'>-- 'InconsistenContexts' will be raised.</span>
<a name="line-530"></a><span class='hs-definition'>withProcFunC</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Name</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Loc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-varid'>a</span>
<a name="line-531"></a><span class='hs-definition'>withProcFunC</span> <span class='hs-varid'>name</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>action</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-532"></a> <span class='hs-comment'>-- get the initial context</span>
<a name="line-533"></a> <span class='hs-varid'>st</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-534"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>local</span> <span class='hs-varid'>st</span>
<a name="line-535"></a> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>context</span> <span class='hs-varid'>l</span>
<a name="line-536"></a> <span class='hs-comment'>-- set the modified context</span>
<a name="line-537"></a> <span class='hs-varid'>put</span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>l</span><span class='hs-layout'>{</span><span class='hs-varid'>context</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>setProcFunC</span> <span class='hs-varid'>name</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>c</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-538"></a> <span class='hs-comment'>-- execute the action</span>
<a name="line-539"></a> <span class='hs-varid'>res</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>action</span>
<a name="line-540"></a> <span class='hs-comment'>-- restore the initial context</span>
<a name="line-541"></a> <span class='hs-varid'>st'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-542"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>l'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>local</span> <span class='hs-varid'>st'</span>
<a name="line-543"></a> <span class='hs-varid'>put</span> <span class='hs-varid'>st'</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>l'</span><span class='hs-layout'>{</span><span class='hs-varid'>context</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>c</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-544"></a> <span class='hs-comment'>-- return the result</span>
<a name="line-545"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>res</span>
<a name="line-546"></a>
<a name="line-547"></a>
<a name="line-548"></a>
<a name="line-549"></a><a name="withProcValC"></a><span class='hs-comment'>-- | Execute certain operation with a concrete process function context.</span>
<a name="line-550"></a><span class='hs-comment'>-- The initial context is restored after the operation is executed</span>
<a name="line-551"></a><span class='hs-comment'>-- Note: the initial context must be a process context or </span>
<a name="line-552"></a><span class='hs-comment'>-- 'InconsistenContexts' will be raised.</span>
<a name="line-553"></a><span class='hs-definition'>withProcValC</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Exp</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VHDLM</span> <span class='hs-varid'>a</span>
<a name="line-554"></a><span class='hs-definition'>withProcValC</span> <span class='hs-varid'>exp</span> <span class='hs-varid'>action</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-555"></a> <span class='hs-comment'>-- get the initial context</span>
<a name="line-556"></a> <span class='hs-varid'>st</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-557"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>local</span> <span class='hs-varid'>st</span>
<a name="line-558"></a> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>context</span> <span class='hs-varid'>l</span>
<a name="line-559"></a> <span class='hs-comment'>-- set the modified context</span>
<a name="line-560"></a> <span class='hs-varid'>put</span> <span class='hs-varid'>st</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>l</span><span class='hs-layout'>{</span><span class='hs-varid'>context</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>setProcValC</span> <span class='hs-varid'>exp</span> <span class='hs-varid'>c</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-561"></a> <span class='hs-comment'>-- execute the action</span>
<a name="line-562"></a> <span class='hs-varid'>res</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>action</span>
<a name="line-563"></a> <span class='hs-comment'>-- restore the initial context</span>
<a name="line-564"></a> <span class='hs-varid'>st'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-565"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>l'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>local</span> <span class='hs-varid'>st'</span>
<a name="line-566"></a> <span class='hs-varid'>put</span> <span class='hs-varid'>st'</span><span class='hs-layout'>{</span><span class='hs-varid'>local</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>l'</span><span class='hs-layout'>{</span><span class='hs-varid'>context</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>c</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-567"></a> <span class='hs-comment'>-- return the result</span>
<a name="line-568"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>res</span>
<a name="line-569"></a>
<a name="line-570"></a>
<a name="line-571"></a><span class='hs-comment'>----------------</span>
<a name="line-572"></a><span class='hs-comment'>-- IntSignalInfo</span>
<a name="line-573"></a><span class='hs-comment'>----------------</span>
<a name="line-574"></a>
<a name="line-575"></a><a name="IntSignalInfo"></a><span class='hs-comment'>-- | Intermediate signal information. Tag generated for each output of each</span>
<a name="line-576"></a><a name="IntSignalInfo"></a><span class='hs-comment'>-- node found during the traversal. </span>
<a name="line-577"></a><a name="IntSignalInfo"></a><span class='hs-comment'>-- (see ForSyDe.Netlist.Traverse.traverseSIO).</span>
<a name="line-578"></a><a name="IntSignalInfo"></a><span class='hs-comment'>-- It contains the VHDL intemediate signal name associated with the process </span>
<a name="line-579"></a><a name="IntSignalInfo"></a><span class='hs-comment'>-- output.</span>
<a name="line-580"></a><a name="IntSignalInfo"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>IntSignalInfo</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SimpleName</span>
<a name="line-581"></a>
</pre></body>
</html>
distrib
>
Fedora
>
14
>
x86_64
>
media
>
updates
>
by-pkgid
>
a47f0719970f9f829128f311a437816d
>
files
>
313
