diff --git a/.github/workflows/docker-ci.yml b/.github/workflows/docker-ci.yml new file mode 100644 index 000000000..7ab7672ff --- /dev/null +++ b/.github/workflows/docker-ci.yml @@ -0,0 +1,216 @@ +name: Docker CI + +on: + push: + branches: + - '**' + pull_request: + workflow_dispatch: + +jobs: + test: + name: "Test" + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - name: Debug Info + run: | + echo "Runner OS: $(uname -a)" + echo "Current directory: $(pwd)" + echo "Files in current directory: $(ls -la)" + + # ------------------------------ + # Basic linting requirements for new commits + build-check-src: + name: "Check: code cleanliness" + runs-on: ubuntu-latest + timeout-minutes: 15 + steps: + - uses: actions/checkout@v4 + - name: Check tabs and whitespace + shell: bash + run: ".github/workflows/check_whitespace.sh" + + build-check-testsuite: + name: "Check: testsuite lint" + runs-on: ubuntu-latest + timeout-minutes: 15 + steps: + - uses: actions/checkout@v4 + - name: Check CONFDIR + run: | + cd testsuite + ../.github/workflows/check_confdir.py + ../.github/workflows/check_symlinks.py + + # ------------------------------ + # Builds for release, using a reliable and stable version of GHC + build-and-test-ubuntu: + name: "Build/Test: Ubuntu" + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - name: Debug Info + run: | + echo "Runner OS: $(uname -a)" + echo "Current directory: $(pwd)" + echo "Files in current directory: $(ls -la)" + - name: Install GHC + uses: haskell/actions/setup@v2 + with: + ghc-version: 9.6.6 + cabal-version: latest + - name: Build and Test + run: | + make -j3 + make -j3 test + + build-and-test-macos: + strategy: + matrix: + os: [ macos-13, macos-14, macos-15 ] + fail-fast: false + name: "Build/Test: ${{ matrix.os }}" + runs-on: ${{ matrix.os }} + steps: + - uses: actions/checkout@v4 + - name: Install GHC and HLS + uses: haskell/actions/setup@v2 + with: + ghc-version: 9.6.6 + cabal-version: latest + - name: Build and Test + run: | + make -j3 + make -j3 test + + # ------------------------------ + # Tests using other recent versions of GHC + build-and-test-ghc-ubuntu: + strategy: + matrix: + ghc: + - version: 9.4.8 + - version: 9.8.4 + - version: 9.10.1 + - version: 9.12.1 + fail-fast: false + name: "Build/Test: GHC Ubuntu" + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - name: Install GHC + uses: haskell/actions/setup@v2 + with: + ghc-version: ${{ matrix.ghc.version }} + cabal-version: latest + - name: Build and Test + run: | + make -j3 + make -j3 test + + build-and-test-ghc-macos: + strategy: + matrix: + ghc: + - version: 9.4.8 + - version: 9.8.4 + - version: 9.10.1 + - version: 9.12.1 + fail-fast: false + name: "Build/Test: GHC macOS" + runs-on: macos-14 + steps: + - uses: actions/checkout@v4 + - name: Install GHC and HLS + uses: haskell/actions/setup@v2 + with: + ghc-version: ${{ matrix.ghc.version }} + cabal-version: latest + - name: Build and Test + run: | + make -j3 + make -j3 test + + # ------------------------------ + # Test the building of documentation + build-doc-ubuntu: + strategy: + matrix: + os: [ ubuntu-20.04, ubuntu-22.04, ubuntu-24.04 ] + fail-fast: false + name: "Build doc: ${{ matrix.os }}" + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - name: Install dependencies + run: | + sudo apt-get update + sudo apt-get install -y texlive-full + - name: Build + run: | + make -j3 install-doc + tar czf inst.tar.gz inst + - name: Upload artifact + uses: actions/upload-artifact@v4 + with: + name: ${{ matrix.os }} build doc + path: inst.tar.gz + - name: Upload doc not tar + uses: actions/upload-artifact@v4 + with: + name: ${{matrix.os}}-doc-not-tar + path: inst/doc + + build-doc-macOS: + strategy: + matrix: + os: [ macos-13, macos-14, macos-15 ] + fail-fast: false + name: "Build doc: ${{ matrix.os }}" + runs-on: ${{ matrix.os }} + steps: + - uses: actions/checkout@v4 + - name: Install dependencies + run: | + brew install mactex + - name: Build + run: | + export PATH=/Library/TeX/texbin/:$PATH + make -j3 install-doc + tar czf inst.tar.gz inst + - name: Upload artifact + uses: actions/upload-artifact@v4 + with: + name: ${{ matrix.os }} build doc + path: inst.tar.gz + - name: Upload doc not tar + uses: actions/upload-artifact@v4 + with: + name: ${{matrix.os}}-doc-not-tar + path: inst/doc + + # ------------------------------ + # Build platform-generic documents for releases + build-releasenotes-ubuntu: + strategy: + matrix: + os: [ ubuntu-22.04 ] + fail-fast: false + name: "Build releasenotes: ${{ matrix.os }}" + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - name: Install dependencies + run: | + sudo apt-get update + sudo apt-get install -y texlive-full + - name: Build + run: | + make install-release + tar czf inst.tar.gz inst + - name: Upload artifact + uses: actions/upload-artifact@v4 + with: + name: ${{ matrix.os }} releasenotes + path: inst.tar.gz \ No newline at end of file diff --git a/.github/workflows/minimal-test.yml b/.github/workflows/minimal-test.yml new file mode 100644 index 000000000..aff884340 --- /dev/null +++ b/.github/workflows/minimal-test.yml @@ -0,0 +1,21 @@ +name: Minimal Test + +on: + workflow_dispatch: + push: + branches: [ docker-workflow ] + +jobs: + test: + runs-on: macos-latest + steps: + - uses: actions/checkout@v4 + + - name: Print Hello + run: echo "Hello from GitHub Actions!" + + - name: Show Environment + run: | + echo "Runner OS: $RUNNER_OS" + echo "Runner Architecture: $RUNNER_ARCH" + echo "Runner Name: $RUNNER_NAME" \ No newline at end of file diff --git a/.gitignore b/.gitignore index 3672c257b..0912d696b 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,7 @@ build .vagrant/ vagrant-out/ +bsc.log +bsc.sum +dist-newstyle/ + diff --git a/Dockerfile b/Dockerfile index b53daa36b..88f74eff3 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,15 +1,207 @@ -FROM ubuntu:18.04 as build -ADD .github/workflows/install_dependencies_ubuntu.sh /build/ -RUN DEBIAN_FRONTEND=noninteractive \ - /build/install_dependencies_ubuntu.sh -ADD . /build/ -RUN make -C /build -j2 GHCJOBS=2 GHCRTSFLAGS='+RTS -M5G -A128m -RTS' - -FROM ubuntu:18.04 -RUN apt-get update \ - && DEBIAN_FRONTEND=noninteractive \ - apt-get install -y \ - build-essential tcl iverilog \ - && rm -rf /var/lib/apt/lists/* -COPY --from=build /build/inst /opt/bluespec/ -ENV PATH /opt/bluespec/bin:$PATH +# Use Ubuntu 22.04 as the base image +FROM ubuntu:22.04 as builder + +# Set environment variables for GHC and Cabal versions +ARG GHC_VERSION=8.10.7 +ARG CABAL_VERSION=3.12.1.0 +ARG HLS_VERSION=1.10.0.0 + +# Prevent timezone configuration prompts +ENV DEBIAN_FRONTEND=noninteractive +ENV TZ=UTC + +# Create necessary directories +RUN echo "Creating directories..." && \ + mkdir -p /opt/ghc /opt/cabal/bin /opt/ccache + +# Install system dependencies and LLVM +RUN echo "Installing system dependencies and LLVM..." && \ + apt-get update && \ + apt-get install -y --no-install-recommends \ + curl \ + wget \ + build-essential \ + libffi-dev \ + libgmp-dev \ + libtinfo-dev \ + libncurses-dev \ + libnuma-dev \ + libtinfo5 \ + libncurses5 \ + libgmp10 \ + libffi7 \ + libnuma1 \ + zlib1g-dev \ + git \ + python3 \ + python3-pip \ + python3-dev \ + libpython3.10-dev \ + libxml2-dev \ + libicu-dev \ + liblzma-dev \ + libz3-dev \ + libssl-dev \ + pkg-config \ + llvm-12 \ + llvm-12-dev \ + clang-12 \ + libclang-12-dev \ + libclang-cpp12-dev \ + python3-clang-12 \ + autoconf \ + gperf \ + flex \ + bison \ + tcl \ + tcl-dev \ + && rm -rf /var/lib/apt/lists/* && \ + update-alternatives --install /usr/bin/opt opt /usr/bin/opt-12 100 && \ + update-alternatives --install /usr/bin/llc llc /usr/bin/llc-12 100 + +# Set LLVM environment variables +ENV PATH="/usr/lib/llvm-12/bin:${PATH}" +ENV LLVM_CONFIG=/usr/bin/llvm-config-12 + +# Install GHCup +RUN echo "Installing GHCup..." && \ + curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh + +# Install GHC and Cabal +RUN echo "Installing GHC and Cabal..." && \ + . "$HOME/.ghcup/env" && \ + ghcup install ghc ${GHC_VERSION} && \ + ghcup install cabal ${CABAL_VERSION} && \ + ghcup set ghc ${GHC_VERSION} && \ + ghcup set cabal ${CABAL_VERSION} + +# Update Haskell dependencies +RUN echo "Updating Haskell dependencies..." && \ + . "$HOME/.ghcup/env" && \ + cabal update && \ + cabal install --lib \ + aeson \ + base \ + bytestring \ + containers \ + directory \ + filepath \ + mtl \ + process \ + text \ + time-1.9.3 \ + transformers \ + unix \ + vector \ + yaml \ + regex-compat \ + syb \ + old-time \ + split + +# Set up CCache +RUN echo "Setting up CCache..." && \ + apt-get update && \ + apt-get install -y ccache && \ + mkdir -p /root/.ccache && \ + echo "max_size = 5.0G" > /root/.ccache/ccache.conf && \ + rm -rf /var/lib/apt/lists/* + +# Install Haskell Language Server if version is specified +RUN if [ -n "${HLS_VERSION}" ]; then \ + echo "Installing Haskell Language Server..." && \ + . "$HOME/.ghcup/env" && \ + ghcup install hls ${HLS_VERSION} && \ + ghcup set hls ${HLS_VERSION} && \ + echo "Testing Haskell Language Server..." && \ + echo "HLS bin directory contents:" && \ + ls -la $HOME/.ghcup/hls/${HLS_VERSION}/bin && \ + echo "PATH:" && \ + echo $PATH && \ + export PATH="$HOME/.ghcup/hls/${HLS_VERSION}/bin:$PATH" && \ + haskell-language-server-wrapper --version; \ + fi + +# Build BSC +WORKDIR /app +COPY . . +RUN echo "Installing regex-compat and dependencies..." && \ + . "$HOME/.ghcup/env" && \ + echo "Current GHC version:" && \ + ghc --version && \ + echo "Installing regex-compat and dependencies..." && \ + cabal install --global --lib --force-reinstalls \ + regex-base-0.94.0.2 \ + regex-posix-0.96.0.1 \ + regex-compat-0.95.2.1 && \ + echo "Installing other required packages..." && \ + cabal install --global --lib --force-reinstalls \ + syb \ + old-time \ + split && \ + echo "Registering packages with ghc-pkg..." && \ + find /root/.cabal/store/ghc-8.10.7 -name '*.conf' -exec ghc-pkg register {} \; && \ + echo "Checking installed packages:" && \ + ghc-pkg list + +RUN echo "Building BSC..." && \ + . "$HOME/.ghcup/env" && \ + pwd && \ + ls -la && \ + cd src && \ + pwd && \ + ls -la && \ + if [ -f Makefile ]; then \ + echo "Makefile exists:" && \ + cat Makefile && \ + sh -x -c ". $HOME/.ghcup/env && make install" 2>&1; \ + else \ + echo "Makefile not found!"; \ + fi + +# Test GHCI integration +RUN echo "Testing GHCI integration..." && \ + . "$HOME/.ghcup/env" && \ + ghci -e "putStrLn \"Hello, World!\"" + +# Runtime stage +FROM ubuntu:22.04 + +# Prevent timezone configuration prompts +ENV DEBIAN_FRONTEND=noninteractive +ENV TZ=UTC + +# Copy GHC, Cabal, and BSC installation from builder +COPY --from=builder /opt/ghc /opt/ghc +COPY --from=builder /opt/cabal /opt/cabal +COPY --from=builder /usr/local/bin /usr/local/bin +COPY --from=builder /usr/local/lib /usr/local/lib + +# Install runtime dependencies +RUN echo "Installing runtime dependencies..." && \ + apt-get update && \ + apt-get install -y --no-install-recommends \ + libgmp10 \ + libffi7 \ + libtinfo5 \ + libncurses5 \ + libnuma1 \ + zlib1g \ + python3 \ + python3-pip \ + libpython3.10 \ + libxml2 \ + libicu70 \ + liblzma5 \ + libz3-4 \ + libssl3 \ + && rm -rf /var/lib/apt/lists/* + +# Set up environment +ENV PATH="/opt/ghc/bin:/opt/cabal/bin:$PATH" + +# Set working directory +WORKDIR /app + +# Default command +CMD ["bsc"] diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 000000000..e9715830b --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain \ No newline at end of file diff --git a/bsc.cabal b/bsc.cabal new file mode 100644 index 000000000..d346f8d0a --- /dev/null +++ b/bsc.cabal @@ -0,0 +1,336 @@ +cabal-version: 3.0 +name: bsc +version: 2024.3 +synopsis: Bluespec Compiler +description: The Bluespec Compiler (BSC) is a compiler and simulator for the Bluespec Hardware Description Language. +homepage: https://github.com/B-Lang-org/bsc +bug-reports: https://github.com/B-Lang-org/bsc/issues +license: BSD-3-Clause +license-file: LICENSE.txt +author: Bluespec Inc. +maintainer: B-Lang Maintainers +category: Hardware +build-type: Simple +extra-doc-files: README.md + INSTALL.md + DEVELOP.md +tested-with: GHC == 9.4.7 + +common common-options + default-language: Haskell2010 + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -fno-warn-orphans + -fno-warn-name-shadowing + -fno-warn-unused-matches + if impl(ghc >= 8.0) + ghc-options: -Wredundant-constraints + if impl(ghc >= 8.2) + ghc-options: -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields + if impl(ghc >= 8.10) + ghc-options: -Wunused-packages + +library + import: common-options + hs-source-dirs: src/comp + src/Parsec + src/Libraries + src/comp/Libs + src/vendor/yices/v2.6/HaskellIfc + src/vendor/stp/HaskellIfc + src/vendor/htcl + src/comp/GHC/posix + exposed-modules: Util + , BSC + , VCD + , VFileName + , VFinalCleanup + , VIOProps + , VModInfo + , VPIWrappers + , VPrims + , VVerilogDollar + , Verilog + , Version + , Wires + , TCMisc + , TCPat + , TCheck + , TIMonad + , TclUtils + , TopUtils + , Type + , TypeAnalysis + , TypeAnalysisTclUtil + , TypeCheck + , TypeOps + , Undefined + , SimPrimitiveModules + , Simplify + , SpeedyString + , StdPrel + , Subst + , SymTab + , Synthesize + , SystemCWrapper + , SystemCheck + , SimCCBlock + , SimCOpt + , SimDomainInfo + , SimExpand + , SimFileUtils + , SimMakeCBlocks + , SimPackage + , SimPackageOpt + , Pretty + , Prim + , ProofObligation + , RSchedule + , RealUtil + , SAL + , SAT + , SATPred + , SCC + , SEMonad + , SchedInfo + , Scheme + , SignalNaming + , SimBlocksToC + , PoisonUtils + , Position + , Pragma + , PragmaCheck + , PreIds + , PreStrings + , Pred + , Pred2STP + , Pred2Yices + , PVPrint + , Params + , ParseOp + , Lex + , Literal + , Log2 + , MakeSymTab + , PFPrint + , PPrint + , IWireSet + , Id + , IdPrint + , IfcBetterInfo + , InferKind + , InlineCReg + , InlineReg + , ABin + , ABinUtil + , AConv + , ADumpScheduleInfo + , AExpand + , AExpr2STP + , AExpr2Util + , AExpr2Yices + , AOpt + , AScheduleInfo + , ASyntax + , ASyntaxUtil + , AUses + , AVerilogUtil + , Assump + , BDD + , BExpr + , Backend + , BackendNamingConventions + , Bag + , Balanced + , BinData + , BoolExp + , BoolOpt + , BuildVersion + , CCSyntax + , CFreeVars + , CSubst + , CSyntax + , CSyntaxTypes + , CSyntaxUtil + , CType + , CVPrint + , Classic + , ConTagInfo + , ContextErrors + , CtxRed + , Error + , ErrorMonad + , ErrorUtil + , Eval + , FStringCompat + , FileIOUtil + , FileNameUtil + , Fixity + , Flags + , ForeignFunctions + , GHCPretty + , GenABin + , GenWrapUtils + , GraphMap + , GraphUtil + , GraphWrapper + , IConv + , IConvLet + , IInline + , IInlineUtil + , IOMutVar + , IPrims + , IStateLoc + , ISyntax + , ISyntaxUtil + , ITransform + , IType + , InstNodes + , IntLit + , IntegerUtil + , Intervals + , KIMisc + , LambdaCalcUtil + , SystemVerilogKeywords + , SystemVerilogTokens + , Unify + , IOUtil + , ListMap + , Sort + , Yices + , YicesFFI + , STP + , STPFFI + , HTcl + , BlueTcl + other-modules: ADumpSchedule + , BinParse + , BinUtil + , BluesimLoader + , CPPLineDirectives + , Depend + , FlagsDecode + , GenBin + , GenFuncWrap + , GlobPattern + , MVarStrict + , Parse + , Parsec + , ParsecChar + , ParsecCombinator + , ParsecExpr + , ParsecPrim + , Parser.BSV + , Parser.BSV.CVParser + , Parser.BSV.CVParserAssertion + , Parser.BSV.CVParserCommon + , Parser.BSV.CVParserImperative + , Parser.BSV.CVParserUtil + , Parser.Classic + , Parser.Classic.CParser + , Parser.Classic.Warnings + , SystemVerilogPreprocess + , SystemVerilogScanner + , TmpNam + default-language: Haskell2010 + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-uni-patterns + -Wincomplete-record-updates -fno-warn-orphans + -fno-warn-name-shadowing -fno-warn-unused-matches + -Wredundant-constraints -fhide-source-paths -Wmissing-export-lists + -Wpartial-fields + build-depends: + array, + base >= 4.7 && < 5, + bytestring, + containers, + directory, + filepath, + ghc-prim, + integer-gmp, + mtl, + old-time, + parsec, + process, + regex-compat, + sort, + split, + syb, + text, + time, + transformers, + unix + +executable bsc + import: common-options + hs-source-dirs: src/exec + main-is: Main.hs + build-depends: base >= 4.7 && < 5 + , bsc + , containers + , mtl + , process + , directory + , filepath + +executable bluetcl + import: common-options + hs-source-dirs: src/bluetcl src/comp + c-sources: src/comp/bluetcl_Main.c + main-is: Main.hs + build-depends: base >= 4.7 && < 5 + , bsc + , containers + , mtl + , process + extra-libraries: tcl + build-tool-depends: hsc2hs:hsc2hs -any + other-modules: BlueTcl + default-language: Haskell2010 + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-uni-patterns + -Wincomplete-record-updates -fno-warn-orphans + -fno-warn-name-shadowing -fno-warn-unused-matches + -Wredundant-constraints -fhide-source-paths -Wmissing-export-lists + -Wpartial-fields + +test-suite bsc-test + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: testsuite + main-is: Main.hs + build-depends: base >= 4.7 && < 5 + , bsc + , containers + , mtl + , process + , directory + , filepath + , tasty + , tasty-hunit + , tasty-quickcheck + +test-suite dejagnu-tests + import: common-options + type: detailed-0.9 + test-module: DejaGNUDriver + hs-source-dirs: testsuite/dejagnu-driver + other-modules: DejaGNUTest + build-depends: base >= 4.7 && < 5 + , Cabal >= 3.0 + , process + , directory + , filepath + , text + + -- Test data files that need to be available during testing + extra-source-files: testsuite/config/*.tcl + , testsuite/lib/*.exp + , testsuite/scripts/*.exp + , testsuite/bsc.*/*.exp + , testsuite/bsc.*/*/*.exp + , testsuite/site.exp \ No newline at end of file diff --git a/cabal.project b/cabal.project new file mode 100644 index 000000000..c7ec11bba --- /dev/null +++ b/cabal.project @@ -0,0 +1,16 @@ +packages: . + +package bsc + ghc-options: -j + +optimization: 2 +documentation: True +tests: True + +test-show-details: direct +test-options: --test-option=--color=always + +package bsc + -- Enable all test suites by default + tests: True + test-show-details: direct \ No newline at end of file diff --git a/src/bluetcl/Main.hs b/src/bluetcl/Main.hs new file mode 100644 index 000000000..730d36397 --- /dev/null +++ b/src/bluetcl/Main.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module Main where + +import Foreign.C.Types +import Foreign.Ptr + +type TclInterp = Ptr () + +foreign import ccall "bluetcl_AppInit" bluetcl_AppInit :: TclInterp -> IO CInt +foreign import ccall "Tcl_CreateInterp" tcl_CreateInterp :: IO TclInterp +foreign import ccall "Tcl_Main" tcl_Main :: CInt -> Ptr (Ptr CChar) -> IO () + +main :: IO () +main = do + interp <- tcl_CreateInterp + _ <- bluetcl_AppInit interp + tcl_Main 0 nullPtr \ No newline at end of file diff --git a/src/comp/Bag.hs b/src/comp/Bag.hs index f18a64157..10b94ccdb 100644 --- a/src/comp/Bag.hs +++ b/src/comp/Bag.hs @@ -43,9 +43,9 @@ toList (Bag m) = concatMap (\(k,c) -> replicate c k) null :: Bag k -> Bool null (Bag m) = M.null m - -- other functions remove the node when it becomes 0 - -- so we don't need this check: - -- || (all (== 0) (M.elems m)) + {- other functions remove the node when it becomes 0 + so we don't need this check: + || (all (== 0) (M.elems m)) -} difference :: Ord k => Bag k -> Bag k -> Bag k difference (Bag big) (Bag small) = diff --git a/src/comp/BlueTcl.hs.new b/src/comp/BlueTcl.hs.new new file mode 100644 index 000000000..79fe1ab90 --- /dev/null +++ b/src/comp/BlueTcl.hs.new @@ -0,0 +1,4231 @@ +{-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface, CPP #-} +{-# OPTIONS_GHC -Wall -fno-warn-unused-binds -fno-warn-unused-matches #-} + +-- Blue Tcl Shell +{- +-- TODO + - Commands +-} + +module BlueTcl where + + +import HTcl + +import Control.Monad(foldM, when, mzero) +import Control.Monad.Trans(lift) +import Control.Monad.Except(ExceptT, runExceptT, throwError) +import Control.Concurrent +import qualified Control.Exception as CE +import System.IO.Error(ioeGetErrorString) +import Data.IORef +import Data.Word(Word64) +import Data.List(find, nub, partition, sort, sortBy, intercalate, isPrefixOf, + groupBy, intersect, nubBy, group, elemIndex) +import Data.Maybe +import Data.Ord(comparing) +import System.IO.Unsafe(unsafePerformIO) +import System.Environment(getEnv) +import System.Mem(performGC) +import System.Posix.Signals +import Text.Regex +import Data.Generics (listify) +import qualified Data.Map as M + +-- Bluespec imports +import Util(quote, concatMapM, concatUnzip3, lastOrErr, fromJustOrErr, + thd, readOrErr) +import IOUtil(getEnvDef) + +import Util(mapFst, mapSnd) +import TclUtils +import GHCPretty() + +import Version +import BuildVersion +import Flags(Flags(..), verbose) +import FlagsDecode(defaultFlags, decodeFlags, adjustFinalFlags, updateFlags, + showFlagsLst, showFlagsAllLst, getFlagValueString) +import Error(internalError, EMsg, ErrMsg(..), showErrorList, + ErrorHandle, initErrorHandle, convExceptTToIO) +import Id +import PPrint +import PVPrint +import FileNameUtil + +import PreIds(idIsModule, idInout_, idClock, idReset, idInout, + idPreludeRead, idPreludeWrite, + idReg, id_read, id_write, idRWire, idWHas, idWGet, idWSet, + idPulseWire, idSend, idFIFO, idFIFOF, idEnq, idDeq, idFirst, + id_notFull, id_notEmpty) +import PreStrings(fsEmpty, fsLoop, fsBody) +import CSyntax +import CType +import Pred(Qual(..), expandSyn) +import ISyntax +import ISyntaxUtil(itBool, itClock, itReset) +import ASyntax +import ASyntaxUtil +import Pragma +import AScheduleInfo +import AUses(MethodId(..)) +import VModInfo +import ADumpSchedule +import BackendNamingConventions + +import Parser.BSV(pStringWrapper, pTypeExpr, pQualConstructor) + +import SymTab +import MakeSymTab +import Position(cmdPosition, noPosition) +import FStringCompat(mkFString, concatFString) +import TypeAnalysis +import TypeAnalysisTclUtil + +import ABin +import ABinUtil +import BinUtil(BinMap, BinFile, HashMap, readBin, sortImports) +import ForeignFunctions(ForeignFuncMap) +import SimPrimitiveModules(isPrimitiveModule) +import SimCCBlock(SimCCBlock(..), primBlocks) +import PreStrings(fsPrelude, fsUnderscore) +import GlobPattern + +import BluesimLoader +import Depend(genDepend,genFileDepend,chkDeps) +import InstNodes(InstNode(..), InstTree, isHidden, isHiddenKP, isHiddenAll, nodeChildren, comparein) +-- import Debug.Trace + +------------------------------------- +foreign export ccall "blueshell_Init_Foreign" blueshell_Init :: TclInterp -> IO Int + +-- 1st call to haskell world (run time system has already been setup) +blueshell_Init :: TclInterp -> IO Int +blueshell_Init interp = + let handler :: CE.IOException -> IO Int + handler e = htcl_AddObjErrorInfo interp (ioeGetErrorString e) + >>= return . fromEnum + in CE.catch + (do + initTclPackage + -- register commands + _ <- htclRegCommands interp tclCommands + -- setup a Ctrl-C handler + mv <- newEmptyMVar + _ <- forkIO (handleCtrlC mv) + _ <- installHandler sigINT (Catch $ recordCtrlC mv) Nothing + -- + return 0) -- TCL_OK + handler + +handleCtrlC :: MVar () -> IO () +handleCtrlC mv = do _ <- takeMVar mv + putStrLn "Got Ctrl-C!" + handleCtrlC mv + +recordCtrlC :: MVar () -> IO () +recordCtrlC mv = do putStrLn "recording Ctrl-C..." + _ <- tryPutMVar mv () + return () + +returnIO :: a -> IO a +returnIO = return + +namespace :: String +namespace = "::Bluetcl" + +-- List of all tcl commands provided by this module +tclCommands :: [HTclCmdDesc] +tclCommands = + [ htclMakeCmdDesc showArgGrammar showArgCmd + , HTclCmdDesc helpGrammar (htclRawFnToTclCmd helpCmd) + , htclMakeCmdDesc versionGrammar versionNum + , htclMakeCmdDesc flagsGrammar tclFlags + , htclMakeCmdDesc packageGrammar tclPackage + , htclMakeCmdDesc defsGrammar tclDefs + , htclMakeCmdDesc parseGrammar tclParse + , htclMakeCmdDesc typeGrammar tclType + , htclMakeCmdDesc moduleGrammar tclModule + , htclMakeCmdDesc scheduleGrammar tclSchedule + , htclMakeCmdDesc submodGrammar tclSubmodule + , htclMakeCmdDesc ruleGrammar tclRule + , htclMakeCmdDesc debugGrammar tclDebug + , htclMakeCmdDesc bpackGrammar tclBPack + , htclMakeCmdDesc bmodGrammar tclBMod + , htclMakeCmdDesc btypeGrammar tclBType + , htclMakeCmdDesc simGrammar tclSim + , htclMakeCmdDesc dependGrammar tclDepend + , htclMakeCmdDesc binstGrammar tclBrowseInst + ] +-- NOTE If you want the command exported out of the Bluetcl namespace add +-- export statement to /src/lib/tcllib/bluespec/bluespec.tcl + + +----------------------- +-- global data -- a TCL package +data TclP = TclP { tp_flags :: Flags + , tp_binmap :: !(BinMap Id) + , tp_hashmap :: !HashMap + , tp_symtab :: !SymTab + , tp_cpack :: !CPackage + , tp_mods :: !(Maybe ModInfo) + , tp_packView :: !(ExpandInfoBag BPackView) + , tp_modView :: !(ExpandInfoBag BModView) + , tp_typeView :: !( [(CType, TypeAnalysis)] + , ExpandInfoBag BTypeView ) + , tp_instView :: !(ExpandInfoBag BInst) + , tp_bluesim :: (Maybe BluesimModel) + } + +instance Show TclP where + show p = ( "{ TclP: " + ++ "{ Imports: " ++ show (M.toList (tp_binmap p)) ++ "}" + ++ "}" ) + +initState :: TclP +initState = + let + pid = mk_homeless_id "BlueTcl" + in TclP { tp_flags = defaultFlags "" + , tp_binmap = M.empty + , tp_hashmap = M.empty + , tp_symtab = emptySymtab + , tp_cpack = (CPackage pid (Right []) [] [] [] []) + , tp_mods = Nothing + , tp_packView = initExpandInfoBag + , tp_modView = initExpandInfoBag + , tp_typeView = ([], initExpandInfoBag) + , tp_instView = initExpandInfoBag + , tp_bluesim = Nothing + } + +-- ----- + +type ModInfo = + (Id, -- topmodId + HierMap, + InstModMap, + ForeignFuncMap, + [String], + [(String, ABinEitherModInfo)] -- loaded ba files + ) + +-- ----- + +lookupImport :: String -> IO (BinFile Id) +lookupImport pnm = do + g <- readIORef globalVar + case (M.lookup pnm (tp_binmap g)) of + Just res -> return res + Nothing -> lookupError "Package" pnm + +ip_id :: BinFile Id -> Id +ip_id (_, _, _, ipkg, _) = ipkg_name ipkg + +ip_path :: BinFile Id -> String +ip_path (fname, _, _, _, _) = (dirName fname) ++ "/" + +ip_csig :: BinFile Id -> CSignature +ip_csig (_, _, bo_sig, _, _) = bo_sig + +ip_ipkg :: BinFile Id -> IPackage Id +ip_ipkg (_, _, _, ipkg, _) = ipkg + +-- return the imports in a sorted order (the dependency order in cpack) +-- so that "bpackage" commands return results in a consistent order +getImportsSorted :: IO [BinFile Id] +getImportsSorted = do + imp_names <- getImportNamesSorted + mapM lookupImport imp_names + +getImportNamesSorted :: IO [String] +getImportNamesSorted = do + g <- readIORef globalVar + let (CPackage _ _ cimps _ _ _) = tp_cpack g + -- report the packages in reverse dependency order + imp_names = reverse $ [ iname | (CImpSign iname _ _) <- cimps ] + return imp_names + +-- ----- + +getGFlags :: IO (Flags) +getGFlags = readIORef globalVar >>= (return . tp_flags) + +initTclPackage :: IO () +initTclPackage = do + let handler :: CE.IOException -> IO String + handler e = ioError $ userError "BLUESPECDIR environment is not set." + bsdir <- CE.catch (getEnv "BLUESPECDIR" ) handler + + bscopts <- getEnvDef "BSC_OPTIONS" "" + flags <- updateFlags globalErrHandle cmdPosition (words bscopts) $ defaultFlags bsdir + + btopts <- getEnvDef "BLUETCL_OPTIONS" "" + flags' <- updateFlags globalErrHandle cmdPosition (words btopts) flags + + modifyIORef globalVar (\g -> g { tp_flags = flags' } ) + +{-# NOINLINE globalVar #-} +globalVar :: IORef TclP +globalVar = unsafePerformIO $ newIORef (initState) + +{-# NOINLINE globalErrHandle #-} +globalErrHandle :: ErrorHandle +globalErrHandle = unsafePerformIO $ initErrorHandle + +------------------- + +showArgGrammar :: HTclCmdGrammar +showArgGrammar = (tclcmd "showArg" namespace helpStr "") .+. + (atLeast 1 (arg "arg" StringArg "")) + where helpStr = "Describes the arguments of the command" + +showArgCmd :: [String] -> IO () +showArgCmd args = do _ <- foldM printer 0 args + return () + where printer :: Int -> String -> IO Int + printer cnt s = do putStrLn $ show (cnt+1) ++ ": \"" ++ s ++ "\"" + return $ cnt + 1 + +-------------------------------------------------------------------------------- + +helpGrammar :: HTclCmdGrammar +helpGrammar = (tclcmd "help" namespace helpStr longHelpStr) .+. + (optional $ oneOf [arg "command" StringArg "command name" + , kw "list" "List commands" "" + ]) + where helpStr = "Get help on available commands" + longHelpStr = init $ unlines + [ "Help with no arguments will list all available help topics." + , "Optionally, an argument can be provided to get help on a specific topic." + , "Also, 'help list' will return a string listing the names of all commands." + , "" + , "Examples:" + , " help" + , " help module" + , " help {flags show}" + , " help list" + ] + +-- Note: the helpCmd is different from other commands, since it +-- is used "raw". It takes TCL objects directly so that is can +-- make use of the grammar checking machinery. +helpCmd :: TclInterp -> [TclObj] -> IO String +helpCmd _ [_] = + let cmds = sortBy (\x y -> compare (htclCmdName x) (htclCmdName y)) tclCommands + cleanup ('_':rest) = rest + cleanup x = x + in return $ init $ unlines $ + [ "Available commands:" ] ++ + [ " " ++ name ++ desc + | c <- cmds + , (htclCmdName c) /= "debug" + , let name = take 15 $ (cleanup (htclCmdName c)) ++ (repeat ' ') + , let desc = htclGrammarShortDesc (grammar c) + ] ++ + [ "" + , "Use 'help ' to get help on a specific command." + ] +---------- +helpCmd interp [_,cmd] = do + objs <- htclObjToList interp cmd + case objs of + [] -> return "Use 'help' to see available commands." + (co:aos) -> do cname <- htclObjToString interp co + if ((cname == "list") && (null aos)) + then let cmds = sortBy (\x y -> compare (htclCmdName x) (htclCmdName y)) tclCommands + in return $ intercalate " " $ map htclCmdName cmds + else let c = find (\d -> cname == (htclCmdName d)) tclCommands + in case c of + (Just cd) -> show_help cd (co:aos) + Nothing -> return $ init $ unlines $ + [ "There is no command named '" ++ cname ++ "'" + , "" + , "Use 'help' to see available commands." + ] + where show_help c os = + do (matched, ws', g) <- htclMatchGrammar interp os (grammar c) + let isArg (_,(HTclArgument _ _ _)) = True + isArg _ = False + isKW (Just (HTclKeyword _ _ _)) = True + isKW _ = False + isKWorNone Nothing = True + isKWorNone e = isKW e + matched' = dropWhile isArg matched + cmd_words = map fst (reverse matched') + let cmd_objs = take (length cmd_words) os + prefix = unwords $ cmd_words + (_, _, g') <- htclMatchGrammar interp cmd_objs (grammar c) + let (sd,ld) = head $ [ (d,l) + | (_,(HTclKeyword _ d l)) <- matched' + , not (null d) + ] ++ [ (d,l) + | (_,(HTclCommand _ d l _)) <- matched' + , not (null d) + ] + err = if (null ws') + then [] + else [ "Note: invalid command form specified -- describing closest match", ""] + hdr = [ "Command: " ++ prefix ++ + (if (null sd) then "" else (" - " ++ sd)) ] + grammar_desc = htclDescribeCmdGrammar g' 60 + usage = [ "", "Usage: " ++ prefix ++ " " ++ grammar_desc ] + desc = if (null ld) + then [] + else [ "", ld ] + subtopics = case g' of + (ChooseFrom gs) -> + if (all isKWorNone (map htclFirstCmdElem gs)) + then [ "", "Subcommands: " ] ++ + [ " " ++ name ++ descr + | gr <- gs + , let name = take 30 $ (htclDescribeCmdGrammar gr 29) ++ (repeat ' ') + , let descr = htclGrammarShortDesc gr + ] + else [] + (Sequence (ChooseFrom gs) g2) -> + if (all isKW (map htclFirstCmdElem gs)) + then [ "", "Subcommands: " ] ++ + [ " " ++ name ++ descr + | gr <- gs + , let name = take 30 $ (htclDescribeCmdGrammar (Sequence gr g2) 29) ++ (repeat ' ') + , let descr = htclGrammarShortDesc gr + ] + else [] + _ -> [] + return $ init $ unlines $ + err ++ hdr ++ usage ++ desc ++ subtopics +---------- +helpCmd interp objs = htclCheckCmd helpGrammar fn interp objs + where fn xs = internalError $ "helpCmd: grammar mismatch: " ++ (show xs) + +-------------------------------------------------------------------------------- + +versionGrammar :: HTclCmdGrammar +versionGrammar = (tclcmd "version" namespace helpStr longHelpStr) .+. + (optional $ oneOf [ kw "bsc" bscHelpStr "" + , kw "ghc" ghcHelpStr "" + ]) + where helpStr = "Returns version information for Bluespec software" + longHelpStr = init $ unlines + [ "If no argument is provided, the subcommand 'bsc' is assumed." ] + bscHelpStr = "Show BSC version information" + ghcHelpStr = "Show the GHC version used to compile BSC" + +versionNum :: [String] -> IO HTclObj +versionNum [] = versionNum ["bsc"] +versionNum ["bsc"] = return $ TLst [TStr versionname, TStr buildVersion] +versionNum ["ghc"] = return $ TStr ghcVersionStr +versionNum xs = internalError $ "versionNum: grammar mismatch: " ++ (show xs) + +ghcVersionStr :: String +#if defined(__GLASGOW_HASKELL_FULL_VERSION__) +ghcVersionStr = __GLASGOW_HASKELL_FULL_VERSION__ +#else +ghcVersionStr = + let version_raw :: Int = __GLASGOW_HASKELL__ + (major, minor) :: (Int, Int) = version_raw `divMod` 100 +#if defined(__GLASGOW_HASKELL_PATCHLEVEL1__) + patch1 :: Int = __GLASGOW_HASKELL_PATCHLEVEL1__ + in show major ++ "." ++ show minor ++ "." ++ show patch1 +#else + in show major ++ "." ++ show minor +#endif +#endif + +-------------------------------------------------------------------------------- +-- flags + +flagsGrammar :: HTclCmdGrammar +flagsGrammar = (tclcmd "flags" namespace helpStr "") .+. + (oneOf [ (kw "set" setHelpStr longSetHelpStr) .+. + (atLeast 1 (arg "flag" StringArg "flag setting")) + , (kw "show" showHelpStr longShowHelpStr) .+. + (atLeast 0 (arg "flag" StringArg "flag")) + , (kw "reset" resetHelpStr resetHelpStr) + ]) + where helpStr = "Set or show a flag value" + setHelpStr = "Set a flag value" + longSetHelpStr = init $ unlines + [ "Set the value of a flag by giving its name along with any" + , "required or optional arguments. Include the leading '-'" + , "character in the flag name." + , "" + , "Examples:" + , " flags set -verbose" + , " flags set {-scheduler-effort 0}" + , " flags set {-scheduler-effort 0} -keep-fires" + ] + showHelpStr = "Show a flag value" + longShowHelpStr = init $ unlines + [ "Without an argument, shows the current settings of all flags." + , "With an argument, shows the current value of each flag named" + , "in the argument. Flag names are given without the leading '-'" + , "character. If a boolean flag is not currently set, an empty" + , "list ({}) is returned for its value, otherwise the name of the" + , "flag is returned." + , "" + , "Examples:" + , " flags show" + , " flags show verbose" + , " flags show scheduler-effort" + , " flags show steps steps-max-intervals steps-warn-interval" + ] + resetHelpStr = "Reset all flags to an initial state" +{- -} +tclFlags :: [String] -> IO [String] +tclFlags ["show"] = do + g <- readIORef globalVar + (return . concat . showFlagsLst . tp_flags) g +---------- +tclFlags ["show", "all"] = do + g <- readIORef globalVar + (return . concat . showFlagsAllLst . tp_flags) g +---------- +tclFlags ("show":ss) = do + g <- readIORef globalVar + mapM (getFlagValueString (tp_flags g)) ss >>= return . concat +---------- +tclFlags ("set":strs) = do + g <- readIORef globalVar + let (sets, ws0, es0 ,flags',sss) = decodeFlags strs ([], [], [], (tp_flags g)) + (ws, es, flags2) = adjustFinalFlags ws0 es0 flags' + reportErrorsToTcl ws es + checkEmptyList "Unexpected or unrecognized arguments." sss + modifyIORef globalVar (\gv -> gv{ tp_flags=flags2}) + mapM (getFlagValueString flags2) (reverse sets) >>= return . concat +---------- +tclFlags ["reset"] = do + let handler :: CE.IOException -> IO String + handler e = ioError $ userError "BLUESPECDIR environment is not set." + bsdir <- CE.catch (getEnv "BLUESPECDIR") handler + + bscopts <- getEnvDef "BSC_OPTIONS" "" + flags <- updateFlags globalErrHandle cmdPosition (words bscopts) $ defaultFlags bsdir + + btopts <- getEnvDef "BLUETCL_OPTIONS" "" + flags' <- updateFlags globalErrHandle cmdPosition (words btopts) flags + + modifyIORef globalVar (\gv -> gv{ tp_flags=flags'}) + (return . concat . showFlagsLst) flags + +tclFlags xs = internalError $ "tclFlags: grammar mismatch: " ++ (show xs) + +------------------------------------------------------------------------------- +-- debug command +debugGrammar :: HTclCmdGrammar +debugGrammar = (tclcmd "debug" namespace helpStr "") .+. + (oneOf [ gstateGrammar, importsGrammar, symtabGrammar + , errorGrammar, error2Grammar + , gcGrammar + ]) + where helpStr = "Internal debugging command" + gstateGrammar = kw "gstate" "gstate" "" + importsGrammar = kw "imports" "imports" "" + symtabGrammar = kw "symtab" "symtab" "" + errorGrammar = kw "error" "error" "" + error2Grammar = kw "error2" "error2" "" + gcGrammar = kw "gc" "gc" "" + +tclDebug :: [String] -> IO String +tclDebug ["gstate"] = do + g <- readIORef globalVar + return (show g) +---------- +tclDebug ["symtab"]= do + g <- readIORef globalVar + return $ show (pPrint PDReadable 0 (tp_symtab g)) +---------- +tclDebug ["imports"] = do + g <- readIORef globalVar + let imps = M.toList $ tp_binmap g + mapM_ (putStrLn . show) imps + return "Done" +---------- +-- throws an error via the built-in error +tclDebug ["error"] = do + let foo = ["dd", "ee", "ff", "sc" ] + flags <- getGFlags + return (foo !! 5) -- actually throws error +---------- +-- throws an error using an explicit error call +tclDebug ["error2"] = do + let foo = ["dd", "ee", "ff", "sc"] ++ + (replicate 10 (error "Index too big")) + flags <- getGFlags + return (foo !! 5) -- actually throws error +---------- +tclDebug ["gc"] = do + performGC + return "Done" + +---------- +tclDebug xs = internalError $ "tclDebug: grammar mismatch: " ++ (show xs) + +------------------------------------------------------------------------------- +-- Package commands + +packageGrammar :: HTclCmdGrammar +packageGrammar = (tclcmd "bpackage" namespace helpStr "") .+. + (oneOf [ loadGrammar, clearGrammar, listGrammar + , pdependGrammar, typesGrammar, searchGrammar + , vsignalsGrammar + , positionGrammar + ]) + where helpStr = "Manipulate and query BSV packages" + loadGrammar = (kw "load" "Load packages" "") .+. + (atLeast 1 (arg "pkg" StringArg "package name")) + clearGrammar = kw "clear" "Clear all currently loaded packages" "" + listGrammar = kw "list" "List all currently loaded packages" "" + pdependGrammar = kw "depend" "List package dependencies of all currently loaded packages" "" + typesGrammar = (kw "types" "List the types in a package" "") .+. + (arg "pkg" StringArg "package name") + searchGrammar = (kw "search" "Search packages for names matching a regular expression" "") .+. + (arg "regex" StringArg "regular expression") + vsignalsGrammar = kw "vsignals" "List signals corresponding to inlined Verilog modules" "" + positionGrammar = (kw "position" "get position of definition" "") .+. + (arg "identifier" StringArg "identifier" ) + +tclPackage :: [String] -> IO HTclObj +tclPackage ("load":args) = do + g <- readIORef globalVar + let ids = nub $ map mk_homeless_id args + + -- load the packages and every package that they depend on + let loadFn (binmap, hashmap, ps_read) p = do + (binmap', hashmap', _, new_ps) + <- readBin globalErrHandle (tp_flags g) Nothing binmap hashmap p + return (binmap', hashmap', new_ps ++ ps_read) + let binmap0 = tp_binmap g + hashmap0 = tp_hashmap g + (binmap, hashmap, ps_read) <- foldM loadFn (binmap0, hashmap0, []) ids + + let bininfos = let lookupFn i = fromJustOrErr "tclPackage load" $ + M.lookup (getIdString i) binmap + in map lookupFn ps_read + + -- update the CImports and symbol table + let (CPackage pid exps cimps cf defs incs) = tp_cpack g + mkCImp (_, _, bo_sig, (IPackage iid _ _ _), _) = + -- XXX is False OK here? + CImpSign (getIdString iid) False bo_sig + cimps' = sortImports ((map mkCImp bininfos) ++ cimps) + cpack' = CPackage pid exps cimps' cf defs incs + symtab <- mkSymTab globalErrHandle cpack' + + -- write back the new values + modifyIORef globalVar (\gv -> gv {tp_binmap = binmap, + tp_hashmap = hashmap, + tp_cpack = cpack', + tp_symtab = symtab } ) + -- report the packages in a consistent order + imp_names <- getImportNamesSorted + return $ TLst (map TStr imp_names) +----------- +tclPackage ["list"] = do + g <- readIORef globalVar + -- report the packages in a consistent order + imp_names <- getImportNamesSorted + return $ TLst (map TStr imp_names) +---------- +tclPackage ["depend"] = do + g <- readIORef globalVar + -- report the packages in a consistent order + imps <- getImportsSorted + let mkDep imp = + let ipkg = ip_ipkg imp + pId = ipkg_name ipkg + dIds = map fst (ipkg_depends ipkg) + in tagManyStr (pvpString pId) (map pvpString dIds) + -- XXX should the "bpackage" commands filter out Prelude, PreludeBSV, + -- XXX and any internal packages like PrimArray ? + return $ TLst (map mkDep imps) +---------- +tclPackage ["clear"] = do + let clrCPkg (CPackage pid _ _ _ _ _) = (CPackage pid (Right []) [] [] [] []) + modifyIORef globalVar (\gv -> gv { tp_binmap = M.empty, + tp_hashmap = M.empty, + tp_symtab = emptySymtab, + tp_cpack = clrCPkg (tp_cpack gv) }) + return $ TLst [] +--------- +tclPackage ["types",pkg] = do + g <- readIORef globalVar + let symtab = tp_symtab g + pid = mkFString pkg + isFromPackage :: (Id,TypeInfo) -> Bool + isFromPackage (i,_) = pid == getIdQual i + -- + theseTypes = filter isFromPackage (getAllTypes symtab) + let (is,tis) = unzip $ theseTypes + is' = filter (not . hideId) is + return $ TLst (map (TStr . pvpString . unQualId) is') +---------- +tclPackage ["search",rex] = do + g <- readIORef globalVar + -- report the packages in a consistent order + imps <- getImportsSorted + let regex = mkRegex rex + csigs = [ (ip_id imp, ip_csig imp) | imp <- imps ] + lookinThisPack :: (Id, CSignature) -> [(Id,String)] + lookinThisPack (imp_id, CSignature _ im cf ds) = + [ (imp_id, name) + | (Right i) <- map getName ds + , let name = getIdBaseString i + , isJust (matchRegex regex name) + ] + res = concatMap lookinThisPack csigs + obj <- toTclObj res + return $ TCL obj +---------- +tclPackage ["position",idenstr] = do + g <- readIORef globalVar + let iden = genId idenstr + -- if the Id isn't qualified, then look in all packages + csigs <- if (fsEmpty == getIdQual iden) + then do -- report the packages in a consistent order + imps <- getImportsSorted + return $ map ip_csig imps + else do imp <- lookupImport (getIdQualString iden) + return [ip_csig imp] + -- + let res = [(getPosition i) | (CSignature _ im cf ds) <- csigs, + (Right i) <- map getName ds, + qualEq iden i] + return $ case res of + [] -> toHTObj () + x:_ -> toHTObj (x) +---------- +-- generate the mapping e.g. +-- {read Q_OUT} {first D_OUT} {notFull FULL_N} {i_notFull FULL_N} {notEmpty EMPTY_N} {i_notEmpty EMPTY_N} {wget WGET} {whas WHAS} +-- This is a bit of a hack, since we lose all type information. + +tclPackage ["vsignals"] = + readIORef globalVar >>= + (return . toHTObj . package_vsignals) +---------- +tclPackage xs = internalError $ "tclPackage: grammar mismatch: " ++ (show xs) + +-- Create a new CPackage after package load +addNewImports :: [(CSignature, IPackage a, String, String)] -> + CPackage -> CPackage +addNewImports ims (CPackage pid exps imps cf defs incs) = + (CPackage pid exps imps' cf defs incs) + where imps' = imps ++ map addOneImport ims + addOneImport :: (CSignature, IPackage a, String, String) -> CImport + addOneImport (cs, (IPackage iid _ _ _), _, _) = + -- XXX Bool var for qual names? + CImpSign (getIdString iid) False cs + +------------------------------------------------------------------------------- +-- XX can this be merged with tclPackage command (only return id) + +defsGrammar :: HTclCmdGrammar +defsGrammar = (tclcmd "defs" namespace helpStr "") .+. + (oneOf [ allGrammar, tyGrammar, modGrammar, funcGrammar ]) .+. + (arg "pkg" StringArg "package name") + where helpStr = "Show the definitions in a package" + allGrammar = kw "all" "Show all definitions in a package" "" + tyGrammar = kw "type" "Show all types defined in a package" "" + modGrammar = kw "module" "Show all modules defined in a package" "" + funcGrammar = kw "func" "Show all functions defined in a package" "" + +tclDefs :: [String] -> IO HTclObj +tclDefs ("type":args) = + let getOneTypes :: String -> IO [Id] + getOneTypes pnm = do + imp <- lookupImport pnm + let (CSignature pid im cf ds) = ip_csig imp + return [ i | (Right i) <- map getName (filter isTDef ds) ] + in do tss <- mapM getOneTypes args + let ts = filter (not . hideId) (concat tss) + return $ TLst $ map (TStr . pvpString) ts +------ +tclDefs ("module":args) = + let getOneMods :: String -> IO [Id] + getOneMods pnm = do + imp <- lookupImport pnm + let (IPackage _ _ pragmas _) = ip_ipkg imp + getMods (Pnoinline fs) = fs + getMods (Pproperties m pps) = if (PPverilog `elem` pps) + then [m] + else [] + return $ concatMap getMods pragmas + in do mss <- mapM getOneMods args + let ms = concat mss + return $ TLst $ map (TStr . pvpString) ms +------ +tclDefs ("func":args) = + let getOneDefs :: String -> IO [HTclObj] + getOneDefs pnm = do + imp <- lookupImport pnm + let (CSignature pid im cf ds) = ip_csig imp + isOK d = case (getName d) of + Right i -> not (hideId i) + Left _ -> False + ds' = filter isOK ds + return $ concatMap displayCDefn ds' + in do fss <- mapM getOneDefs args + let fs = concat fss + return $ TLst fs +------ +tclDefs ("all":args) = + let getOneDefs :: String -> IO [Id] + getOneDefs pnm = do + imp <- lookupImport pnm + let (CSignature pid im cf ds) = ip_csig imp + return [ i | (Right i) <- map getName ds, not (hideId i) ] + in do dss <- mapM getOneDefs args + let ds = concat dss + return $ TLst $ map (TStr . pvpString) ds +------ +tclDefs xs = internalError $ "tclDefs: grammar mismatch: " ++ (show xs) + +------ + +-- XXX This displays a CDefn from a signature file. +-- XXX If we looked up the def in the IPackage, then it would have +-- XXX the argument names and we could display them. +displayCDefn :: CDefn -> [HTclObj] +displayCDefn (CIValueSign i cqt) = [displayTypeSignature i cqt] +displayCDefn (Cforeign i cqt _ _) = [displayTypeSignature i cqt] +displayCDefn (Cprimitive i cqt) = [displayTypeSignature i cqt] +displayCDefn (CValue i _) = + internalError ("displayCDefn: unexpected CValue: " ++ ppReadable i) +displayCDefn (CValueSign cdef) = + internalError ("displayCDefn: unexpected CValueSign: " ++ ppReadable cdef) +displayCDefn _ = [] -- don't display types, classes, instances + +displayTypeSignature :: Id -> CQType -> HTclObj +displayTypeSignature i qt@(CQType ps ty) = + let + (args, res) = getArrows ty + (con, conargs) = splitTAp res + + isModOfCon (CPred (CTypeclass isM) [m@(TVar _), _]) + | (isM == idIsModule) && (m == con) = True + isModOfCon _ = False + + (mods, ps') = partition isModOfCon ps + in + case (mods, conargs) of + ((_:_), [ifc]) -> displayModuleSignature i ps' args ifc + _ -> -- XXX check if "con" is a concrete module type? + -- XXX like "Module" + displayFunctionSignature i ps args res + +displayModuleSignature :: Id -> [CPred] -> [CType] -> CType -> HTclObj +displayModuleSignature i ps args ifc = + tag "module" $ + [TStr (pvpString i), + tagLst "interface" [TStr $ pvpString ifc]] ++ + (if (null args) + then [] + else [tagManyStr "arguments" (map pvpString args)]) ++ + (if (null ps) + then [] + else [tagManyStr "provisos" (map pvpString ps)]) ++ + showTaggedPosition i + +displayFunctionSignature :: Id -> [CPred] -> [CType] -> CType -> HTclObj +displayFunctionSignature i ps args res = + tag "function" $ + [TStr (pvpString i), + tagLst "result" [TStr $ pvpString res]] ++ + (if (null args) + then [] + else [tagManyStr "arguments" (map pvpString args)]) ++ + (if (null ps) + then [] + else [tagManyStr "provisos" (map pvpString ps)]) ++ + showTaggedPosition i + + +------------------------------------------------------------------------------- + +parseGrammar :: HTclCmdGrammar +parseGrammar = (tclcmd "parse" namespace helpStr "") .+. + (kw "type" "" "") .+. + (arg "arg" StringArg "string") + where helpStr = "Parse a string and show its internal representation" + +tclParse :: [String] -> IO [String] +tclParse ["type",s] = do + flags <- getGFlags + res <- pStringWrapper globalErrHandle flags pTypeExpr [s] + case res of + Right x -> return $ [(show x),show (pvPrint PDReadable 0 x)] + Left x -> return $ ["Error: " ++ (show x)] +------ +tclParse xs = internalError $ "tclParse: grammar mismatch: " ++ (show xs) + +------------------------------------------------------------------------------- + +typeGrammar :: HTclCmdGrammar +typeGrammar = (tclcmd "type" namespace helpStr longHelpStr) .+. + (oneOf [fullGrammar, constrGrammar,bitifyGrammar]) + where helpStr = "Display information about a type" + longHelpStr = init $ unlines $ + [ "Examples:" + , " type constr Maybe" + , " type full Maybe#(Int#(32))" + , " type full [type constr Maybe]" + ] + fullGrammar = (kw "full" "Describe the properties of a type" "") .+. + (arg "arg" StringArg "type") + constrGrammar = (kw "constr" "Show the type associated with a type constructor" "") .+. + (arg "arg" StringArg "constructor") + bitifyGrammar = (kw "bitify" "get bit information" "") .+. + (arg "arg" StringArg "type constructor") + + +tclType :: [String] -> IO HTclObj +tclType ["full",ty] = do + -- get the state + g <- readIORef globalVar + let st = tp_symtab g + flags = tp_flags g + -- read in the type + et <- pStringWrapper globalErrHandle flags pTypeExpr [ty] + -- do the analysis + case et of + Left err -> do reportErrorsToTcl [] err + return $ TLst [] -- reachable only if no errors + Right t -> case (analyzeType flags st t) of + Left errs -> do reportErrorsToTcl [] errs + return $ TLst [] -- reachable only if no errors + Right ta -> -- convert a non-error result to HTclObj and return it + return $ typeAnalysisToHTclObj ta +---------- +tclType ["constr",con] = do + g <- readIORef globalVar + let symtab = tp_symtab g + flags = tp_flags g + -- + typeid <- pStringWrapper globalErrHandle flags pQualConstructor [con] + let econs = either Left (lookupAndShowTypeInfo symtab) typeid + case econs of + Left err -> do reportErrorsToTcl [] err + return $ TLst [] -- reachable only if no errors + Right x -> return $ TStr x +---------- +tclType ["bitify",con] = do + -- get the state + g <- readIORef globalVar + let st = tp_symtab g + flags = tp_flags g + -- read in the type + et <- pStringWrapper globalErrHandle flags pTypeExpr [con] + -- do the analysis + case et of + Left err -> do reportErrorsToTcl [] err + return $ TLst [] -- reachable only if no errors + Right t -> case (analyzeType flags st t) of + Left errs -> do reportErrorsToTcl [] errs + return $ TLst [] -- reachable only if no errors + Right ta -> return $ typeAnalysisToBitify ta +---------- +tclType xs = internalError $ "tclType: grammar mismatch: " ++ (show xs) + +lookupAndShowTypeInfo :: SymTab -> Id -> Either [EMsg] String +lookupAndShowTypeInfo symtab tid = + case (findType symtab tid) of + Nothing -> Left [(cmdPosition,EUnboundTyCon (pvpString tid))] + Just (TypeInfo _ kind vs tis) -> Right (showType False tid kind vs) + + +---------------------------------------------------- + +moduleGrammar :: HTclCmdGrammar +moduleGrammar = (tclcmd "module" namespace helpStr "") .+. + (oneOf [ loadGrammar, clearGrammar, submodsGrammar + , rulesGrammar, ifcGrammar, methodsGrammar + , bflagsGrammar + , portsGrammar, porttypesGrammar, listGrammar + , methodConditionsGrammar + ]) + where helpStr = "Load and query information on a module" + argmod = (arg "module" StringArg "module name") + loadGrammar = (kw "load" "Load a synthesized module" "") .+. argmod + + clearGrammar = kw "clear" "Clear all loaded modules" "" + submodsGrammar = (kw "submods" "Show submodules of a module" "") .+. argmod + rulesGrammar = (kw "rules" "Show rules in a module" "") .+. + argmod + ifcGrammar = (kw "ifc" "Show the interface type of a module" "") .+. + argmod + methodsGrammar = (kw "methods" "Show the flattened methods of a module" "") .+. + argmod + portsGrammar = (kw "ports" "Show the ports of a module" "") .+. + argmod + methodConditionsGrammar = + (kw "methodconditions" "Show the method predicates of a module" "") .+. + argmod + listGrammar = (kw "list" "List the loaded modules" "") + porttypesGrammar = + (kw "porttypes" "Show the types of the ports of a module" "") .+. + (arg "module" StringArg "module name") + + +bflagsGrammar :: HTclCmdGrammar +bflagsGrammar = (kw "flags" showHelpStr longShowHelpStr) .+. + (arg "module" StringArg "module name") .+. + (atLeast 0 (arg "flag" StringArg "flag")) + where showHelpStr = "Show the flag settings when the module was built" + longShowHelpStr = init $ unlines + [ "With just the module name, shows the build settings of all flags." + , "With an added argument, shows the build value of each flag named" + , "in the argument. Flag names are given without the leading '-'" + , "character. If a boolean flag was not set, an empty" + , "list ({}) is returned for its value, otherwise the name of the" + , "flag is returned." + , "" + , "Examples:" + , " flags modname" + , " flags modname verbose" + , " flags modname scheduler-effort" + , " flags modname steps steps-max-intervals steps-warn-interval" + ] + +tclModule :: [String] -> IO HTclObj +tclModule ["load",topname] = do + g <- readIORef globalVar + let flags = tp_flags g + gen_backend <- case (backend flags) of + Just be -> return be + Nothing -> eMsgsToTcl [(cmdPosition, ENoBackendLinking)] + let prim_names = map sb_name primBlocks + -- when (isPrimitiveModule topname) + when (topname `elem` prim_names) $ + ioError $ userError ("Cannot load " ++ quote topname ++ + ": it is a primitive module") + -- getABIHierarchy calls GenABin.readABinFile to read a .ba file + (topmodId, hierMap, instModMap, ffuncMap, _, foreign_mods, abmis_by_name) + <- convExceptTToIO globalErrHandle $ + getABIHierarchy globalErrHandle + (verbose flags) (ifcPath flags) (Just gen_backend) + prim_names topname [] + let modnames = map fst abmis_by_name + let res = (topmodId, hierMap, instModMap, ffuncMap, foreign_mods, + [(n,mi) | (n,(mi,_)) <- abmis_by_name]) + modifyIORef globalVar (\gv -> gv { tp_mods = Just res }) + + -- now load the package in which the module was defined + -- (so that its interface types are available) + minfo <- findModule (getIdBaseString topmodId) + case minfo of + Nothing -> return () + Just abmi -> do let pkgName = abemi_src_name abmi + _ <- tclPackage ["load", pkgName] + return () + + -- return the list of loaded module + return $ TLst (map TStr modnames) +------ +tclModule ["list"] = do + g <- readIORef globalVar + return $ TLst $ case (tp_mods g) of + Nothing -> [] + Just (_, _, _, _, _, abmis) -> map (TStr . fst) abmis + +------ +tclModule ["clear"] = do + modifyIORef globalVar (\gv -> gv { tp_mods = Nothing }) + return $ TLst [] +------ +tclModule ["submods",modname] = do + if (isPrimitiveModule modname) + then return $ tag "primitive" [TLst [], TLst []] + else do + minfo <- findModuleHier modname + case minfo of + Nothing -> return $ tag "import" [TLst [], TLst []] + Just (mods, noinlines) -> do + let mkpair (inst, m) = TLst [TStr inst, TStr m] + mod_list = TLst (map mkpair mods) + noinline_list = TLst (map mkpair noinlines) + return $ tag "user" [mod_list, noinline_list] +------ +tclModule ["rules",modname] = do + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just abmi -> do + let apkg = abemi_apkg abmi + rule_names = map (pvpString . arule_id) (apkg_rules apkg) + return $ TLst (map TStr rule_names) +------ +tclModule ["ifc",modname] = do + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just abmi -> do + let ifcname = pvpString (getModuleIfc abmi) + return $ TStr ifcname +------ +tclModule ["methods",modname] = do + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just abmi -> do + let apkg = abemi_apkg abmi + pps = abemi_pps abmi + ifc = apkg_interface apkg + ifc_map = [ (aIfaceName aif, rawIfcFieldFromAIFace pps aif) + | aif <- ifc ] + let tifc = getModuleIfc abmi + fs <- getIfcHierarchy Nothing ifc_map tifc + return (dispIfcHierarchyNames fs) + +------ +tclModule ["ports",modname] = do + if (isPrimitiveModule modname) + then -- XXX we should be able to lookup the VModInfo for prim modules + return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] -- XXX can we do something for imports? + Just abmi -> do + let apkg = abemi_apkg abmi + pps = abemi_pps abmi + tifc = getModuleIfc abmi + (arginfo, ifcinfo) <- getModPortInfo apkg pps tifc + return $ TLst [tagLst "interface" (map dispIfc ifcinfo), + tagLst "args" (map dispModArg arginfo)] +------ +tclModule ["methodconditions", modname] = do + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just abmi -> let + defs :: [ADef] + defs = apkg_local_defs $ abemi_apkg abmi + ismethpred :: ADef -> Bool + ismethpred d = hasIdProp (adef_objid d) IdPMethodPredicate + doProp :: DefProp -> [HTclObj] + doProp (DefP_Rule i) = [ tagStr "rule" (getIdBaseString i) ] + doProp (DefP_Method i) = [ tagStr "method" (getIdBaseString i) ] + doProp (DefP_Instance i) = [ tagStr "instance" (getIdBaseString i) ] + doProp DefP_NoCSE = [] + convert :: ADef -> HTclObj + convert (ADef i _t e ps) = + TLst $ [ TStr (getIdBaseString i) + , TLst $ TStr "positions" : + (map toHTObj $ fromMaybe [] $ getIdInlinedPositions i) + ] ++ concatMap doProp ps + -- sort the list, so that the output has a stable canonical order + -- (we sort by the unique number, but we could also do alphabetical) + cmpFn d1 d2 = + let extractNum :: ADef -> Integer + extractNum d = + readOrErr ("MethodPred unique number") $ + reverse $ takeWhile (/= '_') $ reverse $ + getIdBaseString (adef_objid d) + in compare (extractNum d1) (extractNum d2) + in return $ TLst $ map convert $ sortBy cmpFn $ filter ismethpred defs + +------ +tclModule ["porttypes",modname] = do + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just abmi -> do + let apkg = abemi_apkg abmi + pps = abemi_pps abmi + tifc = getModuleIfc abmi + (arginfo, ifcinfo) <- getModPortInfo apkg pps tifc + let h_arg_types = concatMap dispPortsModArg arginfo + h_ifc_types = concatMap dispPortsIfc ifcinfo + return $ TLst $ nub (h_arg_types ++ h_ifc_types) +------ +tclModule ["flags",modname] = do + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just abmi -> return $ TLst (map TStr (concat $ showFlagsLst (abemi_flags abmi))) + +tclModule ["flags", modname, "all"] = do + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just abmi -> return $ TLst (map TStr (concat $ showFlagsAllLst (abemi_flags abmi))) + +tclModule ("flags":modname:ss) = do + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just abmi -> do + strs <- mapM (getFlagValueString (abemi_flags abmi)) ss >>= return . concat + return $ TLst (map TStr strs) + + +------ +tclModule xs = internalError $ "tclModule: grmap (TStr . pvpString) grammar mismatch: " ++ (show xs) + + +findModule :: String -> IO (Maybe ABinEitherModInfo) +findModule modname = + do g <- readIORef globalVar + (amods, fmods) <- + case (tp_mods g) of + Nothing -> lookupError "Module" modname + Just (top, hiermap, instmodmap, ffuncmap, foreigns, abmis) -> + return (abmis, foreigns) + case (lookup modname amods) of + Just abmi -> return $ Just abmi + Nothing -> if (modname `elem` fmods) + then return Nothing + else lookupError "Module" modname + +findModuleHier :: String -> IO (Maybe ([(String,String)], [(String,String)])) +findModuleHier modname = do + g <- readIORef globalVar + (hmap, fmods) <- + case (tp_mods g) of + Nothing -> lookupError "Module" modname + Just (top, hiermap, instmodmap, ffuncmap, foreigns, abmis) -> + return (hiermap, foreigns) + case (M.lookup modname hmap) of + Just res -> return $ Just res + Nothing -> if (modname `elem` fmods) + then return Nothing + else lookupError "Module" modname + +-- error on bad names +-- Left name for primitives +-- Right otherwise +findModuleByInstance :: [String] -> IO (Either String (String, ABinModInfo)) +findModuleByInstance insts = do + let inst = intercalate "." insts + g <- readIORef globalVar + case (tp_mods g) of + Nothing -> lookupError "Module Instance" inst + Just (top, hiermap, instmodmap, ffuncmap, foreigns, abmis) -> + do + case (M.lookup inst instmodmap) of + Nothing -> do mapM_ (putStrLn . show) $ M.toList instmodmap + putStrLn $ "Error looking up: " ++ inst + return (Left $ last insts)-- lookupError "Module Instance2" inst + Just s | isPrimitiveModule s -> return (Left s) + Just s -> + do minfo <- findModule s + case minfo of + Nothing -> return (Left s) + Just (Right info) -> return (Right (s, info)) + -- submodules should not have scheduling errors + Just (Left info) -> + eMsgsToTcl [(cmdPosition, + EABinModSchedErr s Nothing)] + +getModuleIfc :: ABinEitherModInfo -> Type +getModuleIfc abmi = + let (CQType _ ot) = abemi_oqt abmi + in case (getArrows ot) of + (_, TAp _ t) -> t + (_, tm) -> internalError ("getModuleIfc: tm = " ++ ppReadable tm) + +---------------------------------------------------- + +scheduleGrammar :: HTclCmdGrammar +scheduleGrammar = (tclcmd "schedule" namespace helpStr "") .+. + (oneOf [ urgencyKW, execKW, methKW, pathKW, warnKW, errKW ]) .+. + (arg "module" StringArg "module name") + where helpStr = "Query a module schedule" + urgencyKW = kw "urgency" "Show schedule urgency order" "" + execKW = kw "execution" "Show schedule execution order" "" + methKW = kw "methodinfo" "Show schedule method info" "" + pathKW = kw "pathinfo" "Show schedule path info" "" + warnKW = kw "warnings" "Show scheduler warnings" "" + errKW = kw "errors" "Show scheduler errors" "" + +tclSchedule :: [String] -> IO HTclObj +tclSchedule ["urgency",modname] = + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just abmi -> + case (abemi_schedule abmi) of + Nothing -> return $ TLst [] + Just asched -> do + let sched = + let extractEsposito (ASchedEsposito xs) = xs + in concatMap extractEsposito (asch_scheduler asched) + h_sched = + let mkS (r, rs) = tagManyStr (pvpString r) (map pvpString rs) + in map mkS sched + return $ TLst h_sched +------ +tclSchedule ["execution",modname] = + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just abmi -> + case (abemi_schedule abmi) of + Nothing -> do + -- Return just the rules in default order + let apkg = abemi_apkg abmi + rules = map arule_id (apkg_rules apkg) + h_rules = map (TStr . pvpString) rules + return $ TLst h_rules + Just asched -> do + let -- turn around the order - first rule first. + exec_order = reverse $ asch_rev_exec_order asched + h_exec_order = map (TStr . pvpString) exec_order + return $ TLst h_exec_order +------ +tclSchedule ["methodinfo",modname] = + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just (Left abmsei) -> return $ TLst [] + Just (Right abmi) -> do + let asi = abmi_aschedinfo abmi + pkg = abmi_apkg abmi + ifc = apkg_interface pkg + vsi = asi_v_sched_info asi + methmap = genMethodDumpMap vsi ifc + let h_methmap = + let mkC (r,c) = TLst [TStr (pvpString r), TStr (show c)] + mkP (r,_,cs) = tagLst (pvpString r) (map mkC cs) + in map mkP methmap + return $ TLst h_methmap +------ +tclSchedule ["pathinfo",modname] = + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just (Left abmsei) -> return $ TLst [] + Just (Right abmi) -> do + let pathinfo = abmi_pathinfo abmi + -- join paths going to the same output + joinPaths [] = [] + joinPaths zs@((_,o):_) = + case (partition ((== o) . snd) zs) of + (xs, ys) -> (map fst xs, o) : joinPaths ys + joinedinfo = case pathinfo of + VPathInfo ps -> joinPaths ps + -- format for tcl + let h_pathinfo = + let mkP (ins, out) = TLst [TLst (map (TStr . pvpString) ins), + TStr (pvpString out)] + in map mkP joinedinfo + return $ TLst h_pathinfo +------ +tclSchedule ["warnings",modname] = + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just abmi -> do + let ws = abemi_warnings abmi + let h_ws = let mkW (pos, t, str) = + TLst [TLst $ map TStr (tclPosition pos), + TStr t, + TStr str] + in map mkW ws + return $ TLst h_ws +------ +tclSchedule ["errors",modname] = + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just (Right r) -> return $ TLst [] + Just (Left abmsei) -> do + let asi = abmsei_aschederrinfo abmsei + es = asei_errors asi + let h_es = let mkE (pos, t, str) = + TLst [TLst $ map TStr (tclPosition pos), + TStr t, + TStr str] + in map mkE es + return $ TLst h_es +------ +tclSchedule xs = internalError $ "tclSchedule: grammar mismatch: " ++ (show xs) + +---------------------------------------------------- + +submodGrammar :: HTclCmdGrammar +submodGrammar = (tclcmd "submodule" namespace helpStr "") .+. + (oneOf [ (kw "full" "" "") .+. + (arg "module" StringArg "module name") + , (kw "ports" "" "") .+. + (arg "module" StringArg "module name") + , (kw "porttypes" "" "") .+. + (arg "module" StringArg "module name") + ]) + where helpStr = "Query submodules" + +tclSubmodule :: [String] -> IO HTclObj +tclSubmodule ["full",modname] = + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just abmi -> do + flags <- getGFlags + let hide = (not (tclShowHidden flags)) + apkg = abemi_apkg abmi + avis = apkg_state_instances apkg + docmap = M.fromList (mapFst getIdString (apkg_inst_comments apkg)) + findDocs submod = fromMaybe [] (M.lookup submod docmap) + -- convert the method uses map into a subinst uses map + let mumap = abemi_method_uses_map abmi + sumap = + let edges = [ (getIdString instId, [(methId, uses)]) + | (MethodId instId methId, uses) <- M.toList mumap ] + in -- use "flip" to preserve the method order + M.fromListWith (flip (++)) edges + -- mapping from submods to their ifc type + let ifc_map = makeSubmoduleIfcMap hide (apkg_inst_tree apkg) + -- make the result for an individual AVInst + let mkInfo avi = do + let submodname = getVNameString $ vName $ avi_vmi avi + instId = avi_vname avi + instname = getIdString instId + instpos = getPosition instId + docs = findDocs submodname + -- some internal probes won't be found, so use Maybe + mtifc = M.lookup instId ifc_map + (arginfo, ifcinfo) <- getSubmodPortInfo mtifc avi + let vmethod_sis = get_method_to_signal_map (avi_vmi avi) + let h_ports = concatMap dispPortsModArg arginfo ++ + concatMap dispPortsIfc ifcinfo + h_uses = + let mkMU (methId, (rs1, rs2, is)) = + tag (getIdString methId) + [TLst (map (TStr . getIdString) rs1), + TLst (map (TStr . getIdString) rs2), + TLst (map (TStr . getIdString) is)] + concatUses uses = concatUnzip3 (map snd uses) + in case (M.lookup instname sumap) of + Nothing -> [] + Just mus -> [tag "users" + (map mkMU (mapSnd concatUses mus))] + return $ + TLst $ [TStr instname, TStr submodname] ++ + (if (null docs) + then [] + else [tagManyStr "doc" docs]) ++ + [tagLst "ports" h_ports] ++ + h_uses ++ + [tagLst "mports" (map toHTObj vmethod_sis)] ++ + showTaggedPosition instpos + infs <- mapM mkInfo avis + return $ TLst infs +---------- +tclSubmodule ["ports",modname] = + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just abmi -> do + flags <- getGFlags + let hide = (not (tclShowHidden flags)) + apkg = abemi_apkg abmi + avis = apkg_state_instances apkg + -- mapping from submods to their ifc type + let ifc_map = makeSubmoduleIfcMap hide (apkg_inst_tree apkg) + -- make the result for an individual AVInst + let mkInfo avi = do + let vmi = avi_vmi avi + submodname = getVNameString $ vName vmi + instId = avi_vname avi + instname = getIdString instId + -- some internal probes won't be found, so use Maybe + mtifc = M.lookup instId ifc_map + (arginfo, ifcinfo) <- getSubmodPortInfo mtifc avi + let hifcs = map dispIfc ifcinfo + hargs = map dispModArg arginfo + return $ + TLst $ [TStr instname, TStr submodname, + tagLst "interface" hifcs, + tagLst "args" hargs] + infs <- mapM mkInfo avis + return $ TLst infs +---------- +tclSubmodule ["porttypes",modname] = + if (isPrimitiveModule modname) + then return $ TLst [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ TLst [] + Just abmi -> do + flags <- getGFlags + let hide = (not (tclShowHidden flags)) + apkg = abemi_apkg abmi + avis = apkg_state_instances apkg + -- mapping from submods to their ifc type + let ifc_map = makeSubmoduleIfcMap hide (apkg_inst_tree apkg) + -- make the result for an individual AVInst + let mkInfo avi = do + let vmi = avi_vmi avi + submodname = getVNameString $ vName vmi + instId = avi_vname avi + instname = getIdString instId + -- some internal probes won't be found, so use Maybe + mtifc = M.lookup instId ifc_map + (arginfo, ifcinfo) <- getSubmodPortInfo mtifc avi + let hargs = concatMap dispPortsModArg arginfo + hifcs = concatMap dispPortsIfc ifcinfo + return $ + TLst $ [TStr instname, TStr submodname, + TLst [TStr "ports", TLst $ nub (hargs ++ hifcs)]] + infs <- mapM mkInfo avis + return $ TLst infs +---------- +tclSubmodule xs = internalError $ "tclSubmodule: grammar mismatch: " ++ (show xs) + +---------------------------------------------------- + +ruleGrammar :: HTclCmdGrammar +ruleGrammar = (tclcmd "rule" namespace helpStr "") .+. + (oneOf [ fullGrammar, relGrammar ]) + where helpStr = "Query rules and rule relationships in a module" + fullGrammar = (kw "full" "Show rule in a module" "") .+. + (arg "module" StringArg "module name") .+. + (arg "rule" StringArg "rule name") + relGrammar = (kw "rel" "Show rule relationships" "") .+. + (arg "module" StringArg "module name") .+. + (arg "rule1" StringArg "rule name") .+. + (arg "rule2" StringArg "rule name") + +tclRule :: [String] -> IO HTclObj +tclRule ["rel", modname, rule1, rule2] = + if (isPrimitiveModule modname) + then ioError $ userError ("Primitive modules cannot be queried") + else do + minfo <- findModule modname + case minfo of + Nothing -> ioError $ userError ("Imported modules cannot be queried") + Just abmi -> + case (abemi_rule_relation_db abmi) of + Nothing -> return $ + TStr "Rule relationship information not available" + Just rrdb -> do + let apkg = abemi_apkg abmi + user_rule_names = map arule_id (apkg_rules apkg) + ifc_rule_names = concatMap aIfaceSchedNames + (apkg_interface apkg) + rule_names = map pvpString (user_rule_names ++ ifc_rule_names) + let mkRuleErr r = + ioError $ userError (quote r ++ + " is not a rule in module " ++ + quote modname) + when (rule1 `notElem` rule_names) $ mkRuleErr rule1 + when (rule2 `notElem` rule_names) $ mkRuleErr rule2 + let rId1 = mk_homeless_id rule1 + rId2 = mk_homeless_id rule2 + (disj, rinfo) = getRuleRelation rrdb rId1 rId2 + return $ TStr (ppDoc (printRuleRelationInfo rId1 rId2 disj rinfo)) +---------- +tclRule ["full",modname,rule] = + if (isPrimitiveModule modname) + then ioError $ userError ("Primitive modules cannot be queried") + else do + minfo <- findModule modname + case minfo of + Nothing -> ioError $ userError ("Imported modules cannot be queried") + Just abmi -> do + -- package contents + let user_rules = apkg_rules (abemi_apkg abmi) + ifcs = apkg_interface (abemi_apkg abmi) + ds = apkg_local_defs (abemi_apkg abmi) + pps = abemi_pps abmi + mumap = M.toList $ abemi_method_uses_map abmi + -- find the rule + let user_rule_names = map pvpString $ map arule_id user_rules + ifc_rule_names = map pvpString $ concatMap aIfaceSchedNames ifcs + isIfcRule = rule `notElem` user_rule_names + when ((rule `notElem` user_rule_names) && + (rule `notElem` ifc_rule_names)) $ + ioError $ userError (quote rule ++ " is not a rule in module " ++ + quote modname) + let rId = mk_homeless_id rule + let isARule r = (arule_id r == rId) + (attrs, pos, predicate) = + if (isIfcRule) + then let cvtIfc (AIAction inputs props ifPred ifId ifRs fi) = + case (find isARule ifRs) of + Nothing -> Nothing + Just (ARule i ps _ _ rPred _ _ _) -> + Just (ps, getPosition i, aAnds [ifPred, rPred]) + cvtIfc (AIActionValue _ _ ifPred ifId ifRs _ _) = + case (find isARule ifRs) of + Nothing -> Nothing + Just (ARule i ps _ _ rPred _ _ _) -> + Just (ps, getPosition i, aAnds [ifPred, rPred]) + cvtIfc (AIDef _ _ _ ifPred (ADef dId _ _ _) _ _) = + if (dId == rId) + then Just ([], getPosition dId, ifPred) + else Nothing + cvtIfc _ = Nothing + in case (catMaybes (map cvtIfc ifcs)) of + [] -> internalError ("tclRule full: method not found") + (res : _) -> res + else -- find the ARule + case (find isARule user_rules) of + Nothing -> internalError ("tclRule full: rule not found") + Just (ARule i ps _ _ p _ _ _) -> (ps, getPosition i, p) + -- separate the doc attribute from the other attributes + let (doc_attrs, other_attrs) = + let isDoc (RPdoc {}) = True + isDoc _ = False + in partition isDoc attrs + -- expand the predicate + let methodRdys :: [ADef] + methodRdys = [ v + | (AIDef { aif_name = mn, aif_value = v }) <- ifcs + , isRdyId mn ] + let pred_expanded = ppeString (methodRdys ++ ds) bContext predicate + -- method calls + -- XXX flattening the MethodUsesMap is expensive? + let pred_uses = + sort [ ppString mId + | (mId, uses) <- mumap + , (uu, (pred_users, _, _)) <- uses + , rId `elem` pred_users ] + body_uses = + sort [ ppString mId + | (mId, uses) <- mumap + , (uu, (_, body_users, _)) <- uses + , rId `elem` body_users ] + -- relation to other rules if left to the "rel" subcmd + -- put it all together + let h_kind = [TStr $ if (isIfcRule) then "method" else "rule"] + h_pos = showTaggedPosition pos + h_doc_attrs = + let cvtDoc (RPdoc x) = x + cvtDoc _ = internalError ("tclRule: cvtDoc") + in if (null doc_attrs) + then [] + else [tagManyStr "doc" (map cvtDoc doc_attrs)] + h_other_attrs = + if (null other_attrs) + then [] + else [tagManyStr "attrs" (map getRulePragmaName other_attrs)] + h_pred = [tagStr "predicate" pred_expanded] + h_methods = [tagLst "methods" + [TLst (map TStr pred_uses), + TLst (map TStr body_uses)]] + return $ TLst $ h_kind ++ + h_pos ++ + h_other_attrs ++ + h_doc_attrs ++ + h_pred ++ + h_methods +---------- +tclRule xs = internalError $ "tclRule: grammar mismatch: " ++ (show xs) + +---------------------------------------------------- +data BPackView = BRoot + | BDir String -- directory where .bo files were read + | BPackage BPackSub Id + | LeafType Id String -- Id is type name, and String is constr + | LeafFunc Id + | LeafId Id + +data BPackSub = Top | Types | Funcs -- Should be able to break to Ifc and Modules + +descPackElem :: BPackView -> String +descPackElem e = case e of + BRoot -> "root" + BDir _ -> "Directory" + BPackage Top _ -> "Package" + BPackage Types _ -> "Type List" + BPackage Funcs _ -> "Function List" + LeafType _ _ -> "Type" + LeafFunc _ -> "Function" + LeafId _ -> "Unknown" + +-- Instance of ExpandInfoHelper to for iwidget tree view +instance ExpandInfoHelper BPackView where + -- + getRootElem = return BRoot + getChildrenf BRoot = do + g <- readIORef globalVar + let -- display all paths, not just the ones with loaded packages, + -- and do it in the order they are specified in the user's path + paths0 = ifcPath (tp_flags g) + + -- we rely on flag processing to remove empty & duplicate dirs + return (map BDir paths0) + + -- + -- Find the children of the element + -- getChildrenf :: BPackView -> IO [BPackView] + getChildrenf (BDir p) = do + g <- readIORef globalVar + let -- make sure the paths end with '/' + addSlash s = if (lastOrErr "addSlash" s) == '/' + then s + else s ++ "/" + pkgs = sortBy cmpIdByName $ + [ unQualId (ip_id imp) + | imp <- M.elems (tp_binmap g), + (ip_path imp) == (addSlash p) ] + return (map (BPackage Top) pkgs) + + getChildrenf (BPackage Top x) = return [BPackage Funcs x, BPackage Types x] + getChildrenf (BPackage Types x) = do + tids <- getPackageContents x True >>= return . (sortBy cmpIdByName) + symtab <- readIORef globalVar >>= (return . tp_symtab) + -- + let genLeafs :: Id -> BPackView + genLeafs tid = + let econstr = lookupAndShowTypeInfo symtab tid + in either (const (LeafId tid)) (LeafType tid) econstr + return $ map genLeafs tids + + getChildrenf (BPackage Funcs x) = do + tids <- getPackageContents x False >>= return . (sortBy cmpIdByName) + return $ map (LeafFunc) tids + getChildrenf _ = return [] + -- + -- Get the display text in the tree + -- getTextf :: BPackView -> IO String + getTextf BRoot = return "" + getTextf (BDir p) = do + g <- readIORef globalVar + -- replace BLUESPECDIR with "%" + let bscdir = bluespecDir (tp_flags g) + replaceBluespecDir s = + let -- handle bsdir with and without a slash; + -- if bsdir doesn't end in a slash, make sure the next + -- character is a slash (don't match a prefix); + -- remove any duplicate slashes after the bdir + rep ['/'] ('/':rs) = Just ("%/" ++ dropWhile (== '/') rs) + rep [] ('/':rs) = Just ("%/" ++ dropWhile (== '/') rs) + rep (b:bs) (r:rs) | (b == r) = rep bs rs + rep _ rest = Nothing + in fromMaybe s (rep bscdir s) + return $ replaceBluespecDir p + getTextf (BPackage Top x ) = return $ getIdBaseString x + getTextf (BPackage Types _) = return $ "Types and Interfaces" + getTextf (BPackage Funcs _) = return $ "Functions and Modules" + getTextf (LeafType tid s) = return $ getIdBaseString tid + getTextf (LeafFunc x) = return $ getIdBaseString x + getTextf (LeafId x) = return $ getIdBaseString x + + getTagsf _ = return [] + + -- + -- Get the information for the selected element + getInfof (BRoot) = return $ TLst [] + getInfof (BDir p) = return $ TStr p + getInfof (BPackage Top x ) = return $ tag (getIdBaseString x) (showTaggedPosition x) + getInfof (BPackage Types _) = return $ TStr "Types" + getInfof (BPackage Funcs _) = return $ TStr "Functions" + + getInfof (LeafType tid s) = do + g <- readIORef globalVar + let flags = tp_flags g + symtab = tp_symtab g + et <- pStringWrapper globalErrHandle flags pTypeExpr [s] + let es :: Either [EMsg] TypeAnalysis + es = either Left (analyzeType flags symtab) et + return $ case es of + Left err -> TStr $ showErrorList err + Right ty -> typeAnalysisToDetail ty + + getInfof (LeafFunc fid) = do + imp <- lookupImport (getIdQualString fid) + let (CSignature _ _ _ ds) = ip_csig imp + ds' = filter (\d -> getName d == Right fid) ds + case (ds') of + [d] -> case (displayCDefn d) of + [hobj] -> return hobj + _ -> return $ TStr (getIdBaseString fid) + [] -> internalError ("tclBPack: getInfof: def not found: " ++ + ppReadable fid) + _ -> internalError ("tclBPack: getInfof: multiple defs: " ++ + ppReadable fid) + + getInfof (LeafId x) = + return $ TStr (getIdBaseString x) -- XXX + +-- test function for browsepackage search command +bpackSearchf :: String -> BPackView -> Bool +bpackSearchf rex (LeafType i s) = isJust (matchRegex regex s) + where regex = mkRegex rex +bpackSearchf rex (LeafFunc i) = isJust (matchRegex regex s) + where regex = mkRegex rex + s = getIdBaseString i +bpackSearchf _ _ = False + +hideId :: Id -> Bool +hideId i = (isInternal i) || primFun || primType || underunder + where primFun = getIdQual i == fsPrelude && take 4 (getIdBaseString i) == "prim" + primType = getIdQual i == fsPrelude && take 4 (getIdBaseString i) == "Prim" + underunder = getIdQual i == fsPrelude && take 2 (getIdBaseString i) == "__" + + +-- Used in bpackageview command +getPackageContents :: Id -> Bool -> IO [Id] +getPackageContents pid typesonly = do + imp <- lookupImport (getIdBaseString pid) + let (CSignature _ im cf ds) = ip_csig imp + ds' = filter (\x -> typesonly == isTDef x) ds + names = [ i | (Right i) <- map getName ds' ] + -- names from other packages are include in this def, filter them here + names' = filter (\x -> (getIdQual x) == (getIdBase pid)) names + return $ filter (not . hideId) names' + +---- + +bpackGrammar :: HTclCmdGrammar +bpackGrammar = (tclcmd "browsepackage" namespace helpStr "") .+. + (oneOf [ listGrammar, detailGrammar, refreshGrammar + , nodekindGrammar, searchGrammer, dbgGrammar + ]) + where helpStr = "Utility function for viewing package contents" + listGrammar = (kw "list" "" "") .+. (arg "key" IntArg "integer") + detailGrammar = (kw "detail" "" "") .+. (arg "key" IntArg "integer") + refreshGrammar = kw "refresh" "" "" + nodekindGrammar = (kw "nodekind" "" "") .+. (arg "key" IntArg "integer") + searchGrammer = (kw "search" "" "") .+. (arg "regex" StringArg "search regex") + dbgGrammar = kw "debug" "" "" + +tclBPack :: [String] -> IO HTclObj +tclBPack ["list", keystr] = do + let key :: Int = read keystr + g <- readIORef globalVar + let b = tp_packView g + (b',ro) <- getChildren b key + -- + modifyIORef globalVar (\gv -> gv {tp_packView=b'}) + return $ toHTObj ro +---------- +tclBPack ["detail", keystr] = do + let key :: Int = read keystr + b <- readIORef globalVar >>= (return . tp_packView) + getInfo b key +---------- +tclBPack ["refresh"] = do + g <- readIORef globalVar + modifyIORef globalVar (\gv -> gv { tp_packView = initExpandInfoBag }) + return $ TLst [] +---------- +tclBPack ["nodekind", istr] = do + let i :: Int = read istr + g <- readIORef globalVar + let b = tp_packView g + e = getEIElement $ lookupEIElement b i + return $ toHTObj $ descPackElem e +---------- +tclBPack ["search",rex] = do + b <- readIORef globalVar >>= (return . tp_packView) + (b',fs) <- eieSearch (bpackSearchf rex) b + modifyIORef globalVar (\gv -> gv {tp_packView=b'}) + return $ toHTObj (reverse fs) +---------- +tclBPack ["debug"] = do + b <- readIORef globalVar >>= (return . tp_packView) + dmp <- eieDump b + return $ toHTObj dmp + +---------- +tclBPack xs = internalError $ "tclBPack: grammar mismatch: " ++ (show xs) + +---------------------------------------------------- + +data BModView = BModule String String + +-- Instance of ExpandInfoHelper to for iwidget tree view +instance ExpandInfoHelper BModView where + -- + getRootElem = return $ BModule "" "" + getChildrenf (BModule "" "" ) = do + g <- readIORef globalVar + case (tp_mods g) of + Nothing -> return [] + Just (topmodId, _, _, _, _, _) -> + let node = BModule "top" (getIdBaseString topmodId) + in return [node] + -- + -- Find the children of the element + -- getChildrenf :: BModView -> IO [BPackView] + getChildrenf (BModule instname modname) = + if (isPrimitiveModule modname) + then return [] + else do + minfo <- findModuleHier modname + case minfo of + Nothing -> return [] + Just (mods, noinlines) -> + let mkNode (inst, m) = BModule inst m + in return (map mkNode (mods ++ noinlines)) + -- + -- Get the display text in the tree + -- getTextf :: BModView -> IO String + getTextf (BModule inst m) = return $ inst ++ " (" ++ m ++ ")" + getTagsf _ = return [] + -- + -- Get the information for the selected element + getInfof (BModule inst modname) = + if (isPrimitiveModule modname) + then return $ tag "primitive" [] + else do + minfo <- findModule modname + case minfo of + Nothing -> return $ tag "import" [] + Just abmi -> do + let apkg = abemi_apkg abmi + -- interface type + let ifcname = pvpString (getModuleIfc abmi) + -- flattened ifc names + let ifc_names = map pvpString $ + filter (not . isRdyId) $ + map (aIfaceName) (apkg_interface apkg) + -- rules + let rule_names = map (pvpString . arule_id) (apkg_rules apkg) + -- schedule + let sched = case (abemi_schedule abmi) of + Just s -> ppString s + Nothing -> "" + return $ + tag "user" + [tag "instance" $ [TStr inst], + tag "module" $ [TStr modname], + tag "interface" $ [TStr ifcname], + tag "methods" $ [TLst (map TStr ifc_names)], + tag "rules" $ [TLst (map TStr rule_names)], + tag "schedule" $ [TStr sched]] + +---- + +bmodGrammar :: HTclCmdGrammar +bmodGrammar = (tclcmd "browsemodule" namespace helpStr "") .+. + (oneOf [ listGrammar, detailGrammar, refreshGrammar, dbgGrammar ]) + where helpStr = "Utility function for viewing module hierarchy" + listGrammar = (kw "list" "" "") .+. (arg "key" IntArg "integer") + detailGrammar = (kw "detail" "" "") .+. (arg "key" IntArg "integer") + refreshGrammar = kw "refresh" "" "" + dbgGrammar = kw "debug" "" "" + +tclBMod :: [String] -> IO HTclObj +tclBMod ["list", keystr] = do + let key :: Int = read keystr + g <- readIORef globalVar + let b = tp_modView g + (b',ro) <- getChildren b key + -- + modifyIORef globalVar (\gv -> gv {tp_modView=b'}) + obj <- toTclObj ro + return $ TCL obj +---------- +tclBMod ["detail", keystr] = do + let key :: Int = read keystr + b <- readIORef globalVar >>= (return . tp_modView) + getInfo b key +---------- +tclBMod ["refresh"] = do + g <- readIORef globalVar + modifyIORef globalVar (\gv -> gv { tp_modView = initExpandInfoBag }) + return $ TLst [] +---------- +tclBMod ["debug"] = do + b <- readIORef globalVar >>= (return . tp_modView) + dmp <- eieDump b + return $ TLst dmp +---------- +tclBMod xs = internalError $ "tclBMod: grammar mismatch: " ++ (show xs) + + +---------------------------------------------------- +-- Hierarchy viewer using BSVInstance structures +data BInst = BInstRoot + | BNode {binst_sub :: BInstSub + ,binst_mod :: (String, ABinEitherModInfo) -- containing module (ba file) + ,binst_name :: String -- this instance name + ,binst_bsvh :: [String] -- full bsv hierarcry + ,binst_synth :: [String] -- bsv generate hier (flattened) + ,binst_localh :: [String] -- local path from synth to here + ,binst_hide :: Bool -- is instance hidden? + ,binst_hideall :: Bool + } + + +data BInstSub = BTop -- Top file -- no type information :-( + | BMod { bin_name :: Id + ,bin_uname :: Id + ,bin_type :: Maybe CType + ,bin_module :: (String,ABinModInfo) + } -- Synthesized child module, string is this module (.ba) name + | BINode { bin_name :: Id + ,bin_type :: Maybe CType + ,bin_children :: InstTree + } -- internal node + | BLeaf { bin_name :: Id + ,bin_uname :: Id + ,bin_type :: Maybe CType + ,bin_prim :: String + } -- Rule with full name + | BRule { bin_name :: Id + ,bin_uname :: Id + } -- local rule name, unique rule name + +instance PPrint BInstSub where + pPrint d p bin@(BTop) = text "BTop" + pPrint d p bin@(BMod {}) = text "BMod" <+> pvPrint d p (bin_name bin) <+> pvPrint d p (bin_type bin) + pPrint d p bin@(BINode {}) = text "BINode" <+> pvPrint d p (bin_name bin) <+> pvPrint d p (bin_type bin) + pPrint d p bin@(BRule {}) = text "BRule" <+> pvPrint d p (bin_name bin) <+> parens (pvPrint d p (bin_uname bin)) + pPrint d p bin@(BLeaf {}) = text "BLeaf" <+> pvPrint d p (bin_name bin) <+> text (bin_prim bin) <+> pvPrint d p (bin_type bin) + +comparebis :: BInstSub -> BInstSub -> Ordering +comparebis BTop BTop = EQ +comparebis BTop _ = GT +comparebis _ BTop = LT +comparebis l r = + let res = comparing (getPosition . bin_name) l r + in if (res == EQ) then cmpSuffixedIdByName (bin_name l) (bin_name r) else res +-- comparebis l@(BRule {}) r@(BRule {}) = comparing bin_name l r +-- comparebis _ (BRule {}) = LT +-- comparebis (BRule {}) _ = GT +-- comparebis _ _ = EQ + +comparebi :: BInst -> BInst -> Ordering +comparebi (BInstRoot) (BInstRoot) = EQ +comparebi (BInstRoot) (BNode {}) = LT +comparebi (BNode {}) (BInstRoot) = GT +comparebi (BNode {binst_sub = stl, binst_name = nl}) (BNode {binst_sub = str, binst_name = nr}) = + let stc = comparebis stl str + in if (stc == EQ) then compare nl nr else stc + +bInstSearchf :: String -> BInst -> Bool +bInstSearchf _ BInstRoot = False +bInstSearchf rex x@(BNode {}) = minst || msub (binst_sub x) + where match :: String -> Bool + match = isJust . matchRegex (mkRegex rex) + minst = match $ binst_name x + msub :: BInstSub -> Bool + msub s@(BMod {}) = (match $ getIdBaseString $ bin_name s) + msub s@(BLeaf {}) = (match $ getIdBaseString $ bin_name s) + msub s@(BRule {}) = (match $ getIdBaseString $ bin_name s) + msub s@(BINode {}) = (match $ getIdBaseString $ bin_name s) + msub _ = False + + +-- True for a synthesized hierarchy +addInst :: BInst -> (Maybe String) -> String -> BInst +addInst BInstRoot _ _ = BInstRoot +addInst b@(BNode {}) (Just unique) inst = b {binst_name = inst + ,binst_bsvh = inst:(binst_bsvh b) + ,binst_synth = unique:(binst_synth b) + ,binst_localh = [] + ,binst_hide = False + ,binst_hideall = False} +addInst b@(BNode {}) Nothing inst = b {binst_name = inst + ,binst_bsvh = inst:(binst_bsvh b) + ,binst_localh = inst:(binst_localh b) + ,binst_hide = False + ,binst_hideall = False} + +getBInstChildren :: BInst -> IO [BInst] +getBInstChildren BInstRoot = do + g <- readIORef globalVar + case (tp_mods g) of + Nothing -> return [] + Just (topmodId, _, _, _, _, _) -> do + mminfo <- findModule $ getIdBaseString topmodId + let err = error "Could not find top module" + minfo = fromMaybe err mminfo + let node = BNode { binst_sub = BTop, + binst_mod = (getIdBaseString topmodId, minfo), + binst_name = (getIdBaseString topmodId), + binst_bsvh = [], binst_synth = [], + binst_localh = [], binst_hide = False, binst_hideall = False} + return [node] +getBInstChildren b@(BNode {binst_sub = sub}) = + do flags <- getGFlags + let hide = (not (tclShowHidden flags)) + nodeIgnore inode = (node_ignore inode) || (hide && isHiddenKP inode) + getChildrenS :: BInstSub -> IO [BInst] + getChildrenS BTop = + do let (m, ba) = binst_mod b + nodes = getInstTreeList hide (apkg_inst_tree $ abemi_apkg ba) + nss <- mapM (mkChildIN (m,ba) False) nodes + return $ concat nss + getChildrenS (BRule {}) = return [] + getChildrenS (BLeaf {}) = return [] + getChildrenS bs@(BMod {}) = + do let (m,ba0) = bin_module bs + ba = Right ba0 + nodes = getInstTreeList' hide (apkg_inst_tree $ abemi_apkg ba) + nss <- mapM (mkChildIN (m,ba) False) nodes + return $ concat nss + getChildrenS bs@(BINode {}) = + do let (m,ba) = binst_mod b + nodes = getInstTreeList hide (bin_children bs) + allowBody = isLoop bs + nss <- mapM (mkChildIN (m,ba) allowBody) nodes + return $ concat nss + -- + isLoop :: BInstSub -> Bool + isLoop BINode { bin_name = name } | (getIdBase name) == fsLoop = True + isLoop _ = False + -- + mkChildIN :: (String, ABinEitherModInfo) -> Bool -> InstNode -> IO [BInst] + mkChildIN _ allowBody inode | isSynthP hide inode = + do let unique = fromJustOrErr "bluetcl.mkChildIN: unique" $ + getSynthName hide inode + mminfo <- findModuleByInstance (reverse $ (getIdBaseString $ unique) : binst_synth b) + let b_add = addInst b (Just (getIdBaseString $ unique)) + (getIdBaseString $ node_name inode) + hidden = isHidden inode + hide_all = isHiddenAll inode + b' = b_add {binst_hide = hidden, binst_hideall = hide_all} + b'' = case mminfo of + Left pname -> let bsub = BLeaf { bin_name = node_name inode + , bin_uname = unique + , bin_type = node_type inode + , bin_prim = pname } + in b' { binst_sub = bsub } + Right minfo@(m,ba) + -> let eminfo = (m, Right ba) + bsub = BMod { bin_module = minfo + , bin_type = node_type inodep + , bin_name = node_name inodep + , bin_uname = unique + } + in b' { binst_sub = bsub, binst_mod = eminfo } + return $ [b''] + mkChildIN (m,ba) allowBody inode@(StateVar {}) = -- this case should be impossible + do let unique = fromJustOrErr "bluetcl.mkChildIN: unique" $ + getSynthName hide inode + mminfo <- findModuleByInstance (reverse $ (getIdBaseString $ unique) : binst_synth b) + let b_add = addInst b (Just (getIdBaseString $ unique)) + (getIdBaseString $ node_name inode) + hidden = isHidden inode + hide_all = isHiddenAll inode + b' = b_add {binst_hide = hidden, binst_hideall = hide_all} + b'' = case mminfo of + Left pname -> let bsub = BLeaf { bin_name = node_name inode + , bin_uname = unique + , bin_type = node_type inode + , bin_prim = pname } + in b' { binst_sub = bsub } + Right minfo@(m,ba) + -> let eminfo = (m, Right ba) + bsub = BMod { bin_module = minfo + , bin_type = node_type inodep + , bin_name = node_name inodep + , bin_uname = unique + } + in b' { binst_sub = bsub, binst_mod = eminfo } + return $ [b''] + mkChildIN (m,ba) allowBody inode@(Loc { node_name = name } ) | nodeIgnore inode = + do let nodes = getInstTreeList hide (node_children inode) + keep_prop prop = not (isSuffixCountProp prop) + name' = rmIdPropBy name keep_prop + name'' = setIdBase name' fsBody + inode' = inode { node_ignore = False, node_name = name'' } + nss <- concatMapM (mkChildIN (m,ba) False) nodes + nss' <- if (allowBody && ((length nss) > 1)) + then (mkChildIN (m,ba) False inode') + else return nss + return $ nss' + mkChildIN (m,ba) _ inode@(Rule {}) = + do let b' = addInst b Nothing (getIdBaseString $ node_name inode) + bsub = BRule { bin_name = node_name inode, + bin_uname = node_name inode } + return $ [b' { binst_sub = bsub, binst_mod = (m,ba) }] + -- rule with identical parent node + mkChildIN (m,ba) _ inode | isRuleP hide inode = + do let b' = addInst b Nothing (getIdBaseString $ node_name inode) + rule = node_name $ head $ (getInstTreeList hide (node_children inode)) + bsub = BRule { bin_name = node_name inode, + bin_uname = rule } + return $ [b' { binst_sub = bsub, binst_mod = (m,ba) }] + mkChildIN (m,ba) _ inode = + do let b' = addInst b Nothing (getIdBaseString $ node_name inode) + bsub = BINode { bin_children = node_children inode + , bin_type = node_type inode + , bin_name = node_name inode } + return $ [b' { binst_sub = bsub, binst_mod = (m,ba) }] + children <- getChildrenS sub + return children + +instance ExpandInfoHelper BInst where + getRootElem = return BInstRoot + -- + getChildrenf b = + do flags <- getGFlags + let hide = (not (tclShowHidden flags)) + isEnd BNode {binst_hideall = h} = h && hide + isEnd _ = False + isHiddenBInst BNode {binst_hide = h} = h && hide + isHiddenBInst _ = False + getList x | isEnd x = return [] + getList x | isHiddenBInst x = getBInstChildren x + getList x = return [x] + x <- getBInstChildren b + concatMapM getList x + -- + getTextf (BInstRoot) = return "ROOT" + getTextf (BNode {binst_sub = st, binst_name = nm}) = return $ nm ++ subinfo st + where ignores = [] + ptype :: Type -> String + ptype t = let x = toPrintable $ docToOneLine (pvPrint PDNoqual 0 t) + in if (x `elem` ignores) then "" else " " ++ x + -- + subinfo :: BInstSub -> String + subinfo (BMod {bin_type = Just t}) = ptype t + subinfo (BINode {bin_type = Just t}) = "" + subinfo (BLeaf {bin_type = Just t}) = ptype t + subinfo (BRule {}) = "" +-- subinfo (BRule {}) = " (rule)" + subinfo _ = "" + + -- + getTagsf (BNode {binst_sub = sub}) | (getKind sub) == "Rule" = return ["rule"] + | (getKind sub) == "Synthesized" = return ["synth"] + | (getKind sub) == "Primitive" = return ["prim"] + getTagsf _ = return [] + -- + getInfof (BInstRoot) = return $ toHTObj ["Node", "ROOT"] + getInfof b@(BNode {}) = return $ + TLst $ [TStr "Node", toHTObj $ getKind $ binst_sub b + ,TStr "Name", toHTObj $ binst_name b + ,TStr "BSVPath", toHTObj (reverse $ binst_bsvh b) + ,TStr "SynthPath", toHTObj (reverse $ binst_synth b) + ,TStr "LocalPath", toHTObj (reverse $ binst_localh b) + ,TStr "BSVModule", toHTObj $ getBA $ binst_sub b + ] ++ getPos (binst_sub b) ++ getAux (binst_sub b) + ++ [TStr "DEBUG", toHTObj $ getDebug (binst_sub b)] + -- + where getBA :: BInstSub -> String + getBA (BMod {bin_module = (m,ba)} ) = m + getBA _ = let (m,ba) = binst_mod b in m + -- + getPos :: BInstSub -> [HTclObj] + getPos (BTop) = [] + getPos bin = getPositionPair $ bin_name bin + -- + getAuxType :: Maybe CType -> [HTclObj] + getAuxType Nothing = [] + getAuxType (Just t) = [TStr "Interface", toHTObj t] + ++ let p = getPosition t + in if (isRealPosition p) then [TStr "IfcPosition", toHTObj $ tclPosition p] else [] + -- + getAux :: BInstSub -> [HTclObj] + getAux (BTop) = + [TStr "Module", toHTObj ""] + ++ [TStr "UniqueName", toHTObj ""] + getAux (BLeaf {bin_type = mt, bin_prim = prim, bin_uname = n}) = + [TStr "Module", toHTObj $ prim] + ++ [TStr "UniqueName", toHTObj n] + ++ getAuxType mt + getAux (BINode {bin_type = mt}) = getAuxType mt + getAux (BMod {bin_type = mt, bin_module = (m,ba), bin_uname = n}) = + [TStr "Module", toHTObj $ m] + ++ [TStr "UniqueName", toHTObj n] + ++ getAuxType mt + getAux (BRule { bin_uname =rn }) = + [TStr "RuleName", toHTObj $ rn] + -- + getDebug :: BInstSub -> Doc + getDebug n = pPrint PDReadable 0 n + -- + {- TODO get at the position information + -- + -- Auxiliary info + getIfcMod :: Bool -> BSVInstance -> [HTclObj] + getIfcMod False _ = [] + getIfcMod True i = [TStr "Interface", toHTObj (bsvi_ifc_name i) + ,TStr "IfcPosition", fullPositionToTObj $ getPosition (bsvi_ifc_name i) + ,TStr "Module", toHTObj (bsvi_def_name i) + ,TStr "ModulePosition", fullPositionToTObj $ getPosition (bsvi_def_name i) + ] +-} + +getKind :: BInstSub -> String +getKind (BTop {}) = "Synthesized" +getKind (BMod {}) = "Synthesized" +getKind (BINode {}) = "Instance" +getKind (BRule {}) = "Rule" +getKind (BLeaf {}) = "Primitive" + +getInstTreeList :: Bool -> InstTree -> [InstNode] +getInstTreeList hide t = + let result = getInstTreeList' hide t + getMyChildren x = concatMap promote (M.elems $ node_children x) + promote x@(Loc {node_name = nm, node_ignore = True}) | isBadId nm = getMyChildren x + promote x = [x] + in case (result) of + [x@(Loc {})] | (isHiddenAll x && hide) -> [] + [x@(Loc {})] | (isHidden x && hide) -> sortBy comparein (getMyChildren x) + _ -> result + +getInstTreeList' :: Bool -> InstTree -> [InstNode] +getInstTreeList' False t = processInstNodes $ (sortBy comparein (M.elems t)) +getInstTreeList' True t = + let getList x | isHiddenAll x = [] + getList x@(Loc {}) | isHiddenKP x = concatMap getList (sortBy comparein (getMyChildren x)) + getList x | isHiddenKP x = [] + getList x = [x] + getMyChildren x = concatMap promote (M.elems $ node_children x) + promote x@(Loc {node_name = nm, node_ignore = True}) | isBadId nm = getMyChildren x + promote x = [x] + in processInstNodes $ concatMap getList (sortBy comparein (concatMap promote (M.elems t))) + +-- sort before processing to get better orders +processInstNodes :: [InstNode] -> [InstNode] +processInstNodes = map processInstNode + +processInstNode :: InstNode -> InstNode +processInstNode node@(Loc { node_name = name }) = node' + where node' = node { node_name = (addIdDisplayName name) } +processInstNode node = node + +isSynthP :: Bool -> InstNode -> Bool +isSynthP True i | isHiddenKP i = False +isSynthP True i | isHiddenAll i = False +isSynthP hide i@(Loc {}) = case (nodeChildren hide i) of + [StateVar {}] -> True + _ -> False +isSynthP _ _ = False + +isRuleP :: Bool -> InstNode -> Bool +isRuleP True i | isHiddenKP i = False +isRuleP hide i@(Loc {}) = case (nodeChildren hide i) of + [Rule {}] -> True -- should the name be contained? + _ -> False +isRuleP _ _ = False + +getSynthName :: Bool -> InstNode -> Maybe Id +getSynthName hide i@(Loc {}) = case (nodeChildren hide i) of + [StateVar {node_name = name}] -> Just name + _ -> Nothing +getSynthName _ _ = Nothing + +--------------------------- +-- browseinstance tcl command +binstGrammar :: HTclCmdGrammar +binstGrammar = (tclcmd "browseinst" namespace helpStr "") .+. + (oneOf [ listGrammar, detailGrammar, refreshGrammar, dbgGrammar, searchGrammar ]) + where helpStr = "Utility function for viewing instance hierarchy" + listGrammar = (kw "list" "" "") .+. (arg "key" IntArg "integer") + detailGrammar = (kw "detail" "" "") .+. (arg "key" IntArg "integer") + refreshGrammar = kw "refresh" "" "" + dbgGrammar = kw "debug" "" "" + searchGrammar = (kw "search" "Search packages for names matching a regular expression" "") .+. + (arg "regex" StringArg "regular expression") + +tclBrowseInst :: [String] -> IO HTclObj +tclBrowseInst ["list", keystr] = do + g <- readIORef globalVar + let b = tp_instView g + key :: Int = read keystr + (b',ro) <- getChildren b key + -- + modifyIORef globalVar (\gv -> gv {tp_instView=b'}) + return (toHTObj ro) + +---------- +tclBrowseInst ["detail", keystr] = do + g <- readIORef globalVar + let b = tp_instView g + key :: Int = read keystr + getInfo b key +---------- +tclBrowseInst ["refresh"] = do + g <- readIORef globalVar + modifyIORef globalVar (\gv -> gv { tp_instView = initExpandInfoBag }) + return $ TLst [] +---------- +tclBrowseInst ["debug"] = do + g <- readIORef globalVar + let b = tp_instView g + eieDump b >>= (return . TLst) +---------- +tclBrowseInst ["search",rex] = do + b <- readIORef globalVar >>= (return . tp_instView) + (b',fs) <- eieSearch (bInstSearchf rex) b + modifyIORef globalVar (\gv -> gv {tp_instView=b'}) + return $ toHTObj (reverse fs) + +---------- +tclBrowseInst xs = internalError $ "tclBrowseInst: grammar mismatch: " ++ (show xs) + + +---------------------------------------------------- + +data BTypeView = BTypeViewRoot + | BType CType TypeAnalysis + | StructField Id (Qual Type) TypeAnalysis + | UnionTag Id Type TypeAnalysis + | InterfaceField Bool Id (Qual Type) [IfcPragma] TypeAnalysis + | BTVUnknown + +-- Instance of ExpandInfoHelper to for iwidget tree view +instance ExpandInfoHelper BTypeView where + -- + getRootElem = return BTypeViewRoot + getChildrenf BTypeViewRoot = do + g <- readIORef globalVar + let ts = fst $ tp_typeView g + return (map (\ (t,a) -> BType t a) ts) + + -- + -- Find the children of the element + -- getChildrenf :: BTypeView -> IO [BTypeView] + getChildrenf (BType _ ta) = getChildrenFromTypeA ta + getChildrenf (StructField i (_ :=> t) ta) = getChildrenFromTypeA ta + getChildrenf (UnionTag i t ta) = return [(BType t ta)] + getChildrenf (InterfaceField is_subifc _ (_ :=> t) _ ta) = + getChildrenFromTypeA ta + getChildrenf (BTVUnknown) = return [] + + -- + -- Get the display text in the tree + -- getTextf :: BTypeView -> IO String + getTextf (BTypeViewRoot) = return "root" + getTextf (BType t ta) = return $ (pvpStringNQ t) ++ parenStr (typeAnalysisShort ta) ++ pwidth ta + getTextf (StructField i t ta) = return $ pvpStringNQ i ++ " " ++ (pvpStringNQ t) ++ pwidth ta + getTextf (UnionTag i t ta) = return $ "tagged " ++ pvpStringNQ i ++ " " ++ + pvpStringNQ t ++ parenStr (typeAnalysisShort ta)++ pwidth ta + getTextf (InterfaceField is_subifc i qt _ _) = + if (is_subifc) + then return $ "interface " ++ pvpStringNQ qt ++ " " ++ pvpStringNQ i + else return $ "method " ++ pvpStringNQ i + getTextf (BTVUnknown) = return "Unknown" + + getTagsf _ = return [] + -- + -- Get the detail information for the selected element + -- format for workstation + getInfof (BTypeViewRoot) = return $ TLst [] + getInfof (BType t a) = return $ typeAnalysisToDetail a + getInfof (StructField i qt ta) = + return $ tag "field" ( [TStr $ pvpString i, + tagLst "Type" [TStr $ pvpString qt]] ++ + (showWidth $ getWidth ta)) + getInfof (UnionTag i t ta) = + return $ tag "union" ([tagLst "tag" [TStr $ pvpString i], + tagLst "Type" [TStr $ pvpString t]] ++ + (showWidth $ getWidth ta)) + getInfof (InterfaceField is_subifc fid qt ps ta) = + if (is_subifc) then return $ typeAnalysisToDetail ta + else return $ tag "method" [tagLst "" [interfaceFieldToDetail (is_subifc,fid,qt,ps)]] + getInfof (BTVUnknown) = return (TStr "Unknown") + +parenStr :: String -> String +parenStr [] = "" +parenStr s = " (" ++ s ++ ")" + +pwidth :: TypeAnalysis -> String +pwidth a = maybe "" (parenStr . show) (getWidth a) + +getChildrenFromTypeA :: TypeAnalysis -> IO [BTypeView] +getChildrenFromTypeA (List _ t) = do + ma <- getTypeAnalysis t + return $ case ma of + Nothing -> [] + Just a -> [(BType t a)] +getChildrenFromTypeA (Vector _ _ t _) = do + ma <- getTypeAnalysis t + return $ case ma of + Nothing -> [] + Just a -> [(BType t a)] +getChildrenFromTypeA (Alias _ _ _ t) = do + ma <- getTypeAnalysis t + return $ case ma of + Nothing -> [] + Just a -> [(BType t a)] +getChildrenFromTypeA (Struct _ _ _ _ fs _ ) = mapM mkField fs + where mkField (i, qt@(_ :=> t), mw) = do + mta <- getTypeAnalysis t + return $ case mta of + Nothing -> BTVUnknown + Just ta -> StructField i qt ta +getChildrenFromTypeA (TaggedUnion _ _ _ _ ts _) = mapM mkTag ts + where mkTag (i, t, mi) = do + ma <- getTypeAnalysis t + return $ case ma of + Nothing -> BTVUnknown + Just a -> UnionTag i t a +getChildrenFromTypeA (Interface _ _ _ _ fs _) = mapM mkField fs + where mkField (b, i, qt@(_ :=> t), ps) = do + ma <- getTypeAnalysis t + return $ case ma of + Nothing -> BTVUnknown + Just a -> InterfaceField b i qt ps a +-- XXX Enum?? +getChildrenFromTypeA _ = return [] + + +getTypeAnalysis :: CType -> IO (Maybe TypeAnalysis) +getTypeAnalysis t = do + g <- readIORef globalVar + let flags = tp_flags g + symtab = tp_symtab g + case (analyzeType flags symtab t) of + Left _ -> return $ Nothing + Right a -> return $ Just a + +getTypeAnalysis' :: CType -> Bool -> IO (Maybe TypeAnalysis) +getTypeAnalysis' t primpair_is_interface = do + g <- readIORef globalVar + let flags = tp_flags g + symtab = tp_symtab g + case (analyzeType' flags symtab t primpair_is_interface) of + Left _ -> return $ Nothing + Right a -> return $ Just a + +---- + +btypeGrammar :: HTclCmdGrammar +btypeGrammar = (tclcmd "browsetype" namespace helpStr "") .+. + (oneOf [ addGrammar, listGrammar, clearGrammar + , detailGrammar, refreshGrammar, dbgGrammar + ]) + where helpStr = "Utility function for viewing types" + addGrammar = (kw "add" "" "") .+. (arg "type" StringArg "type") + listGrammar = (kw "list" "" "") .+. (arg "key" IntArg "integer") + clearGrammar = kw "clear" "" "" + detailGrammar = (kw "detail" "" "") .+. (arg "key" IntArg "integer") + refreshGrammar = kw "refresh" "" "" + dbgGrammar = kw "debug" "" "" + +tclBType :: [String] -> IO HTclObj +tclBType ["add",s] = do + g <- readIORef globalVar + let (ts, b) = tp_typeView g + flags = tp_flags g + symtab = tp_symtab g + -- parse the type + et <- pStringWrapper globalErrHandle flags pTypeExpr [s] + let eta :: Either [EMsg] (CType, TypeAnalysis) + eta = case (et) of + Left errs -> Left errs + Right t -> case (analyzeType flags symtab t) of + Left errs -> Left errs + Right a -> Right (t,a) + case (eta) of + Left errs -> do reportErrorsToTcl [] errs + -- not reachable if errs not null + return $ TLst [] + Right (t,a) -> do let ts' = ts ++ [(t,a)] + b' = initExpandInfoBag + modifyIORef globalVar (\gv -> gv { tp_typeView = (ts', b') }) + return $ TLst [] +---------- +tclBType ["clear"] = do + g <- readIORef globalVar + modifyIORef globalVar (\gv -> gv { tp_typeView = ([], initExpandInfoBag) }) + return $ TLst [] +---------- +tclBType ["list", keystr] = do + let key :: Int = read keystr + g <- readIORef globalVar + let (ts, b) = tp_typeView g + (b',ro) <- getChildren b key + -- + modifyIORef globalVar (\gv -> gv { tp_typeView = (ts, b') }) + obj <- toTclObj ro + return $ TCL obj +---------- +tclBType ["detail", keystr] = do + let key :: Int = read keystr + b <- readIORef globalVar >>= (return . snd . tp_typeView) + getInfo b key +---------- +tclBType ["debug"] = do + b <- readIORef globalVar >>= (return . snd . tp_typeView) + dmp <- eieDump b + return $ TLst dmp +---------- +tclBType ["refresh"] = do + g <- readIORef globalVar + let (ts, _) = tp_typeView g + modifyIORef globalVar (\gv -> gv { tp_typeView = (ts, initExpandInfoBag) }) + return $ TLst [] +---------- +tclBType xs = internalError $ "tclBType: grammar mismatch: " ++ (show xs) + +---------------------------------------------------- + +cvtMaybe :: (TclObjCvt a) => Maybe a -> IO [HTclObj] +cvtMaybe Nothing = return [] +cvtMaybe (Just x) = toTclObj x >>= (\o -> (return [(TCL o)])) + +cvtMaybeWith :: (TclObjCvt a) => HTclObj -> Maybe a -> IO [HTclObj] +cvtMaybeWith _ Nothing = return [] +cvtMaybeWith h (Just x) = toTclObj x >>= (\o -> (return [TLst [h,(TCL o)]])) + + + +---------------------------------------------------- +-- Bluesim simulation control command + +simGrammar :: HTclCmdGrammar +simGrammar = (tclcmd "sim" namespace helpStr "") .+. + (oneOf [ argGrammar, cdGrammar, clockGrammar, configGrammar + , describeGrammar, getGrammar, getRangeGrammar, loadGrammar + , lookupGrammar, lsGrammar, nextEdgeGrammar, pwdGrammar + , runGrammar, runToGrammar + , stepGrammar, stopGrammar, syncGrammar, timeGrammar + , timescaleGrammar + , unloadGrammar, upGrammar, vcdGrammar, verGrammar + ]) + where helpStr = "Control Bluesim simulation" + argGrammar = (kw "arg" "Set a simulation plus-arg" "") .+. + (atLeast 1 $ arg "arg" StringArg "plus-arg string") + cdGrammar = (kw "cd" "Change location in hierarchy" "") .+. + (optional $ arg "path" StringArg "target instance") + clockGrammar = (kw "clock" "Show or select current clock domain" "") .+. + (optional $ arg "name" StringArg "clock domain name") + configGrammar = (kw "config" "Show or change simulator configuration" "") .+. + (optional $ oneOf [ (kw "interactive" "Include edges with no logic" "") + ]) + describeGrammar = (kw "describe" "Describe the object to which a symbol handle refers" "") .+. + (atLeast 1 $ arg "handle" PtrArg "symbol handle") + getGrammar = (kw "get" "Get simulation value" "") .+. + (atLeast 1 $ arg "handle" PtrArg "symbol handle") + getRangeGrammar = (kw "getrange" "Get simulation values from a range" "") .+. + (arg "handle" PtrArg "symbol handle") .+. + (arg "addr1" IntArg "address or start address") .+. + (optional $ arg "addr2" IntArg "end address") + loadGrammar = (kw "load" "Load a bluesim model object" "") .+. + (arg "model" StringArg "Bluesim model file") .+. + (arg "top" StringArg "Top-level module name") + lookupGrammar = (kw "lookup" "Lookup symbol handles" "") .+. + (arg "pattern" StringArg "Symbol name (wildcards allowed)") .+. + (optional $ arg "root" PtrArg "Starting point for lookup") + lsGrammar = (kw "ls" "List symbols" "") .+. + (atLeast 0 $ arg "pattern" StringArg "Symbol name (wildcards allowed)") + nextEdgeGrammar = (kw "nextedge" "Advance simulation to the next clock edge in any domain" "") + pwdGrammar = (kw "pwd" "Print current location in hierarchy" "") + runGrammar = (kw "run" "Run simulation to completion" "") .+. + (optional $ kw "async" "" "") + runToGrammar = (kw "runto" "Run simulation to a given time" "") .+. + (arg "time" IntArg "Time at which to stop simulation") .+. + (optional $ kw "async" "" "") + stepGrammar = (kw "step" "Advance simulation a given number of cycles" "") .+. + (optional $ arg "cycles" IntArg "Number of cycles to advance") .+. + (optional $ kw "async" "" "") + stopGrammar = kw "stop" "Stop a running simulation" "" + syncGrammar = kw "sync" "Wait for simulator execution to complete" "" + timeGrammar = kw "time" "Display current simulation time" "" + timescaleGrammar = (kw "timescale" "Specify simulation timescale" "") .+. + (arg "timescale" StringArg "simulation timescale (Verilog-format)") + unloadGrammar = kw "unload" "Unload the current bluesim model" "" + upGrammar = (kw "up" "Move up the module hierarchy" "") .+. + (optional $ arg "N" IntArg "number of levels") + vcdGrammar = (kw "vcd" "Control dumping waveforms to a VCD file" "") .+. + (optional $ oneOf [ (kw "on" "Turn on VCD dumping" "") + , (kw "off" "Turn off VCD dumping" "") + , (arg "file" StringArg "Dump to named VCD file") + ]) + verGrammar = kw "version" "Show Bluesim model version information" "" + +tclSim :: [String] -> IO HTclObj +---------- +tclSim ("arg":ss) = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> do mapM_ (bk_append_argument bs) ss + return $ TLst [] + Nothing -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim ("cd":args) = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> if (null args) + then do top_sym <- bk_top_symbol bs + let mbs = Just (bs { current_directory = [top_sym] }) + modifyIORef globalVar (\gv -> gv { tp_bluesim = mbs }) + return $ TLst [] + else do dirs <- lookupSymbols bs (head args) Nothing + case dirs of + [] -> ioError $ userError ("No such instance: " ++ (head args)) + [dir'] -> do let mbs = Just (bs { current_directory = dir' }) + modifyIORef globalVar (\gv -> gv { tp_bluesim = mbs }) + return $ TLst [] + _ -> do let base = current_directory bs + dnames <- mapM (mkDirString bs base) dirs + ioError $ userError $ unlines + ("Ambiguous directory specification could match:":dnames) + Nothing -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim ("clock":args) = do + g <- readIORef globalVar + case (tp_bluesim g, args) of + (Just bs, []) -> do cs <- getClockInfo bs + obj <- toTclObj cs + return $ TCL obj + (Just bs, [clk]) -> do mbs <- setActiveClock bs clk + when (isNothing mbs) $ + ioError $ userError ("'" ++ clk ++ "' is not a valid clock name") + modifyIORef globalVar (\gv -> gv { tp_bluesim = mbs }) + return $ TLst [] + (Just bs, _) -> internalError $ "tclSim: grammar mismatch: " ++ (show args) + (Nothing,_) -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim ("config":args) = do + g <- readIORef globalVar + case (tp_bluesim g, args) of + (Just bs, []) -> do obj <- toTclObj ("interactive", is_interactive bs) + return $ TLst [TCL obj] + (Just bs, ["interactive"]) -> do let bs' = bs { is_interactive = True } + bk_set_interactive bs + modifyIORef globalVar (\gv -> gv { tp_bluesim = Just bs' }) + return $ TLst [] + (Just bs, _) -> internalError $ "tclSim: grammar mismatch: " ++ (show args) + (Nothing,_) -> ioError $ userError ("There is no bluesim model loaded") +-------------------- +tclSim ("describe":hdls) = do + g <- readIORef globalVar + case (tp_bluesim g,hdls) of + (Just bs,[]) -> internalError $ "tclSim: grammar mismatch: " ++ (show hdls) + (Just bs,_) -> do let syms = map read hdls + names <- mapM (bk_get_key bs) syms + descs <- mapM (describeSym bs) syms + objs <- mapM toTclObj (zip names descs) + return $ case objs of + [o] -> TCL o + os -> TLst (map TCL os) + (Nothing,_) -> ioError $ userError ("There is no bluesim model loaded") +-------------------- +tclSim ("get":hdls) = do + g <- readIORef globalVar + case (tp_bluesim g, hdls) of + (Just bs, []) -> internalError $ "tclSim: grammar mismatch: " ++ (show hdls) + (Just bs, _) -> do ptrs <- mapM (handleModuleRedirect bs) (map read hdls) + vs <- mapM (bk_peek_symbol_value bs) ptrs + let bad = [ (p,v) | (p,v) <- zip ptrs vs, v == NoValue ] + when (not (null bad)) $ + do let bad_syms = map fst bad + bad_names <- mapM (bk_get_key bs) bad_syms + let msg = "Cannot get value for symbol(s): " ++ + (intercalate ", " bad_names) + ioError $ userError msg + return $ case (map show vs) of + [x] -> TStr x + xs -> TLst (map TStr xs) + (Nothing,_) -> ioError $ userError ("There is no bluesim model loaded") +-------------------- +tclSim ("getrange":args) = do + g <- readIORef globalVar + case (tp_bluesim g, args) of + (Just bs, [hdl,addr]) -> + do sym <- handleModuleRedirect bs (read hdl) + let idx = read addr + lo <- bk_get_range_min_addr bs sym + hi <- bk_get_range_max_addr bs sym + let range_str = "(" ++ (show lo) ++ ":" ++ (show hi) ++ ")" + when ((idx < lo) || (idx > hi)) $ + ioError $ userError $ (show idx) ++ " is not in the range " ++ range_str + v <- bk_peek_range_value bs sym idx + when (v == NoValue) $ + do name <- bk_get_key bs sym + let msg = "Cannot get value for symbol '" ++ name ++ + "' at index " ++ (show idx) + ioError $ userError msg + return $ TStr (show v) + (Just bs, [hdl,addr1,addr2]) -> + do sym <- handleModuleRedirect bs (read hdl) + let idx1 = read addr1 + idx2 = read addr2 + lo <- bk_get_range_min_addr bs sym + hi <- bk_get_range_max_addr bs sym + let range_str = "(" ++ (show lo) ++ ":" ++ (show hi) ++ ")" + when ((idx1 < lo) || (idx1 > hi)) $ + ioError $ userError $ (show idx1) ++ " is not in the range " ++ range_str + when ((idx2 < lo) || (idx2 > hi)) $ + ioError $ userError $ (show idx2) ++ " is not in the range " ++ range_str + vs <- mapM (bk_peek_range_value bs sym) [idx1..idx2] + case (find ((== NoValue) . fst) (zip vs [idx1..idx2])) of + (Just idx) -> + do name <- bk_get_key bs sym + let msg = "Cannot get value for symbol '" ++ name ++ + "' at index " ++ (show idx) + ioError $ userError msg + Nothing -> return $ TLst (map (TStr . show) vs) + (Just bs, _) -> internalError $ "tclSim: grammar mismatch: " ++ (show args) + (Nothing,_) -> ioError $ userError ("There is no bluesim model loaded") +-------------------- +tclSim ["load", fname, top_name] = do + g <- readIORef globalVar + let mbs0 = tp_bluesim g + when (isJust mbs0) $ unloadBluesimModel (fromJust mbs0) + mbs1 <- loadBluesimModel fname top_name + when (isNothing mbs1) $ + ioError $ userError ("Unable to load model " ++ fname) + modifyIORef globalVar (\gv -> gv { tp_bluesim = mbs1 }) + return $ TLst [] +-------------------- +tclSim ("lookup":args) = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> do let root = case args of + [_,r] -> Just [read r] + _ -> Nothing + dirs <- lookupSymbols bs (head args) root + when (null dirs) $ + ioError $ userError ("No such symbol: " ++ (head args)) + objs <- mapM toTclObj (map hierLeaf dirs) + return $ TLst (map TCL objs) + Nothing -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim ("ls":args) = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> do let pats = if (null args) then ["*"] else args + dlsts <- mapM (flip (lookupSymbols bs) Nothing) pats + entries <- mapM (getLsEntry bs) (concat dlsts) + return $ TLst (catMaybes entries) + Nothing -> ioError $ userError ("There is no bluesim model loaded") +-------------------- +tclSim ["nextedge"] = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> do -- check that $finish hasn't been called + fin <- bk_finished bs + when (fin) $ ioError $ userError ("$finish has been called -- cannot advance to next edge") + -- put a limit at the next edge of every clock + num_clks <- bk_num_clocks bs + clks <- mapM (bk_get_nth_clock bs) [0..(num_clks-1)] + let add_limit hdl = + do pc <- bk_clock_edge_count bs hdl POSEDGE + nc <- bk_clock_edge_count bs hdl NEGEDGE + _ <- bk_quit_after_edge bs hdl POSEDGE (pc+1) + _ <- bk_quit_after_edge bs hdl NEGEDGE (nc+1) + return () + mapM_ add_limit clks + -- advance time + _ <- bk_advance bs False + -- remove limits from clock edges + let remove_limit hdl = + do pc <- bk_clock_edge_count bs hdl POSEDGE + nc <- bk_clock_edge_count bs hdl NEGEDGE + _ <- bk_quit_after_edge bs hdl POSEDGE pc + _ <- bk_quit_after_edge bs hdl NEGEDGE nc + return () + mapM_ remove_limit clks + return $ TLst [] + Nothing -> ioError $ userError ("There is no bluesim model loaded") +-------------------- +tclSim ["pwd"] = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> do str <- getCurDirStr bs + obj <- toTclObj str + return $ TCL obj + Nothing -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim ("run":args) = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> do -- check that $finish hasn't been called + fin <- bk_finished bs + when (fin) $ ioError $ userError ("$finish has been called -- cannot run anymore") + -- advance with no pre-set limit + _ <- bk_advance bs (args == ["async"]) + return $ TLst [] + Nothing -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim ("runto":time:args) = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> do let target = read time + -- get current time + now <- bk_now bs + -- check that the time argument makes sense + when (target <= now) $ + ioError $ userError ("target time must be in the future") + -- check that $finish hasn't been called + fin <- bk_finished bs + when (fin) $ ioError $ userError ("$finish has been called -- cannot run anymore") + -- schedule a UI event for the given time and then advance + _ <- bk_schedule_ui_event bs target + let async = args == ["async"] + _ <- bk_advance bs async + if (async) + then -- setup a cleanup handler + do let hdlrs = cleanup_handlers bs + hdlrs' = (remove_yield target):hdlrs + bs' = bs { cleanup_handlers = hdlrs' } + modifyIORef globalVar (\gv -> gv { tp_bluesim = (Just bs') }) + else -- remove the UI event if we didn't reach the target time + do now' <- bk_now bs + when (now' /= target) $ + do _ <- bk_remove_ui_event bs target + return () + return $ TLst [] + Nothing -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim ("step":args) = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> let (cycles,async) = case args of + [] -> (1,False) + ["async"] -> (1,True) + [n] -> (read n,False) + [n,_] -> (read n,True) + _ -> internalError $ "tclSim: grammar mismatch: " ++ (show args) + in if (cycles < 1) + then ioError $ userError ("Cycle count must be > 0") + else do -- check that $finish hasn't been called + fin <- bk_finished bs + when (fin) $ ioError $ userError ("$finish has been called -- cannot step") + -- gather information on current time & clock value + let clk = current_clock bs + clk_val <- bk_clock_val bs clk + let dir = if (clk_val == CLK_LOW) then NEGEDGE else POSEDGE + now <- bk_now bs + count <- bk_clock_cycle_count bs clk + let dir' = -- If we are before logic has executed at + -- time 0, then a step from here should go + -- to the first edge, not the next edge + -- that returns to the current clock value + if (now == 0 && count == 0) + then case dir of + POSEDGE -> NEGEDGE + NEGEDGE -> POSEDGE + else dir + -- compute the new stopping point + ec <- bk_clock_edge_count bs clk dir' + let limit = ec + cycles + s <- bk_quit_after_edge bs clk dir' limit + when (s < 0) $ ioError $ userError ("No clock to step") + -- advance to the computed point + _ <- bk_advance bs async + if (async) + then -- setup a cleanup handler + do let hdlrs = cleanup_handlers bs + hdlrs' = (restore_edge_limit clk dir' ec):hdlrs + bs' = bs { cleanup_handlers = hdlrs' } + modifyIORef globalVar (\gv -> gv { tp_bluesim = (Just bs') }) + else -- restore the edge limit if we didn't reach it + do ec' <- bk_clock_edge_count bs clk dir' + when (ec' /= limit) $ + do _ <- bk_quit_after_edge bs clk dir' ec + return () + return $ TLst [] + Nothing -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim ["stop"] = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> do -- stop the simulation thread + bk_abort_now bs + t <- bk_sync bs + obj <- toTclObj t + -- run any cleanup handlers + sequence_ (cleanup_handlers bs) + let bs' = bs { cleanup_handlers = [] } + modifyIORef globalVar (\gv -> gv { tp_bluesim = (Just bs') }) + return $ TCL obj + Nothing -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim ["sync"] = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> do t <- bk_sync bs + obj <- toTclObj t + return $ TCL obj + Nothing -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim ["time"] = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> do t <- bk_now bs + obj <- toTclObj t + return $ TCL obj + Nothing -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim ("timescale":args) = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> + case args of + [timescale] -> + case parseTimescale timescale of + Just (timeprecision, scale_factor) -> do + _ <- bk_set_timescale bs timeprecision scale_factor + return $ TLst [] + _ -> ioError $ userError ("Invalid timescale: " ++ timescale) + _ -> internalError $ "tclSim: 'sim timescale' grammar mismatch: " ++ (show args) + Nothing -> ioError $ userError ("There is no bluesim model loaded") +tclSim ["unload"] = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> do modifyIORef globalVar (\gv -> gv { tp_bluesim = Nothing }) + unloadBluesimModel bs + return $ TLst [] + Nothing -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim ("up":args) = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> do top_sym <- bk_top_symbol bs + let n = if (null args) then 1 else read (head args) + dirs = drop n (current_directory bs) + dirs' = if (null dirs) then [top_sym] else dirs + mbs = Just (bs { current_directory = dirs' }) + modifyIORef globalVar (\gv -> gv { tp_bluesim = mbs }) + return $ TLst [] + Nothing -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim ("vcd":args) = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> case args of + [] -> -- return name of active VCD file, if any + do l <- toTclObj $ maybeToList (active_vcd_file bs) + return $ TCL l + ["on"] -> -- turn on VCD dumping + do _ <- bk_enable_VCD_dumping bs + when (isNothing $ active_vcd_file bs) $ + let bs' = bs { active_vcd_file = Just "dump.vcd" } + in modifyIORef globalVar (\gv -> gv { tp_bluesim = Just bs' }) + return $ TLst [] + ["off"] -> -- turn off VCD dumping + do bk_disable_VCD_dumping bs + return $ TLst [] + [file] -> -- dump to named file + do _ <- bk_set_VCD_file bs file + _ <- bk_enable_VCD_dumping bs + let bs' = bs { active_vcd_file = Just file } + modifyIORef globalVar (\gv -> gv { tp_bluesim = Just bs' }) + return $ TLst [] + _ -> internalError $ "tclSim: grammar mismatch: " ++ (show args) + + Nothing -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim ["version"] = do + g <- readIORef globalVar + case (tp_bluesim g) of + Just bs -> do vi <- bk_version bs + obj <- toTclObj vi + return $ TCL obj + Nothing -> ioError $ userError ("There is no bluesim model loaded") +---------- +tclSim xs = internalError $ "tclSim: grammar mismatch: " ++ (show xs) + +-- We treat a list of symbols (starting with leaf, going back to root) +-- as a hierarchical path structure. +type Hier = [BSSymbol] + +hierLeaf :: Hier -> BSSymbol +hierLeaf [] = bad_symbol +hierLeaf (s:_) = s + +hierAdd :: Hier -> BSSymbol -> Hier +hierAdd syms s = s:syms + +mkDirString :: BluesimModel -> Hier -> Hier -> IO String +mkDirString bs relative_to syms = + do let above_root = if (null relative_to) + then bad_symbol + else head relative_to + ds = reverse $ takeWhile (/= above_root) syms + names <- mapM (bk_get_key bs) ds + return $ intercalate "." names + +describeSym :: BluesimModel -> BSSymbol -> IO String +describeSym bs sym = + do ismod <- bk_is_module bs sym + isrule <- bk_is_rule bs sym + isvalue <- bk_is_single_value bs sym + isrange <- bk_is_value_range bs sym + kind <- case (ismod, isvalue, isrule, isrange) of + (True,_,_,_) -> return "module" + (_,True,_,_) -> return "signal" + (_,_,True,_) -> return "rule" + (_,_,_,True) -> return "signal" + _ -> return "?" + redir_sym <- handleModuleRedirect bs sym + isvalue' <- bk_is_single_value bs redir_sym + isrange' <- bk_is_value_range bs redir_sym + range <- case (isvalue', isrange') of + (True,_) -> return $ if isvalue then "" else " with value" + (_,True) -> do lo <- bk_get_range_min_addr bs redir_sym + hi <- bk_get_range_max_addr bs redir_sym + return $ " range(" ++ (show lo) ++ ":" ++ (show hi) ++ ")" + _ -> return "" + return $ kind ++ range + +-- A module (like MOD_Reg, etc.) can have an entry for "" which will be +-- used to supply a value for that module, if it exists. +handleModuleRedirect :: BluesimModel -> BSSymbol -> IO BSSymbol +handleModuleRedirect bs sym = + do ismod <- bk_is_module bs sym + hdl <- if ismod + then bk_lookup_symbol bs sym "" + else return sym + return $ if (hdl /= bad_symbol) then hdl else sym + +getLsEntry :: BluesimModel -> Hier -> IO (Maybe HTclObj) +getLsEntry _ [] = internalError "getLsEntry: empty symbol hierarchy list" +getLsEntry bs dir = + do name <- mkDirString bs (current_directory bs) dir + symtag <- describeSym bs (hierLeaf dir) + obj <- toTclObj (name,symtag) + return $ Just (TCL obj) + +-- ------- +-- Utilities for handling wildcard patterns in hierarchical names + + +data Segment = Exact String + | Pattern String + deriving (Eq, Show) + +-- Break up a hierarchical path into segments. +segmentPath :: String -> ([Segment],Bool) +segmentPath path = + let segments = map removeDot $ groupBy (\_ x-> x /= '.') path + segments' = case segments of + [] -> [] + [""] -> [] + _ -> map tagSegment segments + is_absolute = "." `isPrefixOf` path + in (segments',is_absolute) + where removeDot ('.':x) = x + removeDot x = x + +-- Parse a segment specifier +tagSegment :: String -> Segment +tagSegment s = + let rs = reverse s + in if (null ("*?[\\" `intersect` s)) + then Exact s + else Pattern s + +-- Expand a list of symbols down one level based on a segment specifier +doSegment :: BluesimModel -> Hier -> [Hier] -> Segment -> IO [Hier] +doSegment bs rel ds seg = + do let showDir d = mkDirString bs rel d + ismod <- mapM ((bk_is_module bs) . hierLeaf) ds + let (ok,bad) = partition fst $ zip ismod ds + when (not (null bad)) $ + do names <- mapM (showDir . snd) bad + let str = intercalate ", " names + msg = if (length names == 1) + then "Not a module: " ++ str + else "Not modules: " ++ str + ioError $ userError msg + hdls <- case seg of + (Exact name) -> mapM (doName bs name) ds + (Pattern pat) -> do let p = parseGlobPattern pat + when (isJust (getGlobErr p)) $ + ioError $ userError (fromJust (getGlobErr p)) + mapM (doPattern bs p) ds + let new_ds = concat hdls + (bad2,ok2) = partition ((== bad_symbol) . hierLeaf) new_ds + when (not (null bad2)) $ + do names <- mapM (showDir . tail) bad2 + let str = intercalate ", " names + to_match = case (seg) of + (Exact name) -> name + (Pattern pat) -> pat + msg = "No match for '" ++ to_match ++ + (if (null str) then "'" else ("' in: " ++ str)) + ioError $ userError msg + return ok2 + +doName :: BluesimModel -> String -> Hier -> IO [Hier] +doName _ _ [] = internalError "doName: empty symbol hierarchy list" +doName bs name dir = + do hdl <- bk_lookup_symbol bs (hierLeaf dir) name + return [hierAdd dir hdl] + +doPattern :: BluesimModel -> GlobPattern -> Hier -> IO [Hier] +doPattern _ _ [] = internalError "doPattern: empty symbol hierarchy list" +doPattern bs pat dir = + do count <- bk_num_symbols bs (hierLeaf dir) + syms <- if (count == 0) + then return [] + else mapM (bk_get_nth_symbol bs (hierLeaf dir)) [0..(count-1)] + ns <- mapM (bk_get_key bs) syms + let hdls = [ sym + | (sym,name) <- zip syms ns + , matchGlobPattern pat name + ] + return [ hierAdd dir hdl | hdl <- hdls ] + +-- Get the list of symbol lists matching a full hierarchical path +-- The resulting list is bottom-up, with the deepest symbol at the head of the list +lookupSymbols :: BluesimModel -> String -> (Maybe Hier) -> IO [Hier] +lookupSymbols bs path root = + do top <- bk_top_symbol bs + let (segments,is_absolute) = segmentPath path + start = if is_absolute + then [top] + else case root of + (Just r) -> r + Nothing -> current_directory bs + foldM (doSegment bs start) [start] segments + + +---------------------------------------------------- +-- Utilities for cleaning up after async execution + +restore_edge_limit :: BSClock -> BSEdgeDirection -> Word64 -> IO () +restore_edge_limit clk dir count = + do g <- readIORef globalVar + case (tp_bluesim g) of + (Just bs) -> do _ <- bk_quit_after_edge bs clk dir count + return () + Nothing -> return () + + +remove_yield :: BSTime -> IO () +remove_yield t = + do g <- readIORef globalVar + case (tp_bluesim g) of + (Just bs) -> do _ <- bk_remove_ui_event bs t + return () + Nothing -> return () + +---------------------------------------------------- +-- Submodule interface types + +makeSubmoduleIfcMap :: Bool -> InstTree -> M.Map Id Type +makeSubmoduleIfcMap hide inst_tree = + M.fromList (concatMap getTypes (M.elems inst_tree)) + where + getTypes i@(Loc { node_type = mt }) = + case (nodeChildren hide i) of + [(StateVar x)] -> + case mt of + Just t -> [(x, t)] + Nothing -> internalError ("makeSubmoduleIfcMap: no type: " ++ + ppReadable i) + nodes -> concatMap getTypes nodes + getTypes (Rule {}) = [] + getTypes (StateVar x) = + internalError ("makeSubmoduleIfcMap: no wrapper: " ++ ppReadable x) + + +---------------------------------------------------- +-- Interface hierarchy + +-- raw info about an ifc field, which is common to APackage and AVInst +data RawIfcField = + RawMethod Id -- name + Integer -- multiplicity + (Maybe Id) (Maybe Id) -- associated clk and rst + [(Maybe Id, AType)] -- arguments + [VPort] -- argument ports + (Maybe (VPort, AType)) -- return value + (Maybe VPort) -- enable signal + -- Note: no ready signal at this stage + | RawClock Id + | RawReset Id + | RawInout Id AType VName + (Maybe Id) (Maybe Id) -- associated clk and rst + +rawIfcFieldName :: RawIfcField -> Id +rawIfcFieldName (RawMethod i _ _ _ _ _ _ _) = i +rawIfcFieldName (RawClock i) = i +rawIfcFieldName (RawReset i) = i +rawIfcFieldName (RawInout i _ _ _ _) = i + + +rawIfcFieldFromAIFace :: [PProp] -> AIFace -> RawIfcField +rawIfcFieldFromAIFace _ + (AIDef i args _ _ def + (Method _ clk rst mult ins mo@(Just out) Nothing) _) = + let -- include the type in the "mo" + mo' = Just (out, adef_type def) + in RawMethod i mult clk rst (mapFst Just args) ins mo' Nothing +rawIfcFieldFromAIFace pps + (AIAction args _ _ i _ + (Method _ clk rst mult ins Nothing me@(Just _))) = + let -- filter out inhigh enable ports + -- XXX is there a better way to do this? + me' = if (isAlwaysEn pps i) then Nothing else me + in RawMethod i mult clk rst (mapFst Just args) ins Nothing me' +rawIfcFieldFromAIFace pps + (AIActionValue args _ _ i _ def + (Method _ clk rst mult ins mo@(Just out) me@(Just _))) = + let -- filter out inhigh enable ports + -- XXX is there a better way to do this? + me' = if (isAlwaysEn pps i) then Nothing else me + -- include the type in the "mo" + mo' = Just (out, adef_type def) + in RawMethod i mult clk rst (mapFst Just args) ins mo' me' +rawIfcFieldFromAIFace _ (AIClock i _ (Clock _)) = RawClock i +rawIfcFieldFromAIFace _ (AIReset i _ (Reset _)) = RawReset i +rawIfcFieldFromAIFace _ (AIInout i (AInout e) (Inout _ vn mclk mrst)) = + RawInout i (ae_type e) vn mclk mrst +rawIfcFieldFromAIFace _ aif = + internalError ("rawIfcFieldFromAIFace: unexpected AIFace combo: " ++ + ppReadable aif) + +rawIfcFieldFromAVInst :: ([AType], Maybe AType, Maybe AType) -> + VFieldInfo -> RawIfcField +rawIfcFieldFromAVInst (arg_tys,_,mo_type) (Method i clk rst mult ins mo me) = + let -- XXX AVInst doesn't record argument names + args = zip (repeat Nothing) arg_tys + -- add the return bit-type to the mo + mo' = case (mo, mo_type) of + (Just o, Just o_type) -> Just (o, o_type) + (Nothing, Nothing) -> Nothing + _ -> internalError ("rawIfcFieldFromAVInst: unexpected mo: " ++ + ppReadable (mo, mo_type)) + in RawMethod i mult clk rst args ins mo' me +rawIfcFieldFromAVInst _ (Clock i) = RawClock i +rawIfcFieldFromAVInst _ (Reset i) = RawReset i +rawIfcFieldFromAVInst (_,_,mt) (Inout i vn mclk mrst) = + let t = fromJustOrErr ("getIfc: no type for Inout") mt + in RawInout i t vn mclk mrst + +-- --------------- + +data IfcField = + Field Id RawIfcField (Maybe RawIfcField) -- name, def, maybe RDY def + | SubIfc Id [IfcField] -- name, subfields + -- XXX Vector of Ifc? + -- XXX field multiplicity? + + +getIfcHierarchy :: Maybe Id -> [(Id, RawIfcField)] -> Type -> IO [IfcField] +getIfcHierarchy instId raw_fields tifc = do + mres <- runExceptT (mgetIfcHierarchy instId raw_fields tifc) + case mres of + Right res -> return res + Left msg -> internalError msg + +mgetIfcHierarchy :: Maybe Id -> [(Id, RawIfcField)] -> Type -> + ExceptT String IO [IfcField] +mgetIfcHierarchy instId raw_fields tifc = do + -- use "expandSyn" to avoid getting back "Alias" as the type analysis + maifc <- lift $ getTypeAnalysis' (expandSyn tifc) True + case (maifc) of + Just (Interface _ _ _ _ ifc_fs _) -> mapM (getField emptyId) ifc_fs + where + ifc_map = M.fromList raw_fields + + -- get the AIF for a flattened name + lookupAIF :: Id -> ExceptT String IO RawIfcField + lookupAIF i = + case (M.lookup i ifc_map) of + Just aif -> return aif + _ -> throwError ("getIfcHierarhcy: not in map: " ++ + ppReadable (instId, i, M.keys ifc_map)) + -- get the AIF for its RDY method, if it exists + lookupRdyAIF i = + let -- XXX is there a better way to find the rdy name? + rdy_i = mkRdyId i + in M.lookup rdy_i ifc_map + + -- append to the prefix + addToPrefix pre suf = + if (isEmptyId pre) + then setIdBase pre (getIdBase suf) + else setIdBase pre (concatFString [getIdBase pre, + fsUnderscore, getIdBase suf]) + + -- get the IfcField for one field + getField :: Id -> (Bool, Id, Qual Type, [IfcPragma]) -> + ExceptT String IO IfcField + getField prefix (_, fId, (_ :=> t), _) = getField' prefix fId t + + getField' :: Id -> Id -> Type -> ExceptT String IO IfcField + getField' prefix fId t = do + -- Function for expanding Vectors of subinterfaces + -- (or pseudo-interfaces like Clock, Reset, Inout) + -- Returns Nothing if this is not a Vector of interfaces + -- or Just (sizes, fields) where "sizes" is the sizes of + -- the Vector wrappers and "fs" the fields of the interface. + -- Pseudo-interfaces are treated like interfaces with a + -- single unnamed field. + let expandVectors lenTy elemTy = do + -- ("expandSyn" not needed, since it was applied to "t") + maelem <- lift $ getTypeAnalysis' elemTy True + let sz = getTNum (expandSyn lenTy) + case (maelem) of + Just (Interface _ _ _ _ fs _) -> + return (Just ([sz], fs)) + Just (Vector _ lenTy2 elemTy2 _) -> do + maybe_subifc <- expandVectors lenTy2 elemTy2 + case (maybe_subifc) of + Nothing -> return Nothing + Just (szs, fs) -> + return (Just ((sz:szs), fs)) + Just (Primary i _ _ _ _) + | (i == idClock) || (i == idReset) || (i == idInout) + -> let fs = [(True, emptyId, [] :=> elemTy, [])] + in return (Just ([sz], fs)) + _ -> return Nothing + -- Function to take the output of "expandVectors" and + -- construct the IfcField result + let mkVecSubIfc fs pfx [] n = do + let pfx_n = addToPrefix pfx n + ffs <- mapM (getField pfx_n) fs + return (SubIfc n ffs) + mkVecSubIfc fs pfx (sz:rest) n = do + let pfx_n = addToPrefix pfx n + prefs = if (sz == 0) + then [] + else map mkNumId [0..(sz-1)] + vfs <- mapM (mkVecSubIfc fs pfx_n rest) prefs + return (SubIfc n vfs) + -- expand this field + ma <- lift $ getTypeAnalysis' (expandSyn t) True + let prefix' = if (isEmptyId fId) + then prefix -- indicates a Clock/Reset/Inout + else addToPrefix prefix fId + -- default result (if the type is not a subifc to be expanded) + let mkDefault = do aif <- lookupAIF prefix' + let mrdy_aif = lookupRdyAIF prefix' + return (Field fId aif mrdy_aif) + case (ma) of + Just (Interface _ _ _ _ fs _) -> do + ffs <- mapM (getField prefix') fs + return (SubIfc fId ffs) + Just (Vector _ lenTy elemTy _) -> do + -- find out if it's a vector of ifcs + maelem <- expandVectors lenTy elemTy + case (maelem) of + Just (sz:rest, fs) -> do + let prefs = if (sz == 0) + then [] + else map mkNumId [0..(sz-1)] + vfs <- mapM (mkVecSubIfc fs prefix' rest) prefs + return (SubIfc fId vfs) + _ -> mkDefault + _ -> mkDefault -- not an interface to expand + Nothing -> + -- return [ Field fId inf Nothing | (fId, inf) <- raw_fields ] + throwError ("getIfcHierarchy: ifc type not found: " ++ + ppReadable tifc) + _ -> throwError ("getIfcHierarchy: not an ifc: " ++ ppReadable tifc) + + +dispIfcHierarchyNames :: [IfcField] -> HTclObj +dispIfcHierarchyNames ifc_fs = TLst (map dispField ifc_fs) + where + dispField (Field fId inf mrdy_inf) = + TLst $ [TStr (getIdBaseString fId), + TStr (pvpString (rawIfcFieldName inf))] ++ + case (mrdy_inf) of + Nothing -> [] + Just rdy_inf -> + [tagStr "ready" (pvpString (rawIfcFieldName rdy_inf))] + dispField (SubIfc fId fs) = + tagLst (getIdBaseString fId) (map dispField fs) + + +---------------------------------------------------- +-- Extract and display info about module arguments and interface +-- (common to the "module" and "submodule" commands) + +-- define a datatype for the extracted info +data PortIfcInfo = + -- first Id is the field name at the current level of the hierarchy, + -- while the second Id is the flattened name + PIMethod Id Id + (Maybe Id) (Maybe Id) -- associated clk and rst + [(Maybe Id, AType, (String, IType))] -- arguments + (Maybe (String, AType, IType)) -- return value + (Maybe (String, IType)) -- enable signal + (Maybe (String, IType)) -- ready signal + | PIClock Id Id (Maybe ((String, IType), Maybe (String, IType))) + | PIReset Id Id (Maybe (String, IType)) (Maybe Id) + | PIInout Id Id AType (String, IType) (Maybe Id) (Maybe Id) + | PISubIfc Id [PortIfcInfo] + +data PortArgInfo = + PAParam Id AType String + | PAPort Id AType (String, IType) (Maybe Id) (Maybe Id) + | PAClock Id (Maybe ((String, IType), Maybe (String, IType))) + | PAReset Id (Maybe (String, IType)) (Maybe Id) + | PAInout Id Integer (String, IType) (Maybe Id) (Maybe Id) + + +getModPortInfo :: APackage -> [PProp] -> Type -> + IO ([PortArgInfo], [PortIfcInfo]) +getModPortInfo apkg pps tifc = do + -- port type map + let ptmap = apkg_external_wire_types apkg + + -- interface fields (with VFieldInfo) + let ifc' :: [AIFace] + ifc' = apkg_interface apkg + -- need to filter out ready methods that are always ready + notAlwaysRdy :: AIFace -> Bool + notAlwaysRdy aif = let mid = aif_name aif + in not $ (isRdyId mid) && (isAlwaysRdy pps mid) + ifc = filter notAlwaysRdy ifc' + + -- interface hierarchy + let -- map from flattened ifc name to its raw info + ifc_map = [ (aIfaceName aif, rawIfcFieldFromAIFace pps aif) + | aif <- ifc ] + ifc_hier <- getIfcHierarchy Nothing ifc_map tifc + + -- module arguments + let inps :: [(AAbstractInput, VArgInfo)] + inps = getAPackageInputs apkg + + -- clock and reset info + let + wires = apkg_external_wires apkg + -- clockinfo + out_clkinfo = output_clocks (wClk wires) + in_clkinfo = input_clocks (wClk wires) + -- resetinfo + out_rstinfo = output_resets (wRst wires) + in_rstinfo = input_resets (wRst wires) + + -- construct port info for the interface fields + let getIfcHier = getPortsIfc ptmap out_clkinfo out_rstinfo + + -- construct port info for a module argument + let + getModArg (AAI_Port (i,t), Param v) = + [getPortsModArgParam i t v] + getModArg (AAI_Port (i,t), Port v mclk mrst) = + getPortsModArgPort ptmap i t v mclk mrst + getModArg (AAI_Clock {}, ClockArg i) = + [getPortsModArgClock in_clkinfo i] + getModArg (AAI_Reset {}, ResetArg i) = + [getPortsModArgReset in_rstinfo i] + getModArg (AAI_Inout i sz, InoutArg vn mclk mrst) = + getPortsModArgInout ptmap i sz vn mclk mrst + getModArg a = internalError ("getModArg: unexpected arg combo: " ++ + ppReadable a) + + return + (concatMap getModArg inps, + concatMap getIfcHier ifc_hier) + + +getSubmodPortInfo :: Maybe Type -> AVInst -> IO ([PortArgInfo], [PortIfcInfo]) +getSubmodPortInfo mtifc avi = do + -- port type map + let ptmap = avi_port_types avi + + -- clock and reset info + let vmi = avi_vmi avi + -- clockinfo + out_clkinfo = output_clocks (vClk vmi) + in_clkinfo = input_clocks (vClk vmi) + -- resetinfo + out_rstinfo = output_resets (vRst vmi) + in_rstinfo = input_resets (vRst vmi) + + -- module arguments + let -- VArgInfo + modargs = vArgs vmi + -- XXX is there a better way to get the types? + modarg_tys = map ae_type (avi_iargs avi) + + -- interface fields + let -- VFieldInfo and method bit-types + vfts0 = (vFields vmi, avi_meth_types avi) + -- adjust primitives + (vfi, fts) = adjustPrimFields mtifc avi vfts0 + + -- interface hierarchy + let -- map from flattened ifc name to its raw info + ifc_map = [ (vf_name vf, rawIfcFieldFromAVInst ft vf) + | (ft, vf) <- zip fts vfi ] + ifc_hier <- + let defl_ifc_hier = [ (Field fId inf Nothing) | (fId, inf) <- ifc_map ] + in case mtifc of + Just tifc -> do + mres <- runExceptT $ + mgetIfcHierarchy (Just (avi_vname avi)) ifc_map tifc + case mres of + Right res -> return res + Left _ -> -- the wrapped ifc didn't match the inst ifc, + -- so use the inst's ifc + return defl_ifc_hier + Nothing -> return defl_ifc_hier + + -- construct port info for the interface fields + let getIfcHier = getPortsIfc ptmap out_clkinfo out_rstinfo + + -- construct port info for a module argument + let + getModArg t (Param v) = + let i = vName_to_id v + in [getPortsModArgParam i t v] + getModArg t (Port v mclk mrst) = + let i = vPort_to_id v + in getPortsModArgPort ptmap i t v mclk mrst + getModArg _ (ClockArg i) = + [getPortsModArgClock in_clkinfo i] + getModArg _ (ResetArg i) = + [getPortsModArgReset in_rstinfo i] + getModArg t (InoutArg vn mclk mrst) = + let sz = case t of + (ATAbstract c [n]) + | c `qualEq` idInout_ -> n + _ -> internalError ("getModArg: " ++ + "bad Inout type: " ++ + ppReadable t) + i = vName_to_id vn + in getPortsModArgInout ptmap i sz vn mclk mrst + + return + (concat $ zipWith getModArg modarg_tys modargs, + concatMap getIfcHier ifc_hier) + +adjustPrimFields :: Maybe Type -> AVInst -> + ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> + ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustPrimFields Nothing _ vfts = vfts +adjustPrimFields (Just tifc) avi vfts = + if (leftCon tifc == Just idReg) + then -- wrapper type is Reg + if (isRegAligned avi) + then adjustRegAlignedFields vfts + else if (isRegInst avi) + then adjustRegFields vfts + else if (isRWire0 avi) + then adjustWireFields (adjustRWire0Fields vfts) + else if (isRWire avi) + then adjustWireFields vfts + else if (isBypassWire0 avi) + then adjustBypassWireFields (adjustRWire0Fields vfts) + else if (isBypassWire avi) + then adjustBypassWireFields vfts + else if (isClockCrossingBypassWire avi) + then adjustBypassWireFields vfts + else if (isSyncReg avi) + then adjustSyncRegFields vfts + else vfts + else if (leftCon tifc == Just idRWire) + then -- wrapper type is RWire + if (isRWire0 avi) + then adjustRWireFields (adjustRWire0Fields vfts) + else if (isRWire avi) + then adjustRWireFields vfts + else vfts + else if (leftCon tifc == Just idPulseWire) + then -- wrapper type is PulseWire + if (isRWire0 avi) + then adjustPulseWireFields vfts + else vfts + else if (leftCon tifc == Just idFIFO) || (leftCon tifc == Just idFIFOF) + then -- wrapper type is FIFO or FIFOF + if (isFIFO0 avi) + then adjustFIFOFields (adjustFIFO0Fields vfts) + else if (isFIFO avi) + then adjustFIFOFields vfts + else vfts + else vfts + +-- This is a no-op but it does add some error checking +adjustRegAlignedFields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> + ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustRegAlignedFields (vfi, fts) = + let renameField vf@(Method {vf_name = i }) + | (i `qualEq` id_read noPosition) = vf + | (i `qualEq` id_write noPosition) = vf + renameField vf = internalError ("adjustRegAlignedFields: unknown field: " ++ + ppReadable (vf_name vf)) + in (map renameField vfi, fts) + + +adjustRegFields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> + ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustRegFields (vfi, fts) = + let renameField vf@(Method {vf_name = i }) + | (i `qualEq` idPreludeRead) = vf { vf_name = id_read noPosition } + | (i `qualEq` idPreludeWrite) = vf { vf_name = id_write noPosition } + renameField vf = internalError ("adjustRegFields: unknown field: " ++ + ppReadable (vf_name vf)) + in (map renameField vfi, fts) + +adjustFIFOFields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> + ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustFIFOFields (vfi, fts) = + let enq_rdy = mkRdyId idEnq + deq_rdy = mkRdyId idDeq + first_rdy = mkRdyId idFirst + renameField (vf@(Method {vf_name = i }), ts) + | (i `qualEq` id_notFull) = [ (vf { vf_name = enq_rdy }, ts) ] + | (i `qualEq` id_notEmpty) = [ (vf { vf_name = deq_rdy }, ts), + (vf { vf_name = first_rdy }, ts) ] + renameField vft = [vft] + in unzip $ concatMap renameField $ zip vfi fts + +adjustFIFO0Fields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> + ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustFIFO0Fields (vfi, fts) = + let (clk, rst) = + case vfi of + -- get the clk/rst from the deq method (just in case) + (_:d@(Method _ c r _ _ _ _):_) -> (c, r) + _ -> internalError ("adjustFIFO0Fields: vfi = " ++ + ppReadable vfi) + first_vfi = Method idFirst clk rst 1 [] Nothing Nothing + first_fts = ([], Nothing, Nothing) + in (first_vfi:vfi, first_fts:fts) + +adjustSyncRegFields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> + ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustSyncRegFields (vfi, fts) = + let renameField vf@(Method {vf_name = i }) + -- XXX these are qualified Clock, not Prelude + | (i `qualEq` idPreludeRead) = vf { vf_name = id_read noPosition } + | (i `qualEq` idPreludeWrite) = vf { vf_name = id_write noPosition } + | (i `qualEq` (mkRdyId idPreludeWrite)) = + vf { vf_name = mkRdyId (id_write noPosition) } + renameField vf = internalError ("adjustRegFields: unknown field: " ++ + ppReadable (vf_name vf)) + in (map renameField vfi, fts) + +adjustRWireFields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> + ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustRWireFields (vfi, fts) = + let renameField vf@(Method {vf_name = i }) + | (i `qualEq` idWHas) = vf { vf_name = unQualId $ mkRdyId idWGet } + renameField vf = vf + in (map renameField vfi, fts) + +adjustRWire0Fields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> + ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustRWire0Fields (vfi, fts) = + let (clk, rst) = + case vfi of + ((Method _ c r _ _ _ _):_) -> (c, r) + _ -> internalError ("adjustRWire0Fields: vfi = " ++ + ppReadable vfi) + wget_vfi = Method (unQualId idWGet) clk rst 1 [] Nothing Nothing + wget_fts = ([], Nothing, Nothing) + in (wget_vfi:vfi, wget_fts:fts) + +adjustWireFields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> + ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustWireFields (vfi, fts) = + let readId = id_read noPosition + writeId = id_write noPosition + renameField vf@(Method {vf_name = i }) + | (i `qualEq` idWGet) = vf { vf_name = readId } + | (i `qualEq` idWSet) = vf { vf_name = writeId } + | (i `qualEq` idWHas) = vf { vf_name = mkRdyId readId } + renameField vf = internalError ("adjustWireFields: unknown field: " ++ + ppReadable (vf_name vf)) + in (map renameField vfi, fts) + +adjustPulseWireFields :: + ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> + ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustPulseWireFields (vfi, fts) = + let renameField vf@(Method {vf_name = i }) + | (i `qualEq` idWSet) = vf { vf_name = unQualId idSend } + | (i `qualEq` idWHas) = vf { vf_name = id_read noPosition } + renameField vf = + internalError ("adjustPulseWireFields: unknown field: " ++ + ppReadable (vf_name vf)) + in (map renameField vfi, fts) + +adjustBypassWireFields :: + ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> + ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustBypassWireFields (vfi, fts) = + let renameField vf@(Method {vf_name = i }) + | (i `qualEq` idWGet) = vf { vf_name = id_read noPosition } + | (i `qualEq` idWSet) = vf { vf_name = id_write noPosition } + renameField vf = + internalError ("adjustBypassWireFields: unknown field: " ++ + ppReadable (vf_name vf)) + in (map renameField vfi, fts) + +-- --------------- + +getVNameType :: M.Map VName IType -> VName -> (String, IType) +getVNameType ptmap vn = + case (M.lookup vn ptmap) of + Just t -> (getVNameString vn, t) + Nothing -> internalError ("getVNameType: " ++ ppReadable vn) + +getMVNameType :: M.Map VName IType -> Maybe VName -> Maybe (String, IType) +getMVNameType ptmap mvn = mvn >>= Just . getVNameType ptmap + +getMVPortType :: M.Map VName IType -> Maybe VPort -> Maybe (String, IType) +getMVPortType ptmap mvp = mvp >>= (\ (vn,_) -> Just (getVNameType ptmap vn) ) + +addMVNameType :: Maybe VName -> IType -> Maybe (String, IType) +addMVNameType Nothing _ = Nothing +addMVNameType (Just vn) t = Just (getVNameString vn, t) + +addMVPortType :: Maybe VPort -> IType -> Maybe (String, IType) +addMVPortType Nothing _ = Nothing +addMVPortType (Just (vn,_)) t = Just (getVNameString vn, t) + +isSizeZero :: AType -> Bool +isSizeZero (ATBit sz) = (sz == 0) +isSizeZero (ATAbstract c [sz]) | (c `qualEq` idInout_) = (sz == 0) +isSizeZero _ = False + + +getPortsModArgParam :: Id -> AType -> VName -> PortArgInfo +getPortsModArgParam i t vn = (PAParam i t (getVNameString vn)) + +getPortsModArgPort :: + M.Map VName IType -> + Id -> AType -> VPort -> Maybe Id -> Maybe Id -> [PortArgInfo] +getPortsModArgPort ptmap i t (vn,_) mclk mrst = + if (isSizeZero t) + then [] + else [PAPort i t (getVNameType ptmap vn) mclk mrst] + +getPortsModArgClock :: [InputClockInf] -> Id -> PortArgInfo +getPortsModArgClock in_clkinfo i = + case (lookup i in_clkinfo) of + Nothing -> internalError ("getPortsModArgClock: clock not found: " ++ + ppReadable (i, in_clkinfo)) + Just (Nothing) -> (PAClock i Nothing) + Just (Just (osc, mgate)) -> + let osc' = (getVNameString osc, itClock) + mgate' = case mgate of + Left _ -> Nothing + Right vn -> Just (getVNameString vn, itBool) + in (PAClock i (Just (osc', mgate'))) + +getPortsModArgReset :: [ResetInf] -> Id -> PortArgInfo +getPortsModArgReset in_rstinfo i = + case (lookup i in_rstinfo) of + Nothing -> internalError ("getPortsModArgReset: reset not found: " ++ + ppReadable (i, in_rstinfo)) + Just (mport, mclk) -> + (PAReset i (addMVNameType mport itReset) mclk) + +getPortsModArgInout :: + M.Map VName IType -> + Id -> Integer -> VName -> Maybe Id -> Maybe Id -> [PortArgInfo] +getPortsModArgInout ptmap i sz vn mclk mrst = + if (sz == 0) + then [] + else [PAInout i sz (getVNameType ptmap vn) mclk mrst] + + +getPortsIfc :: M.Map VName IType -> + [OutputClockInf] -> [ResetInf] -> + IfcField -> [PortIfcInfo] +getPortsIfc ptmap out_clkinfo out_rstinfo (SubIfc fId fs) = + let fs' = concatMap (getPortsIfc ptmap out_clkinfo out_rstinfo) fs + in if (null fs') + then [] + else [PISubIfc fId fs'] +getPortsIfc ptmap _ _ + (Field fId (RawMethod i mult mclk mrst args ins mo me) mrdy_inf) = + getPortsIfcMethod ptmap fId i mult mclk mrst args ins mo me mr + where mr = case (mrdy_inf) of + Nothing -> Nothing + (Just (RawMethod ri m _ _ [] [] (Just (vp@(vn,_), t)) Nothing)) + | ((m == 0) || (m == 1)) -> + if (t == aTBool) + then Just vp + else internalError ("getPortsIfc: Rdy wrong size: " ++ + ppReadable (ri,t)) + (Just (RawMethod ri m _ _ as is mout men)) -> + internalError ("getPortsIfc: not Rdy: " ++ + ppReadable (ri, m, as, is, mout, men)) + (Just d) -> internalError ("getPortsIfc: not Rdy: " ++ + ppReadable (rawIfcFieldName d)) +getPortsIfc _ out_clkinfo _ (Field fId (RawClock i) Nothing) = + [getPortsIfcClock out_clkinfo fId i] +getPortsIfc _ _ out_rstinfo (Field fId (RawReset i) Nothing) = + [getPortsIfcReset out_rstinfo fId i] +getPortsIfc ptmap _ _ (Field fId (RawInout i t vn mclk mrst) Nothing) = + getPortsIfcInout ptmap fId i t vn mclk mrst +getPortsIfc _ _ _ (Field fId rf (Just rdy_rf)) = + internalError ("getPortsIfc: subifc should not have a Rdy: " ++ + ppReadable (rawIfcFieldName rf, rawIfcFieldName rdy_rf)) + + +getPortsIfcMethod :: M.Map VName IType -> + Id -> Id -> Integer -> + Maybe Id -> Maybe Id -> + [(Maybe Id, AType)] -> [VPort] -> Maybe (VPort, AType) -> + Maybe VPort -> Maybe VPort -> + [PortIfcInfo] +getPortsIfcMethod ptmap fId methId mult mClk mRst args ins mOut mEn mRdy = + let + -- get the port-type pair for an argument + getPortsArg (mi, bit_type) (vn, _) = + if (isSizeZero bit_type) + then [] + else [(mi, bit_type, getVNameType ptmap vn)] + -- get the port-type pair for the output + getPortsOut Nothing = Nothing + getPortsOut (Just ((vn, _), bit_type)) = + if (isSizeZero bit_type) + then Nothing + else + -- XXX since IExpand is not recording types for rdy methods + if (isRdyId methId) + then Just (getVNameString vn, bit_type, itBool) + else let (s,t) = getVNameType ptmap vn + in Just (s, bit_type, t) + -- get the port-type pair for the enable + getPortsEn Nothing = Nothing + getPortsEn (Just (vn, ps)) = + -- filter out inhigh ports + if (VPinhigh `elem` ps) + then Nothing + else Just (getVNameString vn, itBool) + -- get the port-type pair for the ready + getPortsRdy Nothing = Nothing + getPortsRdy (Just (vn, _)) = Just (getVNameString vn, itBool) + + -- the default result (multiplicity of 1) + def_res = PIMethod fId methId mClk mRst + (concat (zipWith getPortsArg args ins)) + (getPortsOut mOut) (getPortsEn mEn) (getPortsRdy mRdy) + + -- the result if multiplicity > 1 + mkMulRes n = + let s = "_" ++ show n + ins' = map (dupVPort s) ins + in PIMethod (dupId s fId) -- XXX handle mults differently? + (dupId s methId) mClk mRst + (concat (zipWith getPortsArg args ins')) + (getPortsOut (dupMVPortType s mOut)) + (getPortsEn (dupMVPort s mEn)) + (getPortsRdy (dupMVPort s mRdy)) + + dupId suf i = mkIdPost i (mkFString suf) + dupVName suf (VName s) = VName (s ++ suf) + dupVPort suf (vn, ps) = (dupVName suf vn, ps) + dupMVPort :: String -> Maybe VPort -> Maybe VPort + dupMVPort suf mvp = mvp >>= Just . dupVPort suf + dupMVPortType :: String -> Maybe (VPort, AType) -> Maybe (VPort, AType) + dupMVPortType suf mvpt = + mvpt >>= (\ (vp, t) -> Just (dupVPort suf vp, t) ) + in + if (mult == 1) || (mult == 0) + then [def_res] + else map mkMulRes [1..mult] + +getPortsIfcClock :: [OutputClockInf] -> Id -> Id -> PortIfcInfo +getPortsIfcClock out_clkinfo fId i = + case (lookup i out_clkinfo) of + Nothing -> internalError ("getPortsIfcClock: clock not found: " ++ + ppReadable (i, out_clkinfo)) + Just (Nothing) -> (PIClock i fId Nothing) + Just (Just (osc, mgate)) -> + let osc' = (getVNameString osc, itClock) + mgate' = addMVPortType mgate itBool + in (PIClock fId i (Just (osc', mgate'))) + +getPortsIfcReset :: [ResetInf] -> Id -> Id -> PortIfcInfo +getPortsIfcReset out_rstinfo fId i = + case (lookup i out_rstinfo) of + Nothing -> internalError ("getPortsIfcReset: reset not found: " ++ + ppReadable (i, out_rstinfo)) + Just (mport, mclk) -> + (PIReset fId i (addMVNameType mport itReset) mclk) + +getPortsIfcInout :: + M.Map VName IType -> + Id -> Id -> AType -> VName -> Maybe Id -> Maybe Id -> [PortIfcInfo] +getPortsIfcInout ptmap fId i t vn mclk mrst = + if (isSizeZero t) + then [] + else [PIInout fId i t (getVNameType ptmap vn) mclk mrst] + + +---------------------------------------------------- +-- module argument and interface display functions +-- common to the "module" and "submodule" commands + + +-- display clock +dispClockedBy :: Maybe Id -> HTclObj +dispClockedBy Nothing = tagStr "clock" "no_clock" +dispClockedBy (Just c) = tagStr "clock" (pvpString c) + +-- display reset +dispResetBy :: Maybe Id -> HTclObj +dispResetBy Nothing = tagStr "reset" "no_reset" +dispResetBy (Just r) = tagStr "reset" (pvpString r) + +-- display maybe a port name +-- (The first argument is the tag, like "port", "gate", etc) +dispMPort :: String -> Maybe String -> [HTclObj] +dispMPort s mport = + case mport of + Nothing -> [] + Just p -> [tagStr s p] + +dispMPortWithType :: String -> Maybe (String, IType) -> [HTclObj] +dispMPortWithType s mport = + case mport of + Nothing -> [] + Just (p, _) -> [tagStr s p] + +dispMPortWithTypes :: String -> Maybe (String, AType, IType) -> [HTclObj] +dispMPortWithTypes s mport = + case mport of + Nothing -> [] + Just (p, _, _) -> -- XXX we have the opportunity to display the size + [tagStr s p] + +-- display AType +dispSize :: AType -> [HTclObj] +dispSize (ATBit sz) = [tagInt "size" (fromInteger sz)] +dispSize _ = [] + +-- display a numeric size +dispNSize :: Integer -> HTclObj +dispNSize sz = tagInt "size" (fromInteger sz) + + +-- display module arguments +dispModArg :: PortArgInfo -> HTclObj +dispModArg (PAParam i _ name) = + TLst $ [TStr "parameter", TStr (pvpString i)] ++ + [tagStr "param" name] +dispModArg (PAPort i bit_type (port, _) mclk mrst) = + TLst $ [TStr "port", TStr (pvpString i)] ++ + [tagStr "port" port] ++ + [dispClockedBy mclk] ++ + [dispResetBy mrst] ++ + dispSize bit_type +dispModArg (PAClock i Nothing) = + TLst [TStr "clock", TStr (pvpString i)] +dispModArg (PAClock i (Just ((osc, _), mgate))) = + TLst $ [TStr "clock", TStr (pvpString i), + tagStr "osc" osc] ++ + dispMPortWithType "gate" mgate +dispModArg (PAReset i mport mclk) = + TLst $ [TStr "reset", TStr (pvpString i)] ++ + (dispMPortWithType "port" mport) ++ + [dispClockedBy mclk] +dispModArg (PAInout i sz (port,_) mclk mrst) = + TLst $ [TStr "inout", TStr (pvpString i)] ++ + [tagStr "port" port] ++ + [dispClockedBy mclk] ++ + [dispResetBy mrst] ++ + [dispNSize sz] + + +dispMethodArgs :: [(Maybe Id, AType, (String, IType))] -> HTclObj +dispMethodArgs as = + let dispMName Nothing = [] + dispMName (Just i) = [tagStr "name" (pvpString i)] + dispArg (mi, bit_type, (port, _)) = + TLst $ (dispMName mi) ++ + [tagStr "port" port] ++ + dispSize bit_type + in TLst (map dispArg as) + + +dispIfc :: PortIfcInfo -> HTclObj +dispIfc (PIMethod fId i mClk mRst ins mOut mEn mRdy) = + TLst $ [TStr "method", + TStr (getIdBaseString fId), + TStr (pvpString i), + dispClockedBy mClk, + dispResetBy mRst, + tag "args" [dispMethodArgs ins]] ++ + dispMPortWithTypes "result" mOut ++ + dispMPortWithType "enable" mEn ++ + dispMPortWithType "ready" mRdy +dispIfc (PIClock fId i Nothing) = + TLst [TStr "clock", TStr (getIdBaseString fId), TStr (pvpString i)] +dispIfc (PIClock fId i (Just ((osc, _), mgate))) = + TLst $ [TStr "clock", TStr (getIdBaseString fId), TStr (pvpString i), + tagStr "osc" osc] ++ + dispMPortWithType "gate" mgate +dispIfc (PIReset fId i mport mclk) = + TLst $ [TStr "reset", TStr (getIdBaseString fId), TStr (pvpString i)] ++ + (dispMPortWithType "port" mport) ++ + [dispClockedBy mclk] +dispIfc (PIInout fId i bit_type (port,_) mclk mrst) = + TLst $ [TStr "inout", TStr (getIdBaseString fId), TStr (pvpString i)] ++ + [tagStr "port" port] ++ + [dispClockedBy mclk] ++ + [dispResetBy mrst] ++ + (dispSize bit_type) +dispIfc (PISubIfc fId fs) = + TLst $ [TStr "interface", TStr (getIdBaseString fId), + TLst (map dispIfc fs)] + +-- --------------- + +-- Display just the ports and their types + +dispPortType :: (String, IType) -> HTclObj +dispPortType (p,t) = TLst [TStr p, TStr (pvpString t)] + +dispMPortType :: Maybe (String, IType) -> [HTclObj] +dispMPortType Nothing = [] +dispMPortType (Just pt) = [dispPortType pt] + +dispMPortTypes :: Maybe (String, AType, IType) -> [HTclObj] +dispMPortTypes Nothing = [] +dispMPortTypes (Just (p, at, it)) = [dispPortType (p, it)] + + +dispPortsModArg :: PortArgInfo -> [HTclObj] +dispPortsModArg (PAParam _ _ _) = [] +dispPortsModArg (PAPort _ _ pt _ _) = [dispPortType pt] +dispPortsModArg (PAClock _ Nothing) = [] +dispPortsModArg (PAClock _ (Just (osc, mgate))) = + [dispPortType osc] ++ dispMPortType mgate +dispPortsModArg (PAReset _ mpt _) = dispMPortType mpt +dispPortsModArg (PAInout _ _ pt _ _) = [dispPortType pt] + + +dispPortsIfc :: PortIfcInfo -> [HTclObj] +dispPortsIfc (PIMethod _ _ _ _ ins mOut mEn mRdy) = + (map (dispPortType . thd) ins) ++ + dispMPortTypes mOut ++ dispMPortType mEn ++ dispMPortType mRdy +dispPortsIfc (PIClock _ _ Nothing) = [] +dispPortsIfc (PIClock _ _ (Just (osc, mgate))) = + [dispPortType osc] ++ dispMPortType mgate +dispPortsIfc (PIReset _ _ mpt _) = dispMPortType mpt +dispPortsIfc (PIInout _ _ _ pt _ _) = [dispPortType pt] +dispPortsIfc (PISubIfc _ fs) = concatMap dispPortsIfc fs + + +---------------------------------------------------- + +-- Depend functions +dependGrammar :: HTclCmdGrammar +dependGrammar = + ((tclcmd "depend" namespace helpStr "") .+. + (oneOf [(kw "make" makeHelpStr "") .+. (arg "file" StringArg "file name") + ,(kw "file" fileHelpStr "") .+. (arg "file" StringArg "file name") + ,(kw "recomp" recompHelpStr "") .+. (arg "file" StringArg "file name") + ])) + where helpStr = "Show the file and package dependencies for a given file." + makeHelpStr = "Show dependency for top file and all sub packages in a make compatible format" + fileHelpStr = "Lists only the files and not package dependencies" + recompHelpStr = "List all files which need to be recompiled based on file." + + +replaceBSDir :: Flags -> String -> String -> String +replaceBSDir flags substr s = + let dirregex = mkRegex $ bluespecDir flags + in subRegex dirregex s substr + +tclDepend :: [String] -> IO HTclObj +tclDepend ["make",fname] = do + flags <- getGFlags + (errs,dep) <- genDepend globalErrHandle flags fname + reportErrorsToTcl (nubBy (\l r -> snd l == snd r) errs) [] + let dep' = mapSnd (map (replaceBSDir flags "$(BLUESPECDIR)")) dep + return $ toHTObj $ reverse dep' +-- +tclDepend ["file",fname]= do + flags <- getGFlags + (errs,fl) <- genFileDepend globalErrHandle flags fname + reportErrorsToTcl (nubBy (\l r -> snd l == snd r) errs) [] + return $ toHTObj $ reverse fl + +-- +tclDepend ["recomp",fname]= do + flags <- getGFlags + fnames <- chkDeps globalErrHandle flags fname + return $ toHTObj fnames + +tclDepend xs = internalError $ "tclDepend: grammar mismatch: " ++ (show xs) + +find_vmodinfo :: (IPackage Id) -> [VModInfo] +find_vmodinfo = listify + (let + tagVMI :: VModInfo -> Bool + tagVMI _ = True + in tagVMI) + +package_vsignals :: TclP -> [(Id,String)] +package_vsignals tclp = + (map head) $ group $ sort $ -- equivalent to nub, but faster hopefully + (M.elems (tp_binmap tclp)) + >>= (return . ip_ipkg) >>= find_vmodinfo >>= get_method_to_signal_map + +get_method_to_signal_map :: VModInfo -> [(Id,String)] +get_method_to_signal_map vmod = do + f <- vFields vmod + case f of + Method {} -> return () + _ -> mzero -- failure, as in the guard function + port <- (vf_inputs f) ++ (maybeToList $ vf_output f) ++ (maybeToList $ vf_enable f) + count <- case (vf_mult f) of + 1 -> return Nothing + k -> map Just [1..k] + + return (vf_name f, make_numbered_port (fst port) count) + +-- needed for RegFiles +make_numbered_port :: VName -> Maybe Integer -> String +make_numbered_port v Nothing = getVNameString v +-- xxx use something like ASyntax.mkMethId +make_numbered_port v (Just i) = (getVNameString v) ++ "_" ++ (show i) + +parseTimescale :: String -> Maybe (String, BSTime) +parseTimescale timescale = do + separatorIndex <- elemIndex '/' timescale + let timeunitStr = take separatorIndex timescale + timeprecisionStr = drop (separatorIndex + 1) timescale -- drop '/' too + timeunit <- timeOf timeunitStr + timeprecision <- timeOf timeprecisionStr + if (timeunit >= timeprecision) + then return (timeprecisionStr, timeunit `quot` timeprecision) + else Nothing + +timeOf :: String -> Maybe BSTime -- number of femtoseconds +timeOf timeStr = + case words timeStr of + ["1", unitStr] -> getTimeUnitSize unitStr + ["10", unitStr] -> fmap (10 *) $ getTimeUnitSize unitStr + ["100", unitStr] -> fmap (100 *) $ getTimeUnitSize unitStr + _ -> Nothing + where getTimeUnitSize "fs" = Just 1 + getTimeUnitSize "ps" = fmap (1000 *) $ getTimeUnitSize "fs" + getTimeUnitSize "ns" = fmap (1000 *) $ getTimeUnitSize "ps" + getTimeUnitSize "us" = fmap (1000 *) $ getTimeUnitSize "ns" + getTimeUnitSize "ms" = fmap (1000 *) $ getTimeUnitSize "us" + getTimeUnitSize "s" = fmap (1000 *) $ getTimeUnitSize "ms" + getTimeUnitSize _ = Nothing diff --git a/src/comp/IOMutVar.hs b/src/comp/IOMutVar.hs new file mode 100644 index 000000000..1b541b049 --- /dev/null +++ b/src/comp/IOMutVar.hs @@ -0,0 +1,14 @@ +module IOMutVar(MutableVar, newVar, readVar, writeVar) where + +import Data.IORef + +type MutableVar a = IORef a + +newVar :: a -> IO (MutableVar a) +newVar = newIORef + +readVar :: MutableVar a -> IO a +readVar = readIORef + +writeVar :: MutableVar a -> a -> IO () +writeVar = writeIORef \ No newline at end of file diff --git a/src/comp/Sort.hs b/src/comp/Sort.hs new file mode 100644 index 000000000..1d0ba5bae --- /dev/null +++ b/src/comp/Sort.hs @@ -0,0 +1,7 @@ +module Sort(sortLe) where + +import Data.List (sortBy) + +-- | Sort a list using a less-than-or-equal predicate +sortLe :: (a -> a -> Bool) -> [a] -> [a] +sortLe le = sortBy (\x y -> if le x y then LT else GT) \ No newline at end of file diff --git a/src/comp/Version.hs b/src/comp/Version.hs index ba029baea..10b21ce96 100644 --- a/src/comp/Version.hs +++ b/src/comp/Version.hs @@ -14,8 +14,14 @@ bluespec = "Bluespec" versionname :: String versionname = buildVersionName +buildname :: String +buildname = buildVersionName + buildnum :: Integer -buildnum = buildVersionNum +buildnum = read buildVersionNum + +buildstr :: String +buildstr = buildVersion -- Generate the version string (for a given tool) versionStr :: Bool -> String -> String diff --git a/src/comp/bluetcl.hs b/src/comp/bluetcl.hs index 7353ebcbe..849d4a0e1 100644 --- a/src/comp/bluetcl.hs +++ b/src/comp/bluetcl.hs @@ -345,9 +345,9 @@ helpCmd interp [_,cmd] = do ] where show_help c os = do (matched, ws', g) <- htclMatchGrammar interp os (grammar c) - let isArg (_,(Argument _ _ _)) = True + let isArg (_,(HTclArgument _ _ _)) = True isArg _ = False - isKW (Just (Keyword _ _ _)) = True + isKW (Just (HTclKeyword _ _ _)) = True isKW _ = False isKWorNone Nothing = True isKWorNone e = isKW e @@ -357,10 +357,10 @@ helpCmd interp [_,cmd] = do prefix = unwords $ cmd_words (_, _, g') <- htclMatchGrammar interp cmd_objs (grammar c) let (sd,ld) = head $ [ (d,l) - | (_,(Keyword _ d l)) <- matched' + | (_,(HTclKeyword _ d l)) <- matched' , not (null d) ] ++ [ (d,l) - | (_,(Command _ d l _)) <- matched' + | (_,(HTclCommand _ d l _)) <- matched' , not (null d) ] err = if (null ws') @@ -1591,7 +1591,7 @@ tclRule ["full",modname,rule] = let isARule r = (arule_id r == rId) (attrs, pos, predicate) = if (isIfcRule) - then let cvtIfc (AIAction _ _ ifPred ifId ifRs _) = + then let cvtIfc (AIAction inputs props ifPred ifId ifRs fi) = case (find isARule ifRs) of Nothing -> Nothing Just (ARule i ps _ _ rPred _ _ _) -> @@ -1608,7 +1608,7 @@ tclRule ["full",modname,rule] = cvtIfc _ = Nothing in case (catMaybes (map cvtIfc ifcs)) of [] -> internalError ("tclRule full: method not found") - (res:_) -> res + (res : _) -> res else -- find the ARule case (find isARule user_rules) of Nothing -> internalError ("tclRule full: rule not found") @@ -2112,33 +2112,54 @@ getBInstChildren b@(BNode {binst_sub = sub}) = isLoop _ = False -- mkChildIN :: (String, ABinEitherModInfo) -> Bool -> InstNode -> IO [BInst] - mkChildIN _ _ inodep | isSynthP hide inodep = + mkChildIN _ allowBody inode | isSynthP hide inode = do let unique = fromJustOrErr "bluetcl.mkChildIN: unique" $ - getSynthName hide inodep + getSynthName hide inode mminfo <- findModuleByInstance (reverse $ (getIdBaseString $ unique) : binst_synth b) let b_add = addInst b (Just (getIdBaseString $ unique)) - (getIdBaseString $ node_name inodep) - hidden = isHidden inodep - hide_all = isHiddenAll inodep + (getIdBaseString $ node_name inode) + hidden = isHidden inode + hide_all = isHiddenAll inode b' = b_add {binst_hide = hidden, binst_hideall = hide_all} b'' = case mminfo of - Left pname -> let bsub = BLeaf { bin_name = node_name inodep + Left pname -> let bsub = BLeaf { bin_name = node_name inode , bin_uname = unique - , bin_type = node_type inodep + , bin_type = node_type inode , bin_prim = pname } in b' { binst_sub = bsub } Right minfo@(m,ba) -> let eminfo = (m, Right ba) bsub = BMod { bin_module = minfo - , bin_type = node_type inodep - , bin_name = node_name inodep + , bin_type = node_type inode + , bin_name = node_name inode + , bin_uname = unique + } + in b' { binst_sub = bsub, binst_mod = eminfo } + return $ [b''] + mkChildIN (m,ba) allowBody inode@(StateVar {}) = -- this case should be impossible + do let unique = fromJustOrErr "bluetcl.mkChildIN: unique" $ + getSynthName hide inode + mminfo <- findModuleByInstance (reverse $ (getIdBaseString $ unique) : binst_synth b) + let b_add = addInst b (Just (getIdBaseString $ unique)) + (getIdBaseString $ node_name inode) + hidden = isHidden inode + hide_all = isHiddenAll inode + b' = b_add {binst_hide = hidden, binst_hideall = hide_all} + b'' = case mminfo of + Left pname -> let bsub = BLeaf { bin_name = node_name inode + , bin_uname = unique + , bin_type = node_type inode + , bin_prim = pname } + in b' { binst_sub = bsub } + Right minfo@(m,ba) + -> let eminfo = (m, Right ba) + bsub = BMod { bin_module = minfo + , bin_type = node_type inode + , bin_name = node_name inode , bin_uname = unique } in b' { binst_sub = bsub, binst_mod = eminfo } return $ [b''] - mkChildIN (m,ba) _ inode@(StateVar {}) = -- this case should be impossible - internalError $ "mkChildIN: " ++ (show inode) - -- mkChildIN (m,ba) allowBody inode@(Loc { node_name = name } ) | nodeIgnore inode = do let nodes = getInstTreeList hide (node_children inode) keep_prop prop = not (isSuffixCountProp prop) diff --git a/src/comp/bluetcl_Main.c b/src/comp/bluetcl_Main.c new file mode 100644 index 000000000..ff58ff7af --- /dev/null +++ b/src/comp/bluetcl_Main.c @@ -0,0 +1,153 @@ +/* + * tclAppInit.c -- + * + * Provides a default version of the main program and Tcl_AppInit + * procedure for Tcl applications (without Tk). + * + * Copyright (c) 1993 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tclAppInit.c,v 1.11 2002/05/31 22:20:22 dgp Exp $ + */ + +#include "tcl.h" +#include "stdlib.h" + +extern int htcl_initHaskellRTS(int *argc, char **argv[]) ; +extern char *TclSetPreInitScript (char *string); + +// Include for the export from Haskell +#ifdef __GLASGOW_HASKELL__ +#include "BlueTcl_stub.h" +#endif +#ifdef __GLASGOW_HASKELL__ +extern void __stginit_BlueTcl ( void ); +#endif + +int bluetcl_AppInit(Tcl_Interp *interp); +int Bluespec_Init(Tcl_Interp *interp); + +/* + *---------------------------------------------------------------------- + * + * main -- + * + * This is the main program for the application. + * + * Results: + * None: Tcl_Main never returns here, so this procedure never + * returns either. + * + * Side effects: + * Whatever the application does. + * + *---------------------------------------------------------------------- + */ + +int +main(int argc, char **argv) +{ + // Initialize Haskell + int stat = htcl_initHaskellRTS( &argc, &argv ); + if (stat != 0) exit(stat); + +#ifdef __GLASGOW_HASKELL__ +#if (__GLASGOW_HASKELL__ < 804) + hs_add_root(__stginit_BlueTcl); +#endif +#endif + + Tcl_Main(argc, argv, bluetcl_AppInit); + + return 0; /* Needed only to prevent compiler warning. */ +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppInit -- + * + * This procedure performs application-specific initialization. + * Most applications, especially those that incorporate additional + * packages, will have their own version of this procedure. + * + * Results: + * Returns a standard Tcl completion code, and leaves an error + * message in the interp's result if an error occurs. + * + * Side effects: + * Depends on the startup script. + * + *---------------------------------------------------------------------- + */ + +// Source the Bluetcl init script +char startBS[] = "source $env(BLUESPECDIR)/tcllib/bluespec/bluespec.tcl ;"; + +char userStartFile[] = "~/.bluetclrc"; + + +/* Bluespec Shell initialization + 0. The tcl interpreter is already started. + 1. No setup of path or tcl_library needed before loading standard tcl files + 2. Load the standard tcl libraries (under Tcl_Init) + 3. Load the Bluetcl package (Bluespec_Init, also names the user rc file to load) + 4. Source the startBS script from the library + (will add the Bluespec tcllib to the tcl search path and + will source the user's rc file) + */ + +int +bluetcl_AppInit(Tcl_Interp *interp) +{ + + // TCL library must be loaded from $BLUESPECDIR, so setup the right tcllibrary path here + char *bsdir = getenv("BLUESPECDIR"); + if ( bsdir == 0 ) { + fprintf(stderr,"BLUESPECDIR is not set.\n" ); + exit(-1); + } + + // Run the tcl init scripts + // This will, among other things, initialize auto_path with TCLLIBPATH + // from the user's environment, but only if auto_path has not yet been + // assigned + // + if (Tcl_Init(interp) != TCL_OK) { + fprintf(stderr,"Unable to start tcl -- %s\n", Tcl_GetStringResult(interp)); + exit (-1); + } + + // Initialize the Bluespec package + if (Bluespec_Init (interp) != TCL_OK) { + fprintf(stderr,"Unable to initialize Bluespec extensions -- %s\n", Tcl_GetStringResult(interp)); + exit (-1); + } + Tcl_StaticPackage( interp, "Bluetcl", Bluespec_Init, Bluespec_Init); + + // Finish the Bluespec initialization + if (Tcl_Eval(interp, startBS) != TCL_OK) { + fprintf(stderr,"Trouble starting bluetcl -- %s\n", Tcl_GetStringResult(interp)); + exit(-1); + } + + return TCL_OK; +} + +int Bluespec_Init(Tcl_Interp *interp) +{ + int stat = TCL_ERROR ; + stat = blueshell_Init_Foreign ( interp ) ; + + // Specific user startup file when ever starting a new interp. + Tcl_SetVar(interp, "tcl_rcFileName", userStartFile, TCL_GLOBAL_ONLY); + + if ( stat == TCL_OK ) + stat = Tcl_PkgProvide(interp, "Bluetcl", "1.0"); + + return stat ; +} diff --git a/src/comp/bsc.hs b/src/comp/bsc.hs index 2014b763c..71434f1eb 100644 --- a/src/comp/bsc.hs +++ b/src/comp/bsc.hs @@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns, CPP #-} -module Main_bsc(main, hmain) where +module BSC(main, hmain) where -- Haskell libs import Prelude diff --git a/src/exec/Main.hs b/src/exec/Main.hs new file mode 100644 index 000000000..acf1b014b --- /dev/null +++ b/src/exec/Main.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE BangPatterns, CPP #-} +module Main where + +import qualified BSC (main) + +main :: IO () +main = BSC.main \ No newline at end of file diff --git a/src/vendor/htcl/HTcl.hs b/src/vendor/htcl/HTcl.hs index 29a031ede..a1ceda87c 100644 --- a/src/vendor/htcl/HTcl.hs +++ b/src/vendor/htcl/HTcl.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP, ForeignFunctionInterface, CApiFFI #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} -{-# OPTIONS_GHC -Wall -fno-warn-unused-binds -fno-warn-unused-matches -Werror #-} +{-# OPTIONS_GHC -Wall -fno-warn-unused-binds -fno-warn-unused-matches -Werror -Wno-partial-fields #-} -- User level Haskell interface for TCL -- Users of this module should not need to understand the tcl @@ -271,8 +271,9 @@ instance TclObjCvt Double where -- instance for String instance {-# OVERLAPPING #-} TclObjCvt String where -- XXX ?? toTclObj "" = withCStringLen "{}" (\(cs,l) -> tcl_NewStringObj cs l) >>= wrapPtrForExport - toTclObj s = do - withCStringLen s (\(cs,l) -> tcl_NewStringObj cs (castI l)) >>= wrapPtrForExport + toTclObj str = do + withCString str $ \cstr -> do + tcl_NewStringObj cstr (-1) >>= wrapPtrForExport -- instance for UTCTime instance TclObjCvt UTCTime where @@ -478,19 +479,19 @@ data HTclArgType = StringArg | IntArg | PtrArg | DoubleArg | BoolArg deriving (Eq,Show) -- A grammar describes allowed sequences of keywords and arguments -data HTclCmdElem = Keyword { literal :: String - , kw_desc :: String - , kw_long_desc :: String - } - | Argument { arg_name :: String - , arg_type :: HTclArgType - , arg_desc :: String - } - | Command { literal :: String - , cmd_desc :: String - , cmd_long_desc :: String - , cmd_namespace :: String - } +data HTclCmdElem = HTclKeyword { literal :: String + , kw_desc :: String + , kw_long_desc :: String + } + | HTclArgument { arg_name :: String + , arg_type :: HTclArgType + , arg_desc :: String + } + | HTclCommand { literal :: String + , cmd_desc :: String + , cmd_long_desc :: String + , cmd_namespace :: String + } deriving (Eq,Show) -- A command grammar follows standard practice for sequencing, @@ -506,13 +507,13 @@ data HTclCmdGrammar = Exactly HTclCmdElem -- combinators for more succinct grammar expressions kw :: String -> String -> String -> HTclCmdGrammar -kw s sd ld = Exactly (Keyword s sd ld) +kw s sd ld = Exactly (HTclKeyword s sd ld) tclcmd :: String -> String -> String -> String -> HTclCmdGrammar -tclcmd s ns sd ld = Exactly (Command s sd ld ns) +tclcmd s ns sd ld = Exactly (HTclCommand s sd ld ns) arg :: String -> HTclArgType -> String -> HTclCmdGrammar -arg n t d = Exactly (Argument n t d) +arg n t d = Exactly (HTclArgument n t d) (.+.) :: HTclCmdGrammar -> HTclCmdGrammar -> HTclCmdGrammar (.+.) = Sequence @@ -533,9 +534,9 @@ atLeast n g = g .+. (atLeast (n-1) g) -- Get a string describing a command element cmdElemString :: HTclCmdElem -> String -cmdElemString (Keyword s _ _) = s -cmdElemString (Command s _ _ ns) = s -cmdElemString (Argument s _ _) = "<" ++ s ++ ">" +cmdElemString (HTclKeyword s _ _) = s +cmdElemString (HTclArgument s _ _) = "<" ++ s ++ ">" +cmdElemString (HTclCommand s _ _ _) = s -- Find the first element admitted by a grammar. For a normal command, -- this will be a unique keyword. @@ -632,19 +633,19 @@ htclMatchGrammar interp objs cmd_grammar = worker ([], objs, cmd_grammar) return (matched, [], g) worker (matched, ws, None) = return (matched, ws, None) - worker x@(matched, (w:rest), (Exactly el@(Keyword s' _ _))) = do + worker x@(matched, (w:rest), (Exactly el@(HTclKeyword s' _ _))) = do str <- htclObjToMString interp w case str of (Just s) -> if (s == s') then return ((s,el):matched, rest, None) else return x Nothing -> return x - worker x@(matched, (w:rest), (Exactly el@(Command s' _ _ _))) = do + worker x@(matched, (w:rest), (Exactly el@(HTclCommand s' _ _ _))) = do str <- htclObjToMString interp w case str of (Just s) -> return ((s,el):matched, rest, None) Nothing -> return x - worker x@(matched, (w:rest), (Exactly el@(Argument _ ty _))) = do + worker x@(matched, (w:rest), (Exactly el@(HTclArgument _ ty _))) = do str <- matchArgType interp w ty case str of (Just s) -> return ((s,el):matched, rest, None) @@ -689,10 +690,10 @@ htclCanMatchNull (OneOrMore g) = htclCanMatchNull g -- Provide a short description for a command grammar htclGrammarShortDesc :: HTclCmdGrammar -> String -htclGrammarShortDesc g = case (htclFirstCmdElem g) of - Just (Keyword _ s _) -> s - Just (Command _ s _ _) -> s - Just (Argument _ _ s) -> s +htclGrammarShortDesc g = case htclFirstCmdElem g of + Just (HTclKeyword _ s _) -> s + Just (HTclCommand _ s _ _) -> s + Just (HTclArgument _ _ s) -> s Nothing -> "" -- Add grammar checks to a Haskell function for a TCL command. @@ -761,9 +762,9 @@ htclCmdName cmd = case (htclFirstCmdElem (grammar cmd)) of Nothing -> "" htclCmdNameNamespace :: HTclCmdDesc -> String -htclCmdNameNamespace cmd = case (htclFirstCmdElem (grammar cmd)) of - (Just (Command s _ _ ns)) -> if null ns then s else (ns ++ "::" ++ s) - _ -> error "Tcl Command grammar did not begin with a Command." +htclCmdNameNamespace cmd = case htclFirstCmdElem (grammar cmd) of + (Just (HTclCommand s _ _ ns)) -> if null ns then s else ns ++ "::" ++ s + _ -> error "Tcl Command grammar did not begin with a Command." -- Register commands with a TCL interpreter diff --git a/src/vendor/htcl/HTcl.hs.bak b/src/vendor/htcl/HTcl.hs.bak new file mode 100644 index 000000000..0465a8101 --- /dev/null +++ b/src/vendor/htcl/HTcl.hs.bak @@ -0,0 +1,63373 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface, CApiFFI #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# OPTIONS_GHC -Wall -fno-warn-unused-binds -fno-warn-unused-matches -Werror #-} + +-- User level Haskell interface for TCL +-- Users of this module should not need to understand the tcl +-- implementation underneath this module +-- +-- Ed Czeck, Bluespec Inc +-- April 2007 + + +{- + TODO + - I do not like the error handling, via the Maybe type, but some may not want to throw errors + - options processing (getOptions :: TclInterp -> [TclObj] -> [OptionDesc a] -> IO (a, [TclObj]) + - add import for Tcl_Eval +-} + +module HTcl + ( + -- Status return values, and an enum + htcl_OK + ,TclStatus + + ,TclObjCvt(..) + ,TclInterp + ,TclObj + ----------------------- + -- Registering command and other command + -- Types for command objects + ,TclObjCmdProc + ,TclCmdDeleteProc + ,TclClientData + ,htclRawFnToTclCmd + ,htclFnToTclCmd + ,htclCheckCmd + ,htclMakeCmdDesc + ,HTclCmdDesc(..) + ,HTclCmdElem(..) + ,HTclArgType(..) + ,HTclCmdGrammar(..) + ,HTclCmdFn + ,HTclCheckedCmdFn + ,htclRegisterCommand + ,htclRegisterCommandFull + ,htclRegCommands + ,htclCmdName + ,htclFirstCmdElem + ,htclDescribeCmdGrammar + ,htclGrammarShortDesc + ,htclMatchGrammar + ,htclCanMatchNull + ,htclSetReturnVal -- may not be needed + -- Dealing with Errors + ,htcl_AddObjErrorInfo + ,htclErrorCatcher + ------------------------------- + -- Converting from Obj to Native Haskell types + ,htclArgsToTcl + -- primitives + ,htclObjToInt + ,htclObjToBool + ,htclObjToDouble + ,htclObjToString + ,htclObjToList + -- composite + ,htclObjToListInt + ,htclObjToListDouble + ,htclObjToListString + ------------------------------- + ,HTclObj(..) + -- Conversion to from objects to fields of this type + ,HTclObjCvt(..) + ,tag + ,tagStr + ,tagInt + ,tagLst + ,tagManyStr + ,tagManyInt + ,joinHTObj + ,joinHTObjs + ----------------- + -- Grammar combinators + , kw + , tclcmd + , arg + , (.+.) + , oneOf + , optional + , atLeast + ----------------- + -- Tests and Experiments + ) +where + +import Prelude + +import Data.Word + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Marshal.Utils +import Foreign.Ptr +import Foreign.C.Types +import Foreign.C.String +import Data.Time.Clock +import Data.Time.Clock.POSIX + +import Foreign.ForeignPtr +import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr) + +import Control.Monad(foldM, mplus, msum, when) +import System.IO.Error +import System.Exit(ExitCode(..)) +import Data.List(intersperse, nub, isPrefixOf) + +import qualified Control.Exception as CE + +--import Debug.Trace +traceCalls :: Bool +traceCalls = False + + +-- cast function +castE :: (Enum a, Enum b) => a -> b +castE = toEnum . fromEnum + +castI :: (Integral a, Integral b) => a -> b +castI = fromIntegral + +castD :: (RealFloat a, RealFloat b) => a -> b +castD = (uncurry encodeFloat) . decodeFloat + +-------------------------------------------------------------------------------- +-- Common TCL function status +-- Note break, continue are not (yet) defined + + +-- | Status of a TCL command +data TclStatus = TclOK | TclError + deriving (Eq, Show, Enum) + +tclOK :: TclStatus +tclOK = TclOK + +tclError :: TclStatus +tclError = TclError + +-- Get real values from tcl world -- there should be an easier way to do this for #defines! +foreign import capi "tcl.h value TCL_OK" + htcl_OKc :: CInt +foreign import capi "tcl.h value TCL_ERROR" + htcl_Errorc :: CInt + + +-- exported versions of tcl status using native haskell types +htcl_OK :: TclStatus +htcl_OK = TclOK + +htcl_Error :: TclStatus +htcl_Error = TclError + + +-------------------------------------------------------------------------------- + +-- The interperter -- no need for a finalizer call here +data XTclInterp = XTclInterp +type TclInterp = Ptr XTclInterp + +-- Client data structure +type TclClientData = Ptr Int + + +-- Types and functions to deal with Tcl Objects +-- Wrapper for foreign (tcl objects) +-- Objects which are passed to and from commands +data {-# CTYPE "Tcl_Obj" #-} XTclObj = XTclObj +type PTclObj = Ptr XTclObj +type TclObj = ForeignPtr XTclObj +type PTclObjArray = Ptr PTclObj + + +-- Foreign import functions -- Objects +foreign import ccall "Tcl_NewIntObj" + tcl_NewIntObj :: CInt -> IO (PTclObj) + +foreign import ccall "Tcl_NewWideIntObj" + tcl_NewWideIntObj :: CLLong -> IO (PTclObj) -- tcl uses long long + +foreign import ccall "Tcl_NewDoubleObj" + tcl_NewDoubleObj :: CDouble -> IO PTclObj -- tcl double + +foreign import ccall "Tcl_NewStringObj" + tcl_NewStringObj :: Ptr CChar -> CInt -> IO PTclObj + +foreign import ccall "Tcl_NewListObj" + tcl_NewListObj :: CInt -> Ptr PTclObj -> IO PTclObj + + +--------------------------------------------------------------- +-- Reference count on Objects +foreign import capi "tcl.h Tcl_DecrRefCount" + tcl_DecrRefCount :: PTclObj -> IO () + +foreign import capi "tcl.h Tcl_IncrRefCount" + tcl_IncrRefCount :: PTclObj -> IO () + +foreign import ccall "&htcl_finalizeTclObj" + tcl_finalizeTclObj :: FunPtr (PTclObj -> IO ()) + +tclObjFinalizer :: FinalizerPtr XTclObj +tclObjFinalizer = tcl_finalizeTclObj + +-- Function to wrap tcl object into finalizer +wrapPtrForExport :: PTclObj -> IO TclObj +wrapPtrForExport pobj = do + tcl_IncrRefCount pobj + fp <- newForeignPtr_ pobj + addForeignPtrFinalizer tclObjFinalizer fp + return fp + +--------------------------------------------------------- +-- A class to provide means to convert to tcl objects and +-- haskell objects +-- 2 members are defined, one to convert to Ptr XTclObj and the other to convert to +-- ForeignPtr XTclObj. Only the later should be used externally +class TclObjCvt a where + toTclObj :: a -> IO TclObj + + +-- an instance of TclObjCvt call for Unit +instance TclObjCvt () where + toTclObj i = toTclObj "" + +-- an instance of TclObjCvt call for Bool +instance TclObjCvt Bool where + toTclObj b = tcl_NewIntObj (if b then 1 else 0) >>= wrapPtrForExport + +-- an instance of TclObjCvt call for Int +instance TclObjCvt Int where + toTclObj i = tcl_NewIntObj (castI i) >>= wrapPtrForExport + +-- an instance of TclObjCvt call for Integer +-- use show since value can be greater than native representation +instance TclObjCvt Integer where + toTclObj i = toTclObj (show i) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +{-# LANGUAGE CPP, ForeignFunctionInterface, CApiFFI #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# OPTIONS_GHC -Wall -fno-warn-unused-binds -fno-warn-unused-matches -Werror #-} + +-- User level Haskell interface for TCL +-- Users of this module should not need to understand the tcl +-- implementation underneath this module +-- +-- Ed Czeck, Bluespec Inc +-- April 2007 + + +{- + TODO + - I do not like the error handling, via the Maybe type, but some may not want to throw errors + - options processing (getOptions :: TclInterp -> [TclObj] -> [OptionDesc a] -> IO (a, [TclObj]) + - add import for Tcl_Eval +-} + +module HTcl + ( + -- Status return values, and an enum + htcl_OK + ,TclStatus + + ,TclObjCvt(..) + ,TclInterp + ,TclObj + ----------------------- + -- Registering command and other command + -- Types for command objects + ,TclObjCmdProc + ,TclCmdDeleteProc + ,TclClientData + ,htclRawFnToTclCmd + ,htclFnToTclCmd + ,htclCheckCmd + ,htclMakeCmdDesc + ,HTclCmdDesc(..) + ,HTclCmdElem(..) + ,HTclArgType(..) + ,HTclCmdGrammar(..) + ,HTclCmdFn + ,HTclCheckedCmdFn + ,htclRegisterCommand + ,htclRegisterCommandFull + ,htclRegCommands + ,htclCmdName + ,htclFirstCmdElem + ,htclDescribeCmdGrammar + ,htclGrammarShortDesc + ,htclMatchGrammar + ,htclCanMatchNull + ,htclSetReturnVal -- may not be needed + -- Dealing with Errors + ,htcl_AddObjErrorInfo + ,htclErrorCatcher + ------------------------------- + -- Converting from Obj to Native Haskell types + ,htclArgsToTcl + -- primitives + ,htclObjToInt + ,htclObjToBool + ,htclObjToDouble + ,htclObjToString + ,htclObjToList + -- composite + ,htclObjToListInt + ,htclObjToListDouble + ,htclObjToListString + ------------------------------- + ,HTclObj(..) + -- Conversion to from objects to fields of this type + ,HTclObjCvt(..) + ,tag + ,tagStr + ,tagInt + ,tagLst + ,tagManyStr + ,tagManyInt + ,joinHTObj + ,joinHTObjs + ----------------- + -- Grammar combinators + , kw + , tclcmd + , arg + , (.+.) + , oneOf + , optional + , atLeast + ----------------- + -- Tests and Experiments + ) +where + +import Prelude + +import Data.Word + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Marshal.Utils +import Foreign.Ptr +import Foreign.C.Types +import Foreign.C.String +import Data.Time.Clock +import Data.Time.Clock.POSIX + +import Foreign.ForeignPtr +import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr) + +import Control.Monad(foldM, mplus, msum, when) +import System.IO.Error +import System.Exit(ExitCode(..)) +import Data.List(intersperse, nub, isPrefixOf) + +import qualified Control.Exception as CE + +--import Debug.Trace +traceCalls :: Bool +traceCalls = False + + +-- cast function +castE :: (Enum a, Enum b) => a -> b +castE = toEnum . fromEnum + +castI :: (Integral a, Integral b) => a -> b +castI = fromIntegral + +castD :: (RealFloat a, RealFloat b) => a -> b +castD = (uncurry encodeFloat) . decodeFloat + +-------------------------------------------------------------------------------- +-- Common TCL function status +-- Note break, continue are not (yet) defined + + +-- | Status of a TCL command +data TclStatus = TclOK | TclError + deriving (Eq, Show, Enum) + +tclOK :: TclStatus +tclOK = TclOK + +tclError :: TclStatus +tclError = TclError + +-- Get real values from tcl world -- there should be an easier way to do this for #defines! +foreign import capi "tcl.h value TCL_OK" + htcl_OKc :: CInt +foreign import capi "tcl.h value TCL_ERROR" + htcl_Errorc :: CInt + + +-- exported versions of tcl status using native haskell types +htcl_OK :: TclStatus +htcl_OK = TclOK + +htcl_Error :: TclStatus +htcl_Error = TclError + + +-------------------------------------------------------------------------------- + +-- The interperter -- no need for a finalizer call here +data XTclInterp = XTclInterp +type TclInterp = Ptr XTclInterp + +-- Client data structure +type TclClientData = Ptr Int + + +-- Types and functions to deal with Tcl Objects +-- Wrapper for foreign (tcl objects) +-- Objects which are passed to and from commands +data {-# CTYPE "Tcl_Obj" #-} XTclObj = XTclObj +type PTclObj = Ptr XTclObj +type TclObj = ForeignPtr XTclObj +type PTclObjArray = Ptr PTclObj + + +-- Foreign import functions -- Objects +foreign import ccall "Tcl_NewIntObj" + tcl_NewIntObj :: CInt -> IO (PTclObj) + +foreign import ccall "Tcl_NewWideIntObj" + tcl_NewWideIntObj :: CLLong -> IO (PTclObj) -- tcl uses long long + +foreign import ccall "Tcl_NewDoubleObj" + tcl_NewDoubleObj :: CDouble -> IO PTclObj -- tcl double + +foreign import ccall "Tcl_NewStringObj" + tcl_NewStringObj :: Ptr CChar -> CInt -> IO PTclObj + +foreign import ccall "Tcl_NewListObj" + tcl_NewListObj :: CInt -> Ptr PTclObj -> IO PTclObj + + +--------------------------------------------------------------- +-- Reference count on Objects +foreign import capi "tcl.h Tcl_DecrRefCount" + tcl_DecrRefCount :: PTclObj -> IO () + +foreign import capi "tcl.h Tcl_IncrRefCount" + tcl_IncrRefCount :: PTclObj -> IO () + +foreign import ccall "&htcl_finalizeTclObj" + tcl_finalizeTclObj :: FunPtr (PTclObj -> IO ()) + +tclObjFinalizer :: FinalizerPtr XTclObj +tclObjFinalizer = tcl_finalizeTclObj + +-- Function to wrap tcl object into finalizer +wrapPtrForExport :: PTclObj -> IO TclObj +wrapPtrForExport pobj = do + tcl_IncrRefCount pobj + fp <- newForeignPtr_ pobj + addForeignPtrFinalizer tclObjFinalizer fp + return fp + +--------------------------------------------------------- +-- A class to provide means to convert to tcl objects and +-- haskell objects +-- 2 members are defined, one to convert to Ptr XTclObj and the other to convert to +-- ForeignPtr XTclObj. Only the later should be used externally +class TclObjCvt a where + toTclObj :: a -> IO TclObj + + +-- an instance of TclObjCvt call for Unit +instance TclObjCvt () where + toTclObj i = toTclObj "" + +-- an instance of TclObjCvt call for Bool +instance TclObjCvt Bool where + toTclObj b = tcl_NewIntObj (if b then 1 else 0) >>= wrapPtrForExport + +-- an instance of TclObjCvt call for Int +instance TclObjCvt Int where + toTclObj i = tcl_NewIntObj (castI i) >>= wrapPtrForExport + +-- an instance of TclObjCvt call for Integer +-- use show since value can be greater than native representation +instance TclObjCvt Integer where + toTclObj i = toTclObj (show i) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +{-# LANGUAGE CPP, ForeignFunctionInterface, CApiFFI #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# OPTIONS_GHC -Wall -fno-warn-unused-binds -fno-warn-unused-matches -Werror #-} + +-- User level Haskell interface for TCL +-- Users of this module should not need to understand the tcl +-- implementation underneath this module +-- +-- Ed Czeck, Bluespec Inc +-- April 2007 + + +{- + TODO + - I do not like the error handling, via the Maybe type, but some may not want to throw errors + - options processing (getOptions :: TclInterp -> [TclObj] -> [OptionDesc a] -> IO (a, [TclObj]) + - add import for Tcl_Eval +-} + +module HTcl + ( + -- Status return values, and an enum + htcl_OK + ,htcl_Error + ,TclStatus + + ,TclObjCvt(..) + ,TclInterp + ,TclObj + ----------------------- + -- Registering command and other command + -- Types for command objects + ,TclObjCmdProc + ,TclCmdDeleteProc + ,TclClientData + ,htclRawFnToTclCmd + ,htclFnToTclCmd + ,htclCheckCmd + ,htclMakeCmdDesc + ,HTclCmdDesc(..) + ,HTclCmdElem(..) + ,HTclArgType(..) + ,HTclCmdGrammar(..) + ,HTclCmdFn + ,HTclCheckedCmdFn + ,htclRegisterCommand + ,htclRegisterCommandFull + ,htclRegCommands + ,htclCmdName + ,htclFirstCmdElem + ,htclDescribeCmdGrammar + ,htclGrammarShortDesc + ,htclMatchGrammar + ,htclCanMatchNull + ,htclSetReturnVal -- may not be needed + -- Dealing with Errors + ,htcl_AddObjErrorInfo + ,htclErrorCatcher + ------------------------------- + -- Converting from Obj to Native Haskell types + ,htclArgsToTcl + -- primitives + ,htclObjToInt + ,htclObjToBool + ,htclObjToDouble + ,htclObjToString + ,htclObjToList + -- composite + ,htclObjToListInt + ,htclObjToListDouble + ,htclObjToListString + ------------------------------- + ,HTclObj(..) + -- Conversion to from objects to fields of this type + ,HTclObjCvt(..) + ,tag + ,tagStr + ,tagInt + ,tagLst + ,tagManyStr + ,tagManyInt + ,joinHTObj + ,joinHTObjs + ----------------- + -- Grammar combinators + , kw + , tclcmd + , arg + , (.+.) + , oneOf + , optional + , atLeast + ----------------- + -- Tests and Experiments + ) +where + +import Prelude + +import Data.Word + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Marshal.Utils +import Foreign.Ptr +import Foreign.C.Types +import Foreign.C.String +import Data.Time.Clock +import Data.Time.Clock.POSIX + +import Foreign.ForeignPtr +import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr) + +import Control.Monad(foldM, mplus, msum, when) +import System.IO.Error +import System.Exit(ExitCode(..)) +import Data.List(intersperse, nub, isPrefixOf) + +import qualified Control.Exception as CE + +--import Debug.Trace +traceCalls :: Bool +traceCalls = False + + +-- cast function +castE :: (Enum a, Enum b) => a -> b +castE = toEnum . fromEnum + +castI :: (Integral a, Integral b) => a -> b +castI = fromIntegral + +castD :: (RealFloat a, RealFloat b) => a -> b +castD = (uncurry encodeFloat) . decodeFloat + +-------------------------------------------------------------------------------- +-- Common TCL function status +-- Note break, continue are not (yet) defined + + +-- | Status of a TCL command +data TclStatus = TclOK | TclError + deriving (Eq, Show, Enum) + +tclOK :: TclStatus +tclOK = TclOK + +tclError :: TclStatus +tclError = TclError + +-- Get real values from tcl world -- there should be an easier way to do this for #defines! +foreign import capi "tcl.h value TCL_OK" + htcl_OKc :: CInt +foreign import capi "tcl.h value TCL_ERROR" + htcl_Errorc :: CInt + + +-- exported versions of tcl status using native haskell types +htcl_OK :: TclStatus +htcl_OK = TclOK + +htcl_Error :: TclStatus +htcl_Error = TclError + + +-------------------------------------------------------------------------------- + +-- The interperter -- no need for a finalizer call here +data XTclInterp = XTclInterp +type TclInterp = Ptr XTclInterp + +-- Client data structure +type TclClientData = Ptr Int + + +-- Types and functions to deal with Tcl Objects +-- Wrapper for foreign (tcl objects) +-- Objects which are passed to and from commands +data {-# CTYPE "Tcl_Obj" #-} XTclObj = XTclObj +type PTclObj = Ptr XTclObj +type TclObj = ForeignPtr XTclObj +type PTclObjArray = Ptr PTclObj + + +-- Foreign import functions -- Objects +foreign import ccall "Tcl_NewIntObj" + tcl_NewIntObj :: CInt -> IO (PTclObj) + +foreign import ccall "Tcl_NewWideIntObj" + tcl_NewWideIntObj :: CLLong -> IO (PTclObj) -- tcl uses long long + +foreign import ccall "Tcl_NewDoubleObj" + tcl_NewDoubleObj :: CDouble -> IO PTclObj -- tcl double + +foreign import ccall "Tcl_NewStringObj" + tcl_NewStringObj :: Ptr CChar -> CInt -> IO PTclObj + +foreign import ccall "Tcl_NewListObj" + tcl_NewListObj :: CInt -> Ptr PTclObj -> IO PTclObj + + +--------------------------------------------------------------- +-- Reference count on Objects +foreign import capi "tcl.h Tcl_DecrRefCount" + tcl_DecrRefCount :: PTclObj -> IO () + +foreign import capi "tcl.h Tcl_IncrRefCount" + tcl_IncrRefCount :: PTclObj -> IO () + +foreign import ccall "&htcl_finalizeTclObj" + tcl_finalizeTclObj :: FunPtr (PTclObj -> IO ()) + +tclObjFinalizer :: FinalizerPtr XTclObj +tclObjFinalizer = tcl_finalizeTclObj + +-- Function to wrap tcl object into finalizer +wrapPtrForExport :: PTclObj -> IO TclObj +wrapPtrForExport pobj = do + tcl_IncrRefCount pobj + fp <- newForeignPtr_ pobj + addForeignPtrFinalizer tclObjFinalizer fp + return fp + +--------------------------------------------------------- +-- A class to provide means to convert to tcl objects and +-- haskell objects +-- 2 members are defined, one to convert to Ptr XTclObj and the other to convert to +-- ForeignPtr XTclObj. Only the later should be used externally +class TclObjCvt a where + toTclObj :: a -> IO TclObj + + +-- an instance of TclObjCvt call for Unit +instance TclObjCvt () where + toTclObj i = toTclObj "" + +-- an instance of TclObjCvt call for Bool +instance TclObjCvt Bool where + toTclObj b = tcl_NewIntObj (if b then 1 else 0) >>= wrapPtrForExport + +-- an instance of TclObjCvt call for Int +instance TclObjCvt Int where + toTclObj i = tcl_NewIntObj (castI i) >>= wrapPtrForExport + +-- an instance of TclObjCvt call for Integer +-- use show since value can be greater than native representation +instance TclObjCvt Integer where + toTclObj i = toTclObj (show i) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +htcl_Error = TclError \ No newline at end of file diff --git a/src/vendor/htcl/HTcl.hs.new b/src/vendor/htcl/HTcl.hs.new new file mode 100644 index 000000000..a67a44e46 --- /dev/null +++ b/src/vendor/htcl/HTcl.hs.new @@ -0,0 +1,74843 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface, CApiFFI #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# OPTIONS_GHC -Wall -fno-warn-unused-binds -fno-warn-unused-matches -Werror #-} + +-- User level Haskell interface for TCL +-- Users of this module should not need to understand the tcl +-- implementation underneath this module +-- +-- Ed Czeck, Bluespec Inc +-- April 2007 + + +{- + TODO + - I do not like the error handling, via the Maybe type, but some may not want to throw errors + - options processing (getOptions :: TclInterp -> [TclObj] -> [OptionDesc a] -> IO (a, [TclObj]) + - add import for Tcl_Eval +-} + +module HTcl + ( + -- Status return values, and an enum + htcl_OK + ,htcl_Error + ,TclStatus + + ,TclObjCvt(..) + ,TclInterp + ,TclObj + ----------------------- + -- Registering command and other command + -- Types for command objects + ,TclObjCmdProc + ,TclCmdDeleteProc + ,TclClientData + ,htclRawFnToTclCmd + ,htclFnToTclCmd + ,htclCheckCmd + ,htclMakeCmdDesc + ,HTclCmdDesc(..) + ,HTclCmdElem(..) + ,HTclArgType(..) + ,HTclCmdGrammar(..) + ,HTclCmdFn + ,HTclCheckedCmdFn + ,htclRegisterCommand + ,htclRegisterCommandFull + ,htclRegCommands + ,htclCmdName + ,htclFirstCmdElem + ,htclDescribeCmdGrammar + ,htclGrammarShortDesc + ,htclMatchGrammar + ,htclCanMatchNull + ,htclSetReturnVal -- may not be needed + -- Dealing with Errors + ,htcl_AddObjErrorInfo + ,htclErrorCatcher + ------------------------------- + -- Converting from Obj to Native Haskell types + ,htclArgsToTcl + -- primitives + ,htclObjToInt + ,htclObjToBool + ,htclObjToDouble + ,htclObjToString + ,htclObjToList + -- composite + ,htclObjToListInt + ,htclObjToListDouble + ,htclObjToListString + ------------------------------- + ,HTclObj(..) + -- Conversion to from objects to fields of this type + ,HTclObjCvt(..) + ,tag + ,tagStr + ,tagInt + ,tagLst + ,tagManyStr + ,tagManyInt + ,joinHTObj + ,joinHTObjs + ----------------- + -- Grammar combinators + , kw + , tclcmd + , arg + , (.+.) + , oneOf + , optional + , atLeast + ----------------- + -- Tests and Experiments + ) +where + +import Prelude + +import Data.Word + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Marshal.Utils +import Foreign.Ptr +import Foreign.C.Types +import Foreign.C.String +import Data.Time.Clock +import Data.Time.Clock.POSIX + +import Foreign.ForeignPtr +import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr) + +import Control.Monad(foldM, mplus, msum, when) +import System.IO.Error +import System.Exit(ExitCode(..)) +import Data.List(intersperse, nub, isPrefixOf) + +import qualified Control.Exception as CE + +--import Debug.Trace +traceCalls :: Bool +traceCalls = False + + +-- cast function +castE :: (Enum a, Enum b) => a -> b +castE = toEnum . fromEnum + +castI :: (Integral a, Integral b) => a -> b +castI = fromIntegral + +castD :: (RealFloat a, RealFloat b) => a -> b +castD = (uncurry encodeFloat) . decodeFloat + +-------------------------------------------------------------------------------- +-- Common TCL function status +-- Note break, continue are not (yet) defined + + +-- | Status of a TCL command +data TclStatus = TclOK | TclError + deriving (Eq, Show, Enum) + +tclOK :: TclStatus +tclOK = TclOK + +tclError :: TclStatus +tclError = TclError + +-- Get real values from tcl world -- there should be an easier way to do this for #defines! +foreign import capi "tcl.h value TCL_OK" + htcl_OKc :: CInt +foreign import capi "tcl.h value TCL_ERROR" + htcl_Errorc :: CInt + + +-- exported versions of tcl status using native haskell types +htcl_OK :: TclStatus +htcl_OK = TclOK + +htcl_Error :: TclStatus +htcl_Error = TclError + + +-------------------------------------------------------------------------------- + +-- The interperter -- no need for a finalizer call here +data XTclInterp = XTclInterp +type TclInterp = Ptr XTclInterp + +-- Client data structure +type TclClientData = Ptr Int + + +-- Types and functions to deal with Tcl Objects +-- Wrapper for foreign (tcl objects) +-- Objects which are passed to and from commands +data {-# CTYPE "Tcl_Obj" #-} XTclObj = XTclObj +type PTclObj = Ptr XTclObj +type TclObj = ForeignPtr XTclObj +type PTclObjArray = Ptr PTclObj + + +-- Foreign import functions -- Objects +foreign import ccall "Tcl_NewIntObj" + tcl_NewIntObj :: CInt -> IO (PTclObj) + +foreign import ccall "Tcl_NewWideIntObj" + tcl_NewWideIntObj :: CLLong -> IO (PTclObj) -- tcl uses long long + +foreign import ccall "Tcl_NewDoubleObj" + tcl_NewDoubleObj :: CDouble -> IO PTclObj -- tcl double + +foreign import ccall "Tcl_NewStringObj" + tcl_NewStringObj :: Ptr CChar -> CInt -> IO PTclObj + +foreign import ccall "Tcl_NewListObj" + tcl_NewListObj :: CInt -> Ptr PTclObj -> IO PTclObj + + +--------------------------------------------------------------- +-- Reference count on Objects +foreign import capi "tcl.h Tcl_DecrRefCount" + tcl_DecrRefCount :: PTclObj -> IO () + +foreign import capi "tcl.h Tcl_IncrRefCount" + tcl_IncrRefCount :: PTclObj -> IO () + +foreign import ccall "&htcl_finalizeTclObj" + tcl_finalizeTclObj :: FunPtr (PTclObj -> IO ()) + +tclObjFinalizer :: FinalizerPtr XTclObj +tclObjFinalizer = tcl_finalizeTclObj + +-- Function to wrap tcl object into finalizer +wrapPtrForExport :: PTclObj -> IO TclObj +wrapPtrForExport pobj = do + tcl_IncrRefCount pobj + fp <- newForeignPtr_ pobj + addForeignPtrFinalizer tclObjFinalizer fp + return fp + +--------------------------------------------------------- +-- A class to provide means to convert to tcl objects and +-- haskell objects +-- 2 members are defined, one to convert to Ptr XTclObj and the other to convert to +-- ForeignPtr XTclObj. Only the later should be used externally +class TclObjCvt a where + toTclObj :: a -> IO TclObj + + +-- an instance of TclObjCvt call for Unit +instance TclObjCvt () where + toTclObj i = toTclObj "" + +-- an instance of TclObjCvt call for Bool +instance TclObjCvt Bool where + toTclObj b = tcl_NewIntObj (if b then 1 else 0) >>= wrapPtrForExport + +-- an instance of TclObjCvt call for Int +instance TclObjCvt Int where + toTclObj i = tcl_NewIntObj (castI i) >>= wrapPtrForExport + +-- an instance of TclObjCvt call for Integer +-- use show since value can be greater than native representation +instance TclObjCvt Integer where + toTclObj i = toTclObj (show i) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +{-# LANGUAGE CPP, ForeignFunctionInterface, CApiFFI #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# OPTIONS_GHC -Wall -fno-warn-unused-binds -fno-warn-unused-matches -Werror #-} + +-- User level Haskell interface for TCL +-- Users of this module should not need to understand the tcl +-- implementation underneath this module +-- +-- Ed Czeck, Bluespec Inc +-- April 2007 + + +{- + TODO + - I do not like the error handling, via the Maybe type, but some may not want to throw errors + - options processing (getOptions :: TclInterp -> [TclObj] -> [OptionDesc a] -> IO (a, [TclObj]) + - add import for Tcl_Eval +-} + +module HTcl + ( + -- Status return values, and an enum + htcl_OK + ,htcl_Error + ,TclStatus + + ,TclObjCvt(..) + ,TclInterp + ,TclObj + ----------------------- + -- Registering command and other command + -- Types for command objects + ,TclObjCmdProc + ,TclCmdDeleteProc + ,TclClientData + ,htclRawFnToTclCmd + ,htclFnToTclCmd + ,htclCheckCmd + ,htclMakeCmdDesc + ,HTclCmdDesc(..) + ,HTclCmdElem(..) + ,HTclArgType(..) + ,HTclCmdGrammar(..) + ,HTclCmdFn + ,HTclCheckedCmdFn + ,htclRegisterCommand + ,htclRegisterCommandFull + ,htclRegCommands + ,htclCmdName + ,htclFirstCmdElem + ,htclDescribeCmdGrammar + ,htclGrammarShortDesc + ,htclMatchGrammar + ,htclCanMatchNull + ,htclSetReturnVal -- may not be needed + -- Dealing with Errors + ,htcl_AddObjErrorInfo + ,htclErrorCatcher + ------------------------------- + -- Converting from Obj to Native Haskell types + ,htclArgsToTcl + -- primitives + ,htclObjToInt + ,htclObjToBool + ,htclObjToDouble + ,htclObjToString + ,htclObjToList + -- composite + ,htclObjToListInt + ,htclObjToListDouble + ,htclObjToListString + ------------------------------- + ,HTclObj(..) + -- Conversion to from objects to fields of this type + ,HTclObjCvt(..) + ,tag + ,tagStr + ,tagInt + ,tagLst + ,tagManyStr + ,tagManyInt + ,joinHTObj + ,joinHTObjs + ----------------- + -- Grammar combinators + , kw + , tclcmd + , arg + , (.+.) + , oneOf + , optional + , atLeast + ----------------- + -- Tests and Experiments + ) +where + +import Prelude + +import Data.Word + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Marshal.Utils +import Foreign.Ptr +import Foreign.C.Types +import Foreign.C.String +import Data.Time.Clock +import Data.Time.Clock.POSIX + +import Foreign.ForeignPtr +import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr) + +import Control.Monad(foldM, mplus, msum, when) +import System.IO.Error +import System.Exit(ExitCode(..)) +import Data.List(intersperse, nub, isPrefixOf) + +import qualified Control.Exception as CE + +--import Debug.Trace +traceCalls :: Bool +traceCalls = False + + +-- cast function +castE :: (Enum a, Enum b) => a -> b +castE = toEnum . fromEnum + +castI :: (Integral a, Integral b) => a -> b +castI = fromIntegral + +castD :: (RealFloat a, RealFloat b) => a -> b +castD = (uncurry encodeFloat) . decodeFloat + +-------------------------------------------------------------------------------- +-- Common TCL function status +-- Note break, continue are not (yet) defined + + +-- | Status of a TCL command +data TclStatus = TclOK | TclError + deriving (Eq, Show, Enum) + +tclOK :: TclStatus +tclOK = TclOK + +tclError :: TclStatus +tclError = TclError + +-- Get real values from tcl world -- there should be an easier way to do this for #defines! +foreign import capi "tcl.h value TCL_OK" + htcl_OKc :: CInt +foreign import capi "tcl.h value TCL_ERROR" + htcl_Errorc :: CInt + + +-- exported versions of tcl status using native haskell types +htcl_OK :: TclStatus +htcl_OK = TclOK + +htcl_Error :: TclStatus +htcl_Error = TclError + + +-------------------------------------------------------------------------------- + +-- The interperter -- no need for a finalizer call here +data XTclInterp = XTclInterp +type TclInterp = Ptr XTclInterp + +-- Client data structure +type TclClientData = Ptr Int + + +-- Types and functions to deal with Tcl Objects +-- Wrapper for foreign (tcl objects) +-- Objects which are passed to and from commands +data {-# CTYPE "Tcl_Obj" #-} XTclObj = XTclObj +type PTclObj = Ptr XTclObj +type TclObj = ForeignPtr XTclObj +type PTclObjArray = Ptr PTclObj + + +-- Foreign import functions -- Objects +foreign import ccall "Tcl_NewIntObj" + tcl_NewIntObj :: CInt -> IO (PTclObj) + +foreign import ccall "Tcl_NewWideIntObj" + tcl_NewWideIntObj :: CLLong -> IO (PTclObj) -- tcl uses long long + +foreign import ccall "Tcl_NewDoubleObj" + tcl_NewDoubleObj :: CDouble -> IO PTclObj -- tcl double + +foreign import ccall "Tcl_NewStringObj" + tcl_NewStringObj :: Ptr CChar -> CInt -> IO PTclObj + +foreign import ccall "Tcl_NewListObj" + tcl_NewListObj :: CInt -> Ptr PTclObj -> IO PTclObj + + +--------------------------------------------------------------- +-- Reference count on Objects +foreign import capi "tcl.h Tcl_DecrRefCount" + tcl_DecrRefCount :: PTclObj -> IO () + +foreign import capi "tcl.h Tcl_IncrRefCount" + tcl_IncrRefCount :: PTclObj -> IO () + +foreign import ccall "&htcl_finalizeTclObj" + tcl_finalizeTclObj :: FunPtr (PTclObj -> IO ()) + +tclObjFinalizer :: FinalizerPtr XTclObj +tclObjFinalizer = tcl_finalizeTclObj + +-- Function to wrap tcl object into finalizer +wrapPtrForExport :: PTclObj -> IO TclObj +wrapPtrForExport pobj = do + tcl_IncrRefCount pobj + fp <- newForeignPtr_ pobj + addForeignPtrFinalizer tclObjFinalizer fp + return fp + +--------------------------------------------------------- +-- A class to provide means to convert to tcl objects and +-- haskell objects +-- 2 members are defined, one to convert to Ptr XTclObj and the other to convert to +-- ForeignPtr XTclObj. Only the later should be used externally +class TclObjCvt a where + toTclObj :: a -> IO TclObj + + +-- an instance of TclObjCvt call for Unit +instance TclObjCvt () where + toTclObj i = toTclObj "" + +-- an instance of TclObjCvt call for Bool +instance TclObjCvt Bool where + toTclObj b = tcl_NewIntObj (if b then 1 else 0) >>= wrapPtrForExport + +-- an instance of TclObjCvt call for Int +instance TclObjCvt Int where + toTclObj i = tcl_NewIntObj (castI i) >>= wrapPtrForExport + +-- an instance of TclObjCvt call for Integer +-- use show since value can be greater than native representation +instance TclObjCvt Integer where + toTclObj i = toTclObj (show i) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +{-# LANGUAGE CPP, ForeignFunctionInterface, CApiFFI #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# OPTIONS_GHC -Wall -fno-warn-unused-binds -fno-warn-unused-matches -Werror #-} + +-- User level Haskell interface for TCL +-- Users of this module should not need to understand the tcl +-- implementation underneath this module +-- +-- Ed Czeck, Bluespec Inc +-- April 2007 + + +{- + TODO + - I do not like the error handling, via the Maybe type, but some may not want to throw errors + - options processing (getOptions :: TclInterp -> [TclObj] -> [OptionDesc a] -> IO (a, [TclObj]) + - add import for Tcl_Eval +-} + +module HTcl + ( + -- Status return values, and an enum + htcl_OK + ,htcl_Error + ,TclStatus + + ,TclObjCvt(..) + ,TclInterp + ,TclObj + ----------------------- + -- Registering command and other command + -- Types for command objects + ,TclObjCmdProc + ,TclCmdDeleteProc + ,TclClientData + ,htclRawFnToTclCmd + ,htclFnToTclCmd + ,htclCheckCmd + ,htclMakeCmdDesc + ,HTclCmdDesc(..) + ,HTclCmdElem(..) + ,HTclArgType(..) + ,HTclCmdGrammar(..) + ,HTclCmdFn + ,HTclCheckedCmdFn + ,htclRegisterCommand + ,htclRegisterCommandFull + ,htclRegCommands + ,htclCmdName + ,htclFirstCmdElem + ,htclDescribeCmdGrammar + ,htclGrammarShortDesc + ,htclMatchGrammar + ,htclCanMatchNull + ,htclSetReturnVal -- may not be needed + -- Dealing with Errors + ,htcl_AddObjErrorInfo + ,htclErrorCatcher + ------------------------------- + -- Converting from Obj to Native Haskell types + ,htclArgsToTcl + -- primitives + ,htclObjToInt + ,htclObjToBool + ,htclObjToDouble + ,htclObjToString + ,htclObjToList + -- composite + ,htclObjToListInt + ,htclObjToListDouble + ,htclObjToListString + ------------------------------- + ,HTclObj(..) + -- Conversion to from objects to fields of this type + ,HTclObjCvt(..) + ,tag + ,tagStr + ,tagInt + ,tagLst + ,tagManyStr + ,tagManyInt + ,joinHTObj + ,joinHTObjs + ----------------- + -- Grammar combinators + , kw + , tclcmd + , arg + , (.+.) + , oneOf + , optional + , atLeast + ----------------- + -- Tests and Experiments + ) +where + +import Prelude + +import Data.Word + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Marshal.Utils +import Foreign.Ptr +import Foreign.C.Types +import Foreign.C.String +import Data.Time.Clock +import Data.Time.Clock.POSIX + +import Foreign.ForeignPtr +import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr) + +import Control.Monad(foldM, mplus, msum, when) +import System.IO.Error +import System.Exit(ExitCode(..)) +import Data.List(intersperse, nub, isPrefixOf) + +import qualified Control.Exception as CE + +--import Debug.Trace +traceCalls :: Bool +traceCalls = False + + +-- cast function +castE :: (Enum a, Enum b) => a -> b +castE = toEnum . fromEnum + +castI :: (Integral a, Integral b) => a -> b +castI = fromIntegral + +castD :: (RealFloat a, RealFloat b) => a -> b +castD = (uncurry encodeFloat) . decodeFloat + +-------------------------------------------------------------------------------- +-- Common TCL function status +-- Note break, continue are not (yet) defined + + +-- | Status of a TCL command +data TclStatus = TclOK | TclError + deriving (Eq, Show, Enum) + +tclOK :: TclStatus +tclOK = TclOK + +tclError :: TclStatus +tclError = TclError + +-- Get real values from tcl world -- there should be an easier way to do this for #defines! +foreign import capi "tcl.h value TCL_OK" + htcl_OKc :: CInt +foreign import capi "tcl.h value TCL_ERROR" + htcl_Errorc :: CInt + + +-- exported versions of tcl status using native haskell types +htcl_OK :: TclStatus +htcl_OK = TclOK + +htcl_Error :: TclStatus +htcl_Error = TclError + + +-------------------------------------------------------------------------------- + +-- The interperter -- no need for a finalizer call here +data XTclInterp = XTclInterp +type TclInterp = Ptr XTclInterp + +-- Client data structure +type TclClientData = Ptr Int + + +-- Types and functions to deal with Tcl Objects +-- Wrapper for foreign (tcl objects) +-- Objects which are passed to and from commands +data {-# CTYPE "Tcl_Obj" #-} XTclObj = XTclObj +type PTclObj = Ptr XTclObj +type TclObj = ForeignPtr XTclObj +type PTclObjArray = Ptr PTclObj + + +-- Foreign import functions -- Objects +foreign import ccall "Tcl_NewIntObj" + tcl_NewIntObj :: CInt -> IO (PTclObj) + +foreign import ccall "Tcl_NewWideIntObj" + tcl_NewWideIntObj :: CLLong -> IO (PTclObj) -- tcl uses long long + +foreign import ccall "Tcl_NewDoubleObj" + tcl_NewDoubleObj :: CDouble -> IO PTclObj -- tcl double + +foreign import ccall "Tcl_NewStringObj" + tcl_NewStringObj :: Ptr CChar -> CInt -> IO PTclObj + +foreign import ccall "Tcl_NewListObj" + tcl_NewListObj :: CInt -> Ptr PTclObj -> IO PTclObj + + +--------------------------------------------------------------- +-- Reference count on Objects +foreign import capi "tcl.h Tcl_DecrRefCount" + tcl_DecrRefCount :: PTclObj -> IO () + +foreign import capi "tcl.h Tcl_IncrRefCount" + tcl_IncrRefCount :: PTclObj -> IO () + +foreign import ccall "&htcl_finalizeTclObj" + tcl_finalizeTclObj :: FunPtr (PTclObj -> IO ()) + +tclObjFinalizer :: FinalizerPtr XTclObj +tclObjFinalizer = tcl_finalizeTclObj + +-- Function to wrap tcl object into finalizer +wrapPtrForExport :: PTclObj -> IO TclObj +wrapPtrForExport pobj = do + tcl_IncrRefCount pobj + fp <- newForeignPtr_ pobj + addForeignPtrFinalizer tclObjFinalizer fp + return fp + +--------------------------------------------------------- +-- A class to provide means to convert to tcl objects and +-- haskell objects +-- 2 members are defined, one to convert to Ptr XTclObj and the other to convert to +-- ForeignPtr XTclObj. Only the later should be used externally +class TclObjCvt a where + toTclObj :: a -> IO TclObj + + +-- an instance of TclObjCvt call for Unit +instance TclObjCvt () where + toTclObj i = toTclObj "" + +-- an instance of TclObjCvt call for Bool +instance TclObjCvt Bool where + toTclObj b = tcl_NewIntObj (if b then 1 else 0) >>= wrapPtrForExport + +-- an instance of TclObjCvt call for Int +instance TclObjCvt Int where + toTclObj i = tcl_NewIntObj (castI i) >>= wrapPtrForExport + +-- an instance of TclObjCvt call for Integer +-- use show since value can be greater than native representation +instance TclObjCvt Integer where + toTclObj i = toTclObj (show i) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +{-# LANGUAGE CPP, ForeignFunctionInterface, CApiFFI #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# OPTIONS_GHC -Wall -fno-warn-unused-binds -fno-warn-unused-matches -Werror #-} + +-- User level Haskell interface for TCL +-- Users of this module should not need to understand the tcl +-- implementation underneath this module +-- +-- Ed Czeck, Bluespec Inc +-- April 2007 + + +{- + TODO + - I do not like the error handling, via the Maybe type, but some may not want to throw errors + - options processing (getOptions :: TclInterp -> [TclObj] -> [OptionDesc a] -> IO (a, [TclObj]) + - add import for Tcl_Eval +-} + +module HTcl + ( + -- Status return values, and an enum + htcl_OK + ,htcl_Error + ,TclStatus + + ,TclObjCvt(..) + ,TclInterp + ,TclObj + ----------------------- + -- Registering command and other command + -- Types for command objects + ,TclObjCmdProc + ,TclCmdDeleteProc + ,TclClientData + ,htclRawFnToTclCmd + ,htclFnToTclCmd + ,htclCheckCmd + ,htclMakeCmdDesc + ,HTclCmdDesc(..) + ,HTclCmdElem(..) + ,HTclArgType(..) + ,HTclCmdGrammar(..) + ,HTclCmdFn + ,HTclCheckedCmdFn + ,htclRegisterCommand + ,htclRegisterCommandFull + ,htclRegCommands + ,htclCmdName + ,htclFirstCmdElem + ,htclDescribeCmdGrammar + ,htclGrammarShortDesc + ,htclMatchGrammar + ,htclCanMatchNull + ,htclSetReturnVal -- may not be needed + -- Dealing with Errors + ,htcl_AddObjErrorInfo + ,htclErrorCatcher + ------------------------------- + -- Converting from Obj to Native Haskell types + ,htclArgsToTcl + -- primitives + ,htclObjToInt + ,htclObjToBool + ,htclObjToDouble + ,htclObjToString + ,htclObjToList + -- composite + ,htclObjToListInt + ,htclObjToListDouble + ,htclObjToListString + ------------------------------- + ,HTclObj(..) + -- Conversion to from objects to fields of this type + ,HTclObjCvt(..) + ,tag + ,tagStr + ,tagInt + ,tagLst + ,tagManyStr + ,tagManyInt + ,joinHTObj + ,joinHTObjs + ----------------- + -- Grammar combinators + , kw + , tclcmd + , arg + , (.+.) + , oneOf + , optional + , atLeast + ----------------- + -- Tests and Experiments + ) +where + +import Prelude + +import Data.Word + +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Marshal.Utils +import Foreign.Ptr +import Foreign.C.Types +import Foreign.C.String +import Data.Time.Clock +import Data.Time.Clock.POSIX + +import Foreign.ForeignPtr +import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr) + +import Control.Monad(foldM, mplus, msum, when) +import System.IO.Error +import System.Exit(ExitCode(..)) +import Data.List(intersperse, nub, isPrefixOf) + +import qualified Control.Exception as CE + +--import Debug.Trace +traceCalls :: Bool +traceCalls = False + + +-- cast function +castE :: (Enum a, Enum b) => a -> b +castE = toEnum . fromEnum + +castI :: (Integral a, Integral b) => a -> b +castI = fromIntegral + +castD :: (RealFloat a, RealFloat b) => a -> b +castD = (uncurry encodeFloat) . decodeFloat + +-------------------------------------------------------------------------------- +-- Common TCL function status +-- Note break, continue are not (yet) defined + + +-- | Status of a TCL command +data TclStatus = TclOK | TclError + deriving (Eq, Show, Enum) + +tclOK :: TclStatus +tclOK = TclOK + +tclError :: TclStatus +tclError = TclError + +-- Get real values from tcl world -- there should be an easier way to do this for #defines! +foreign import capi "tcl.h value TCL_OK" + htcl_OKc :: CInt +foreign import capi "tcl.h value TCL_ERROR" + htcl_Errorc :: CInt + + +-- exported versions of tcl status using native haskell types +htcl_OK :: TclStatus +htcl_OK = TclOK + +htcl_Error :: TclStatus +htcl_Error = TclError + + +-------------------------------------------------------------------------------- + +-- The interperter -- no need for a finalizer call here +data XTclInterp = XTclInterp +type TclInterp = Ptr XTclInterp + +-- Client data structure +type TclClientData = Ptr Int + + +-- Types and functions to deal with Tcl Objects +-- Wrapper for foreign (tcl objects) +-- Objects which are passed to and from commands +data {-# CTYPE "Tcl_Obj" #-} XTclObj = XTclObj +type PTclObj = Ptr XTclObj +type TclObj = ForeignPtr XTclObj +type PTclObjArray = Ptr PTclObj + + +-- Foreign import functions -- Objects +foreign import ccall "Tcl_NewIntObj" + tcl_NewIntObj :: CInt -> IO (PTclObj) + +foreign import ccall "Tcl_NewWideIntObj" + tcl_NewWideIntObj :: CLLong -> IO (PTclObj) -- tcl uses long long + +foreign import ccall "Tcl_NewDoubleObj" + tcl_NewDoubleObj :: CDouble -> IO PTclObj -- tcl double + +foreign import ccall "Tcl_NewStringObj" + tcl_NewStringObj :: Ptr CChar -> CInt -> IO PTclObj + +foreign import ccall "Tcl_NewListObj" + tcl_NewListObj :: CInt -> Ptr PTclObj -> IO PTclObj + + +--------------------------------------------------------------- +-- Reference count on Objects +foreign import capi "tcl.h Tcl_DecrRefCount" + tcl_DecrRefCount :: PTclObj -> IO () + +foreign import capi "tcl.h Tcl_IncrRefCount" + tcl_IncrRefCount :: PTclObj -> IO () + +foreign import ccall "&htcl_finalizeTclObj" + tcl_finalizeTclObj :: FunPtr (PTclObj -> IO ()) + +tclObjFinalizer :: FinalizerPtr XTclObj +tclObjFinalizer = tcl_finalizeTclObj + +-- Function to wrap tcl object into finalizer +wrapPtrForExport :: PTclObj -> IO TclObj +wrapPtrForExport pobj = do + tcl_IncrRefCount pobj + fp <- newForeignPtr_ pobj + addForeignPtrFinalizer tclObjFinalizer fp + return fp + +--------------------------------------------------------- +-- A class to provide means to convert to tcl objects and +-- haskell objects +-- 2 members are defined, one to convert to Ptr XTclObj and the other to convert to +-- ForeignPtr XTclObj. Only the later should be used externally +class TclObjCvt a where + toTclObj :: a -> IO TclObj + + +-- an instance of TclObjCvt call for Unit +instance TclObjCvt () where + toTclObj i = toTclObj "" + +-- an instance of TclObjCvt call for Bool +instance TclObjCvt Bool where + toTclObj b = tcl_NewIntObj (if b then 1 else 0) >>= wrapPtrForExport + +-- an instance of TclObjCvt call for Int +instance TclObjCvt Int where + toTclObj i = tcl_NewIntObj (castI i) >>= wrapPtrForExport + +-- an instance of TclObjCvt call for Integer +-- use show since value can be greater than native representation +instance TclObjCvt Integer where + toTclObj i = toTclObj (show i) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +htcl_Error = TclError \ No newline at end of file diff --git a/testsuite/Main.hs b/testsuite/Main.hs new file mode 100644 index 000000000..41fcd1ae0 --- /dev/null +++ b/testsuite/Main.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE BangPatterns, CPP #-} +module Main (main) where + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = testGroup "BSC Tests" + [ testGroup "Unit Tests" + [ testCase "Basic Compilation" $ do + -- Test that bsc can compile a simple file + True @=? True -- Placeholder test + ] + , testGroup "Property Tests" + [ testProperty "Simple Property" $ \x -> + (x :: Int) + 0 == x -- Placeholder property test + ] + ] \ No newline at end of file diff --git a/testsuite/dejagnu-driver/DejaGNUDriver.hs b/testsuite/dejagnu-driver/DejaGNUDriver.hs new file mode 100644 index 000000000..8889d8f00 --- /dev/null +++ b/testsuite/dejagnu-driver/DejaGNUDriver.hs @@ -0,0 +1,44 @@ +module DejaGNUDriver (tests) where + +import Distribution.TestSuite +import Distribution.Simple.Utils (findFileWithExtension) +import System.Directory +import System.FilePath +import System.Exit +import Control.Monad +import DejaGNUTest + +main :: IO () +main = do + -- Get test configuration from environment + config <- configFromEnv + + -- Get the test directory (should be the testsuite directory) + currentDir <- getCurrentDirectory + let testDir = takeDirectory currentDir + + -- Run the tests + exitCode <- runDejaGNUTests config testDir + + case exitCode of + ExitSuccess -> putStrLn "All DejaGNU tests passed!" + ExitFailure n -> do + putStrLn $ "DejaGNU tests failed with exit code: " ++ show n + exitWith exitCode + +tests :: IO [Test] +tests = do + config <- configFromEnv + currentDir <- getCurrentDirectory + let testDir = takeDirectory currentDir + return [Test $ TestInstance + { run = do + exitCode <- runDejaGNUTests config testDir + case exitCode of + ExitSuccess -> return $ Finished Pass + ExitFailure n -> return $ Finished $ Fail $ "Tests failed with exit code: " ++ show n + , name = "dejagnu" + , tags = [] + , options = [] + , setOption = \_ _ -> Right $ error "no options supported" + }] \ No newline at end of file diff --git a/testsuite/dejagnu-driver/DejaGNUTest.hs b/testsuite/dejagnu-driver/DejaGNUTest.hs new file mode 100644 index 000000000..8b4588e20 --- /dev/null +++ b/testsuite/dejagnu-driver/DejaGNUTest.hs @@ -0,0 +1,89 @@ +module DejaGNUTest where + +import System.Process +import System.Directory +import System.FilePath +import System.Exit +import System.Environment +import Control.Monad +import qualified Data.Text as T +import qualified Data.Text.IO as T + +data DejaGNUConfig = DejaGNUConfig + { testRelease :: FilePath -- ^ Path to BSC installation + , verilogSim :: String -- ^ Verilog simulator to use + , enableCTest :: Bool -- ^ Whether to run Bluesim tests + , enableVTest :: Bool -- ^ Whether to run Verilog tests + , enableSystemC :: Bool -- ^ Whether to run SystemC tests + , bscOptions :: [String] -- ^ Additional BSC options + , systemCInc :: Maybe String -- ^ SystemC include path + , systemCLib :: Maybe String -- ^ SystemC library path + } + +defaultConfig :: DejaGNUConfig +defaultConfig = DejaGNUConfig + { testRelease = "../inst" + , verilogSim = "iverilog" + , enableCTest = True + , enableVTest = True + , enableSystemC = True + , bscOptions = [] + , systemCInc = Nothing + , systemCLib = Nothing + } + +-- | Run DejaGNU tests with the given configuration +runDejaGNUTests :: DejaGNUConfig -> FilePath -> IO ExitCode +runDejaGNUTests config testDir = do + -- Set up environment variables + let env = [ ("TEST_RELEASE", testRelease config) + , ("TEST_BSC_VERILOG_SIM", verilogSim config) + , ("CTEST", if enableCTest config then "1" else "0") + , ("VTEST", if enableVTest config then "1" else "0") + , ("SYSTEMCTEST", if enableSystemC config then "1" else "0") + , ("TEST_BSC_OPTIONS", unwords $ bscOptions config) + ] ++ + maybe [] (\inc -> [("TEST_SYSTEMC_INC", inc)]) (systemCInc config) ++ + maybe [] (\lib -> [("TEST_SYSTEMC_LIB", lib)]) (systemCLib config) + + -- Create site.exp if it doesn't exist + let siteExp = testDir "site.exp" + siteExpExists <- doesFileExist siteExp + unless siteExpExists $ + writeFile siteExp "set tool bsc\n" + + -- Run dejagnu + (exitCode, stdout, stderr) <- readProcessWithExitCode "runtest" + ["--tool", "bsc", "--srcdir", testDir] "" + + -- Print output + putStr stdout + putStr stderr + + return exitCode + +-- | Parse environment variables to create DejaGNUConfig +configFromEnv :: IO DejaGNUConfig +configFromEnv = do + testRelease' <- lookupEnvDef "TEST_RELEASE" (testRelease defaultConfig) + verilogSim' <- lookupEnvDef "TEST_BSC_VERILOG_SIM" (verilogSim defaultConfig) + enableCTest' <- lookupEnvBool "CTEST" (enableCTest defaultConfig) + enableVTest' <- lookupEnvBool "VTEST" (enableVTest defaultConfig) + enableSystemC' <- lookupEnvBool "SYSTEMCTEST" (enableSystemC defaultConfig) + bscOptions' <- words <$> lookupEnvDef "TEST_BSC_OPTIONS" "" + systemCInc' <- lookupEnv "TEST_SYSTEMC_INC" + systemCLib' <- lookupEnv "TEST_SYSTEMC_LIB" + + return defaultConfig + { testRelease = testRelease' + , verilogSim = verilogSim' + , enableCTest = enableCTest' + , enableVTest = enableVTest' + , enableSystemC = enableSystemC' + , bscOptions = bscOptions' + , systemCInc = systemCInc' + , systemCLib = systemCLib' + } + where + lookupEnvDef name def = maybe def id <$> lookupEnv name + lookupEnvBool name def = maybe def (\v -> v /= "0") <$> lookupEnv name \ No newline at end of file