feldspar-compiler 0.6.0.2 → 0.7

raw patch · 68 files changed

+3441/−5461 lines, 68 filesdep +Cabaldep +QuickCheckdep +bytestringdep −MonadCatchIO-mtldep −ansi-terminaldep −haskell-src-extsdep ~basedep ~directorydep ~feldspar-languagePVP ok

version bump matches the API change (PVP)

Dependencies added: Cabal, QuickCheck, bytestring, criterion, data-default, deepseq, ghc-paths, plugins, plugins-multistage, pretty, storable-record, storable-tuple, tasty, tasty-golden, tasty-quickcheck, template-haskell

Dependencies removed: MonadCatchIO-mtl, ansi-terminal, haskell-src-exts, hint

Dependency ranges changed: base, directory, feldspar-language, syntactic

API changes (from Hackage documentation)

Files

• LICENSE +4/−2
• benchs/CRC.hs +55/−0
• feldspar-compiler.cabal +114/−88
• lib/Feldspar/C/feldspar_array.c +0/−61
• lib/Feldspar/C/feldspar_array.h +51/−63
• lib/Feldspar/C/feldspar_c99.c +346/−278
• lib/Feldspar/C/feldspar_c99.h +246/−236
• lib/Feldspar/C/ivar.c +4/−1
• lib/Feldspar/C/ivar.h +2/−0
• lib/Feldspar/C/taskpool.c +4/−1
• lib/Feldspar/C/taskpool.h +10/−8
• lib/Feldspar/Compiler.hs +14/−33
• lib/Feldspar/Compiler/Backend/C/CodeGeneration.hs +214/−92
• lib/Feldspar/Compiler/Backend/C/Library.hs +9/−39
• lib/Feldspar/Compiler/Backend/C/Options.hs +15/−11
• lib/Feldspar/Compiler/Backend/C/Platforms.hs +270/−171
• lib/Feldspar/Compiler/Backend/C/Plugin/BlockProgramHandler.hs +0/−78
• lib/Feldspar/Compiler/Backend/C/Plugin/Locator.hs +0/−232
• lib/Feldspar/Compiler/Backend/C/Plugin/PrettyPrint.hs +0/−714
• lib/Feldspar/Compiler/Backend/C/Plugin/Rule.hs +8/−1
• lib/Feldspar/Compiler/Backend/C/Plugin/TypeCorrector.hs +0/−199
• lib/Feldspar/Compiler/Backend/C/Plugin/TypeDefinitionGenerator.hs +0/−87
• lib/Feldspar/Compiler/Backend/C/Plugin/VariableRoleAssigner.hs +0/−76
• lib/Feldspar/Compiler/CallConv.hs +65/−0
• lib/Feldspar/Compiler/Compiler.hs +74/−152
• lib/Feldspar/Compiler/Frontend/Interactive/Interface.hs +31/−38
• lib/Feldspar/Compiler/Imperative/FromCore.hs +86/−50
• lib/Feldspar/Compiler/Imperative/FromCore/Array.hs +112/−33
• lib/Feldspar/Compiler/Imperative/FromCore/Binding.hs +20/−8
• lib/Feldspar/Compiler/Imperative/FromCore/Condition.hs +2/−6
• lib/Feldspar/Compiler/Imperative/FromCore/ConditionM.hs +2/−6
• lib/Feldspar/Compiler/Imperative/FromCore/Error.hs +5/−3
• lib/Feldspar/Compiler/Imperative/FromCore/FFI.hs +2/−2
• lib/Feldspar/Compiler/Imperative/FromCore/Future.hs +27/−21
• lib/Feldspar/Compiler/Imperative/FromCore/Interpretation.hs +276/−106
• lib/Feldspar/Compiler/Imperative/FromCore/Literal.hs +61/−79
• lib/Feldspar/Compiler/Imperative/FromCore/Loop.hs +41/−24
• lib/Feldspar/Compiler/Imperative/FromCore/Mutable.hs +34/−28
• lib/Feldspar/Compiler/Imperative/FromCore/MutableToPure.hs +40/−5
• lib/Feldspar/Compiler/Imperative/FromCore/NoInline.hs +17/−15
• lib/Feldspar/Compiler/Imperative/FromCore/Par.hs +29/−25
• lib/Feldspar/Compiler/Imperative/FromCore/Primitive.hs +6/−3
• lib/Feldspar/Compiler/Imperative/FromCore/SourceInfo.hs +4/−4
• lib/Feldspar/Compiler/Imperative/FromCore/Switch.hs +59/−0
• lib/Feldspar/Compiler/Imperative/FromCore/Tuple.hs +36/−35
• lib/Feldspar/Compiler/Imperative/Frontend.hs +170/−397
• lib/Feldspar/Compiler/Imperative/Plugin/CollectFreeVars.hs +0/−82
• lib/Feldspar/Compiler/Imperative/Plugin/ConstantFolding.hs +0/−69
• lib/Feldspar/Compiler/Imperative/Plugin/Free.hs +0/−61
• lib/Feldspar/Compiler/Imperative/Plugin/IVars.hs +4/−18
• lib/Feldspar/Compiler/Imperative/Plugin/Naming.hs +0/−194
• lib/Feldspar/Compiler/Imperative/Plugin/Unroll.hs +0/−285
• lib/Feldspar/Compiler/Imperative/Representation.hs +102/−384
• lib/Feldspar/Compiler/Imperative/TransformationInstance.hs +79/−74
• lib/Feldspar/Compiler/Internal.hs +46/−0
• lib/Feldspar/Compiler/Marshal.hs +212/−0
• lib/Feldspar/Compiler/Plugin.hs +174/−0
• lib/Feldspar/NameExtractor.hs +0/−159
• lib/Feldspar/Runtime.hs +26/−0
• lib/Feldspar/Transformation.hs +1/−1
• lib/Feldspar/Transformation/Framework.hs +0/−6
• src/Feldspar/Compiler/Frontend/CommandLine/API.hs +0/−155
• src/Feldspar/Compiler/Frontend/CommandLine/API/Constants.hs +0/−36
• src/Feldspar/Compiler/Frontend/CommandLine/API/Library.hs +0/−72
• src/Feldspar/Compiler/Frontend/CommandLine/API/Options.hs +0/−135
• src/Feldspar/Compiler/Frontend/CommandLine/Main.hs +0/−219
• tests/CallingConvention.hs +57/−0
• tests/RegressionTests.hs +175/−0

@@ -1,3 +1,5 @@+Copyright (c) 2013, Emil Axelsson, Peter Jonsson, Anders Persson and+                    Josef Svenningsson Copyright (c) 2012, Emil Axelsson, Gergely Dévai, Anders Persson and                     Josef Svenningsson Copyright (c) 2009-2011, ERICSSON AB@@ -6,7 +8,7 @@ Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -    * Redistributions of source code must retain the above copyright notice, +    * Redistributions of source code must retain the above copyright notice,       this list of conditions and the following disclaimer.     * Redistributions in binary form must reproduce the above copyright       notice, this list of conditions and the following disclaimer in the@@ -17,7 +19,7 @@  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR

@@ -0,0 +1,55 @@+{-# LANGUAGE TemplateHaskell #-}++import Feldspar hiding (force)+import Feldspar.Vector+import Feldspar.Compiler.Plugin+import Feldspar.Algorithm.CRC++import Foreign.Marshal (with)+import Data.Default+import Control.DeepSeq (force)+import Control.Exception (evaluate)++import Criterion.Main++testdata :: [Word8]+testdata = Prelude.take (16*1024) $ cycle [1,2,3,4]++naive :: Vector1 Word8 -> Data Word16+naive = crcNaive 0x8005 0++normal :: Vector1 Word8 -> Data Word16+normal v = share (makeCrcTable 0x8005) $ \t -> crcNormal t 0 v++h_naive :: [Word8] -> Word16+h_naive = eval naive++h_normal :: [Word8] -> Word16+h_normal = eval normal++loadFun ['naive, 'normal]++main :: IO ()+main = with def $ \out -> do+    d  <- evaluate $ force testdata+    pd <- pack d >>= evaluate+    _  <- evaluate c_naive_builder+    _  <- evaluate c_normal_builder+    defaultMain+      [+        bgroup "evaluated"+          [ bench "h_naive"  $ nf h_naive  (Prelude.take 1024 d)+          , bench "h_normal" $ nf h_normal (Prelude.take 1024 d)+          ]+      , bgroup "compiled"+          [ bgroup "marshal"+              [ bench "c_naive"  $ c_naive_worker d+              , bench "c_normal" $ c_normal_worker d+              ]+          , bgroup "raw"+              [ bench "c_naive"  $ c_naive_raw pd out+              , bench "c_normal" $ c_normal_raw pd out+              ]+          ]+      ]+

@@ -1,17 +1,19 @@ name:           feldspar-compiler-version:        0.6.0.2+version:        0.7 cabal-version:  >= 1.14 build-type:     Simple license:        BSD3 license-file:   LICENSE-copyright:      Copyright (c) 2012 Emil Axelsson, Gergely Dévai,+copyright:      Copyright (c) 2013-2014 Emil Axelsson, Peter Jonsson,+                                        Anders Persson, Josef Svenningsson+                Copyright (c) 2012 Emil Axelsson, Gergely Dévai,                                    Anders Persson, Josef Svenningsson                 Copyright (c) 2009-2011, ERICSSON AB author:         Feldspar group,                 Eotvos Lorand University Faculty of Informatics-maintainer:     deva@inf.elte.hu+maintainer:     anders.cj.persson@gmail.com stability:      experimental-homepage:       https://feldspar.github.com+homepage:       http://feldspar.github.com bug-reports:    https://github.com/feldspar/feldspar-compiler/issues synopsis:       Compiler for the Feldspar language description:    Feldspar (**F**unctional **E**mbedded **L**anguage for **DSP**@@ -22,11 +24,11 @@                 language both according to ANSI C and also targeted to a real                 DSP HW. category:       Compiler-tested-with:    GHC==7.6.1, GHC==7.4.2+tested-with:    GHC==7.8, GHC==7.6, GHC==7.4  source-repository head   type:     git-  location: git://github.com/feldspar/feldspar-compiler.git+  location: git://github.com/Feldspar/feldspar-compiler.git  library   hs-source-dirs: lib@@ -53,80 +55,65 @@     Feldspar.Compiler.Imperative.FromCore.Tuple     Feldspar.Compiler.Imperative.FromCore.FFI     Feldspar.Compiler.Imperative.FromCore.Save+    Feldspar.Compiler.Imperative.FromCore.Switch     Feldspar.Compiler.Imperative.Frontend     Feldspar.Compiler.Imperative.TransformationInstance-    Feldspar.Compiler.Imperative.Plugin.CollectFreeVars-    Feldspar.Compiler.Imperative.Plugin.ConstantFolding-    Feldspar.Compiler.Imperative.Plugin.Free     Feldspar.Compiler.Imperative.Plugin.IVars-    Feldspar.Compiler.Imperative.Plugin.Unroll-    Feldspar.Compiler.Imperative.Plugin.Naming     Feldspar.Compiler.Backend.C.CodeGeneration-    Feldspar.Compiler.Backend.C.Plugin.PrettyPrint-    Feldspar.Compiler.Backend.C.Plugin.Locator-    Feldspar.Compiler.Backend.C.Plugin.BlockProgramHandler-    Feldspar.Compiler.Backend.C.Plugin.TypeCorrector-    Feldspar.Compiler.Backend.C.Plugin.TypeDefinitionGenerator-    Feldspar.Compiler.Backend.C.Plugin.VariableRoleAssigner     Feldspar.Compiler.Backend.C.Plugin.Rule     Feldspar.Compiler.Backend.C.Library     Feldspar.Compiler.Backend.C.Options     Feldspar.Compiler.Backend.C.Platforms     Feldspar.Compiler.Frontend.Interactive.Interface+    Feldspar.Compiler.Plugin+    Feldspar.Compiler.Marshal+    Feldspar.Compiler.CallConv     Feldspar.Compiler.Compiler     Feldspar.Compiler.Error+    Feldspar.Compiler.Internal     Feldspar.Compiler     Feldspar.Transformation     Feldspar.Transformation.Framework-    Feldspar.NameExtractor+    Feldspar.Runtime -  default-language: Haskell98+  default-language: Haskell2010    build-depends:-    feldspar-language >= 0.6 && < 0.7,-    ansi-terminal,-    base >= 4 && < 4.7,-    containers,-    haskell-src-exts >= 1.12,-    directory,-    filepath,-    MonadCatchIO-mtl,+    base              == 4.*,+    Cabal,+    ghc-paths,+    syntactic,+    plugins-multistage >= 0.5 && < 0.6,+    feldspar-language  >= 0.7 && < 0.8,     mtl,+    pretty,+    filepath,+    containers,     process,-    syntactic >= 1.4 && < 1.5+    directory >= 1.1,+    template-haskell,+    plugins >= 1.5.4,+    data-default >= 0.5,+    storable-tuple  >= 0.0.2,+    storable-record >= 0.0.2.5    default-extensions:-    DeriveDataTypeable-    EmptyDataDecls-    FlexibleContexts-    FlexibleInstances-    GADTs-    MultiParamTypeClasses-    PatternGuards-    Rank2Types-    ScopedTypeVariables-    StandaloneDeriving-    TypeFamilies-    TypeOperators-    TypeSynonymInstances-    UndecidableInstances-    FunctionalDependencies-    ViewPatterns    include-dirs:     ./lib/Feldspar/C    c-sources:---    lib/Feldspar/C/feldspar_c99.c---    lib/Feldspar/C/feldspar_array.c---    lib/Feldspar/C/ivar.c---    lib/Feldspar/C/taskpool.c+   lib/Feldspar/C/feldspar_c99.c+   lib/Feldspar/C/taskpool.c+   lib/Feldspar/C/ivar.c    cc-options: -std=c99 -Wall +  if os(linux)+    extra-libraries: gcc_s+   install-includes:     feldspar_array.h-    feldspar_array.c     feldspar_c99.h     feldspar_c99.c     feldspar_tic64x.h@@ -142,54 +129,93 @@    cpp-options: -DRELEASE -executable feldspar-  hs-source-dirs: src+-- executable feldspar+--   hs-source-dirs: src -  main-is : Feldspar/Compiler/Frontend/CommandLine/Main.hs+--   main-is : Feldspar/Compiler/Frontend/CommandLine/Main.hs -  default-language: Haskell98+--   default-language: Haskell2010 -  other-modules:-    Feldspar.Compiler.Frontend.CommandLine.API.Library-    Feldspar.Compiler.Frontend.CommandLine.API.Constants-    Feldspar.Compiler.Frontend.CommandLine.API.Options-    Feldspar.Compiler.Frontend.CommandLine.API+--   other-modules:+--     Feldspar.Compiler.Frontend.CommandLine.NameExtractor+--     Feldspar.Compiler.Frontend.CommandLine.API.Library+--     Feldspar.Compiler.Frontend.CommandLine.API.Constants+--     Feldspar.Compiler.Frontend.CommandLine.API.Options+--     Feldspar.Compiler.Frontend.CommandLine.API +--   build-depends:+--     feldspar-language,+--     feldspar-compiler,+--     mtl,+--     base,+--     hint,+--     process,+--     filepath,+--     directory,+--     ansi-terminal,+--     MonadCatchIO-mtl,+--     haskell-src-exts >= 1.14++--   default-extensions:++--   ghc-options: -fcontext-stack=100++--   cpp-options: -DRELEASE++test-suite regression+  type: exitcode-stdio-1.0++  hs-source-dirs: tests++  main-is: RegressionTests.hs++  default-language: Haskell2010+   build-depends:-    feldspar-language >= 0.6 && < 0.7,+    feldspar-language,     feldspar-compiler,-    syntactic >= 1.4 && < 1.5,-    base >= 4 && < 4.7,-    hint,-    MonadCatchIO-mtl,     mtl,-    directory,-    filepath,+    base,+    Cabal,     process,-    ansi-terminal,-    containers,-    haskell-src-exts >= 1.12+    bytestring       >= 0.9 && < 0.11,+    tasty            >= 0.3,+    tasty-golden     >= 2.0,+    tasty-quickcheck >= 0.3,+    QuickCheck       >= 2.5 && < 3.0 -  default-extensions:-    CPP-    DeriveDataTypeable-    EmptyDataDecls-    FlexibleContexts-    FlexibleInstances-    GADTs-    MultiParamTypeClasses-    PatternGuards-    Rank2Types-    ScopedTypeVariables-    StandaloneDeriving-    TypeFamilies-    TypeOperators-    TypeSynonymInstances-    UndecidableInstances-    FunctionalDependencies-    ViewPatterns+test-suite callconv+  type: exitcode-stdio-1.0 -  ghc-options: -fcontext-stack=100+  hs-source-dirs: tests -  cpp-options: -DRELEASE+  main-is: CallingConvention.hs +  default-language: Haskell2010++  build-depends:+    feldspar-language,+    feldspar-compiler,+    base,+    tasty            >= 0.3,+    tasty-quickcheck >= 0.3,+    QuickCheck       >= 2.5 && < 3.0++benchmark crc+  type: exitcode-stdio-1.0++  hs-source-dirs: benchs++  main-is: CRC.hs++  default-language: Haskell2010++  ghc-options: -O2++  build-depends:+    feldspar-language,+    feldspar-compiler,+    data-default       >= 0.5.3 && < 0.6,+    base,+    deepseq,+    criterion

@@ -1,61 +0,0 @@-//-// Copyright (c) 2009-2011, ERICSSON AB-// All rights reserved.-// -// Redistribution and use in source and binary forms, with or without-// modification, are permitted provided that the following conditions are met:-// -//     * Redistributions of source code must retain the above copyright notice, -//       this list of conditions and the following disclaimer.-//     * Redistributions in binary form must reproduce the above copyright-//       notice, this list of conditions and the following disclaimer in the-//       documentation and/or other materials provided with the distribution.-//     * Neither the name of the ERICSSON AB nor the names of its contributors-//       may be used to endorse or promote products derived from this software-//       without specific prior written permission.-// -// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"-// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -// DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE-// FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-// SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER-// CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,-// OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-// OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-//--#include "feldspar_array.h"-#include <string.h>-#include <assert.h>-#include <stdio.h>-//#define LOG-#include "log.h"--unsigned int feldspar_array_linker_hook = 0xDECAFBAD;--/* Deep array copy with a given length */-void copyArrayLen(struct array *to, struct array *from, int32_t len)-{-    assert(to);-    assert(from);-    log_3("copyArrayLen %p %p %d - enter\n", to, from, len);-    if( from->elemSize < 0 )-    {-        unsigned i;-        log_3("copyArrayLen %p %p %d - nested\n", to, from, len);-        for( i = 0; i < len; ++i )-            copyArray( &at(struct array, to, i), &at(struct array, from, i) );-    }-    else-    {-        assert(to->buffer);-        assert(from->buffer);-        log_4("copyArrayLen %p %p %d - memcpy %d bytes\n", to, from, len-            , len*from->elemSize);-        memcpy( to->buffer, from->buffer, len * from->elemSize );-    }-    log_3("copyArrayLen %p %p %d - leave\n", to, from, len);-}-

@@ -1,11 +1,11 @@ // // Copyright (c) 2009-2011, ERICSSON AB // All rights reserved.-// +// // Redistribution and use in source and binary forms, with or without // modification, are permitted provided that the following conditions are met:-// -//     * Redistributions of source code must retain the above copyright notice, +//+//     * Redistributions of source code must retain the above copyright notice, //       this list of conditions and the following disclaimer. //     * Redistributions in binary form must reproduce the above copyright //       notice, this list of conditions and the following disclaimer in the@@ -13,10 +13,10 @@ //     * Neither the name of the ERICSSON AB nor the names of its contributors //       may be used to endorse or promote products derived from this software //       without specific prior written permission.-// +// // THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" // AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE // DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE // FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL // DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR@@ -38,17 +38,6 @@  #include <stdio.h> /* to be removed */ -/* Important: Always zero-initialize struct arrays in the definitions- * and call initArray on them before use:- * - * struct array my = {0};- * initArray( &my, sizeof(elementType), numberOfElements );- * - * Zero initialization certifies that initArray works correctly.- * (There is a "magic number" check in initArray in case you forget to- * zero-initialize, but it is not 100% safe.)- */- /* TODO qualify the names to avoid clashes with Haskell names */  struct array@@ -57,29 +46,33 @@     int32_t  length;   /* number of elements in the array */     int32_t  elemSize; /* size of elements in bytes; (- sizeof(struct array)) for nested arrays */     uint32_t bytes;    /* The number of bytes the buffer can hold */-    uint32_t inited;   /* To decide between first initialization and reinitialization - This is to catch */ }; -/* Magic number */-#define INITED 0x89abcdef- /* Indexing into an array: */ /* Result: element of type 'type' */ #define at(type,arr,idx) (((type*)((arr)->buffer))[idx])  /* Array (re)initialization */-static inline void initArray(struct array *arr, int32_t size, int32_t len)+static inline struct array *initArray(struct array *arr, int32_t size, int32_t len) {     int newBytes;      log_3("initArray %p %d %d - enter\n", arr, size, len);+    if ( !arr )+    {+      struct array * ptr;+      ptr = calloc(1, sizeof(struct array));+      log_4("initArray %p %d %d - alloc fresh struct array %p\n", arr, size, len, ptr);+      arr = ptr;+    }+     assert(arr);     arr->elemSize = size;-    arr->length = len;+    arr->length   = len;     if( size < 0 )         size = sizeof(struct array);     newBytes = size * len;-    if( arr->buffer && (arr->inited == INITED) )+    if( arr->buffer )     {         // Re-initialization         log_1("initArray %p - reinitialize\n",arr);@@ -88,9 +81,8 @@             log_3("initArray %p - realloc since %d < %d\n"                  , arr, arr->bytes, newBytes);             // Not enough space: reallocation needed-            arr->bytes = newBytes;-            free(arr->buffer);-            arr->buffer = (void*)malloc( newBytes );+            arr->bytes  = newBytes;+            arr->buffer = realloc(arr->buffer, newBytes);         }         else         {@@ -103,13 +95,13 @@     {         // First initialization         arr->bytes = newBytes;-        arr->buffer = (void*)malloc( newBytes );        -        log_5("initArray %p - alloc %d * %d bytes %d at %p\n"+        arr->buffer = (void*)calloc(len,size);+        log_5("initArray %p - alloc %d * %d = %d bytes at %p\n"              , arr, arr->length, arr->elemSize, newBytes, arr->buffer);-        arr->inited = INITED;     }     assert( arr->buffer );     log_3("initArray %p %d %d - leave\n", arr, size, len);+    return arr; }  // Free array@@ -117,23 +109,20 @@ static inline void freeArray(struct array *arr) {     log_1("freeArray %p - enter\n", arr);-    // assert(arr);-    // if( !arr->buffer || arr->inited != INITED )-    // {-        // return;-    // }-    // if( arr->elemSize < 0 )-    // {-        // int i;-        // for( i=0; i<arr->length; ++i )-            // freeArray( &at(struct array,arr,i) );-    // }-    // free(arr->buffer);-    // For the sake of extra safety:-    // arr->buffer = 0;-    // arr->length = 0;-    // arr->bytes = 0;-    // arr->inited = 0;+    if( arr && arr->buffer )+    {+      if( arr->elemSize < 0 )+      {+        for(int i=0; i<arr->length; ++i )+          freeArray( &at(struct array,arr,i) );+      }+      free(arr->buffer);+      // For the sake of extra safety:+      arr->buffer = 0;+      arr->length = 0;+      arr->bytes = 0;+      free(arr);+    }     log_1("freeArray %p - leave\n", arr); } @@ -149,10 +138,10 @@         unsigned i;         for( i = 0; i < from->length; ++i )         {-            struct array *to_row = &at(struct array, to, i);+            struct array *to_row   = &at(struct array, to, i);             struct array *from_row = &at(struct array, from, i);-            if( !to_row->buffer || to_row->inited != INITED )-                initArray( to_row, from_row->elemSize, from_row->length );+            if( to_row == NULL )+                to_row = initArray( to_row, from_row->elemSize, from_row->length );             copyArray( to_row, from_row );         }         log_2("copyArray %p %p - nested leave\n", to, from);@@ -190,9 +179,6 @@ }  -/* Deep array copy with a given length */-void copyArrayLen(struct array *to, struct array *from, int32_t len);- /* Array length */ static inline int32_t getLength(struct array *arr) {@@ -201,25 +187,27 @@ }  /* Reset array length */-static inline void setLength(struct array *arr, int32_t len)+static inline struct array *setLength(struct array *arr, int32_t size, int32_t len) {+    if ( !arr )+      arr = calloc(1, sizeof(struct array));+     assert(arr);     log_2("setLength %p %d - enter\n", arr, len);+    arr->elemSize = size;+    if( size < 0 )+        size = sizeof(struct array);     int newBytes = arr->elemSize * len;-    if( arr->bytes >= newBytes )-    {-        arr->length = len;-    }-    else+    arr->length = len;+    if( arr->bytes < newBytes )     {         log_3("setLength %p %d - realloc %d bytes\n", arr, len, newBytes);-        // TODO: copy-        arr->bytes = newBytes;-        free( arr->buffer );-        arr->buffer = malloc( newBytes );-        assert( arr->buffer );+        arr->buffer = realloc(arr->buffer,newBytes);+        assert(arr->buffer);+        arr->bytes  = newBytes;     }     log_2("setLength %p %d - leave\n", arr, len);+    return arr; }  #endif

@@ -41,14 +41,16 @@   #include <time.h> #endif /* WIN32 */ --unsigned int feldspar_c99_linker_hook = 0xDECAFBAD;+int feldspar_c99_hook(void)+{+  return 0;+}  /*--------------------------------------------------------------------------*  *                 pow(), abs(), signum(), logBase()                        *  *--------------------------------------------------------------------------*/ -int8_t pow_fun_int8( int8_t a, int8_t b )+int8_t pow_fun_int8_t( int8_t a, int8_t b ) {     int8_t r = 1;     int i;@@ -61,7 +63,7 @@     return r; } -int16_t pow_fun_int16( int16_t a, int16_t b )+int16_t pow_fun_int16_t( int16_t a, int16_t b ) {     int16_t r = 1;     int i;@@ -74,7 +76,7 @@     return r; } -int32_t pow_fun_int32( int32_t a, int32_t b )+int32_t pow_fun_int32_t( int32_t a, int32_t b ) {     int32_t r = 1;     int i;@@ -87,7 +89,7 @@     return r; } -int64_t pow_fun_int64( int64_t a, int64_t b )+int64_t pow_fun_int64_t( int64_t a, int64_t b ) {     int64_t r = 1;     int i;@@ -100,7 +102,7 @@     return r; } -uint8_t pow_fun_uint8( uint8_t a, uint8_t b )+uint8_t pow_fun_uint8_t( uint8_t a, uint8_t b ) {     uint8_t r = 1;     int i;@@ -109,7 +111,7 @@     return r; } -uint16_t pow_fun_uint16( uint16_t a, uint16_t b )+uint16_t pow_fun_uint16_t( uint16_t a, uint16_t b ) {     uint16_t r = 1;     int i;@@ -118,7 +120,7 @@     return r; } -uint32_t pow_fun_uint32( uint32_t a, uint32_t b )+uint32_t pow_fun_uint32_t( uint32_t a, uint32_t b ) {     uint32_t r = 1;     int i;@@ -127,7 +129,7 @@     return r; } -uint64_t pow_fun_uint64( uint64_t a, uint64_t b )+uint64_t pow_fun_uint64_t( uint64_t a, uint64_t b ) {     uint64_t r = 1;     int i;@@ -138,7 +140,7 @@   -int8_t abs_fun_int8( int8_t a )+int8_t abs_fun_int8_t( int8_t a ) {     // From Bit Twiddling Hacks:     //    "Compute the integer absolute value (abs) without branching"@@ -146,7 +148,7 @@     return (a + mask) ^ mask; } -int16_t abs_fun_int16( int16_t a )+int16_t abs_fun_int16_t( int16_t a ) {     // From Bit Twiddling Hacks:     //    "Compute the integer absolute value (abs) without branching"@@ -154,7 +156,7 @@     return (a + mask) ^ mask; } -int32_t abs_fun_int32( int32_t a )+int32_t abs_fun_int32_t( int32_t a ) {     // From Bit Twiddling Hacks:     //    "Compute the integer absolute value (abs) without branching"@@ -162,7 +164,7 @@     return (a + mask) ^ mask; } -int64_t abs_fun_int64( int64_t a )+int64_t abs_fun_int64_t( int64_t a ) {     // From Bit Twiddling Hacks:     //    "Compute the integer absolute value (abs) without branching"@@ -172,46 +174,46 @@   -int8_t signum_fun_int8( int8_t a )+int8_t signum_fun_int8_t( int8_t a ) {     // From Bit Twiddling Hacks: "Compute the sign of an integer"     return (a != 0) | (a >> 7); } -int16_t signum_fun_int16( int16_t a )+int16_t signum_fun_int16_t( int16_t a ) {     // From Bit Twiddling Hacks: "Compute the sign of an integer"     return (a != 0) | (a >> 15); } -int32_t signum_fun_int32( int32_t a )+int32_t signum_fun_int32_t( int32_t a ) {     // From Bit Twiddling Hacks: "Compute the sign of an integer"     return (a != 0) | (a >> 31); } -int64_t signum_fun_int64( int64_t a )+int64_t signum_fun_int64_t( int64_t a ) {     // From Bit Twiddling Hacks: "Compute the sign of an integer"     return (a != 0) | (a >> 63); } -uint8_t signum_fun_uint8( uint8_t a )+uint8_t signum_fun_uint8_t( uint8_t a ) {     return (a > 0); } -uint16_t signum_fun_uint16( uint16_t a )+uint16_t signum_fun_uint16_t( uint16_t a ) {     return (a > 0); } -uint32_t signum_fun_uint32( uint32_t a )+uint32_t signum_fun_uint32_t( uint32_t a ) {     return (a > 0); } -uint64_t signum_fun_uint64( uint64_t a )+uint64_t signum_fun_uint64_t( uint64_t a ) {     return (a > 0); }@@ -230,222 +232,236 @@ }  +double signum_fun_double( double a )+{+    // From Bit Twiddling Hacks: "Compute the sign of an integer"+    return (a > 0) - (a < 0);+} +++double logBase_fun_double( double a, double b )+{+    return log(b) / log(a);+}+++ /*--------------------------------------------------------------------------*  *                 Bit operations                                           *  *--------------------------------------------------------------------------*/ -int8_t setBit_fun_int8( int8_t x, uint32_t i )+int8_t setBit_fun_int8_t( int8_t x, uint32_t i ) {     return x | 1 << i; } -int16_t setBit_fun_int16( int16_t x, uint32_t i )+int16_t setBit_fun_int16_t( int16_t x, uint32_t i ) {     return x | 1 << i; } -int32_t setBit_fun_int32( int32_t x, uint32_t i )+int32_t setBit_fun_int32_t( int32_t x, uint32_t i ) {     return x | 1 << i; } -int64_t setBit_fun_int64( int64_t x, uint32_t i )+int64_t setBit_fun_int64_t( int64_t x, uint32_t i ) {     return x | 1 << i; } -uint8_t setBit_fun_uint8( uint8_t x, uint32_t i )+uint8_t setBit_fun_uint8_t( uint8_t x, uint32_t i ) {     return x | 1 << i; } -uint16_t setBit_fun_uint16( uint16_t x, uint32_t i )+uint16_t setBit_fun_uint16_t( uint16_t x, uint32_t i ) {     return x | 1 << i; } -uint32_t setBit_fun_uint32( uint32_t x, uint32_t i )+uint32_t setBit_fun_uint32_t( uint32_t x, uint32_t i ) {     return x | 1 << i; } -uint64_t setBit_fun_uint64( uint64_t x, uint32_t i )+uint64_t setBit_fun_uint64_t( uint64_t x, uint32_t i ) {     return x | 1 << i; }   -int8_t clearBit_fun_int8( int8_t x, uint32_t i )+int8_t clearBit_fun_int8_t( int8_t x, uint32_t i ) {     return x & ~(1 << i); } -int16_t clearBit_fun_int16( int16_t x, uint32_t i )+int16_t clearBit_fun_int16_t( int16_t x, uint32_t i ) {     return x & ~(1 << i); } -int32_t clearBit_fun_int32( int32_t x, uint32_t i )+int32_t clearBit_fun_int32_t( int32_t x, uint32_t i ) {     return x & ~(1 << i); } -int64_t clearBit_fun_int64( int64_t x, uint32_t i )+int64_t clearBit_fun_int64_t( int64_t x, uint32_t i ) {     return x & ~(1 << i); } -uint8_t clearBit_fun_uint8( uint8_t x, uint32_t i )+uint8_t clearBit_fun_uint8_t( uint8_t x, uint32_t i ) {     return x & ~(1 << i); } -uint16_t clearBit_fun_uint16( uint16_t x, uint32_t i )+uint16_t clearBit_fun_uint16_t( uint16_t x, uint32_t i ) {     return x & ~(1 << i); } -uint32_t clearBit_fun_uint32( uint32_t x, uint32_t i )+uint32_t clearBit_fun_uint32_t( uint32_t x, uint32_t i ) {     return x & ~(1 << i); } -uint64_t clearBit_fun_uint64( uint64_t x, uint32_t i )+uint64_t clearBit_fun_uint64_t( uint64_t x, uint32_t i ) {     return x & ~(1 << i); }   -int8_t complementBit_fun_int8( int8_t x, uint32_t i )+int8_t complementBit_fun_int8_t( int8_t x, uint32_t i ) {     return x ^ 1 << i; } -int16_t complementBit_fun_int16( int16_t x, uint32_t i )+int16_t complementBit_fun_int16_t( int16_t x, uint32_t i ) {     return x ^ 1 << i; } -int32_t complementBit_fun_int32( int32_t x, uint32_t i )+int32_t complementBit_fun_int32_t( int32_t x, uint32_t i ) {     return x ^ 1 << i; } -int64_t complementBit_fun_int64( int64_t x, uint32_t i )+int64_t complementBit_fun_int64_t( int64_t x, uint32_t i ) {     return x ^ 1 << i; } -uint8_t complementBit_fun_uint8( uint8_t x, uint32_t i )+uint8_t complementBit_fun_uint8_t( uint8_t x, uint32_t i ) {     return x ^ 1 << i; } -uint16_t complementBit_fun_uint16( uint16_t x, uint32_t i )+uint16_t complementBit_fun_uint16_t( uint16_t x, uint32_t i ) {     return x ^ 1 << i; } -uint32_t complementBit_fun_uint32( uint32_t x, uint32_t i )+uint32_t complementBit_fun_uint32_t( uint32_t x, uint32_t i ) {     return x ^ 1 << i; } -uint64_t complementBit_fun_uint64( uint64_t x, uint32_t i )+uint64_t complementBit_fun_uint64_t( uint64_t x, uint32_t i ) {     return x ^ 1 << i; }   -int testBit_fun_int8( int8_t x, uint32_t i )+int testBit_fun_int8_t( int8_t x, uint32_t i ) {     return (x & 1 << i) != 0; } -int testBit_fun_int16( int16_t x, uint32_t i )+int testBit_fun_int16_t( int16_t x, uint32_t i ) {     return (x & 1 << i) != 0; } -int testBit_fun_int32( int32_t x, uint32_t i )+int testBit_fun_int32_t( int32_t x, uint32_t i ) {     return (x & 1 << i) != 0; } -int testBit_fun_int64( int64_t x, uint32_t i )+int testBit_fun_int64_t( int64_t x, uint32_t i ) {     return (x & 1 << i) != 0; } -int testBit_fun_uint8( uint8_t x, uint32_t i )+int testBit_fun_uint8_t( uint8_t x, uint32_t i ) {     return (x & 1 << i) != 0; } -int testBit_fun_uint16( uint16_t x, uint32_t i )+int testBit_fun_uint16_t( uint16_t x, uint32_t i ) {     return (x & 1 << i) != 0; } -int testBit_fun_uint32( uint32_t x, uint32_t i )+int testBit_fun_uint32_t( uint32_t x, uint32_t i ) {     return (x & 1 << i) != 0; } -int testBit_fun_uint64( uint64_t x, uint32_t i )+int testBit_fun_uint64_t( uint64_t x, uint32_t i ) {     return (x & 1 << i) != 0; }   -int8_t rotateL_fun_int8( int8_t x, int32_t i )+int8_t rotateL_fun_int8_t( int8_t x, int32_t i ) {     if ((i %= 8) == 0) return x;     return (x << i) | ((0x7f >> (7 - i)) & (x >> (8 - i))); } -int16_t rotateL_fun_int16( int16_t x, int32_t i )+int16_t rotateL_fun_int16_t( int16_t x, int32_t i ) {     if ((i %= 16) == 0) return x;     return (x << i) | ((0x7fff >> (15 - i)) & (x >> (16 - i))); } -int32_t rotateL_fun_int32( int32_t x, int32_t i )+int32_t rotateL_fun_int32_t( int32_t x, int32_t i ) {     if ((i %= 32) == 0) return x;     return (x << i) | ((0x7fffffff >> (31 - i)) & (x >> (32 - i))); } -int64_t rotateL_fun_int64( int64_t x, int32_t i )+int64_t rotateL_fun_int64_t( int64_t x, int32_t i ) {     if ((i %= 64) == 0) return x;     return (x << i) | ((0x7fffffffffffffffll >> (63 - i)) & (x >> (64 - i))); } -uint8_t rotateL_fun_uint8( uint8_t x, int32_t i )+uint8_t rotateL_fun_uint8_t( uint8_t x, int32_t i ) {     if ((i %= 8) == 0) return x;     return (x << i) | (x >> (8 - i)); } -uint16_t rotateL_fun_uint16( uint16_t x, int32_t i )+uint16_t rotateL_fun_uint16_t( uint16_t x, int32_t i ) {     if ((i %= 16) == 0) return x;     return (x << i) | (x >> (16 - i)); } -uint32_t rotateL_fun_uint32( uint32_t x, int32_t i )+uint32_t rotateL_fun_uint32_t( uint32_t x, int32_t i ) {     if ((i %= 32) == 0) return x;     return (x << i) | (x >> (32 - i)); } -uint64_t rotateL_fun_uint64( uint64_t x, int32_t i )+uint64_t rotateL_fun_uint64_t( uint64_t x, int32_t i ) {     if ((i %= 64) == 0) return x;     return (x << i) | (x >> (64 - i));@@ -453,49 +469,49 @@   -int8_t rotateR_fun_int8( int8_t x, int32_t i )+int8_t rotateR_fun_int8_t( int8_t x, int32_t i ) {     if ((i %= 8) == 0) return x;     return (x << (8 - i)) | ((0x7f >> (i - 1)) & (x >> i)); } -int16_t rotateR_fun_int16( int16_t x, int32_t i )+int16_t rotateR_fun_int16_t( int16_t x, int32_t i ) {     if ((i %= 16) == 0) return x;     return (x << (16 - i)) | ((0x7fff >> (i - 1)) & (x >> i)); } -int32_t rotateR_fun_int32( int32_t x, int32_t i )+int32_t rotateR_fun_int32_t( int32_t x, int32_t i ) {     if ((i %= 32) == 0) return x;     return (x << (32 - i)) | ((0x7fffffff >> (i - 1)) & (x >> i)); } -int64_t rotateR_fun_int64( int64_t x, int32_t i )+int64_t rotateR_fun_int64_t( int64_t x, int32_t i ) {     if ((i %= 64) == 0) return x;     return (x << (64 - i)) | ((0x7fffffffffffffffll >> (i - 1)) & (x >> i)); } -uint8_t rotateR_fun_uint8( uint8_t x, int32_t i )+uint8_t rotateR_fun_uint8_t( uint8_t x, int32_t i ) {     if ((i %= 8) == 0) return x;     return (x << (8 - i)) | (x >> i); } -uint16_t rotateR_fun_uint16( uint16_t x, int32_t i )+uint16_t rotateR_fun_uint16_t( uint16_t x, int32_t i ) {     if ((i %= 16) == 0) return x;     return (x << (16 - i)) | (x >> i); } -uint32_t rotateR_fun_uint32( uint32_t x, int32_t i )+uint32_t rotateR_fun_uint32_t( uint32_t x, int32_t i ) {     if ((i %= 32) == 0) return x;     return (x << (32 - i)) | (x >> i); } -uint64_t rotateR_fun_uint64( uint64_t x, int32_t i )+uint64_t rotateR_fun_uint64_t( uint64_t x, int32_t i ) {     if ((i %= 64) == 0) return x;     return (x << (64 - i)) | (x >> i);@@ -503,7 +519,7 @@   -int8_t reverseBits_fun_int8( int8_t x )+int8_t reverseBits_fun_int8_t( int8_t x ) {     int8_t r = x;     int i = 7;@@ -515,7 +531,7 @@     return r << i; } -int16_t reverseBits_fun_int16( int16_t x )+int16_t reverseBits_fun_int16_t( int16_t x ) {     int16_t r = x;     int i = 15;@@ -527,7 +543,7 @@     return r << i; } -int32_t reverseBits_fun_int32( int32_t x )+int32_t reverseBits_fun_int32_t( int32_t x ) {     int32_t r = x;     int i = 31;@@ -539,7 +555,7 @@     return r << i; } -int64_t reverseBits_fun_int64( int64_t x )+int64_t reverseBits_fun_int64_t( int64_t x ) {     int64_t r = x;     int i = 63;@@ -551,7 +567,7 @@     return r << i; } -uint8_t reverseBits_fun_uint8( uint8_t x )+uint8_t reverseBits_fun_uint8_t( uint8_t x ) {     uint8_t r = x;     int i = 7;@@ -563,7 +579,7 @@     return r << i; } -uint16_t reverseBits_fun_uint16( uint16_t x )+uint16_t reverseBits_fun_uint16_t( uint16_t x ) {     uint16_t r = x;     int i = 15;@@ -575,7 +591,7 @@     return r << i; } -uint32_t reverseBits_fun_uint32( uint32_t x )+uint32_t reverseBits_fun_uint32_t( uint32_t x ) {     uint32_t r = x;     int i = 31;@@ -587,7 +603,7 @@     return r << i; } -uint64_t reverseBits_fun_uint64( uint64_t x )+uint64_t reverseBits_fun_uint64_t( uint64_t x ) {     uint64_t r = x;     int i = 63;@@ -601,7 +617,7 @@   -uint32_t bitScan_fun_int8( int8_t x )+uint32_t bitScan_fun_int8_t( int8_t x ) {     uint32_t r = 0;     int8_t s = (x & 0x80);@@ -611,7 +627,7 @@     return r; } -uint32_t bitScan_fun_int16( int16_t x )+uint32_t bitScan_fun_int16_t( int16_t x ) {     uint32_t r = 0;     int16_t s = (x & 0x8000);@@ -621,7 +637,7 @@     return r; } -uint32_t bitScan_fun_int32( int32_t x )+uint32_t bitScan_fun_int32_t( int32_t x ) {     uint32_t r = 0;     int32_t s = (x & 0x80000000);@@ -631,7 +647,7 @@     return r; } -uint32_t bitScan_fun_int64( int64_t x )+uint32_t bitScan_fun_int64_t( int64_t x ) {     uint32_t r = 0;     int64_t s = (x & 0x8000000000000000ll);@@ -641,7 +657,7 @@     return r; } -uint32_t bitScan_fun_uint8( uint8_t x )+uint32_t bitScan_fun_uint8_t( uint8_t x ) {     uint32_t r = 8;     while (x)@@ -652,7 +668,7 @@     return r; } -uint32_t bitScan_fun_uint16( uint16_t x )+uint32_t bitScan_fun_uint16_t( uint16_t x ) {     uint32_t r = 16;     while (x)@@ -663,7 +679,7 @@     return r; } -uint32_t bitScan_fun_uint32( uint32_t x )+uint32_t bitScan_fun_uint32_t( uint32_t x ) {     uint32_t r = 32;     while (x)@@ -674,7 +690,7 @@     return r; } -uint32_t bitScan_fun_uint64( uint64_t x )+uint32_t bitScan_fun_uint64_t( uint64_t x ) {     uint32_t r = 64;     while (x)@@ -687,7 +703,7 @@   -uint32_t bitCount_fun_int8( int8_t x )+uint32_t bitCount_fun_int8_t( int8_t x ) {     uint32_t r = x & 1;     for (x = x >> 1 & 0x7f; x; x >>= 1)@@ -695,7 +711,7 @@     return r; } -uint32_t bitCount_fun_int16( int16_t x )+uint32_t bitCount_fun_int16_t( int16_t x ) {     uint32_t r = x & 1;     for (x = x >> 1 & 0x7fff; x; x >>= 1)@@ -703,7 +719,7 @@     return r; } -uint32_t bitCount_fun_int32( int32_t x )+uint32_t bitCount_fun_int32_t( int32_t x ) {     uint32_t r = x & 1;     for (x = x >> 1 & 0x7fffffff; x; x >>= 1)@@ -711,7 +727,7 @@     return r; } -uint32_t bitCount_fun_int64( int64_t x )+uint32_t bitCount_fun_int64_t( int64_t x ) {     uint32_t r = x & 1;     for (x = x >> 1 & 0x7fffffffffffffffll; x; x >>= 1)@@ -719,7 +735,7 @@     return r; } -uint32_t bitCount_fun_uint8( uint8_t x )+uint32_t bitCount_fun_uint8_t( uint8_t x ) {     uint32_t r = x & 1;     while (x >>= 1)@@ -727,7 +743,7 @@     return r; } -uint32_t bitCount_fun_uint16( uint16_t x )+uint32_t bitCount_fun_uint16_t( uint16_t x ) {     uint32_t r = x & 1;     while (x >>= 1)@@ -735,7 +751,7 @@     return r; } -uint32_t bitCount_fun_uint32( uint32_t x )+uint32_t bitCount_fun_uint32_t( uint32_t x ) {     uint32_t r = x & 1;     while (x >>= 1)@@ -743,7 +759,7 @@     return r; } -uint32_t bitCount_fun_uint64( uint64_t x )+uint32_t bitCount_fun_uint64_t( uint64_t x ) {     uint32_t r = x & 1;     while (x >>= 1)@@ -757,98 +773,98 @@  *                 Complex numbers                                          *  *--------------------------------------------------------------------------*/ -int equal_fun_complexOf_int8( complexOf_int8 a, complexOf_int8 b )+int equal_fun_complexOf_int8_t( complexOf_int8_t a, complexOf_int8_t b ) {     return a.re == b.re && a.im == b.im; } -int equal_fun_complexOf_int16( complexOf_int16 a, complexOf_int16 b )+int equal_fun_complexOf_int16_t( complexOf_int16_t a, complexOf_int16_t b ) {     return a.re == b.re && a.im == b.im; } -int equal_fun_complexOf_int32( complexOf_int32 a, complexOf_int32 b )+int equal_fun_complexOf_int32_t( complexOf_int32_t a, complexOf_int32_t b ) {     return a.re == b.re && a.im == b.im; } -int equal_fun_complexOf_int64( complexOf_int64 a, complexOf_int64 b )+int equal_fun_complexOf_int64_t( complexOf_int64_t a, complexOf_int64_t b ) {     return a.re == b.re && a.im == b.im; } -int equal_fun_complexOf_uint8( complexOf_uint8 a, complexOf_uint8 b )+int equal_fun_complexOf_uint8_t( complexOf_uint8_t a, complexOf_uint8_t b ) {     return a.re == b.re && a.im == b.im; } -int equal_fun_complexOf_uint16( complexOf_uint16 a, complexOf_uint16 b )+int equal_fun_complexOf_uint16_t( complexOf_uint16_t a, complexOf_uint16_t b ) {     return a.re == b.re && a.im == b.im; } -int equal_fun_complexOf_uint32( complexOf_uint32 a, complexOf_uint32 b )+int equal_fun_complexOf_uint32_t( complexOf_uint32_t a, complexOf_uint32_t b ) {     return a.re == b.re && a.im == b.im; } -int equal_fun_complexOf_uint64( complexOf_uint64 a, complexOf_uint64 b )+int equal_fun_complexOf_uint64_t( complexOf_uint64_t a, complexOf_uint64_t b ) {     return a.re == b.re && a.im == b.im; }   -complexOf_int8 negate_fun_complexOf_int8( complexOf_int8 a )+complexOf_int8_t negate_fun_complexOf_int8_t( complexOf_int8_t a ) {     a.re = -a.re;     a.im = -a.im;     return a; } -complexOf_int16 negate_fun_complexOf_int16( complexOf_int16 a )+complexOf_int16_t negate_fun_complexOf_int16_t( complexOf_int16_t a ) {     a.re = -a.re;     a.im = -a.im;     return a; } -complexOf_int32 negate_fun_complexOf_int32( complexOf_int32 a )+complexOf_int32_t negate_fun_complexOf_int32_t( complexOf_int32_t a ) {     a.re = -a.re;     a.im = -a.im;     return a; } -complexOf_int64 negate_fun_complexOf_int64( complexOf_int64 a )+complexOf_int64_t negate_fun_complexOf_int64_t( complexOf_int64_t a ) {     a.re = -a.re;     a.im = -a.im;     return a; } -complexOf_uint8 negate_fun_complexOf_uint8( complexOf_uint8 a )+complexOf_uint8_t negate_fun_complexOf_uint8_t( complexOf_uint8_t a ) {     a.re = -a.re;     a.im = -a.im;     return a; } -complexOf_uint16 negate_fun_complexOf_uint16( complexOf_uint16 a )+complexOf_uint16_t negate_fun_complexOf_uint16_t( complexOf_uint16_t a ) {     a.re = -a.re;     a.im = -a.im;     return a; } -complexOf_uint32 negate_fun_complexOf_uint32( complexOf_uint32 a )+complexOf_uint32_t negate_fun_complexOf_uint32_t( complexOf_uint32_t a ) {     a.re = -a.re;     a.im = -a.im;     return a; } -complexOf_uint64 negate_fun_complexOf_uint64( complexOf_uint64 a )+complexOf_uint64_t negate_fun_complexOf_uint64_t( complexOf_uint64_t a ) {     a.re = -a.re;     a.im = -a.im;@@ -857,162 +873,162 @@   -complexOf_int8 abs_fun_complexOf_int8( complexOf_int8 a )+complexOf_int8_t abs_fun_complexOf_int8_t( complexOf_int8_t a ) {-    a.re = magnitude_fun_complexOf_int8(a);+    a.re = magnitude_fun_complexOf_int8_t(a);     a.im = 0;     return a; } -complexOf_int16 abs_fun_complexOf_int16( complexOf_int16 a )+complexOf_int16_t abs_fun_complexOf_int16_t( complexOf_int16_t a ) {-    a.re = magnitude_fun_complexOf_int16(a);+    a.re = magnitude_fun_complexOf_int16_t(a);     a.im = 0;     return a; } -complexOf_int32 abs_fun_complexOf_int32( complexOf_int32 a )+complexOf_int32_t abs_fun_complexOf_int32_t( complexOf_int32_t a ) {-    a.re = magnitude_fun_complexOf_int32(a);+    a.re = magnitude_fun_complexOf_int32_t(a);     a.im = 0;     return a; } -complexOf_int64 abs_fun_complexOf_int64( complexOf_int64 a )+complexOf_int64_t abs_fun_complexOf_int64_t( complexOf_int64_t a ) {-    a.re = magnitude_fun_complexOf_int64(a);+    a.re = magnitude_fun_complexOf_int64_t(a);     a.im = 0;     return a; } -complexOf_uint8 abs_fun_complexOf_uint8( complexOf_uint8 a )+complexOf_uint8_t abs_fun_complexOf_uint8_t( complexOf_uint8_t a ) {-    a.re = magnitude_fun_complexOf_uint8(a);+    a.re = magnitude_fun_complexOf_uint8_t(a);     a.im = 0;     return a; } -complexOf_uint16 abs_fun_complexOf_uint16( complexOf_uint16 a )+complexOf_uint16_t abs_fun_complexOf_uint16_t( complexOf_uint16_t a ) {-    a.re = magnitude_fun_complexOf_uint16(a);+    a.re = magnitude_fun_complexOf_uint16_t(a);     a.im = 0;     return a; } -complexOf_uint32 abs_fun_complexOf_uint32( complexOf_uint32 a )+complexOf_uint32_t abs_fun_complexOf_uint32_t( complexOf_uint32_t a ) {-    a.re = magnitude_fun_complexOf_uint32(a);+    a.re = magnitude_fun_complexOf_uint32_t(a);     a.im = 0;     return a; } -complexOf_uint64 abs_fun_complexOf_uint64( complexOf_uint64 a )+complexOf_uint64_t abs_fun_complexOf_uint64_t( complexOf_uint64_t a ) {-    a.re = magnitude_fun_complexOf_uint64(a);+    a.re = magnitude_fun_complexOf_uint64_t(a);     a.im = 0;     return a; }   -complexOf_int8 signum_fun_complexOf_int8( complexOf_int8 a )+complexOf_int8_t signum_fun_complexOf_int8_t( complexOf_int8_t a ) {     int8_t m;     if (a.re == 0 && a.im == 0) {         return a;     } else {-        m = magnitude_fun_complexOf_int8(a);+        m = magnitude_fun_complexOf_int8_t(a);         a.re = a.re / m;         a.im = a.im / m;         return a;     } } -complexOf_int16 signum_fun_complexOf_int16( complexOf_int16 a )+complexOf_int16_t signum_fun_complexOf_int16_t( complexOf_int16_t a ) {     int16_t m;     if (a.re == 0 && a.im == 0) {         return a;     } else {-        m = magnitude_fun_complexOf_int16(a);+        m = magnitude_fun_complexOf_int16_t(a);         a.re = a.re / m;         a.im = a.im / m;         return a;     } } -complexOf_int32 signum_fun_complexOf_int32( complexOf_int32 a )+complexOf_int32_t signum_fun_complexOf_int32_t( complexOf_int32_t a ) {     int32_t m;     if (a.re == 0 && a.im == 0) {         return a;     } else {-        m = magnitude_fun_complexOf_int32(a);+        m = magnitude_fun_complexOf_int32_t(a);         a.re = a.re / m;         a.im = a.im / m;         return a;     } } -complexOf_int64 signum_fun_complexOf_int64( complexOf_int64 a )+complexOf_int64_t signum_fun_complexOf_int64_t( complexOf_int64_t a ) {     int64_t m;     if (a.re == 0 && a.im == 0) {         return a;     } else {-        m = magnitude_fun_complexOf_int64(a);+        m = magnitude_fun_complexOf_int64_t(a);         a.re = a.re / m;         a.im = a.im / m;         return a;     } } -complexOf_uint8 signum_fun_complexOf_uint8( complexOf_uint8 a )+complexOf_uint8_t signum_fun_complexOf_uint8_t( complexOf_uint8_t a ) {     uint8_t m;     if (a.re == 0 && a.im == 0) {         return a;     } else {-        m = magnitude_fun_complexOf_uint8(a);+        m = magnitude_fun_complexOf_uint8_t(a);         a.re = a.re / m;         a.im = a.im / m;         return a;     } } -complexOf_uint16 signum_fun_complexOf_uint16( complexOf_uint16 a )+complexOf_uint16_t signum_fun_complexOf_uint16_t( complexOf_uint16_t a ) {     uint16_t m;     if (a.re == 0 && a.im == 0) {         return a;     } else {-        m = magnitude_fun_complexOf_uint16(a);+        m = magnitude_fun_complexOf_uint16_t(a);         a.re = a.re / m;         a.im = a.im / m;         return a;     } } -complexOf_uint32 signum_fun_complexOf_uint32( complexOf_uint32 a )+complexOf_uint32_t signum_fun_complexOf_uint32_t( complexOf_uint32_t a ) {     uint32_t m;     if (a.re == 0 && a.im == 0) {         return a;     } else {-        m = magnitude_fun_complexOf_uint32(a);+        m = magnitude_fun_complexOf_uint32_t(a);         a.re = a.re / m;         a.im = a.im / m;         return a;     } } -complexOf_uint64 signum_fun_complexOf_uint64( complexOf_uint64 a )+complexOf_uint64_t signum_fun_complexOf_uint64_t( complexOf_uint64_t a ) {     uint64_t m;     if (a.re == 0 && a.im == 0) {         return a;     } else {-        m = magnitude_fun_complexOf_uint64(a);+        m = magnitude_fun_complexOf_uint64_t(a);         a.re = a.re / m;         a.im = a.im / m;         return a;@@ -1031,57 +1047,69 @@ }  +double complex signum_fun_complexOf_double( double complex a )+{+    double m;+    if (a == 0) {+        return a;+    } else {+        m = cabsf(a);+        return crealf(a) / m + cimagf(a) / m * I;+    }+} -complexOf_int8 add_fun_complexOf_int8( complexOf_int8 a, complexOf_int8 b )+++complexOf_int8_t add_fun_complexOf_int8_t( complexOf_int8_t a, complexOf_int8_t b ) {     a.re = a.re + b.re;     a.im = a.im + b.im;     return a; } -complexOf_int16 add_fun_complexOf_int16( complexOf_int16 a, complexOf_int16 b )+complexOf_int16_t add_fun_complexOf_int16_t( complexOf_int16_t a, complexOf_int16_t b ) {     a.re = a.re + b.re;     a.im = a.im + b.im;     return a; } -complexOf_int32 add_fun_complexOf_int32( complexOf_int32 a, complexOf_int32 b )+complexOf_int32_t add_fun_complexOf_int32_t( complexOf_int32_t a, complexOf_int32_t b ) {     a.re = a.re + b.re;     a.im = a.im + b.im;     return a; } -complexOf_int64 add_fun_complexOf_int64( complexOf_int64 a, complexOf_int64 b )+complexOf_int64_t add_fun_complexOf_int64_t( complexOf_int64_t a, complexOf_int64_t b ) {     a.re = a.re + b.re;     a.im = a.im + b.im;     return a; } -complexOf_uint8 add_fun_complexOf_uint8( complexOf_uint8 a, complexOf_uint8 b )+complexOf_uint8_t add_fun_complexOf_uint8_t( complexOf_uint8_t a, complexOf_uint8_t b ) {     a.re = a.re + b.re;     a.im = a.im + b.im;     return a; } -complexOf_uint16 add_fun_complexOf_uint16( complexOf_uint16 a, complexOf_uint16 b )+complexOf_uint16_t add_fun_complexOf_uint16_t( complexOf_uint16_t a, complexOf_uint16_t b ) {     a.re = a.re + b.re;     a.im = a.im + b.im;     return a; } -complexOf_uint32 add_fun_complexOf_uint32( complexOf_uint32 a, complexOf_uint32 b )+complexOf_uint32_t add_fun_complexOf_uint32_t( complexOf_uint32_t a, complexOf_uint32_t b ) {     a.re = a.re + b.re;     a.im = a.im + b.im;     return a; } -complexOf_uint64 add_fun_complexOf_uint64( complexOf_uint64 a, complexOf_uint64 b )+complexOf_uint64_t add_fun_complexOf_uint64_t( complexOf_uint64_t a, complexOf_uint64_t b ) {     a.re = a.re + b.re;     a.im = a.im + b.im;@@ -1090,56 +1118,56 @@   -complexOf_int8 sub_fun_complexOf_int8( complexOf_int8 a, complexOf_int8 b )+complexOf_int8_t sub_fun_complexOf_int8_t( complexOf_int8_t a, complexOf_int8_t b ) {     a.re = a.re - b.re;     a.im = a.im - b.im;     return a; } -complexOf_int16 sub_fun_complexOf_int16( complexOf_int16 a, complexOf_int16 b )+complexOf_int16_t sub_fun_complexOf_int16_t( complexOf_int16_t a, complexOf_int16_t b ) {     a.re = a.re - b.re;     a.im = a.im - b.im;     return a; } -complexOf_int32 sub_fun_complexOf_int32( complexOf_int32 a, complexOf_int32 b )+complexOf_int32_t sub_fun_complexOf_int32_t( complexOf_int32_t a, complexOf_int32_t b ) {     a.re = a.re - b.re;     a.im = a.im - b.im;     return a; } -complexOf_int64 sub_fun_complexOf_int64( complexOf_int64 a, complexOf_int64 b )+complexOf_int64_t sub_fun_complexOf_int64_t( complexOf_int64_t a, complexOf_int64_t b ) {     a.re = a.re - b.re;     a.im = a.im - b.im;     return a; } -complexOf_uint8 sub_fun_complexOf_uint8( complexOf_uint8 a, complexOf_uint8 b )+complexOf_uint8_t sub_fun_complexOf_uint8_t( complexOf_uint8_t a, complexOf_uint8_t b ) {     a.re = a.re - b.re;     a.im = a.im - b.im;     return a; } -complexOf_uint16 sub_fun_complexOf_uint16( complexOf_uint16 a, complexOf_uint16 b )+complexOf_uint16_t sub_fun_complexOf_uint16_t( complexOf_uint16_t a, complexOf_uint16_t b ) {     a.re = a.re - b.re;     a.im = a.im - b.im;     return a; } -complexOf_uint32 sub_fun_complexOf_uint32( complexOf_uint32 a, complexOf_uint32 b )+complexOf_uint32_t sub_fun_complexOf_uint32_t( complexOf_uint32_t a, complexOf_uint32_t b ) {     a.re = a.re - b.re;     a.im = a.im - b.im;     return a; } -complexOf_uint64 sub_fun_complexOf_uint64( complexOf_uint64 a, complexOf_uint64 b )+complexOf_uint64_t sub_fun_complexOf_uint64_t( complexOf_uint64_t a, complexOf_uint64_t b ) {     a.re = a.re - b.re;     a.im = a.im - b.im;@@ -1148,65 +1176,65 @@   -complexOf_int8 mult_fun_complexOf_int8( complexOf_int8 a, complexOf_int8 b )+complexOf_int8_t mult_fun_complexOf_int8_t( complexOf_int8_t a, complexOf_int8_t b ) {-    complexOf_int8 r;+    complexOf_int8_t r;     r.re = a.re * b.re - a.im * b.im;     r.im = a.im * b.re + a.re * b.im;     return r; } -complexOf_int16 mult_fun_complexOf_int16( complexOf_int16 a, complexOf_int16 b )+complexOf_int16_t mult_fun_complexOf_int16_t( complexOf_int16_t a, complexOf_int16_t b ) {-    complexOf_int16 r;+    complexOf_int16_t r;     r.re = a.re * b.re - a.im * b.im;     r.im = a.im * b.re + a.re * b.im;     return r; } -complexOf_int32 mult_fun_complexOf_int32( complexOf_int32 a, complexOf_int32 b )+complexOf_int32_t mult_fun_complexOf_int32_t( complexOf_int32_t a, complexOf_int32_t b ) {-    complexOf_int32 r;+    complexOf_int32_t r;     r.re = a.re * b.re - a.im * b.im;     r.im = a.im * b.re + a.re * b.im;     return r; } -complexOf_int64 mult_fun_complexOf_int64( complexOf_int64 a, complexOf_int64 b )+complexOf_int64_t mult_fun_complexOf_int64_t( complexOf_int64_t a, complexOf_int64_t b ) {-    complexOf_int64 r;+    complexOf_int64_t r;     r.re = a.re * b.re - a.im * b.im;     r.im = a.im * b.re + a.re * b.im;     return r; } -complexOf_uint8 mult_fun_complexOf_uint8( complexOf_uint8 a, complexOf_uint8 b )+complexOf_uint8_t mult_fun_complexOf_uint8_t( complexOf_uint8_t a, complexOf_uint8_t b ) {-    complexOf_uint8 r;+    complexOf_uint8_t r;     r.re = a.re * b.re - a.im * b.im;     r.im = a.im * b.re + a.re * b.im;     return r; } -complexOf_uint16 mult_fun_complexOf_uint16( complexOf_uint16 a, complexOf_uint16 b )+complexOf_uint16_t mult_fun_complexOf_uint16_t( complexOf_uint16_t a, complexOf_uint16_t b ) {-    complexOf_uint16 r;+    complexOf_uint16_t r;     r.re = a.re * b.re - a.im * b.im;     r.im = a.im * b.re + a.re * b.im;     return r; } -complexOf_uint32 mult_fun_complexOf_uint32( complexOf_uint32 a, complexOf_uint32 b )+complexOf_uint32_t mult_fun_complexOf_uint32_t( complexOf_uint32_t a, complexOf_uint32_t b ) {-    complexOf_uint32 r;+    complexOf_uint32_t r;     r.re = a.re * b.re - a.im * b.im;     r.im = a.im * b.re + a.re * b.im;     return r; } -complexOf_uint64 mult_fun_complexOf_uint64( complexOf_uint64 a, complexOf_uint64 b )+complexOf_uint64_t mult_fun_complexOf_uint64_t( complexOf_uint64_t a, complexOf_uint64_t b ) {-    complexOf_uint64 r;+    complexOf_uint64_t r;     r.re = a.re * b.re - a.im * b.im;     r.im = a.im * b.re + a.re * b.im;     return r;@@ -1226,66 +1254,72 @@ }  +double complex logBase_fun_complexOf_double( double complex a, double complex b )+{+    return clogf(b) / clogf(a);+} -complexOf_int8 complex_fun_int8( int8_t re, int8_t im )+++complexOf_int8_t complex_fun_int8_t( int8_t re, int8_t im ) {-    complexOf_int8 r;+    complexOf_int8_t r;     r.re = re;     r.im = im;     return r; } -complexOf_int16 complex_fun_int16( int16_t re, int16_t im )+complexOf_int16_t complex_fun_int16_t( int16_t re, int16_t im ) {-    complexOf_int16 r;+    complexOf_int16_t r;     r.re = re;     r.im = im;     return r; } -complexOf_int32 complex_fun_int32( int32_t re, int32_t im )+complexOf_int32_t complex_fun_int32_t( int32_t re, int32_t im ) {-    complexOf_int32 r;+    complexOf_int32_t r;     r.re = re;     r.im = im;     return r; } -complexOf_int64 complex_fun_int64( int64_t re, int64_t im )+complexOf_int64_t complex_fun_int64_t( int64_t re, int64_t im ) {-    complexOf_int64 r;+    complexOf_int64_t r;     r.re = re;     r.im = im;     return r; } -complexOf_uint8 complex_fun_uint8( uint8_t re, uint8_t im )+complexOf_uint8_t complex_fun_uint8_t( uint8_t re, uint8_t im ) {-    complexOf_uint8 r;+    complexOf_uint8_t r;     r.re = re;     r.im = im;     return r; } -complexOf_uint16 complex_fun_uint16( uint16_t re, uint16_t im )+complexOf_uint16_t complex_fun_uint16_t( uint16_t re, uint16_t im ) {-    complexOf_uint16 r;+    complexOf_uint16_t r;     r.re = re;     r.im = im;     return r; } -complexOf_uint32 complex_fun_uint32( uint32_t re, uint32_t im )+complexOf_uint32_t complex_fun_uint32_t( uint32_t re, uint32_t im ) {-    complexOf_uint32 r;+    complexOf_uint32_t r;     r.re = re;     r.im = im;     return r; } -complexOf_uint64 complex_fun_uint64( uint64_t re, uint64_t im )+complexOf_uint64_t complex_fun_uint64_t( uint64_t re, uint64_t im ) {-    complexOf_uint64 r;+    complexOf_uint64_t r;     r.re = re;     r.im = im;     return r;@@ -1297,134 +1331,140 @@ }  +double complex complex_fun_double( double re, double im )+{+    return ( re + im * I );+} -int8_t creal_fun_complexOf_int8( complexOf_int8 a )+++int8_t creal_fun_complexOf_int8_t( complexOf_int8_t a ) {     return a.re; } -int16_t creal_fun_complexOf_int16( complexOf_int16 a )+int16_t creal_fun_complexOf_int16_t( complexOf_int16_t a ) {     return a.re; } -int32_t creal_fun_complexOf_int32( complexOf_int32 a )+int32_t creal_fun_complexOf_int32_t( complexOf_int32_t a ) {     return a.re; } -int64_t creal_fun_complexOf_int64( complexOf_int64 a )+int64_t creal_fun_complexOf_int64_t( complexOf_int64_t a ) {     return a.re; } -uint8_t creal_fun_complexOf_uint8( complexOf_uint8 a )+uint8_t creal_fun_complexOf_uint8_t( complexOf_uint8_t a ) {     return a.re; } -uint16_t creal_fun_complexOf_uint16( complexOf_uint16 a )+uint16_t creal_fun_complexOf_uint16_t( complexOf_uint16_t a ) {     return a.re; } -uint32_t creal_fun_complexOf_uint32( complexOf_uint32 a )+uint32_t creal_fun_complexOf_uint32_t( complexOf_uint32_t a ) {     return a.re; } -uint64_t creal_fun_complexOf_uint64( complexOf_uint64 a )+uint64_t creal_fun_complexOf_uint64_t( complexOf_uint64_t a ) {     return a.re; }   -int8_t cimag_fun_complexOf_int8( complexOf_int8 a )+int8_t cimag_fun_complexOf_int8_t( complexOf_int8_t a ) {     return a.im; } -int16_t cimag_fun_complexOf_int16( complexOf_int16 a )+int16_t cimag_fun_complexOf_int16_t( complexOf_int16_t a ) {     return a.im; } -int32_t cimag_fun_complexOf_int32( complexOf_int32 a )+int32_t cimag_fun_complexOf_int32_t( complexOf_int32_t a ) {     return a.im; } -int64_t cimag_fun_complexOf_int64( complexOf_int64 a )+int64_t cimag_fun_complexOf_int64_t( complexOf_int64_t a ) {     return a.im; } -uint8_t cimag_fun_complexOf_uint8( complexOf_uint8 a )+uint8_t cimag_fun_complexOf_uint8_t( complexOf_uint8_t a ) {     return a.im; } -uint16_t cimag_fun_complexOf_uint16( complexOf_uint16 a )+uint16_t cimag_fun_complexOf_uint16_t( complexOf_uint16_t a ) {     return a.im; } -uint32_t cimag_fun_complexOf_uint32( complexOf_uint32 a )+uint32_t cimag_fun_complexOf_uint32_t( complexOf_uint32_t a ) {     return a.im; } -uint64_t cimag_fun_complexOf_uint64( complexOf_uint64 a )+uint64_t cimag_fun_complexOf_uint64_t( complexOf_uint64_t a ) {     return a.im; }   -complexOf_int8 conj_fun_complexOf_int8( complexOf_int8 a )+complexOf_int8_t conj_fun_complexOf_int8_t( complexOf_int8_t a ) {     a.im = -a.im;     return a; } -complexOf_int16 conj_fun_complexOf_int16( complexOf_int16 a )+complexOf_int16_t conj_fun_complexOf_int16_t( complexOf_int16_t a ) {     a.im = -a.im;     return a; } -complexOf_int32 conj_fun_complexOf_int32( complexOf_int32 a )+complexOf_int32_t conj_fun_complexOf_int32_t( complexOf_int32_t a ) {     a.im = -a.im;     return a; } -complexOf_int64 conj_fun_complexOf_int64( complexOf_int64 a )+complexOf_int64_t conj_fun_complexOf_int64_t( complexOf_int64_t a ) {     a.im = -a.im;     return a; } -complexOf_uint8 conj_fun_complexOf_uint8( complexOf_uint8 a )+complexOf_uint8_t conj_fun_complexOf_uint8_t( complexOf_uint8_t a ) {     a.im = -a.im;     return a; } -complexOf_uint16 conj_fun_complexOf_uint16( complexOf_uint16 a )+complexOf_uint16_t conj_fun_complexOf_uint16_t( complexOf_uint16_t a ) {     a.im = -a.im;     return a; } -complexOf_uint32 conj_fun_complexOf_uint32( complexOf_uint32 a )+complexOf_uint32_t conj_fun_complexOf_uint32_t( complexOf_uint32_t a ) {     a.im = -a.im;     return a; } -complexOf_uint64 conj_fun_complexOf_uint64( complexOf_uint64 a )+complexOf_uint64_t conj_fun_complexOf_uint64_t( complexOf_uint64_t a ) {     a.im = -a.im;     return a;@@ -1432,91 +1472,91 @@   -int8_t magnitude_fun_complexOf_int8( complexOf_int8 a )+int8_t magnitude_fun_complexOf_int8_t( complexOf_int8_t a ) {     return lroundf(hypotf(a.re, a.im)); } -int16_t magnitude_fun_complexOf_int16( complexOf_int16 a )+int16_t magnitude_fun_complexOf_int16_t( complexOf_int16_t a ) {     return lroundf(hypotf(a.re, a.im)); } -int32_t magnitude_fun_complexOf_int32( complexOf_int32 a )+int32_t magnitude_fun_complexOf_int32_t( complexOf_int32_t a ) {     return lroundf(hypotf(a.re, a.im)); } -int64_t magnitude_fun_complexOf_int64( complexOf_int64 a )+int64_t magnitude_fun_complexOf_int64_t( complexOf_int64_t a ) {     return llroundf(hypotf(a.re, a.im)); } -uint8_t magnitude_fun_complexOf_uint8( complexOf_uint8 a )+uint8_t magnitude_fun_complexOf_uint8_t( complexOf_uint8_t a ) {     return lroundf(hypotf(a.re, a.im)); } -uint16_t magnitude_fun_complexOf_uint16( complexOf_uint16 a )+uint16_t magnitude_fun_complexOf_uint16_t( complexOf_uint16_t a ) {     return lroundf(hypotf(a.re, a.im)); } -uint32_t magnitude_fun_complexOf_uint32( complexOf_uint32 a )+uint32_t magnitude_fun_complexOf_uint32_t( complexOf_uint32_t a ) {     return lroundf(hypotf(a.re, a.im)); } -uint64_t magnitude_fun_complexOf_uint64( complexOf_uint64 a )+uint64_t magnitude_fun_complexOf_uint64_t( complexOf_uint64_t a ) {     return llroundf(hypotf(a.re, a.im)); }   -int8_t phase_fun_complexOf_int8( complexOf_int8 a )+int8_t phase_fun_complexOf_int8_t( complexOf_int8_t a ) {     if (a.re == 0 && a.im == 0) return 0;     else return lroundf(atan2f(a.im, a.re)); } -int16_t phase_fun_complexOf_int16( complexOf_int16 a )+int16_t phase_fun_complexOf_int16_t( complexOf_int16_t a ) {     if (a.re == 0 && a.im == 0) return 0;     else return lroundf(atan2f(a.im, a.re)); } -int32_t phase_fun_complexOf_int32( complexOf_int32 a )+int32_t phase_fun_complexOf_int32_t( complexOf_int32_t a ) {     if (a.re == 0 && a.im == 0) return 0;     else return lroundf(atan2f(a.im, a.re)); } -int64_t phase_fun_complexOf_int64( complexOf_int64 a )+int64_t phase_fun_complexOf_int64_t( complexOf_int64_t a ) {     if (a.re == 0 && a.im == 0) return 0;     else return llroundf(atan2f(a.im, a.re)); } -uint8_t phase_fun_complexOf_uint8( complexOf_uint8 a )+uint8_t phase_fun_complexOf_uint8_t( complexOf_uint8_t a ) {     if (a.re == 0 && a.im == 0) return 0;     else return lroundf(atan2f(a.im, a.re)); } -uint16_t phase_fun_complexOf_uint16( complexOf_uint16 a )+uint16_t phase_fun_complexOf_uint16_t( complexOf_uint16_t a ) {     if (a.re == 0 && a.im == 0) return 0;     else return lroundf(atan2f(a.im, a.re)); } -uint32_t phase_fun_complexOf_uint32( complexOf_uint32 a )+uint32_t phase_fun_complexOf_uint32_t( complexOf_uint32_t a ) {     if (a.re == 0 && a.im == 0) return 0;     else return lroundf(atan2f(a.im, a.re)); } -uint64_t phase_fun_complexOf_uint64( complexOf_uint64 a )+uint64_t phase_fun_complexOf_uint64_t( complexOf_uint64_t a ) {     if (a.re == 0 && a.im == 0) return 0;     else return llroundf(atan2f(a.im, a.re));@@ -1524,65 +1564,65 @@   -complexOf_int8 mkPolar_fun_int8( int8_t r, int8_t t )+complexOf_int8_t mkPolar_fun_int8_t( int8_t r, int8_t t ) {-    complexOf_int8 a;+    complexOf_int8_t a;     a.re = lroundf(r * cosf(t));     a.im = lroundf(r * sinf(t));     return a; } -complexOf_int16 mkPolar_fun_int16( int16_t r, int16_t t )+complexOf_int16_t mkPolar_fun_int16_t( int16_t r, int16_t t ) {-    complexOf_int16 a;+    complexOf_int16_t a;     a.re = lroundf(r * cosf(t));     a.im = lroundf(r * sinf(t));     return a; } -complexOf_int32 mkPolar_fun_int32( int32_t r, int32_t t )+complexOf_int32_t mkPolar_fun_int32_t( int32_t r, int32_t t ) {-    complexOf_int32 a;+    complexOf_int32_t a;     a.re = lroundf(r * cosf(t));     a.im = lroundf(r * sinf(t));     return a; } -complexOf_int64 mkPolar_fun_int64( int64_t r, int64_t t )+complexOf_int64_t mkPolar_fun_int64_t( int64_t r, int64_t t ) {-    complexOf_int64 a;+    complexOf_int64_t a;     a.re = llroundf(r * cosf(t));     a.im = llroundf(r * sinf(t));     return a; } -complexOf_uint8 mkPolar_fun_uint8( uint8_t r, uint8_t t )+complexOf_uint8_t mkPolar_fun_uint8_t( uint8_t r, uint8_t t ) {-    complexOf_uint8 a;+    complexOf_uint8_t a;     a.re = lroundf(r * cosf(t));     a.im = lroundf(r * sinf(t));     return a; } -complexOf_uint16 mkPolar_fun_uint16( uint16_t r, uint16_t t )+complexOf_uint16_t mkPolar_fun_uint16_t( uint16_t r, uint16_t t ) {-    complexOf_uint16 a;+    complexOf_uint16_t a;     a.re = lroundf(r * cosf(t));     a.im = lroundf(r * sinf(t));     return a; } -complexOf_uint32 mkPolar_fun_uint32( uint32_t r, uint32_t t )+complexOf_uint32_t mkPolar_fun_uint32_t( uint32_t r, uint32_t t ) {-    complexOf_uint32 a;+    complexOf_uint32_t a;     a.re = lroundf(r * cosf(t));     a.im = lroundf(r * sinf(t));     return a; } -complexOf_uint64 mkPolar_fun_uint64( uint64_t r, uint64_t t )+complexOf_uint64_t mkPolar_fun_uint64_t( uint64_t r, uint64_t t ) {-    complexOf_uint64 a;+    complexOf_uint64_t a;     a.re = llroundf(r * cosf(t));     a.im = llroundf(r * sinf(t));     return a;@@ -1594,66 +1634,72 @@ }  +double complex mkPolar_fun_double( double r, double t )+{+    return r * cosf(t) + r * sinf(t) * I;+} -complexOf_int8 cis_fun_int8( int8_t t )+++complexOf_int8_t cis_fun_int8_t( int8_t t ) {-    complexOf_int8 r;+    complexOf_int8_t r;     r.re = lroundf(cosf(t));     r.im = lroundf(sinf(t));     return r; } -complexOf_int16 cis_fun_int16( int16_t t )+complexOf_int16_t cis_fun_int16_t( int16_t t ) {-    complexOf_int16 r;+    complexOf_int16_t r;     r.re = lroundf(cosf(t));     r.im = lroundf(sinf(t));     return r; } -complexOf_int32 cis_fun_int32( int32_t t )+complexOf_int32_t cis_fun_int32_t( int32_t t ) {-    complexOf_int32 r;+    complexOf_int32_t r;     r.re = lroundf(cosf(t));     r.im = lroundf(sinf(t));     return r; } -complexOf_int64 cis_fun_int64( int64_t t )+complexOf_int64_t cis_fun_int64_t( int64_t t ) {-    complexOf_int64 r;+    complexOf_int64_t r;     r.re = llroundf(cosf(t));     r.im = llroundf(sinf(t));     return r; } -complexOf_uint8 cis_fun_uint8( uint8_t t )+complexOf_uint8_t cis_fun_uint8_t( uint8_t t ) {-    complexOf_uint8 r;+    complexOf_uint8_t r;     r.re = lroundf(cosf(t));     r.im = lroundf(sinf(t));     return r; } -complexOf_uint16 cis_fun_uint16( uint16_t t )+complexOf_uint16_t cis_fun_uint16_t( uint16_t t ) {-    complexOf_uint16 r;+    complexOf_uint16_t r;     r.re = lroundf(cosf(t));     r.im = lroundf(sinf(t));     return r; } -complexOf_uint32 cis_fun_uint32( uint32_t t )+complexOf_uint32_t cis_fun_uint32_t( uint32_t t ) {-    complexOf_uint32 r;+    complexOf_uint32_t r;     r.re = lroundf(cosf(t));     r.im = lroundf(sinf(t));     return r; } -complexOf_uint64 cis_fun_uint64( uint64_t t )+complexOf_uint64_t cis_fun_uint64_t( uint64_t t ) {-    complexOf_uint64 r;+    complexOf_uint64_t r;     r.re = llroundf(cosf(t));     r.im = llroundf(sinf(t));     return r;@@ -1665,7 +1711,13 @@ }  +double complex cis_fun_double( double t )+{+    return cosf(t) + sinf(t) * I;+} ++ /*--------------------------------------------------------------------------*  *                 Trace functions                                          *  *--------------------------------------------------------------------------*/@@ -1748,7 +1800,7 @@     fclose(trace_log_file); } -void trace_int8( int8_t val, int32_t id )+void trace_int8_t( int8_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1756,7 +1808,7 @@     fflush(trace_log_file); } -void trace_int16( int16_t val, int32_t id )+void trace_int16_t( int16_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1764,7 +1816,7 @@     fflush(trace_log_file); } -void trace_int32( int32_t val, int32_t id )+void trace_int32_t( int32_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1772,7 +1824,7 @@     fflush(trace_log_file); } -void trace_int64( int64_t val, int32_t id )+void trace_int64_t( int64_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1780,7 +1832,7 @@     fflush(trace_log_file); } -void trace_uint8( uint8_t val, int32_t id )+void trace_uint8_t( uint8_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1788,7 +1840,7 @@     fflush(trace_log_file); } -void trace_uint16( uint16_t val, int32_t id )+void trace_uint16_t( uint16_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1796,7 +1848,7 @@     fflush(trace_log_file); } -void trace_uint32( uint32_t val, int32_t id )+void trace_uint32_t( uint32_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1804,7 +1856,7 @@     fflush(trace_log_file); } -void trace_uint64( uint64_t val, int32_t id )+void trace_uint64_t( uint64_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1820,15 +1872,23 @@     fflush(trace_log_file); } -void trace_complexOf_int8( complexOf_int8 val, int32_t id )+void trace_double( double val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);+    fprintf(trace_log_file, "id=%d, time=%s, value=%f\n", id, timestr, val);+    fflush(trace_log_file);+}++void trace_complexOf_int8_t( complexOf_int8_t val, int32_t id )+{+    char timestr [80];+    elapsedTimeString(timestr);     fprintf(trace_log_file, "id=%d, time=%s, value=%d+%d*I\n", id, timestr, val.re, val.im);     fflush(trace_log_file); } -void trace_complexOf_int16( complexOf_int16 val, int32_t id )+void trace_complexOf_int16_t( complexOf_int16_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1836,7 +1896,7 @@     fflush(trace_log_file); } -void trace_complexOf_int32( complexOf_int32 val, int32_t id )+void trace_complexOf_int32_t( complexOf_int32_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1844,7 +1904,7 @@     fflush(trace_log_file); } -void trace_complexOf_int64( complexOf_int64 val, int32_t id )+void trace_complexOf_int64_t( complexOf_int64_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1852,7 +1912,7 @@     fflush(trace_log_file); } -void trace_complexOf_uint8( complexOf_uint8 val, int32_t id )+void trace_complexOf_uint8_t( complexOf_uint8_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1860,7 +1920,7 @@     fflush(trace_log_file); } -void trace_complexOf_uint16( complexOf_uint16 val, int32_t id )+void trace_complexOf_uint16_t( complexOf_uint16_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1868,7 +1928,7 @@     fflush(trace_log_file); } -void trace_complexOf_uint32( complexOf_uint32 val, int32_t id )+void trace_complexOf_uint32_t( complexOf_uint32_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1876,7 +1936,7 @@     fflush(trace_log_file); } -void trace_complexOf_uint64( complexOf_uint64 val, int32_t id )+void trace_complexOf_uint64_t( complexOf_uint64_t val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);@@ -1885,6 +1945,14 @@ }  void trace_complexOf_float( float complex val, int32_t id )+{+    char timestr [80];+    elapsedTimeString(timestr);+    fprintf(trace_log_file, "id=%d, time=%s, value=%f+%f*I\n", id, timestr, creal(val), cimag(val));+    fflush(trace_log_file);+}++void trace_complexOf_double( double complex val, int32_t id ) {     char timestr [80];     elapsedTimeString(timestr);

@@ -33,324 +33,334 @@ #include <complex.h>  +int feldspar_c99_hook(void);  #define min(X, Y)  ((X) < (Y) ? (X) : (Y)) #define max(X, Y)  ((X) > (Y) ? (X) : (Y)) -int8_t pow_fun_int8( int8_t, int8_t );-int16_t pow_fun_int16( int16_t, int16_t );-int32_t pow_fun_int32( int32_t, int32_t );-int64_t pow_fun_int64( int64_t, int64_t );-uint8_t pow_fun_uint8( uint8_t, uint8_t );-uint16_t pow_fun_uint16( uint16_t, uint16_t );-uint32_t pow_fun_uint32( uint32_t, uint32_t );-uint64_t pow_fun_uint64( uint64_t, uint64_t );+int8_t pow_fun_int8_t( int8_t, int8_t );+int16_t pow_fun_int16_t( int16_t, int16_t );+int32_t pow_fun_int32_t( int32_t, int32_t );+int64_t pow_fun_int64_t( int64_t, int64_t );+uint8_t pow_fun_uint8_t( uint8_t, uint8_t );+uint16_t pow_fun_uint16_t( uint16_t, uint16_t );+uint32_t pow_fun_uint32_t( uint32_t, uint32_t );+uint64_t pow_fun_uint64_t( uint64_t, uint64_t ); -int8_t abs_fun_int8( int8_t );-int16_t abs_fun_int16( int16_t );-int32_t abs_fun_int32( int32_t );-int64_t abs_fun_int64( int64_t );+int8_t abs_fun_int8_t( int8_t );+int16_t abs_fun_int16_t( int16_t );+int32_t abs_fun_int32_t( int32_t );+int64_t abs_fun_int64_t( int64_t ); -int8_t signum_fun_int8( int8_t );-int16_t signum_fun_int16( int16_t );-int32_t signum_fun_int32( int32_t );-int64_t signum_fun_int64( int64_t );-uint8_t signum_fun_uint8( uint8_t );-uint16_t signum_fun_uint16( uint16_t );-uint32_t signum_fun_uint32( uint32_t );-uint64_t signum_fun_uint64( uint64_t );+int8_t signum_fun_int8_t( int8_t );+int16_t signum_fun_int16_t( int16_t );+int32_t signum_fun_int32_t( int32_t );+int64_t signum_fun_int64_t( int64_t );+uint8_t signum_fun_uint8_t( uint8_t );+uint16_t signum_fun_uint16_t( uint16_t );+uint32_t signum_fun_uint32_t( uint32_t );+uint64_t signum_fun_uint64_t( uint64_t ); float signum_fun_float( float );+double signum_fun_double( double );  float logBase_fun_float( float, float );+double logBase_fun_double( double, double );   -int8_t setBit_fun_int8( int8_t, uint32_t );-int16_t setBit_fun_int16( int16_t, uint32_t );-int32_t setBit_fun_int32( int32_t, uint32_t );-int64_t setBit_fun_int64( int64_t, uint32_t );-uint8_t setBit_fun_uint8( uint8_t, uint32_t );-uint16_t setBit_fun_uint16( uint16_t, uint32_t );-uint32_t setBit_fun_uint32( uint32_t, uint32_t );-uint64_t setBit_fun_uint64( uint64_t, uint32_t );+int8_t setBit_fun_int8_t( int8_t, uint32_t );+int16_t setBit_fun_int16_t( int16_t, uint32_t );+int32_t setBit_fun_int32_t( int32_t, uint32_t );+int64_t setBit_fun_int64_t( int64_t, uint32_t );+uint8_t setBit_fun_uint8_t( uint8_t, uint32_t );+uint16_t setBit_fun_uint16_t( uint16_t, uint32_t );+uint32_t setBit_fun_uint32_t( uint32_t, uint32_t );+uint64_t setBit_fun_uint64_t( uint64_t, uint32_t ); -int8_t clearBit_fun_int8( int8_t, uint32_t );-int16_t clearBit_fun_int16( int16_t, uint32_t );-int32_t clearBit_fun_int32( int32_t, uint32_t );-int64_t clearBit_fun_int64( int64_t, uint32_t );-uint8_t clearBit_fun_uint8( uint8_t, uint32_t );-uint16_t clearBit_fun_uint16( uint16_t, uint32_t );-uint32_t clearBit_fun_uint32( uint32_t, uint32_t );-uint64_t clearBit_fun_uint64( uint64_t, uint32_t );+int8_t clearBit_fun_int8_t( int8_t, uint32_t );+int16_t clearBit_fun_int16_t( int16_t, uint32_t );+int32_t clearBit_fun_int32_t( int32_t, uint32_t );+int64_t clearBit_fun_int64_t( int64_t, uint32_t );+uint8_t clearBit_fun_uint8_t( uint8_t, uint32_t );+uint16_t clearBit_fun_uint16_t( uint16_t, uint32_t );+uint32_t clearBit_fun_uint32_t( uint32_t, uint32_t );+uint64_t clearBit_fun_uint64_t( uint64_t, uint32_t ); -int8_t complementBit_fun_int8( int8_t, uint32_t );-int16_t complementBit_fun_int16( int16_t, uint32_t );-int32_t complementBit_fun_int32( int32_t, uint32_t );-int64_t complementBit_fun_int64( int64_t, uint32_t );-uint8_t complementBit_fun_uint8( uint8_t, uint32_t );-uint16_t complementBit_fun_uint16( uint16_t, uint32_t );-uint32_t complementBit_fun_uint32( uint32_t, uint32_t );-uint64_t complementBit_fun_uint64( uint64_t, uint32_t );+int8_t complementBit_fun_int8_t( int8_t, uint32_t );+int16_t complementBit_fun_int16_t( int16_t, uint32_t );+int32_t complementBit_fun_int32_t( int32_t, uint32_t );+int64_t complementBit_fun_int64_t( int64_t, uint32_t );+uint8_t complementBit_fun_uint8_t( uint8_t, uint32_t );+uint16_t complementBit_fun_uint16_t( uint16_t, uint32_t );+uint32_t complementBit_fun_uint32_t( uint32_t, uint32_t );+uint64_t complementBit_fun_uint64_t( uint64_t, uint32_t ); -int testBit_fun_int8( int8_t, uint32_t );-int testBit_fun_int16( int16_t, uint32_t );-int testBit_fun_int32( int32_t, uint32_t );-int testBit_fun_int64( int64_t, uint32_t );-int testBit_fun_uint8( uint8_t, uint32_t );-int testBit_fun_uint16( uint16_t, uint32_t );-int testBit_fun_uint32( uint32_t, uint32_t );-int testBit_fun_uint64( uint64_t, uint32_t );+int testBit_fun_int8_t( int8_t, uint32_t );+int testBit_fun_int16_t( int16_t, uint32_t );+int testBit_fun_int32_t( int32_t, uint32_t );+int testBit_fun_int64_t( int64_t, uint32_t );+int testBit_fun_uint8_t( uint8_t, uint32_t );+int testBit_fun_uint16_t( uint16_t, uint32_t );+int testBit_fun_uint32_t( uint32_t, uint32_t );+int testBit_fun_uint64_t( uint64_t, uint32_t ); -int8_t rotateL_fun_int8( int8_t, int32_t );-int16_t rotateL_fun_int16( int16_t, int32_t );-int32_t rotateL_fun_int32( int32_t, int32_t );-int64_t rotateL_fun_int64( int64_t, int32_t );-uint8_t rotateL_fun_uint8( uint8_t, int32_t );-uint16_t rotateL_fun_uint16( uint16_t, int32_t );-uint32_t rotateL_fun_uint32( uint32_t, int32_t );-uint64_t rotateL_fun_uint64( uint64_t, int32_t );+int8_t rotateL_fun_int8_t( int8_t, int32_t );+int16_t rotateL_fun_int16_t( int16_t, int32_t );+int32_t rotateL_fun_int32_t( int32_t, int32_t );+int64_t rotateL_fun_int64_t( int64_t, int32_t );+uint8_t rotateL_fun_uint8_t( uint8_t, int32_t );+uint16_t rotateL_fun_uint16_t( uint16_t, int32_t );+uint32_t rotateL_fun_uint32_t( uint32_t, int32_t );+uint64_t rotateL_fun_uint64_t( uint64_t, int32_t ); -int8_t rotateR_fun_int8( int8_t, int32_t );-int16_t rotateR_fun_int16( int16_t, int32_t );-int32_t rotateR_fun_int32( int32_t, int32_t );-int64_t rotateR_fun_int64( int64_t, int32_t );-uint8_t rotateR_fun_uint8( uint8_t, int32_t );-uint16_t rotateR_fun_uint16( uint16_t, int32_t );-uint32_t rotateR_fun_uint32( uint32_t, int32_t );-uint64_t rotateR_fun_uint64( uint64_t, int32_t );+int8_t rotateR_fun_int8_t( int8_t, int32_t );+int16_t rotateR_fun_int16_t( int16_t, int32_t );+int32_t rotateR_fun_int32_t( int32_t, int32_t );+int64_t rotateR_fun_int64_t( int64_t, int32_t );+uint8_t rotateR_fun_uint8_t( uint8_t, int32_t );+uint16_t rotateR_fun_uint16_t( uint16_t, int32_t );+uint32_t rotateR_fun_uint32_t( uint32_t, int32_t );+uint64_t rotateR_fun_uint64_t( uint64_t, int32_t ); -int8_t reverseBits_fun_int8( int8_t );-int16_t reverseBits_fun_int16( int16_t );-int32_t reverseBits_fun_int32( int32_t );-int64_t reverseBits_fun_int64( int64_t );-uint8_t reverseBits_fun_uint8( uint8_t );-uint16_t reverseBits_fun_uint16( uint16_t );-uint32_t reverseBits_fun_uint32( uint32_t );-uint64_t reverseBits_fun_uint64( uint64_t );+int8_t reverseBits_fun_int8_t( int8_t );+int16_t reverseBits_fun_int16_t( int16_t );+int32_t reverseBits_fun_int32_t( int32_t );+int64_t reverseBits_fun_int64_t( int64_t );+uint8_t reverseBits_fun_uint8_t( uint8_t );+uint16_t reverseBits_fun_uint16_t( uint16_t );+uint32_t reverseBits_fun_uint32_t( uint32_t );+uint64_t reverseBits_fun_uint64_t( uint64_t ); -uint32_t bitScan_fun_int8( int8_t );-uint32_t bitScan_fun_int16( int16_t );-uint32_t bitScan_fun_int32( int32_t );-uint32_t bitScan_fun_int64( int64_t );-uint32_t bitScan_fun_uint8( uint8_t );-uint32_t bitScan_fun_uint16( uint16_t );-uint32_t bitScan_fun_uint32( uint32_t );-uint32_t bitScan_fun_uint64( uint64_t );+uint32_t bitScan_fun_int8_t( int8_t );+uint32_t bitScan_fun_int16_t( int16_t );+uint32_t bitScan_fun_int32_t( int32_t );+uint32_t bitScan_fun_int64_t( int64_t );+uint32_t bitScan_fun_uint8_t( uint8_t );+uint32_t bitScan_fun_uint16_t( uint16_t );+uint32_t bitScan_fun_uint32_t( uint32_t );+uint32_t bitScan_fun_uint64_t( uint64_t ); -uint32_t bitCount_fun_int8( int8_t );-uint32_t bitCount_fun_int16( int16_t );-uint32_t bitCount_fun_int32( int32_t );-uint32_t bitCount_fun_int64( int64_t );-uint32_t bitCount_fun_uint8( uint8_t );-uint32_t bitCount_fun_uint16( uint16_t );-uint32_t bitCount_fun_uint32( uint32_t );-uint32_t bitCount_fun_uint64( uint64_t );+uint32_t bitCount_fun_int8_t( int8_t );+uint32_t bitCount_fun_int16_t( int16_t );+uint32_t bitCount_fun_int32_t( int32_t );+uint32_t bitCount_fun_int64_t( int64_t );+uint32_t bitCount_fun_uint8_t( uint8_t );+uint32_t bitCount_fun_uint16_t( uint16_t );+uint32_t bitCount_fun_uint32_t( uint32_t );+uint32_t bitCount_fun_uint64_t( uint64_t );    typedef struct {     int8_t re;     int8_t im;-} complexOf_int8;+} complexOf_int8_t;  typedef struct {     int16_t re;     int16_t im;-} complexOf_int16;+} complexOf_int16_t;  typedef struct {     int32_t re;     int32_t im;-} complexOf_int32;+} complexOf_int32_t;  typedef struct {     int64_t re;     int64_t im;-} complexOf_int64;+} complexOf_int64_t;  typedef struct {     uint8_t re;     uint8_t im;-} complexOf_uint8;+} complexOf_uint8_t;  typedef struct {     uint16_t re;     uint16_t im;-} complexOf_uint16;+} complexOf_uint16_t;  typedef struct {     uint32_t re;     uint32_t im;-} complexOf_uint32;+} complexOf_uint32_t;  typedef struct {     uint64_t re;     uint64_t im;-} complexOf_uint64;+} complexOf_uint64_t; -int equal_fun_complexOf_int8( complexOf_int8, complexOf_int8 );-int equal_fun_complexOf_int16( complexOf_int16, complexOf_int16 );-int equal_fun_complexOf_int32( complexOf_int32, complexOf_int32 );-int equal_fun_complexOf_int64( complexOf_int64, complexOf_int64 );-int equal_fun_complexOf_uint8( complexOf_uint8, complexOf_uint8 );-int equal_fun_complexOf_uint16( complexOf_uint16, complexOf_uint16 );-int equal_fun_complexOf_uint32( complexOf_uint32, complexOf_uint32 );-int equal_fun_complexOf_uint64( complexOf_uint64, complexOf_uint64 );+int equal_fun_complexOf_int8_t( complexOf_int8_t, complexOf_int8_t );+int equal_fun_complexOf_int16_t( complexOf_int16_t, complexOf_int16_t );+int equal_fun_complexOf_int32_t( complexOf_int32_t, complexOf_int32_t );+int equal_fun_complexOf_int64_t( complexOf_int64_t, complexOf_int64_t );+int equal_fun_complexOf_uint8_t( complexOf_uint8_t, complexOf_uint8_t );+int equal_fun_complexOf_uint16_t( complexOf_uint16_t, complexOf_uint16_t );+int equal_fun_complexOf_uint32_t( complexOf_uint32_t, complexOf_uint32_t );+int equal_fun_complexOf_uint64_t( complexOf_uint64_t, complexOf_uint64_t ); -complexOf_int8 negate_fun_complexOf_int8( complexOf_int8 );-complexOf_int16 negate_fun_complexOf_int16( complexOf_int16 );-complexOf_int32 negate_fun_complexOf_int32( complexOf_int32 );-complexOf_int64 negate_fun_complexOf_int64( complexOf_int64 );-complexOf_uint8 negate_fun_complexOf_uint8( complexOf_uint8 );-complexOf_uint16 negate_fun_complexOf_uint16( complexOf_uint16 );-complexOf_uint32 negate_fun_complexOf_uint32( complexOf_uint32 );-complexOf_uint64 negate_fun_complexOf_uint64( complexOf_uint64 );+complexOf_int8_t negate_fun_complexOf_int8_t( complexOf_int8_t );+complexOf_int16_t negate_fun_complexOf_int16_t( complexOf_int16_t );+complexOf_int32_t negate_fun_complexOf_int32_t( complexOf_int32_t );+complexOf_int64_t negate_fun_complexOf_int64_t( complexOf_int64_t );+complexOf_uint8_t negate_fun_complexOf_uint8_t( complexOf_uint8_t );+complexOf_uint16_t negate_fun_complexOf_uint16_t( complexOf_uint16_t );+complexOf_uint32_t negate_fun_complexOf_uint32_t( complexOf_uint32_t );+complexOf_uint64_t negate_fun_complexOf_uint64_t( complexOf_uint64_t ); -complexOf_int8 abs_fun_complexOf_int8( complexOf_int8 );-complexOf_int16 abs_fun_complexOf_int16( complexOf_int16 );-complexOf_int32 abs_fun_complexOf_int32( complexOf_int32 );-complexOf_int64 abs_fun_complexOf_int64( complexOf_int64 );-complexOf_uint8 abs_fun_complexOf_uint8( complexOf_uint8 );-complexOf_uint16 abs_fun_complexOf_uint16( complexOf_uint16 );-complexOf_uint32 abs_fun_complexOf_uint32( complexOf_uint32 );-complexOf_uint64 abs_fun_complexOf_uint64( complexOf_uint64 );+complexOf_int8_t abs_fun_complexOf_int8_t( complexOf_int8_t );+complexOf_int16_t abs_fun_complexOf_int16_t( complexOf_int16_t );+complexOf_int32_t abs_fun_complexOf_int32_t( complexOf_int32_t );+complexOf_int64_t abs_fun_complexOf_int64_t( complexOf_int64_t );+complexOf_uint8_t abs_fun_complexOf_uint8_t( complexOf_uint8_t );+complexOf_uint16_t abs_fun_complexOf_uint16_t( complexOf_uint16_t );+complexOf_uint32_t abs_fun_complexOf_uint32_t( complexOf_uint32_t );+complexOf_uint64_t abs_fun_complexOf_uint64_t( complexOf_uint64_t ); -complexOf_int8 signum_fun_complexOf_int8( complexOf_int8 );-complexOf_int16 signum_fun_complexOf_int16( complexOf_int16 );-complexOf_int32 signum_fun_complexOf_int32( complexOf_int32 );-complexOf_int64 signum_fun_complexOf_int64( complexOf_int64 );-complexOf_uint8 signum_fun_complexOf_uint8( complexOf_uint8 );-complexOf_uint16 signum_fun_complexOf_uint16( complexOf_uint16 );-complexOf_uint32 signum_fun_complexOf_uint32( complexOf_uint32 );-complexOf_uint64 signum_fun_complexOf_uint64( complexOf_uint64 );+complexOf_int8_t signum_fun_complexOf_int8_t( complexOf_int8_t );+complexOf_int16_t signum_fun_complexOf_int16_t( complexOf_int16_t );+complexOf_int32_t signum_fun_complexOf_int32_t( complexOf_int32_t );+complexOf_int64_t signum_fun_complexOf_int64_t( complexOf_int64_t );+complexOf_uint8_t signum_fun_complexOf_uint8_t( complexOf_uint8_t );+complexOf_uint16_t signum_fun_complexOf_uint16_t( complexOf_uint16_t );+complexOf_uint32_t signum_fun_complexOf_uint32_t( complexOf_uint32_t );+complexOf_uint64_t signum_fun_complexOf_uint64_t( complexOf_uint64_t ); float complex signum_fun_complexOf_float( float complex );+double complex signum_fun_complexOf_double( double complex ); -complexOf_int8 add_fun_complexOf_int8( complexOf_int8, complexOf_int8 );-complexOf_int16 add_fun_complexOf_int16( complexOf_int16, complexOf_int16 );-complexOf_int32 add_fun_complexOf_int32( complexOf_int32, complexOf_int32 );-complexOf_int64 add_fun_complexOf_int64( complexOf_int64, complexOf_int64 );-complexOf_uint8 add_fun_complexOf_uint8( complexOf_uint8, complexOf_uint8 );-complexOf_uint16 add_fun_complexOf_uint16( complexOf_uint16, complexOf_uint16 );-complexOf_uint32 add_fun_complexOf_uint32( complexOf_uint32, complexOf_uint32 );-complexOf_uint64 add_fun_complexOf_uint64( complexOf_uint64, complexOf_uint64 );+complexOf_int8_t add_fun_complexOf_int8_t( complexOf_int8_t, complexOf_int8_t );+complexOf_int16_t add_fun_complexOf_int16_t( complexOf_int16_t, complexOf_int16_t );+complexOf_int32_t add_fun_complexOf_int32_t( complexOf_int32_t, complexOf_int32_t );+complexOf_int64_t add_fun_complexOf_int64_t( complexOf_int64_t, complexOf_int64_t );+complexOf_uint8_t add_fun_complexOf_uint8_t( complexOf_uint8_t, complexOf_uint8_t );+complexOf_uint16_t add_fun_complexOf_uint16_t( complexOf_uint16_t, complexOf_uint16_t );+complexOf_uint32_t add_fun_complexOf_uint32_t( complexOf_uint32_t, complexOf_uint32_t );+complexOf_uint64_t add_fun_complexOf_uint64_t( complexOf_uint64_t, complexOf_uint64_t ); -complexOf_int8 sub_fun_complexOf_int8( complexOf_int8, complexOf_int8 );-complexOf_int16 sub_fun_complexOf_int16( complexOf_int16, complexOf_int16 );-complexOf_int32 sub_fun_complexOf_int32( complexOf_int32, complexOf_int32 );-complexOf_int64 sub_fun_complexOf_int64( complexOf_int64, complexOf_int64 );-complexOf_uint8 sub_fun_complexOf_uint8( complexOf_uint8, complexOf_uint8 );-complexOf_uint16 sub_fun_complexOf_uint16( complexOf_uint16, complexOf_uint16 );-complexOf_uint32 sub_fun_complexOf_uint32( complexOf_uint32, complexOf_uint32 );-complexOf_uint64 sub_fun_complexOf_uint64( complexOf_uint64, complexOf_uint64 );+complexOf_int8_t sub_fun_complexOf_int8_t( complexOf_int8_t, complexOf_int8_t );+complexOf_int16_t sub_fun_complexOf_int16_t( complexOf_int16_t, complexOf_int16_t );+complexOf_int32_t sub_fun_complexOf_int32_t( complexOf_int32_t, complexOf_int32_t );+complexOf_int64_t sub_fun_complexOf_int64_t( complexOf_int64_t, complexOf_int64_t );+complexOf_uint8_t sub_fun_complexOf_uint8_t( complexOf_uint8_t, complexOf_uint8_t );+complexOf_uint16_t sub_fun_complexOf_uint16_t( complexOf_uint16_t, complexOf_uint16_t );+complexOf_uint32_t sub_fun_complexOf_uint32_t( complexOf_uint32_t, complexOf_uint32_t );+complexOf_uint64_t sub_fun_complexOf_uint64_t( complexOf_uint64_t, complexOf_uint64_t ); -complexOf_int8 mult_fun_complexOf_int8( complexOf_int8, complexOf_int8 );-complexOf_int16 mult_fun_complexOf_int16( complexOf_int16, complexOf_int16 );-complexOf_int32 mult_fun_complexOf_int32( complexOf_int32, complexOf_int32 );-complexOf_int64 mult_fun_complexOf_int64( complexOf_int64, complexOf_int64 );-complexOf_uint8 mult_fun_complexOf_uint8( complexOf_uint8, complexOf_uint8 );-complexOf_uint16 mult_fun_complexOf_uint16( complexOf_uint16, complexOf_uint16 );-complexOf_uint32 mult_fun_complexOf_uint32( complexOf_uint32, complexOf_uint32 );-complexOf_uint64 mult_fun_complexOf_uint64( complexOf_uint64, complexOf_uint64 );+complexOf_int8_t mult_fun_complexOf_int8_t( complexOf_int8_t, complexOf_int8_t );+complexOf_int16_t mult_fun_complexOf_int16_t( complexOf_int16_t, complexOf_int16_t );+complexOf_int32_t mult_fun_complexOf_int32_t( complexOf_int32_t, complexOf_int32_t );+complexOf_int64_t mult_fun_complexOf_int64_t( complexOf_int64_t, complexOf_int64_t );+complexOf_uint8_t mult_fun_complexOf_uint8_t( complexOf_uint8_t, complexOf_uint8_t );+complexOf_uint16_t mult_fun_complexOf_uint16_t( complexOf_uint16_t, complexOf_uint16_t );+complexOf_uint32_t mult_fun_complexOf_uint32_t( complexOf_uint32_t, complexOf_uint32_t );+complexOf_uint64_t mult_fun_complexOf_uint64_t( complexOf_uint64_t, complexOf_uint64_t );  float complex logBase_fun_complexOf_float( float complex, float complex );+double complex logBase_fun_complexOf_double( double complex, double complex ); -complexOf_int8 complex_fun_int8( int8_t, int8_t );-complexOf_int16 complex_fun_int16( int16_t, int16_t );-complexOf_int32 complex_fun_int32( int32_t, int32_t );-complexOf_int64 complex_fun_int64( int64_t, int64_t );-complexOf_uint8 complex_fun_uint8( uint8_t, uint8_t );-complexOf_uint16 complex_fun_uint16( uint16_t, uint16_t );-complexOf_uint32 complex_fun_uint32( uint32_t, uint32_t );-complexOf_uint64 complex_fun_uint64( uint64_t, uint64_t );+complexOf_int8_t complex_fun_int8_t( int8_t, int8_t );+complexOf_int16_t complex_fun_int16_t( int16_t, int16_t );+complexOf_int32_t complex_fun_int32_t( int32_t, int32_t );+complexOf_int64_t complex_fun_int64_t( int64_t, int64_t );+complexOf_uint8_t complex_fun_uint8_t( uint8_t, uint8_t );+complexOf_uint16_t complex_fun_uint16_t( uint16_t, uint16_t );+complexOf_uint32_t complex_fun_uint32_t( uint32_t, uint32_t );+complexOf_uint64_t complex_fun_uint64_t( uint64_t, uint64_t ); float complex complex_fun_float( float, float );+double complex complex_fun_double( double, double ); -int8_t creal_fun_complexOf_int8( complexOf_int8 );-int16_t creal_fun_complexOf_int16( complexOf_int16 );-int32_t creal_fun_complexOf_int32( complexOf_int32 );-int64_t creal_fun_complexOf_int64( complexOf_int64 );-uint8_t creal_fun_complexOf_uint8( complexOf_uint8 );-uint16_t creal_fun_complexOf_uint16( complexOf_uint16 );-uint32_t creal_fun_complexOf_uint32( complexOf_uint32 );-uint64_t creal_fun_complexOf_uint64( complexOf_uint64 );+int8_t creal_fun_complexOf_int8_t( complexOf_int8_t );+int16_t creal_fun_complexOf_int16_t( complexOf_int16_t );+int32_t creal_fun_complexOf_int32_t( complexOf_int32_t );+int64_t creal_fun_complexOf_int64_t( complexOf_int64_t );+uint8_t creal_fun_complexOf_uint8_t( complexOf_uint8_t );+uint16_t creal_fun_complexOf_uint16_t( complexOf_uint16_t );+uint32_t creal_fun_complexOf_uint32_t( complexOf_uint32_t );+uint64_t creal_fun_complexOf_uint64_t( complexOf_uint64_t ); -int8_t cimag_fun_complexOf_int8( complexOf_int8 );-int16_t cimag_fun_complexOf_int16( complexOf_int16 );-int32_t cimag_fun_complexOf_int32( complexOf_int32 );-int64_t cimag_fun_complexOf_int64( complexOf_int64 );-uint8_t cimag_fun_complexOf_uint8( complexOf_uint8 );-uint16_t cimag_fun_complexOf_uint16( complexOf_uint16 );-uint32_t cimag_fun_complexOf_uint32( complexOf_uint32 );-uint64_t cimag_fun_complexOf_uint64( complexOf_uint64 );+int8_t cimag_fun_complexOf_int8_t( complexOf_int8_t );+int16_t cimag_fun_complexOf_int16_t( complexOf_int16_t );+int32_t cimag_fun_complexOf_int32_t( complexOf_int32_t );+int64_t cimag_fun_complexOf_int64_t( complexOf_int64_t );+uint8_t cimag_fun_complexOf_uint8_t( complexOf_uint8_t );+uint16_t cimag_fun_complexOf_uint16_t( complexOf_uint16_t );+uint32_t cimag_fun_complexOf_uint32_t( complexOf_uint32_t );+uint64_t cimag_fun_complexOf_uint64_t( complexOf_uint64_t ); -complexOf_int8 conj_fun_complexOf_int8( complexOf_int8 );-complexOf_int16 conj_fun_complexOf_int16( complexOf_int16 );-complexOf_int32 conj_fun_complexOf_int32( complexOf_int32 );-complexOf_int64 conj_fun_complexOf_int64( complexOf_int64 );-complexOf_uint8 conj_fun_complexOf_uint8( complexOf_uint8 );-complexOf_uint16 conj_fun_complexOf_uint16( complexOf_uint16 );-complexOf_uint32 conj_fun_complexOf_uint32( complexOf_uint32 );-complexOf_uint64 conj_fun_complexOf_uint64( complexOf_uint64 );+complexOf_int8_t conj_fun_complexOf_int8_t( complexOf_int8_t );+complexOf_int16_t conj_fun_complexOf_int16_t( complexOf_int16_t );+complexOf_int32_t conj_fun_complexOf_int32_t( complexOf_int32_t );+complexOf_int64_t conj_fun_complexOf_int64_t( complexOf_int64_t );+complexOf_uint8_t conj_fun_complexOf_uint8_t( complexOf_uint8_t );+complexOf_uint16_t conj_fun_complexOf_uint16_t( complexOf_uint16_t );+complexOf_uint32_t conj_fun_complexOf_uint32_t( complexOf_uint32_t );+complexOf_uint64_t conj_fun_complexOf_uint64_t( complexOf_uint64_t ); -int8_t magnitude_fun_complexOf_int8( complexOf_int8 );-int16_t magnitude_fun_complexOf_int16( complexOf_int16 );-int32_t magnitude_fun_complexOf_int32( complexOf_int32 );-int64_t magnitude_fun_complexOf_int64( complexOf_int64 );-uint8_t magnitude_fun_complexOf_uint8( complexOf_uint8 );-uint16_t magnitude_fun_complexOf_uint16( complexOf_uint16 );-uint32_t magnitude_fun_complexOf_uint32( complexOf_uint32 );-uint64_t magnitude_fun_complexOf_uint64( complexOf_uint64 );+int8_t magnitude_fun_complexOf_int8_t( complexOf_int8_t );+int16_t magnitude_fun_complexOf_int16_t( complexOf_int16_t );+int32_t magnitude_fun_complexOf_int32_t( complexOf_int32_t );+int64_t magnitude_fun_complexOf_int64_t( complexOf_int64_t );+uint8_t magnitude_fun_complexOf_uint8_t( complexOf_uint8_t );+uint16_t magnitude_fun_complexOf_uint16_t( complexOf_uint16_t );+uint32_t magnitude_fun_complexOf_uint32_t( complexOf_uint32_t );+uint64_t magnitude_fun_complexOf_uint64_t( complexOf_uint64_t ); -int8_t phase_fun_complexOf_int8( complexOf_int8 );-int16_t phase_fun_complexOf_int16( complexOf_int16 );-int32_t phase_fun_complexOf_int32( complexOf_int32 );-int64_t phase_fun_complexOf_int64( complexOf_int64 );-uint8_t phase_fun_complexOf_uint8( complexOf_uint8 );-uint16_t phase_fun_complexOf_uint16( complexOf_uint16 );-uint32_t phase_fun_complexOf_uint32( complexOf_uint32 );-uint64_t phase_fun_complexOf_uint64( complexOf_uint64 );+int8_t phase_fun_complexOf_int8_t( complexOf_int8_t );+int16_t phase_fun_complexOf_int16_t( complexOf_int16_t );+int32_t phase_fun_complexOf_int32_t( complexOf_int32_t );+int64_t phase_fun_complexOf_int64_t( complexOf_int64_t );+uint8_t phase_fun_complexOf_uint8_t( complexOf_uint8_t );+uint16_t phase_fun_complexOf_uint16_t( complexOf_uint16_t );+uint32_t phase_fun_complexOf_uint32_t( complexOf_uint32_t );+uint64_t phase_fun_complexOf_uint64_t( complexOf_uint64_t ); -complexOf_int8 mkPolar_fun_int8( int8_t, int8_t );-complexOf_int16 mkPolar_fun_int16( int16_t, int16_t );-complexOf_int32 mkPolar_fun_int32( int32_t, int32_t );-complexOf_int64 mkPolar_fun_int64( int64_t, int64_t );-complexOf_uint8 mkPolar_fun_uint8( uint8_t, uint8_t );-complexOf_uint16 mkPolar_fun_uint16( uint16_t, uint16_t );-complexOf_uint32 mkPolar_fun_uint32( uint32_t, uint32_t );-complexOf_uint64 mkPolar_fun_uint64( uint64_t, uint64_t );+complexOf_int8_t mkPolar_fun_int8_t( int8_t, int8_t );+complexOf_int16_t mkPolar_fun_int16_t( int16_t, int16_t );+complexOf_int32_t mkPolar_fun_int32_t( int32_t, int32_t );+complexOf_int64_t mkPolar_fun_int64_t( int64_t, int64_t );+complexOf_uint8_t mkPolar_fun_uint8_t( uint8_t, uint8_t );+complexOf_uint16_t mkPolar_fun_uint16_t( uint16_t, uint16_t );+complexOf_uint32_t mkPolar_fun_uint32_t( uint32_t, uint32_t );+complexOf_uint64_t mkPolar_fun_uint64_t( uint64_t, uint64_t ); float complex mkPolar_fun_float( float, float );+double complex mkPolar_fun_double( double, double ); -complexOf_int8 cis_fun_int8( int8_t );-complexOf_int16 cis_fun_int16( int16_t );-complexOf_int32 cis_fun_int32( int32_t );-complexOf_int64 cis_fun_int64( int64_t );-complexOf_uint8 cis_fun_uint8( uint8_t );-complexOf_uint16 cis_fun_uint16( uint16_t );-complexOf_uint32 cis_fun_uint32( uint32_t );-complexOf_uint64 cis_fun_uint64( uint64_t );+complexOf_int8_t cis_fun_int8_t( int8_t );+complexOf_int16_t cis_fun_int16_t( int16_t );+complexOf_int32_t cis_fun_int32_t( int32_t );+complexOf_int64_t cis_fun_int64_t( int64_t );+complexOf_uint8_t cis_fun_uint8_t( uint8_t );+complexOf_uint16_t cis_fun_uint16_t( uint16_t );+complexOf_uint32_t cis_fun_uint32_t( uint32_t );+complexOf_uint64_t cis_fun_uint64_t( uint64_t ); float complex cis_fun_float( float );+double complex cis_fun_double( double );    void traceStart(); void traceEnd(); -void trace_int8( int8_t, int32_t );-void trace_int16( int16_t, int32_t );-void trace_int32( int32_t, int32_t );-void trace_int64( int64_t, int32_t );-void trace_uint8( uint8_t, int32_t );-void trace_uint16( uint16_t, int32_t );-void trace_uint32( uint32_t, int32_t );-void trace_uint64( uint64_t, int32_t );+void trace_int8_t( int8_t, int32_t );+void trace_int16_t( int16_t, int32_t );+void trace_int32_t( int32_t, int32_t );+void trace_int64_t( int64_t, int32_t );+void trace_uint8_t( uint8_t, int32_t );+void trace_uint16_t( uint16_t, int32_t );+void trace_uint32_t( uint32_t, int32_t );+void trace_uint64_t( uint64_t, int32_t ); void trace_float( float, int32_t );-void trace_complexOf_int8( complexOf_int8, int32_t );-void trace_complexOf_int16( complexOf_int16, int32_t );-void trace_complexOf_int32( complexOf_int32, int32_t );-void trace_complexOf_int64( complexOf_int64, int32_t );-void trace_complexOf_uint8( complexOf_uint8, int32_t );-void trace_complexOf_uint16( complexOf_uint16, int32_t );-void trace_complexOf_uint32( complexOf_uint32, int32_t );-void trace_complexOf_uint64( complexOf_uint64, int32_t );+void trace_double( double, int32_t );+void trace_complexOf_int8_t( complexOf_int8_t, int32_t );+void trace_complexOf_int16_t( complexOf_int16_t, int32_t );+void trace_complexOf_int32_t( complexOf_int32_t, int32_t );+void trace_complexOf_int64_t( complexOf_int64_t, int32_t );+void trace_complexOf_uint8_t( complexOf_uint8_t, int32_t );+void trace_complexOf_uint16_t( complexOf_uint16_t, int32_t );+void trace_complexOf_uint32_t( complexOf_uint32_t, int32_t );+void trace_complexOf_uint64_t( complexOf_uint64_t, int32_t ); void trace_complexOf_float( float complex, int32_t );+void trace_complexOf_double( double complex, int32_t );  #endif /* FELDSPAR_C99_H */

@@ -32,7 +32,10 @@ //#define LOG #include "log.h" -unsigned int ivar_linker_hook = 0xDECAFBAD;+int feldspar_ivar_hook(void)+{+  return 0;+}  void *worker( void *p ); 

@@ -33,6 +33,8 @@ #include "taskpool.h" #include "feldspar_array.h" +int feldspar_ivar_hook(void);+ /* Declaration of the Feldspar application's global taskpool. */ extern struct taskpool feldspar_taskpool; 

@@ -32,7 +32,10 @@ //#define LOG #include "log.h" -unsigned int taskpool_linker_hook = 0xDECAFBAD;+int feldspar_taskpool_hook(void)+{+  return 0;+}  /* Definition of the Feldspar application's global taskpool. */ struct taskpool *feldspar_taskpool = 0;

@@ -31,6 +31,8 @@  #include <pthread.h> +int feldspar_taskpool_hook(void);+ struct taskpool {     int capacity;@@ -63,7 +65,7 @@     {   \         void *buffer = malloc( sizeof(void(*)()) );   \         char *p = buffer;   \-        void *t0 = (task);    \+        void *t0 = &task;    \         memcpy( p, &t0, sizeof(void(*)()) );   \         spawn( buffer );    \     }   \@@ -72,7 +74,7 @@     {   \         void *buffer = malloc( sizeof(void(*)()) + sizeof(t1) );   \         char *p = buffer;   \-        void *t0 = task;    \+        void *t0 = &task;    \         t1 temp1 = (p1);    \         memcpy( p, &t0, sizeof(void(*)()) );   \         p += sizeof(void(*)()); \@@ -85,7 +87,7 @@     {   \         void *buffer = malloc( sizeof(void(*)()) + sizeof(t1) + sizeof(t2) );   \         char *p = buffer;   \-        void *t0 = task;    \+        void *t0 = &task;    \         t1 temp1 = (p1);    \         t2 temp2 = (p2);    \         memcpy( p, &t0, sizeof(void(*)()) );   \@@ -102,7 +104,7 @@     {   \         void *buffer = malloc( sizeof(void(*)()) + sizeof(t1) + sizeof(t2) + sizeof(t3) );   \         char *p = buffer;   \-        void *t0 = task;    \+        void *t0 = &task;    \         t1 temp1 = (p1);    \         t2 temp2 = (p2);    \         t3 temp3 = (p3);    \@@ -123,7 +125,7 @@     {   \         void *buffer = malloc( sizeof(void(*)()) + sizeof(t1) + sizeof(t2) + sizeof(t3) + sizeof(t4) );   \         char *p = buffer;   \-        void *t0 = task;    \+        void *t0 = &task;    \         t1 temp1 = (p1);    \         t2 temp2 = (p2);    \         t3 temp3 = (p3);    \@@ -148,7 +150,7 @@     {   \         void *buffer = malloc( sizeof(void(*)()) + sizeof(t1) + sizeof(t2) + sizeof(t3) + sizeof(t4) + sizeof(t5) );   \         char *p = buffer;   \-        void *t0 = task;    \+        void *t0 = &task;    \         t1 temp1 = (p1);    \         t2 temp2 = (p2);    \         t3 temp3 = (p3);    \@@ -177,7 +179,7 @@     {   \         void *buffer = malloc( sizeof(void(*)()) + sizeof(t1) + sizeof(t2) + sizeof(t3) + sizeof(t4) + sizeof(t5) + sizeof(t6) );   \         char *p = buffer;   \-        void *t0 = task;    \+        void *t0 = &task;    \         t1 temp1 = (p1);    \         t2 temp2 = (p2);    \         t3 temp3 = (p3);    \@@ -210,7 +212,7 @@     {   \         void *buffer = malloc( sizeof(void(*)()) + sizeof(t1) + sizeof(t2) + sizeof(t3) + sizeof(t4) + sizeof(t5) + sizeof(t6) + sizeof(t7) );   \         char *p = buffer;   \-        void *t0 = task;    \+        void *t0 = &task;    \         t1 temp1 = (p1);    \         t2 temp2 = (p2);    \         t3 temp3 = (p3);    \

@@ -1,43 +1,24 @@------ Copyright (c) 2009-2011, ERICSSON AB--- All rights reserved.--- --- Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are met:--- ---     * Redistributions of source code must retain the above copyright notice, ---       this list of conditions and the following disclaimer.---     * Redistributions in binary form must reproduce the above copyright---       notice, this list of conditions and the following disclaimer in the---       documentation and/or other materials provided with the distribution.---     * Neither the name of the ERICSSON AB nor the names of its contributors---       may be used to endorse or promote products derived from this software---       without specific prior written permission.--- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"--- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE--- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE --- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE--- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL--- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR--- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER--- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,--- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE--- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.---  module Feldspar.Compiler-    ( defaultOptions+    ( compile+    , icompile+    , icompileWith+    , icompile'+    , getCore+    , printCore+    , Options (..)+    , defaultOptions+    , FeldOpts(..)+    , Target(..)     , c99PlatformOptions+    , c99OpenMpPlatformOptions     , tic64xPlatformOptions+    , nativeArrayRules     , unrollOptions     , noPrimitiveInstructionHandling     , noMemoryInformation-    , module Internal     ) where -import Feldspar.Compiler.Compiler-import Feldspar.Compiler.Frontend.Interactive.Interface as Internal-import Feldspar.Compiler.Backend.C.Options              as Internal-import Feldspar.Compiler.Imperative.Frontend            as Internal hiding (Type, spawn)+import Feldspar.Compiler.Internal+import Feldspar.Core.Interpretation (FeldOpts(..), Target(..)) 

@@ -1,11 +1,11 @@ -- -- Copyright (c) 2009-2011, ERICSSON AB -- All rights reserved.--- +-- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are met:--- ---     * Redistributions of source code must retain the above copyright notice, +--+--     * Redistributions of source code must retain the above copyright notice, --       this list of conditions and the following disclaimer. --     * Redistributions in binary form must reproduce the above copyright --       notice, this list of conditions and the following disclaimer in the@@ -13,10 +13,10 @@ --     * Neither the name of the ERICSSON AB nor the names of its contributors --       may be used to endorse or promote products derived from this software --       without specific prior written permission.--- +-- -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE--- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR@@ -26,119 +26,241 @@ -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleInstances #-}  module Feldspar.Compiler.Backend.C.CodeGeneration where  import Feldspar.Compiler.Imperative.Representation-import Feldspar.Compiler.Error+import Feldspar.Compiler.Error (handleError, ErrorClass(..)) import Feldspar.Compiler.Backend.C.Options-import Feldspar.Compiler.Backend.C.Library--import qualified Data.List as List (find)+import Feldspar.Compiler.Imperative.Frontend (isNativeArray) --- =======================--- == C code generation ==--- =======================+import Text.PrettyPrint  codeGenerationError :: ErrorClass -> String -> a codeGenerationError = handleError "CodeGeneration" -defaultMemberName :: String-defaultMemberName = "member"+data PrintEnv = PEnv+    { options :: Options+    } -class ToC a where-    toC :: Options -> Place -> a -> String+compToCWithInfos :: Options -> Module () -> String+compToCWithInfos opts procedure = render $ cgen (PEnv opts) procedure -getStructTypeName :: Options -> Place -> Type -> String-getStructTypeName options place (StructType ts) =-    '_' : concatMap (\(_,t) -> (++"_") $ getStructTypeName options place t) ts-getStructTypeName options place (ArrayType len innerType) =-    "arr_T" ++ getStructTypeName options place innerType ++ "_S" ++ len2str len-    where-        len2str :: Length -> String-        len2str UndefinedLen = "UD"-        len2str (LiteralLen i) = show i-getStructTypeName options place t = replace (toC options place t) " " "" -- float complex -> floatcomplex+class CodeGen a+  where+    cgen     :: PrintEnv -> a -> Doc+    cgenList :: PrintEnv -> [a] -> Doc -instance ToC Type where-    toC _ MainParameter_pl VoidType = "void"-    toC _ _ VoidType = "int"-    toC options place t@(StructType _) = "struct s" ++ getStructTypeName options place t-    toC _ _ (UserType u) = u-    toC _ _ (ArrayType _ _) = arrayTypeName-    toC _ _ (IVarType _) = ivarTypeName-    toC options place t = case List.find (\(t',_,_) -> t == t') $ types $ platform options of-        Just (_,s,_)  -> s-        Nothing       -> codeGenerationError InternalError $-                         "Unhandled type in platform " ++ name (platform options) ++ ": " ++ show t ++ " place: " ++ show place+instance CodeGen (Module ())+  where+    cgen env Module{..} = cgenList env entities+    cgenList env = sep . map (cgen env) -instance ToC (Variable ()) where-    toC options place (Variable vname typ role _) = showVariable options place role typ vname+instance CodeGen (Entity ())+  where+    cgen env StructDef{..} = text "struct"   <+> text structName     $+$ block env (cgenList env structMembers) <> semi+    cgen env TypeDef{..}   = text "typedef"  <+> cgen env actualType <+> text typeName <> semi+    cgen env Proc{..}+      | Just body <- procBody = start $$ block env (cgen env body)+      | otherwise = start <> semi+        where+         start = text "void" <+> text procName <> parens (pvars env $ inParams ++ outParams)+    cgen env ValueDef{..} = static <+> typ <+> text "const" <+> name <+> equals <+> vals <> semi+      where+        static = text "static"+        typ  = cgen env (typeof valVar)+        name = cgen env valVar <> size valValue+        vals = cgen env valValue+        size (ArrayConst vs) = brackets $ text $ show $ length vs+        size _               = empty -showVariable :: Options -> Place -> VariableRole -> Type -> String -> String-showVariable options place role typ vname  = listprint id " " [variableType, showName role place typ vname] where-    variableType = showType options role place typ restr-    restr-        | place == MainParameter_pl = isRestrict $ platform options-        | otherwise = NoRestrict+    cgenList env = vcat . punctuate (text "\n") . map (cgen env) -showType :: Options -> VariableRole -> Place -> Type -> IsRestrict -> String-showType options role MainParameter_pl t _-    | passByReference t || role == Pointer  = tname ++ " *"-    | otherwise                             = tname+instance CodeGen (StructMember ())   where-    tname = toC options MainParameter_pl t-showType options _ Declaration_pl t _ = toC options Declaration_pl t-showType _ _ _ _ _ = ""+    cgen env StructMember{..} = cgen env structMemberType <+> text structMemberName <> sizeInBrackets structMemberType <> semi -arrayTypeName :: String-arrayTypeName = "struct array"+    cgenList env = vcat . map (cgen env) -ivarTypeName :: String-ivarTypeName = "struct ivar"+instance CodeGen (Block ())+  where+    cgen env Block{..} = sep [ cgenList env locals+                            , if null locals then empty else text ""+                            , cgen env blockBody+                            ]+    cgenList env = sep . punctuate (text "\n") . map (cgen env) -showName :: VariableRole -> Place -> Type -> String  -> String-showName Value place t n-    | place == AddressNeed_pl = '&' : n-    | place == FunctionCallIn_pl && passByReference t  = '&' : n-    | otherwise = n-showName Pointer _ ArrayType{} n = n-showName Pointer place _ n-    | place == AddressNeed_pl   = n-    | place == Declaration_pl   = codeGenerationError InternalError "Output variable of the function declared!"-    | place == MainParameter_pl = n-    | otherwise = "(* " ++ n ++ ")"+instance CodeGen (Declaration ())+  where+    cgen env Declaration{..} = pvar env declVar <+> nest (nestSize $ options env) initial <> semi+      where+        initial = case (initVal, varType declVar) of+                    (Just i, _)           -> equals <+> cgen env i+                    (_     , Pointer{})   -> equals <+> text "NULL"+                    (_     , ArrayType{}) -> equals <+> text "NULL"+                    _                     -> empty+    cgenList env = vcat . map (cgen env) -passByReference :: Type -> Bool-passByReference ArrayType{}  = True-passByReference StructType{} = True-passByReference _            = False+instance CodeGen (Program ())+  where+    cgen _   Empty = empty+    cgen _   Comment{..}+      | isBlockComment = blockComment $ map text $ lines commentValue+      | otherwise      = text "//" <+> text commentValue+    cgen env Assign{..} = cgen env lhs <+> equals <+> nest (nestSize $ options env) (cgen env rhs) <> semi+    cgen env ProcedureCall{..} = stmt $ call (text procCallName) (map (cgen env) procCallParams)+    cgen env Sequence{..} = cgenList env sequenceProgs+    cgen env (Switch scrut [(Pat (ConstExpr (BoolConst True)), thenBlock),+                            (Pat (ConstExpr (BoolConst False)), elseBlock)])+                        = text "if" <+> parens (cgen env scrut)+                       $$ block env (cgen env thenBlock)+                       $$ text "else"+                       $$ block env (cgen env elseBlock)+    cgen env Switch{..} =  text "switch" <+> parens (cgen env scrutinee)+                       $$ block env (vcat [ cgen env p $$ nest (nestSize $ options env) (cgen env b $$ text "break" <> semi) | (p, b) <- alts])+    cgen env SeqLoop{..} =  cgen env sLoopCondCalc+                        $$ text "while" <+> parens (cgen env sLoopCond)+                        $$ block env (cgen env sLoopBlock $+$ cgen env sLoopCondCalc)+    cgen env ParLoop{..}+     | pParallel && (name . platform . options $ env) == "c99OpenMp"+     = text "#pragma omp parallel for" $$ forL+     | otherwise = forL+      where+        forL  = text "for" <+> parens (sep $ map (nest 4) $ punctuate semi [ini, guard, next])+              $$ block env (cgen env pLoopBlock)+        ixd   = pvar env pLoopCounter+        ixv   = cgen env  pLoopCounter+        ini   = ixd <+> equals    <+> int 0+        guard = ixv <+> char '<'  <+> cgen env pLoopBound+        next  = ixv <+> text "+=" <+> cgen env pLoopStep -------------------------- Helper functions -------------------------+    cgen env BlockProgram{..} = block env (cgen env blockProgram) -ind :: (a-> String) -> a -> String-ind f x = unlines $ map (\a -> "    " ++ a) $ lines $ f x+    cgenList env = vcat . map (cgen env) -listprint :: (a->String) -> String -> [a] -> String-listprint f s = listprint' . filter (/= "") . map f+instance CodeGen (Pattern ())   where-    listprint' [] = ""-    listprint' [x] = x-    listprint' (x:xs) = x ++ s ++ listprint' xs+    cgen _   PatDefault = text "default" <> colon+    cgen env (Pat c)    = text "case" <+> cgen env c <> colon -decrArrayDepth :: Type -> Type-decrArrayDepth (ArrayType _ t) = t-decrArrayDepth t = codeGenerationError InternalError $ "Non-array variable of type " ++ show t ++ " is indexed!"+    cgenList env = vcat . map (cgen env) -getStructFieldType :: String -> Type -> Type-getStructFieldType f (StructType l) = case List.find (\(a,_) -> a == f) l of-    Just (_,t) -> t-    Nothing -> structFieldNotFound f-getStructFieldType f t = codeGenerationError InternalError $-    "Trying to get a struct field from not a struct typed expression\n" ++ "Field: " ++ f ++ "\nType:  " ++ show t+instance CodeGen (ActualParameter ())+  where+    cgen env ValueParameter{..}      = cgen env valueParam+    cgen env TypeParameter{..}       = cgen env typeParam+    cgen _   FunParameter{..}        = text funParamName+    cgenList env = hsep . punctuate comma . map (cgen env) -structFieldNotFound :: String -> a-structFieldNotFound f = codeGenerationError InternalError $ "Not found struct field with this name: " ++ f+instance CodeGen (Expression ())+  where+    cgen env VarExpr{..} = cgen env varExpr+    cgen env e@ArrayElem{..}+     | c@ConstExpr{} <- array+     , (NativeArray _ t) <- typeof c+     = parens (parens (cgen env t <> brackets empty) <> cgen env c) <> brackets (cgen env arrayIndex)+     | isNativeArray $ typeof array+     = cgen env array <> brackets (cgen env arrayIndex)+     | otherwise = text "at" <> parens (hcat $ punctuate comma [ cgen env $ typeof e+                                                               , cgen env array+                                                               , cgen env arrayIndex+                                                               ])+    cgen env StructField{..}  = parens (cgen env struct) <> char '.' <> text fieldName+    cgen env ConstExpr{..}    = cgen env constExpr+    cgen env FunctionCall{..}+        | funName function == "!"   = call (text "at") $ map (cgen env) funCallParams+        | funMode function == Infix+        , [a,b] <- funCallParams    = parens (cgen env a <+> text (funName function) <+> cgen env b)+        | otherwise                 = call (text $ funName function) $ map (cgen env) funCallParams+    cgen env Cast{..} = parens $ parens (cgen env castType) <> parens (cgen env castExpr)+    cgen env AddrOf{..}+        | VarExpr v@(Variable{..}) <- addrExpr+        , Pointer t <- typeof addrExpr = cgen env (v{varType = t})+        | otherwise                      = prefix <> cgen env addrExpr+     where+       prefix = case (addrExpr, typeof addrExpr) of+                 (e, Pointer{}) | specialConstruct e -> empty -- Skip single level AddrOf+                   where specialConstruct ArrayElem{}   = True+                         specialConstruct StructField{} = True+                         specialConstruct _             = False++                 _                          -> text "&"+    cgen env SizeOf{..} = call (text "sizeof") [cgen env sizeOf]++    cgenList env = sep . punctuate comma . map (cgen env)++instance CodeGen (Variable t)+  where+    cgen _ = go+      where+        go v@Variable{..} = case varType of+                   Pointer t -> text "*" <> go (v {varType = t})-- char '*'+                   _         -> text varName++    cgenList env = hsep . punctuate comma . map (cgen env)++instance CodeGen (Constant ())+  where+    cgen env cnst@(IntConst c _)    = maybe (integer c) text $ transformConst env cnst+    cgen env cnst@(DoubleConst c)   = maybe (double c)  text $ transformConst env cnst+    cgen env cnst@(FloatConst c)    = maybe (float c)   text $ transformConst env cnst+    cgen env cnst@(BoolConst False) = maybe (int 0)     text $ transformConst env cnst+    cgen env cnst@(BoolConst True)  = maybe (int 1)     text $ transformConst env cnst+    cgen env      (ArrayConst cs)   = braces (cgenList env cs)+    cgen env cnst@ComplexConst{..}  = maybe cmplxCnst   text $ transformConst env cnst+      where+        cmplxCnst = text "complex" <> parens (cgenList env [realPartComplexValue, imagPartComplexValue])+    cgenList env = sep . punctuate comma . map (cgen env)++transformConst :: PrintEnv -> Constant () -> Maybe String+transformConst PEnv{..} cnst = do+    f <- lookup (typeof cnst) $ values $ platform options+    return $ f cnst++instance CodeGen Type+  where+    cgen env = toC+      where+        toC VoidType                   = text "void"+        toC ArrayType{}                = text "struct array *"+        toC IVarType{}                 = text "struct ivar"+        toC (UserType u)               = text u+        toC (StructType n _)           = text "struct" <+> text n+        toC (NativeArray _ t)          = toC t+        toC (Pointer t)                = toC t <+> text "*"+        toC t | Just s <- lookup t pts = text s+        toC t = codeGenerationError InternalError+              $ unwords ["Unhandled type in platform ", name pfm,  ": ", show t]+        pfm = platform $ options env+        pts = types pfm++    cgenList env = sep . map (cgen env)++call :: Doc -> [Doc] -> Doc+call fn args = fn <> parens (hsep $ punctuate comma args)++blockComment :: [Doc] -> Doc+blockComment ds = vcat (zipWith (<+>) (text "/*" : repeat (text " *")) ds)+                  $$ text " */"++sizeInBrackets :: Type -> Doc+sizeInBrackets (NativeArray l t) = brackets (maybe empty (text . show) l) <> sizeInBrackets t+sizeInBrackets _                 = empty++stmt :: Doc -> Doc+stmt = (<>semi)++block :: PrintEnv -> Doc -> Doc+block env d = lbrace $+$ nest (nestSize $ options env) d $+$ rbrace++pvar :: PrintEnv -> Variable t -> Doc+pvar env Variable{..} = typ <+> (name <> size)+  where+    typ  = cgen env varType+    size = sizeInBrackets varType+    name = text varName++pvars :: PrintEnv -> [Variable t] -> Doc+pvars env = hsep . punctuate comma . map (pvar env)

@@ -26,37 +26,26 @@ -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- -module Feldspar.Compiler.Backend.C.Library-    (module System.Console.ANSI,-     module Feldspar.Compiler.Backend.C.Library) where--import Control.Monad.State-import System.Console.ANSI-import System.FilePath-import qualified Feldspar.Compiler.Imperative.Representation as AIR+module Feldspar.Compiler.Backend.C.Library where -data CompilationMode = Interactive | Standalone-    deriving (Show, Eq)+import Data.List (isPrefixOf)+import System.FilePath ((<.>)) -type AllocationInfo = ([AIR.Type],[AIR.Type],[AIR.Type])-     -- =========================================================================== --  == String tools -- ===========================================================================  replace :: Eq a => [a] -> [a] -> [a] -> [a] replace [] _ _ = []-replace s find repl | take (length find) s == find = repl ++ replace (drop (length find) s) find repl+replace s find repl | find `isPrefixOf` s = repl ++ replace (drop (length find) s) find repl                     | otherwise = head s : replace (tail s) find repl -fixFunctionName :: String -> String-fixFunctionName functionName = replace (replace functionName "_" "__") "'" "_prime"--makeDebugHFileName :: String -> String-makeDebugHFileName = (<.> "h.dbg.txt")+-- | Encode special characters in function names +encodeFunctionName :: String -> String+encodeFunctionName functionName = replace (replace functionName "_" "__") "'" "_prime" -makeDebugCFileName :: String -> String-makeDebugCFileName = (<.> "c.dbg.txt")+makeDebugFileName :: String -> String+makeDebugFileName = (<.> "dbg.txt")  makeHFileName :: String -> String makeHFileName = (<.> "h")@@ -64,22 +53,3 @@ makeCFileName :: String -> String makeCFileName = (<.> "c") --- ===========================================================================---  == Name generator--- ===========================================================================--newName  :: (Monad m) => String -> StateT Integer m String-newName name = do-    n <- get-    put $ n+1-    return $ name ++ show n---- ===========================================================================---  == Console tools--- ===========================================================================--withColor :: Color -> IO () -> IO ()-withColor color action = do-    setSGR [SetColor Foreground Vivid color, SetColor Background Dull Black] -- , SetConsoleIntensity BoldIntensity]-    action-    setSGR [Reset]

@@ -36,19 +36,22 @@ module Feldspar.Compiler.Backend.C.Options where  import Data.Typeable-import Text.Show.Functions -import Feldspar.Compiler.Imperative.Representation-import Feldspar.Compiler.Imperative.Frontend hiding (UserType, Type, Var)+import Feldspar.Core.Interpretation (FeldOpts(..)) +import Feldspar.Compiler.Imperative.Representation (Type(..), Constant(..))+ data Options =     Options     { platform          :: Platform     , unroll            :: UnrollStrategy     , debug             :: DebugOption     , memoryInfoVisible :: Bool+    , printHeader       :: Bool     , rules             :: [Rule]-    } deriving (Eq, Show)+    , frontendOpts      :: FeldOpts+    , nestSize          :: Int -- ^ Indentation size for PrettyPrinting+    }  data UnrollStrategy = NoUnroll | Unroll Int     deriving (Eq, Show)@@ -58,12 +61,13 @@  data Platform = Platform {     name            :: String,-    types           :: [(Type, String, String)],+    types           :: [(Type, String)],     values          :: [(Type, ShowValue)],     includes        :: [String],     platformRules   :: [Rule],+    varFloating     :: Bool,     isRestrict      :: IsRestrict-} deriving (Eq, Show)+} deriving (Show)  type ShowValue = Constant () -> String @@ -91,11 +95,11 @@ instance Eq Rule where     _ == _ = False -rule :: (Interface t, Typeable (Repr t)) => (t -> [Action (Repr t)]) -> Rule-rule f = Rule $ \x -> f $ toInterface x+rule :: (Typeable t) => (t -> [Action t]) -> Rule+rule f = Rule $ \x -> f x -replaceWith :: (Interface t) => t -> Action (Repr t)-replaceWith = Replace . fromInterface+replaceWith :: t -> Action t+replaceWith = Replace -propagate :: (Interface t, Typeable (Repr t)) => (t -> [Action (Repr t)]) -> Action t'+propagate :: (Typeable t) => (t -> [Action t]) -> Action t' propagate = Propagate . rule

@@ -27,83 +27,101 @@ --  {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE RecordWildCards #-}  module Feldspar.Compiler.Backend.C.Platforms     ( availablePlatforms     , c99+    , c99OpenMp     , tic64x     , c99Rules     , tic64xRules     , traceRules+    , nativeArrayRules     ) where +import Data.Maybe (fromMaybe) +import Feldspar.Range import Feldspar.Compiler.Backend.C.Options-import Feldspar.Compiler.Imperative.Representation hiding (Type, Cast, In, Out, Block)+import Feldspar.Compiler.Imperative.Representation import Feldspar.Compiler.Imperative.Frontend  availablePlatforms :: [Platform]-availablePlatforms = [ c99, tic64x ]+availablePlatforms = [ c99, c99OpenMp, tic64x ]  c99 :: Platform c99 = Platform {     name = "c99",     types =-        [ (NumType Signed S8,    "int8_t",   "int8")-        , (NumType Signed S16,   "int16_t",  "int16")-        , (NumType Signed S32,   "int32_t",  "int32")-        , (NumType Signed S64,   "int64_t",  "int64")-        , (NumType Unsigned S8,  "uint8_t",  "uint8")-        , (NumType Unsigned S16, "uint16_t", "uint16")-        , (NumType Unsigned S32, "uint32_t", "uint32")-        , (NumType Unsigned S64, "uint64_t", "uint64")-        , (BoolType,  "uint32_t",    "uint32_t") -- TODO sizeof(bool) is implementation dependent-        , (FloatType, "float",  "float")-        , (ComplexType FloatType,              "float complex",    "complexOf_float")+        [ (NumType Signed S8,     "int8_t")+        , (NumType Signed S16,    "int16_t")+        , (NumType Signed S32,    "int32_t")+        , (NumType Signed S64,    "int64_t")+        , (NumType Unsigned S8,   "uint8_t")+        , (NumType Unsigned S16,  "uint16_t")+        , (NumType Unsigned S32,  "uint32_t")+        , (NumType Unsigned S64,  "uint64_t")+        , (BoolType,              "uint32_t")+        , (FloatType,             "float")+        , (DoubleType,            "double")+        , (ComplexType FloatType, "float complex")+        , (ComplexType DoubleType,"double complex")         ] ,     values =         [ (ComplexType FloatType, \cx -> "(" ++ showRe cx ++ "+" ++ showIm cx ++ "i)")+        , (ComplexType DoubleType, \cx -> "(" ++ showRe cx ++ "+" ++ showIm cx ++ "i)")         , (BoolType, \b -> if boolValue b then "true" else "false")         ] ,     includes =-        [ "\"feldspar_c99.h\""-        , "\"feldspar_array.h\""-        , "\"feldspar_future.h\""-        , "\"ivar.h\""-        , "\"taskpool.h\""+        [ "feldspar_c99.h"+        , "feldspar_array.h"+        , "feldspar_future.h"+        , "ivar.h"+        , "taskpool.h"         , "<stdint.h>"         , "<string.h>"         , "<math.h>"         , "<stdbool.h>"         , "<complex.h>"],-    platformRules = c99Rules ++ traceRules,+    platformRules = c99Rules ++ traceRules ++ arrayRules,+    varFloating = True,     isRestrict = NoRestrict } +c99OpenMp :: Platform+c99OpenMp = c99 { name = "c99OpenMp"+                , varFloating = False+                }+ tic64x :: Platform tic64x = Platform {     name = "tic64x",     types =-        [ (NumType Signed S8,    "char",     "char")-        , (NumType Signed S16,   "short",    "short")-        , (NumType Signed S32,   "int",      "int")-        , (NumType Signed S40,   "long",     "long")-        , (NumType Signed S64,   "long long","llong")-        , (NumType Unsigned S8,  "unsigned char",  "uchar")-        , (NumType Unsigned S16, "unsigned short", "ushort")-        , (NumType Unsigned S32, "unsigned",       "uint")-        , (NumType Unsigned S40, "unsigned long",  "ulong")-        , (NumType Unsigned S64, "unsigned long long", "ullong")-        , (BoolType,  "int",    "bool")-        , (FloatType, "float",  "float")-        , (ComplexType FloatType,              "complexOf_float",  "complexOf_float")+        [ (NumType Signed S8,     "char")+        , (NumType Signed S16,    "short")+        , (NumType Signed S32,    "int")+        , (NumType Signed S40,    "long")+        , (NumType Signed S64,    "long long")+        , (NumType Unsigned S8,   "unsigned char")+        , (NumType Unsigned S16,  "unsigned short")+        , (NumType Unsigned S32,  "unsigned")+        , (NumType Unsigned S40,  "unsigned long")+        , (NumType Unsigned S64,  "unsigned long long")+        , (BoolType,              "int")+        , (FloatType,             "float")+        , (DoubleType,            "double")+        , (ComplexType FloatType, "complexOf_float")+        , (ComplexType DoubleType,"complexOf_double")         ] ,     values =          [ (ComplexType FloatType, \cx -> "complex_fun_float(" ++ showRe cx ++ "," ++ showIm cx ++ ")")+        , (ComplexType DoubleType, \cx -> "complex_fun_double(" ++ showRe cx ++ "," ++ showIm cx ++ ")")         , (BoolType, \b -> if boolValue b then "1" else "0")         ] ,-    includes = ["\"feldspar_tic64x.h\"", "\"feldspar_array.h\"", "<c6x.h>", "<string.h>", "<math.h>"],+    includes = ["feldspar_tic64x.h", "feldspar_array.h", "<c6x.h>", "<string.h>", "<math.h>"],     platformRules = tic64xRules ++ c99Rules ++ traceRules,+    varFloating = True,     isRestrict = Restrict } @@ -112,168 +130,249 @@ showIm = showConstant . imagPartComplexValue  showConstant :: Constant t -> String-showConstant (IntConst c _ _ _)    = show c-showConstant (FloatConst c _ _)  = show c ++ "f"+showConstant (DoubleConst c) = show c ++ "f"+showConstant (FloatConst c)  = show c ++ "f"+showConstant c               = show c -c99Rules :: [Rule]-c99Rules = [rule copy, rule c99]+arrayRules :: [Rule]+arrayRules = [rule copy]   where-    copy (Call "copy" [Out arg1, In arg2])-        | isArray (typeof arg1) = [replaceWith $ Call "copyArray" [Out arg1,In arg2]]-        | otherwise = [replaceWith $ arg1 := arg2]+    copy (ProcedureCall "copy" [ValueParameter arg1, ValueParameter arg2])+        | arg1 == arg2+        = [replaceWith Empty]++        | ConstExpr ArrayConst{..} <- arg2+        = [replaceWith $ Sequence $ initArray (Just arg1) (litI32 $ toInteger $ length arrayValues):zipWith (\i c -> Assign (ArrayElem arg1 (litI32 i)) (ConstExpr c)) [0..] arrayValues]++        | NativeArray{} <- typeof arg2+        , l@(ConstExpr (IntConst n _)) <- arrayLength arg2+        = [replaceWith $ Sequence $ initArray (Just arg1) l:map (\i -> Assign (ArrayElem arg1 (litI32 i)) (ArrayElem arg2 (litI32 i))) [0..(n-1)]]++        | not (isArray (typeof arg1))+        = [replaceWith $ Assign arg1 arg2]++    copy (ProcedureCall "copy" (dst@(ValueParameter arg1):ins'@(ValueParameter in1:ins)))+        | isArray (typeof arg1)+        = [replaceWith $ Sequence ([+               initArray (Just arg1) (foldr ePlus (litI32 0) aLens)+             , if arg1 == in1 then Empty else call "copyArray" [dst, ValueParameter in1]+             ] ++ flattenCopy dst ins argnLens arg1len)]+           where+             aLens@(arg1len:argnLens) = map (\(ValueParameter src) -> arrayLength src) ins'++    copy (ProcedureCall "copy" _) = error "Multiple scalar arguments to copy"+     copy _ = []-    c99 (Fun _ "(!)" [arg1,arg2])    = [replaceWith $ arg1 :!: arg2]-    c99 (Fun _ "getFst" [arg]) = [replaceWith $ arg :.: first]-    c99 (Fun _ "getSnd" [arg]) = [replaceWith $ arg :.: second]-    c99 (Fun t "(==)" [arg1, arg2])  = [replaceWith $ Binop t "==" [arg1, arg2]]-    c99 (Fun t "(/=)" [arg1, arg2])  = [replaceWith $ Binop t "!=" [arg1, arg2]]-    c99 (Fun t "(<)" [arg1, arg2])   = [replaceWith $ Binop t "<" [arg1, arg2]]-    c99 (Fun t "(>)" [arg1, arg2])   = [replaceWith $ Binop t ">" [arg1, arg2]]-    c99 (Fun t "(<=)" [arg1, arg2])  = [replaceWith $ Binop t "<=" [arg1, arg2]]-    c99 (Fun t "(>=)" [arg1, arg2])  = [replaceWith $ Binop t ">=" [arg1, arg2]]-    c99 (Fun t "not" [arg])  = [replaceWith $ Fun t "!" [arg]]-    c99 (Fun t "(&&)" [arg1, arg2])  = [replaceWith $ Binop t "&&" [arg1, arg2]]-    c99 (Fun t "(||)" [arg1, arg2])  = [replaceWith $ Binop t "||" [arg1, arg2]]-    c99 (Fun t "quot" [arg1, arg2])  = [replaceWith $ Binop t "/" [arg1, arg2]]-    c99 (Fun t "rem" [arg1, arg2])   = [replaceWith $ Binop t "%" [arg1, arg2]]-    c99 (Fun t "(^)" [arg1, arg2])   = [replaceWith $ Fun t (extend "pow" t) [arg1, arg2]]-    c99 (Fun t "abs" [arg])  = [replaceWith $ Fun t (extend "abs" t) [arg]]-    c99 (Fun t "signum" [arg])   = [replaceWith $ Fun t (extend "signum" t) [arg]]-    c99 (Fun t "(+)" [arg1, arg2])   = [replaceWith $ Binop t "+" [arg1, arg2]]-    c99 (Fun t "(-)" [LitI _ 0, arg2])   = [replaceWith $ Fun t "-" [arg2]]-    c99 (Fun t "(-)" [LitF 0, arg2]) = [replaceWith $ Fun t "-" [arg2]]-    c99 (Fun t "(-)" [arg1, arg2])   = [replaceWith $ Binop t "-" [arg1, arg2]]-    c99 (Fun t "(*)" [LitI _ (log2 -> Just n), arg2])    = [replaceWith $ Binop t "<<" [arg2, LitI I32 n]]-    c99 (Fun t "(*)" [arg1, LitI _ (log2 -> Just n)])    = [replaceWith $ Binop t "<<" [arg1, LitI I32 n]]-    c99 (Fun t "(*)" [arg1, arg2])   = [replaceWith $ Binop t "*" [arg1, arg2]]-    c99 (Fun t "(/)" [arg1, arg2])   = [replaceWith $ Binop t "/" [arg1, arg2]]-    c99 (Fun t@(Complex _) "exp" [arg])  = [replaceWith $ Fun t "cexpf" [arg]]-    c99 (Fun t "exp" [arg])  = [replaceWith $ Fun t "expf" [arg]]-    c99 (Fun t@(Complex _) "sqrt" [arg]) = [replaceWith $ Fun t "csqrtf" [arg]]-    c99 (Fun t "sqrt" [arg]) = [replaceWith $ Fun t "sqrtf" [arg]]-    c99 (Fun t@(Complex _) "log" [arg])  = [replaceWith $ Fun t "clogf" [arg]]-    c99 (Fun t "log" [arg])  = [replaceWith $ Fun t "logf" [arg]]-    c99 (Fun t@(Complex _) "(**)" [arg1, arg2])  = [replaceWith $ Fun t "cpowf" [arg1,arg2]]-    c99 (Fun t "(**)" [arg1, arg2])  = [replaceWith $ Fun t "powf" [arg1,arg2]]-    c99 (Fun t "logBase" [arg1, arg2])   = [replaceWith $ Fun t (extend "logBase" t) [arg1,arg2]]-    c99 (Fun t@(Complex _) "sin" [arg])  = [replaceWith $ Fun t "csinf" [arg]]-    c99 (Fun t "sin" [arg])  = [replaceWith $ Fun t "sinf" [arg]]-    c99 (Fun t@(Complex _) "tan" [arg])  = [replaceWith $ Fun t "ctanf" [arg]]-    c99 (Fun t "tan" [arg])  = [replaceWith $ Fun t "tanf" [arg]]-    c99 (Fun t@(Complex _) "cos" [arg])  = [replaceWith $ Fun t "ccosf" [arg]]-    c99 (Fun t "cos" [arg])  = [replaceWith $ Fun t "cosf" [arg]]-    c99 (Fun t@(Complex _) "asin" [arg]) = [replaceWith $ Fun t "casinf" [arg]]-    c99 (Fun t "asin" [arg]) = [replaceWith $ Fun t "asinf" [arg]]-    c99 (Fun t@(Complex _) "atan" [arg]) = [replaceWith $ Fun t "catanf" [arg]]-    c99 (Fun t "atan" [arg]) = [replaceWith $ Fun t "atanf" [arg]]-    c99 (Fun t@(Complex _) "acos" [arg]) = [replaceWith $ Fun t "cacosf" [arg]]-    c99 (Fun t "acos" [arg]) = [replaceWith $ Fun t "acosf" [arg]]-    c99 (Fun t@(Complex _) "sinh" [arg]) = [replaceWith $ Fun t "csinhf" [arg]]-    c99 (Fun t "sinh" [arg]) = [replaceWith $ Fun t "sinhf" [arg]]-    c99 (Fun t@(Complex _) "tanh" [arg]) = [replaceWith $ Fun t "ctanhf" [arg]]-    c99 (Fun t "tanh" [arg]) = [replaceWith $ Fun t "tanhf" [arg]]-    c99 (Fun t@(Complex _) "cosh" [arg]) = [replaceWith $ Fun t "ccoshf" [arg]]-    c99 (Fun t "cosh" [arg]) = [replaceWith $ Fun t "coshf" [arg]]-    c99 (Fun t@(Complex _) "asinh" [arg])    = [replaceWith $ Fun t "casinhf" [arg]]-    c99 (Fun t "asinh" [arg])    = [replaceWith $ Fun t "asinhf" [arg]]-    c99 (Fun t@(Complex _) "atanh" [arg])    = [replaceWith $ Fun t "catanhf" [arg]]-    c99 (Fun t "atanh" [arg])    = [replaceWith $ Fun t "atanhf" [arg]]-    c99 (Fun t@(Complex _) "acosh" [arg])    = [replaceWith $ Fun t "cacoshf" [arg]]-    c99 (Fun t "acosh" [arg])    = [replaceWith $ Fun t "acoshf" [arg]]-    c99 (Fun t "(.&.)" [arg1, arg2]) = [replaceWith $ Binop t "&" [arg1, arg2]]-    c99 (Fun t "(.|.)" [arg1, arg2]) = [replaceWith $ Binop t "|" [arg1, arg2]]-    c99 (Fun t "xor" [arg1, arg2])   = [replaceWith $ Binop t "^" [arg1, arg2]]-    c99 (Fun t "complement" [arg])   = [replaceWith $ Fun t "~" [arg]]-    c99 (Fun t "bit" [arg])  = [replaceWith $ Binop t "<<" [LitI t 1, arg]]-    c99 (Fun t "setBit" [arg1, arg2])    = [replaceWith $ Fun t (extend "setBit" t) [arg1, arg2]]-    c99 (Fun t "clearBit" [arg1, arg2])  = [replaceWith $ Fun t (extend "clearBit" t) [arg1, arg2]]-    c99 (Fun t "complementBit" [arg1, arg2]) = [replaceWith $ Fun t (extend "complementBit" t) [arg1, arg2]]-    c99 (Fun t "testBit" [arg1, arg2])   = [replaceWith $ Fun t (extend "testBit" $ typeof arg1) [arg1, arg2]]-    c99 (Fun t "shiftL" [arg1, arg2])    = [replaceWith $ Binop t "<<" [arg1, arg2]]-    c99 (Fun t "shiftR" [arg1, arg2])    = [replaceWith $ Binop t ">>" [arg1, arg2]]-    c99 (Fun t "rotateL" [arg1, arg2])   = [replaceWith $ Fun t (extend "rotateL" t) [arg1, arg2]]-    c99 (Fun t "rotateR" [arg1, arg2])   = [replaceWith $ Fun t (extend "rotateR" t) [arg1, arg2]]-    c99 (Fun t "reverseBits" [arg])  = [replaceWith $ Fun t (extend "reverseBits" t) [arg]]-    c99 (Fun t "bitScan" [arg])  = [replaceWith $ Fun t (extend "bitScan" $ typeof arg) [arg]]-    c99 (Fun t "bitCount" [arg]) = [replaceWith $ Fun t (extend "bitCount" $ typeof arg) [arg]]-    c99 (Fun _ "bitSize" [intWidth . typeof -> Just n])  = [replaceWith $ LitI U32 n]-    c99 (Fun _ "isSigned" [intSigned . typeof -> Just b])    = [replaceWith $ litB b]-    c99 (Fun t "complex" [arg1, arg2])   = [replaceWith $ Fun t (extend "complex" $ typeof arg1) [arg1,arg2]]-    c99 (Fun t "creal" [arg])    = [replaceWith $ Fun t "crealf" [arg]]-    c99 (Fun t "cimag" [arg])    = [replaceWith $ Fun t "cimagf" [arg]]-    c99 (Fun t "conjugate" [arg])    = [replaceWith $ Fun t "conjf" [arg]]-    c99 (Fun t "magnitude" [arg])    = [replaceWith $ Fun t "cabsf" [arg]]-    c99 (Fun t "phase" [arg])    = [replaceWith $ Fun t "cargf" [arg]]-    c99 (Fun t "mkPolar" [arg1, arg2])   = [replaceWith $ Fun t (extend "mkPolar" $ typeof arg1) [arg1, arg2]]-    c99 (Fun t "cis" [arg])  = [replaceWith $ Fun t (extend "cis" $ typeof arg) [arg]]-    c99 (Fun t "f2i" [arg])  = [replaceWith $ Cast t $ Fun Floating "truncf" [arg]]-    c99 (Fun (Complex t) "i2n" [arg])    = [replaceWith $ Fun (Complex t) (extend "complex" t) [Cast t arg, LitF 0]]-    c99 (Fun t "i2n" [arg])  = [replaceWith $ Cast t arg]-    c99 (Fun t "b2i" [arg])  = [replaceWith $ Cast t arg]-    c99 (Fun t "round" [arg])    = [replaceWith $ Cast t $ Fun Floating "roundf" [arg]]-    c99 (Fun t "ceiling" [arg])  = [replaceWith $ Cast t $ Fun Floating "ceilf" [arg]]-    c99 (Fun t "floor" [arg])    = [replaceWith $ Cast t $ Fun Floating "floorf" [arg]]-    c99 _ = [] +nativeArrayRules :: [Rule]+nativeArrayRules = [rule toNativeExpr, rule toNativeProg, rule toNativeVariable]+  where+    toNativeExpr :: Expression () -> [Action (Expression ())]+    toNativeExpr _ = []++    toNativeProg (Assign _ (FunctionCall (Function "initArray" _ _) [arr,_,_]))+      | native (typeof arr) = [replaceWith $ call "assert" [ValueParameter arr]]+    toNativeProg (ProcedureCall "freeArray" [ValueParameter arr])+      | native (typeof arr) = [replaceWith Empty]+    toNativeProg _ = []+++    toNativeVariable :: Variable () -> [Action (Variable ())]+    toNativeVariable v@Variable{..} | isArray varType+      = [replaceWith $ v { varType = nativeArray varType }]+    toNativeVariable _ = []++    nativeArray (Pointer (ArrayType sz t)) = NativeArray (fromSingleton sz) (nativeArray t)    +    nativeArray (ArrayType sz t) = NativeArray (fromSingleton sz) (nativeArray t)+    nativeArray (Pointer t)      = Pointer (nativeArray t)+    nativeArray t = t++    native (NativeArray {}) = True+    native (Pointer t)      = native t+    native _                = False++    fromSingleton r = if isSingleton r+                        then Just $ upperBound r+                        else Nothing++flattenCopy :: ActualParameter () -> [ActualParameter ()] -> [Expression ()] -> Expression () -> [Program ()]+flattenCopy _ [] [] _ = []+flattenCopy dst (ValueParameter t:ts) (l:ls) cLen = call "copyArrayPos" [dst, ValueParameter cLen, ValueParameter t]+                                   : flattenCopy dst ts ls (ePlus cLen l)++ePlus :: Expression () -> Expression () -> Expression ()+ePlus (ConstExpr (IntConst 0 _)) e = e+ePlus e (ConstExpr (IntConst 0 _)) = e+ePlus e1 e2 = binop (NumType Signed S32) "+" e1 e2++c99Rules :: [Rule]+c99Rules = [rule go]+  where+    go :: Expression () -> [Action (Expression ())]+    go (FunctionCall (Function "(!)" _ _) [arg1,arg2])    = [replaceWith $ ArrayElem arg1 arg2]+    go (FunctionCall (Function "getFst" _ _) [arg]) = [replaceWith $ StructField arg first]+    go (FunctionCall (Function "getSnd" _ _) [arg]) = [replaceWith $ StructField arg second]+    go (FunctionCall (Function "(==)" t _) [arg1, arg2])  = [replaceWith $ binop t "==" arg1 arg2]+    go (FunctionCall (Function "(/=)" t _) [arg1, arg2])  = [replaceWith $ binop t "!=" arg1 arg2]+    go (FunctionCall (Function "(<)" t _) [arg1, arg2])   = [replaceWith $ binop t "<" arg1 arg2]+    go (FunctionCall (Function "(>)" t _) [arg1, arg2])   = [replaceWith $ binop t ">" arg1 arg2]+    go (FunctionCall (Function "(<=)" t _) [arg1, arg2])  = [replaceWith $ binop t "<=" arg1 arg2]+    go (FunctionCall (Function "(>=)" t _) [arg1, arg2])  = [replaceWith $ binop t ">=" arg1 arg2]+    go (FunctionCall (Function "not" t _) [arg])  = [replaceWith $ fun t "!" [arg]]+    go (FunctionCall (Function "(&&)" t _) [arg1, arg2])  = [replaceWith $ binop t "&&" arg1 arg2]+    go (FunctionCall (Function "(||)" t _) [arg1, arg2])  = [replaceWith $ binop t "||" arg1 arg2]+    go (FunctionCall (Function "quot" t _) [arg1, arg2])  = [replaceWith $ binop t "/" arg1 arg2]+    go (FunctionCall (Function "rem" t _) [arg1, arg2])   = [replaceWith $ binop t "%" arg1 arg2]+    go (FunctionCall (Function "(^)" t _) [arg1, arg2])   = [replaceWith $ fun t (extend c99 "pow" t) [arg1, arg2]]+    go (FunctionCall (Function "abs" t _) [arg])  = [replaceWith $ fun t (extend c99 "abs" t) [arg]]+    go (FunctionCall (Function "signum" t _) [arg])   = [replaceWith $ fun t (extend c99 "signum" t) [arg]]+    go (FunctionCall (Function "(+)" t _) [arg1, arg2])   = [replaceWith $ binop t "+" arg1 arg2]+    go (FunctionCall (Function "(-)" t _) [ConstExpr (IntConst 0 _), arg2]) = [replaceWith $ fun t "-" [arg2]]+    go (FunctionCall (Function "(-)" t _) [ConstExpr (FloatConst 0), arg2]) = [replaceWith $ fun t "-" [arg2]]+    go (FunctionCall (Function "(-)" t _) [arg1, arg2])   = [replaceWith $ binop t "-" arg1 arg2]+    go (FunctionCall (Function "(*)" t _) [ConstExpr (IntConst (log2 -> Just n) _), arg2])    = [replaceWith $ binop t "<<" arg2 (litI32 n)]+    go (FunctionCall (Function "(*)" t _) [arg1, ConstExpr (IntConst (log2 -> Just n) _)])    = [replaceWith $ binop t "<<" arg1 (litI32 n)]+    go (FunctionCall (Function "(*)" t _) [arg1, arg2])   = [replaceWith $ binop t "*" arg1 arg2]+    go (FunctionCall (Function "(/)" t _) [arg1, arg2])   = [replaceWith $ binop t "/" arg1 arg2]+    go (FunctionCall (Function "div" t _) [arg1, arg2]) = [replaceWith $ StructField (fun div_t (div_f t) [arg1, arg2]) "quot"]+      where div_t = Alias (StructType "div_t" [("quot", t), ("rem", t)]) "div_t"+            div_f (NumType Signed S8)  = "div"+            div_f (NumType Signed S16) = "div"+            div_f (NumType Signed S32) = "div"+            div_f (NumType Signed S40) = "ldiv"+            div_f (NumType Signed S64) = "lldiv"+            div_f typ = error $ "div not defined for " ++ show typ+    go (FunctionCall (Function "exp" t@(ComplexType _) _) [arg])  = [replaceWith $ fun t "cexpf" [arg]]+    go (FunctionCall (Function "exp" t _) [arg])  = [replaceWith $ fun t "expf" [arg]]+    go (FunctionCall (Function "sqrt" t@(ComplexType _) _) [arg]) = [replaceWith $ fun t "csqrtf" [arg]]+    go (FunctionCall (Function "sqrt" t _) [arg]) = [replaceWith $ fun t "sqrtf" [arg]]+    go (FunctionCall (Function "log" t@(ComplexType _) _) [arg])  = [replaceWith $ fun t "clogf" [arg]]+    go (FunctionCall (Function "log" t _) [arg])  = [replaceWith $ fun t "logf" [arg]]+    go (FunctionCall (Function "(**)" t@(ComplexType _) _) [arg1, arg2])  = [replaceWith $ fun t "cpowf" [arg1,arg2]]+    go (FunctionCall (Function "(**)" t _) [arg1, arg2])  = [replaceWith $ fun t "powf" [arg1,arg2]]+    go (FunctionCall (Function "logBase" t _) [arg1, arg2])   = [replaceWith $ fun t (extend c99 "logBase" t) [arg1,arg2]]+    go (FunctionCall (Function "sin" t@(ComplexType _) _) [arg])  = [replaceWith $ fun t "csinf" [arg]]+    go (FunctionCall (Function "sin" t _) [arg])  = [replaceWith $ fun t "sinf" [arg]]+    go (FunctionCall (Function "tan" t@(ComplexType _) _) [arg])  = [replaceWith $ fun t "ctanf" [arg]]+    go (FunctionCall (Function "tan" t _) [arg])  = [replaceWith $ fun t "tanf" [arg]]+    go (FunctionCall (Function "cos" t@(ComplexType _)  _) [arg])  = [replaceWith $ fun t "ccosf" [arg]]+    go (FunctionCall (Function "cos" t _) [arg])  = [replaceWith $ fun t "cosf" [arg]]+    go (FunctionCall (Function "asin" t@(ComplexType _) _) [arg]) = [replaceWith $ fun t "casinf" [arg]]+    go (FunctionCall (Function "asin" t _) [arg]) = [replaceWith $ fun t "asinf" [arg]]+    go (FunctionCall (Function "atan" t@(ComplexType _) _) [arg]) = [replaceWith $ fun t "catanf" [arg]]+    go (FunctionCall (Function "atan" t _) [arg]) = [replaceWith $ fun t "atanf" [arg]]+    go (FunctionCall (Function "acos" t@(ComplexType _) _) [arg]) = [replaceWith $ fun t "cacosf" [arg]]+    go (FunctionCall (Function "acos" t _) [arg]) = [replaceWith $ fun t "acosf" [arg]]+    go (FunctionCall (Function "sinh" t@(ComplexType _) _) [arg]) = [replaceWith $ fun t "csinhf" [arg]]+    go (FunctionCall (Function "sinh" t _) [arg]) = [replaceWith $ fun t "sinhf" [arg]]+    go (FunctionCall (Function "tanh" t@(ComplexType _) _) [arg]) = [replaceWith $ fun t "ctanhf" [arg]]+    go (FunctionCall (Function "tanh" t _) [arg]) = [replaceWith $ fun t "tanhf" [arg]]+    go (FunctionCall (Function "cosh" t@(ComplexType _) _) [arg]) = [replaceWith $ fun t "ccoshf" [arg]]+    go (FunctionCall (Function "cosh" t _) [arg]) = [replaceWith $ fun t "coshf" [arg]]+    go (FunctionCall (Function "asinh" t@(ComplexType _) _) [arg])    = [replaceWith $ fun t "casinhf" [arg]]+    go (FunctionCall (Function "asinh" t _) [arg])    = [replaceWith $ fun t "asinhf" [arg]]+    go (FunctionCall (Function "atanh" t@(ComplexType _) _) [arg])    = [replaceWith $ fun t "catanhf" [arg]]+    go (FunctionCall (Function "atanh" t _) [arg])    = [replaceWith $ fun t "atanhf" [arg]]+    go (FunctionCall (Function "acosh" t@(ComplexType _) _) [arg])    = [replaceWith $ fun t "cacoshf" [arg]]+    go (FunctionCall (Function "acosh" t _) [arg])    = [replaceWith $ fun t "acoshf" [arg]]+    go (FunctionCall (Function "atan2" t@FloatType _) [arg1, arg2]) = [replaceWith $ fun t "atan2f" [arg1, arg2]]+    go (FunctionCall (Function "(.&.)" t _) [arg1, arg2]) = [replaceWith $ binop t "&" arg1 arg2]+    go (FunctionCall (Function "(.|.)" t _) [arg1, arg2]) = [replaceWith $ binop t "|" arg1 arg2]+    go (FunctionCall (Function "xor" t _) [arg1, arg2])   = [replaceWith $ binop t "^" arg1 arg2]+    go (FunctionCall (Function "complement" t _) [arg])   = [replaceWith $ fun t "~" [arg]]+    go (FunctionCall (Function "bit" t _) [arg])  = [replaceWith $ binop t "<<" (litI t 1) arg]+    go (FunctionCall (Function "setBit" t _) [arg1, arg2])    = [replaceWith $ fun t (extend c99 "setBit" t) [arg1, arg2]]+    go (FunctionCall (Function "clearBit" t _) [arg1, arg2])  = [replaceWith $ fun t (extend c99 "clearBit" t) [arg1, arg2]]+    go (FunctionCall (Function "complementBit" t _) [arg1, arg2]) = [replaceWith $ fun t (extend c99 "complementBit" t) [arg1, arg2]]+    go (FunctionCall (Function "testBit" t _) [arg1, arg2])   = [replaceWith $ fun t (extend c99 "testBit" $ typeof arg1) [arg1, arg2]]+    go (FunctionCall (Function "shiftL" t _) [arg1, arg2])    = [replaceWith $ binop t "<<" arg1 arg2]+    go (FunctionCall (Function "shiftLU" t _) [arg1, arg2])    = [replaceWith $ binop t "<<" arg1 arg2]+    go (FunctionCall (Function "shiftR" t _) [arg1, arg2])    = [replaceWith $ binop t ">>" arg1 arg2]+    go (FunctionCall (Function "shiftRU" t _) [arg1, arg2])    = [replaceWith $ binop t ">>" arg1 arg2]+    go (FunctionCall (Function "rotateL" t _) [arg1, arg2])   = [replaceWith $ fun t (extend c99 "rotateL" t) [arg1, arg2]]+    go (FunctionCall (Function "rotateR" t _) [arg1, arg2])   = [replaceWith $ fun t (extend c99 "rotateR" t) [arg1, arg2]]+    go (FunctionCall (Function "reverseBits" t _) [arg])  = [replaceWith $ fun t (extend c99 "reverseBits" t) [arg]]+    go (FunctionCall (Function "bitScan" t _) [arg])  = [replaceWith $ fun t (extend c99 "bitScan" $ typeof arg) [arg]]+    go (FunctionCall (Function "bitCount" t _) [arg]) = [replaceWith $ fun t (extend c99 "bitCount" $ typeof arg) [arg]]+    go (FunctionCall (Function "bitSize" _ _) [intWidth . typeof -> Just n])  = [replaceWith $ litI (NumType Unsigned S32) n]+    go (FunctionCall (Function "isSigned" _ _) [intSigned . typeof -> Just b])    = [replaceWith $ litB b]+    go (FunctionCall (Function "complex" t _) [arg1, arg2])   = [replaceWith $ fun t (extend c99 "complex" $ typeof arg1) [arg1,arg2]]+    go (FunctionCall (Function "creal" t _) [arg])    = [replaceWith $ fun t "crealf" [arg]]+    go (FunctionCall (Function "cimag" t _) [arg])    = [replaceWith $ fun t "cimagf" [arg]]+    go (FunctionCall (Function "conjugate" t _) [arg])    = [replaceWith $ fun t "conjf" [arg]]+    go (FunctionCall (Function "magnitude" t _) [arg])    = [replaceWith $ fun t "cabsf" [arg]]+    go (FunctionCall (Function "phase" t _) [arg])    = [replaceWith $ fun t "cargf" [arg]]+    go (FunctionCall (Function "mkPolar" t _) [arg1, arg2])   = [replaceWith $ fun t (extend c99 "mkPolar" $ typeof arg1) [arg1, arg2]]+    go (FunctionCall (Function "cis" t _) [arg])  = [replaceWith $ fun t (extend c99 "cis" $ typeof arg) [arg]]+    go (FunctionCall (Function "f2i" t _) [arg])  = [replaceWith $ Cast t $ fun FloatType "truncf" [arg]]+    go (FunctionCall (Function "i2n" (ComplexType t) _) [arg])    = [replaceWith $ fun (ComplexType t) (extend c99 "complex" t) [Cast t arg, litF 0]]+    go (FunctionCall (Function "i2n" t _) [arg])  = [replaceWith $ Cast t arg]+    go (FunctionCall (Function "b2i" t _) [arg])  = [replaceWith $ Cast t arg]+    go (FunctionCall (Function "round" t _) [arg])    = [replaceWith $ Cast t $ fun FloatType "roundf" [arg]]+    go (FunctionCall (Function "ceiling" t _) [arg])  = [replaceWith $ Cast t $ fun FloatType "ceilf" [arg]]+    go (FunctionCall (Function "floor" t _) [arg])    = [replaceWith $ Cast t $ fun FloatType "floorf" [arg]]+    go _ = []+ tic64xRules :: [Rule]-tic64xRules = [rule tic64x]+tic64xRules = [rule go]   where-    tic64x (Fun t "(==)" [arg1@(typeof -> Complex _), arg2])    = [replaceWith $ Fun t (extend "equal" $ typeof arg1) [arg1, arg2]]-    tic64x (Fun t "(/=)" [arg1@(typeof -> Complex _), arg2])    = [replaceWith $ Fun t "!" [Fun t (extend "equal" $ typeof arg1) [arg1, arg2]]]-    tic64x (Fun t "abs" [arg@(typeof -> Floating)]) = [replaceWith $ Fun t "_fabs" [arg]]-    tic64x (Fun t "abs" [arg@(typeof -> I32)])  = [replaceWith $ Fun t "_abs" [arg]]-    tic64x (Fun t "(+)" [arg1@(typeof -> Complex _), arg2]) = [replaceWith $ Fun t (extend "add" $ typeof arg1) [arg1, arg2]]-    tic64x (Fun t "(-)" [arg1@(typeof -> Complex _), arg2]) = [replaceWith $ Fun t (extend "sub" $ typeof arg1) [arg1, arg2]]-    tic64x (Fun t "(*)" [arg1@(typeof -> Complex _), arg2]) = [replaceWith $ Fun t (extend "mult" $ typeof arg1) [arg1, arg2]]-    tic64x (Fun t "(/)" [arg1@(typeof -> Complex _), arg2]) = [replaceWith $ Fun t (extend "div" $ typeof arg1) [arg1, arg2]]-    tic64x (Fun t "exp" [arg1@(typeof -> Complex _), arg2]) = [replaceWith $ Fun t (extend "exp" $ typeof arg1) [arg1, arg2]]-    tic64x (Fun t "sqrt" [arg1@(typeof -> Complex _), arg2])    = [replaceWith $ Fun t (extend "sqrt" $ typeof arg1) [arg1, arg2]]-    tic64x (Fun t "log" [arg1@(typeof -> Complex _), arg2]) = [replaceWith $ Fun t (extend "log" $ typeof arg1) [arg1, arg2]]-    tic64x (Fun t "(**)" [arg1@(typeof -> Complex _), arg2])    = [replaceWith $ Fun t (extend "cpow" $ typeof arg1) [arg1, arg2]]-    tic64x (Fun t "logBase" [arg1@(typeof -> Complex _), arg2]) = [replaceWith $ Fun t (extend "logBase" $ typeof arg1) [arg1, arg2]]-    tic64x (Fun t fn [arg@(typeof -> Complex _)])-        | fn `elem` ["sin","tan","cos","asin","atan","acos","sinh","tanh","cosh","asinh","atanh","acosh","creal","cimag","conjugate","magnitude","phase"]-            = [replaceWith $ Fun t (extend fn $ typeof arg) [arg]]-    tic64x (Fun t "rotateL" [arg1@(typeof -> U32), arg2])   = [replaceWith $ Fun t "_rotl" [arg1, arg2]]-    tic64x (Fun t "reverseBits" [arg@(typeof -> U32)])  = [replaceWith $ Fun t "_bitr" [arg]]-    tic64x (Fun t "bitCount" [arg@(typeof -> U32)])  = [replaceWith $ Fun t "_dotpu4" [Fun t "_bitc4" [arg], LitI U32 0x01010101]]-    tic64x (Fun t _ [arg@(typeof -> Complex _)]) = [replaceWith $ Fun t (extend "creal" $ typeof arg) [arg]]-    tic64x _ = []+    go (FunctionCall (Function "(==)" t _) [arg1@(typeof -> ComplexType _), arg2])    = [replaceWith $ fun t (extend tic64x "equal" $ typeof arg1) [arg1, arg2]]+    go (FunctionCall (Function "(/=)" t _) [arg1@(typeof -> ComplexType _), arg2])    = [replaceWith $ fun t "!" [fun t (extend tic64x "equal" $ typeof arg1) [arg1, arg2]]]+    go (FunctionCall (Function "abs" t _) [arg@(typeof -> FloatType)]) = [replaceWith $ fun t "_fabs" [arg]]+    go (FunctionCall (Function "abs" t _) [arg@(typeof -> (NumType Signed S32))])  = [replaceWith $ fun t "_abs" [arg]]+    go (FunctionCall (Function "(+)" t _) [arg1@(typeof -> ComplexType _), arg2]) = [replaceWith $ fun t (extend tic64x "add" $ typeof arg1) [arg1, arg2]]+    go (FunctionCall (Function "(-)" t _) [arg1@(typeof -> ComplexType _), arg2]) = [replaceWith $ fun t (extend tic64x "sub" $ typeof arg1) [arg1, arg2]]+    go (FunctionCall (Function "(*)" t _) [arg1@(typeof -> ComplexType _), arg2]) = [replaceWith $ fun t (extend tic64x "mult" $ typeof arg1) [arg1, arg2]]+    go (FunctionCall (Function "(/)" t _) [arg1@(typeof -> ComplexType _), arg2]) = [replaceWith $ fun t (extend tic64x "div" $ typeof arg1) [arg1, arg2]]+    go (FunctionCall (Function "exp" t _) [arg1@(typeof -> ComplexType _), arg2]) = [replaceWith $ fun t (extend tic64x "exp" $ typeof arg1) [arg1, arg2]]+    go (FunctionCall (Function "sqrt" t _ ) [arg1@(typeof -> ComplexType _), arg2])    = [replaceWith $ fun t (extend tic64x "sqrt" $ typeof arg1) [arg1, arg2]]+    go (FunctionCall (Function "log" t _) [arg1@(typeof -> ComplexType _), arg2]) = [replaceWith $ fun t (extend tic64x "log" $ typeof arg1) [arg1, arg2]]+    go (FunctionCall (Function "(**)" t _) [arg1@(typeof -> ComplexType _), arg2])    = [replaceWith $ fun t (extend tic64x "cpow" $ typeof arg1) [arg1, arg2]]+    go (FunctionCall (Function "logBase" t _) [arg1@(typeof -> ComplexType _), arg2]) = [replaceWith $ fun t (extend tic64x "logBase" $ typeof arg1) [arg1, arg2]]+    go (FunctionCall (Function fn t _) [arg@(typeof -> ComplexType _)])+       | fn `elem` ["sin","tan","cos","asin","atan","acos","sinh","tanh","cosh","asinh","atanh","acosh","creal","cimag","conjugate","magnitude","phase"]+       = [replaceWith $ fun t (extend tic64x fn $ typeof arg) [arg]]+    go (FunctionCall (Function "rotateL" t _) [arg1@(typeof -> (NumType Unsigned S32)), arg2])   = [replaceWith $ fun t "_rotl" [arg1, arg2]]+    go (FunctionCall (Function "reverseBits" t _) [arg@(typeof -> (NumType Unsigned S32))])  = [replaceWith $ fun t "_bitr" [arg]]+    go (FunctionCall (Function "bitCount" t _) [arg@(typeof -> (NumType Unsigned S32))])  = [replaceWith $ fun t "_dotpu4" [fun t "_bitc4" [arg], litI32 0x01010101]]+    go (FunctionCall (Function _ t _) [arg@(typeof -> ComplexType _)]) = [replaceWith $ fun t (extend tic64x "creal" $ typeof arg) [arg]]+    go _ = []  traceRules :: [Rule] traceRules = [rule trace]   where-    trace (Fun t "trace" [lab, val]) = [WithId acts]+    trace (FunctionCall (Function "trace" t _) [lab, val]) = [WithId acts]       where        acts i = [replaceWith trcVar, propagate decl, propagate trc, propagate frame]          where-            trcVar = Var t trcVarName+            v          = Variable t trcVarName+            trcVar     = varToExpr v             trcVarName = "trc" ++ show i-            defTrcVar = Def t trcVarName-            decl (Bl defs prg) = [replaceWith $ Bl (defs ++ [defTrcVar]) prg]-            trc :: Prog -> [Action (Repr Prog)]-            trc instr = [replaceWith $ Seq [trcVar := val,trcCall,instr]]-            trcCall = Call (extend' "trace" t) [In trcVar, In lab]-            frame (ProcDf pname ins outs prg) = [replaceWith $ ProcDf pname ins outs prg']+            defTrcVar  = Declaration v Nothing+            decl :: Block () -> [Action (Block ())]+            decl (Block defs prg) = [replaceWith $ Block (defs ++ [defTrcVar]) prg]+            trc :: Program () -> [Action (Program ())]+            trc instr = [replaceWith $ Sequence [Assign trcVar val,trcCall,instr]]+            trcCall = call (extend' "trace" t) [ValueParameter trcVar, ValueParameter lab]+            frame (Proc pname ins outs (Just prg)) = [replaceWith $ Proc pname ins outs prg']               where-                prg' = case prg of-                    Seq (Call "traceStart" [] : _) -> prg-                    Block _ (Seq (Call "traceStart" [] : _)) -> prg-                    _ -> Seq [Call "traceStart" [], prg, Call "traceEnd" []]+                prg' = Just $ case prg of+                    Block _ (Sequence (ProcedureCall "traceStart" [] : _)) -> prg+                    Block ds ps -> Block ds (Sequence [call "traceStart" [], ps, call "traceEnd" []])     trace _ = [] -extend :: String -> Type -> String-extend s t = s ++ "_fun_" ++ show t+extend :: Platform -> String -> Type -> String+extend Platform{..} s t = s ++ "_fun_" ++ fromMaybe (show t) (lookup t types)  extend' :: String -> Type -> String extend' s t = s ++ "_" ++ show t  log2 :: Integer -> Maybe Integer log2 n-    | n == 2 Prelude.^ l    = Just l-    | otherwise             = Nothing+    | n == 2 Prelude.^ l = Just l+    | otherwise          = Nothing   where-    l = toInteger $ length $ takeWhile (<=n) $ map (2 Prelude.^) [1..]+    l = toInteger $ length $ takeWhile (<n) $ iterate (*2) 1  first, second :: String first  = "member1"

@@ -1,78 +0,0 @@------ Copyright (c) 2009-2011, ERICSSON AB--- All rights reserved.--- --- Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are met:--- ---     * Redistributions of source code must retain the above copyright notice, ---       this list of conditions and the following disclaimer.---     * Redistributions in binary form must reproduce the above copyright---       notice, this list of conditions and the following disclaimer in the---       documentation and/or other materials provided with the distribution.---     * Neither the name of the ERICSSON AB nor the names of its contributors---       may be used to endorse or promote products derived from this software---       without specific prior written permission.--- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"--- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE--- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE --- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE--- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL--- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR--- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER--- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,--- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE--- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-----{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module Feldspar.Compiler.Backend.C.Plugin.BlockProgramHandler where--import Feldspar.Transformation---- ===========================================================================---  == Type definition generator plugin--- ===========================================================================--data BlockProgramHandler = BlockProgramHandler--instance Default [Declaration ()] where-    def = []--instance Combine [Declaration ()] where-    combine a b = a ++ b--instance Transformation BlockProgramHandler where-    type From BlockProgramHandler = ()-    type To BlockProgramHandler = ()-    type Down BlockProgramHandler = ()-    type Up BlockProgramHandler = [Declaration ()]-    type State BlockProgramHandler = ()--instance Transformable BlockProgramHandler Block where-        transform t s d b = tr-            { result = (result tr)-                { locals = locals (result tr) ++ up tr-                }-            , up = []-            }-            where-                tr = defaultTransform t s d b--instance Transformable BlockProgramHandler Program where-        transform t s d p =-            case result tr of-                BlockProgram b _ -> Result (blockBody b) () (locals b ++ up tr)-                _ -> tr-            where-                    tr = defaultTransform t s d p---instance Plugin BlockProgramHandler where-    type ExternalInfo BlockProgramHandler = ()-    executePlugin BlockProgramHandler _ procedure = -        result $ transform BlockProgramHandler ({-state-}) () procedure

@@ -1,232 +0,0 @@------ Copyright (c) 2009-2011, ERICSSON AB--- All rights reserved.------ Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are met:------     * Redistributions of source code must retain the above copyright notice,---       this list of conditions and the following disclaimer.---     * Redistributions in binary form must reproduce the above copyright---       notice, this list of conditions and the following disclaimer in the---       documentation and/or other materials provided with the distribution.---     * Neither the name of the ERICSSON AB nor the names of its contributors---       may be used to endorse or promote products derived from this software---       without specific prior written permission.------ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"--- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE--- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE--- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE--- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL--- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR--- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER--- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,--- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE--- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-----{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module Feldspar.Compiler.Backend.C.Plugin.Locator where--import Feldspar.Transformation-import Feldspar.Compiler.Backend.C.CodeGeneration-import Feldspar.Compiler.Backend.C.Plugin.PrettyPrint----- ===========================================================================---  == GetPrg plugin--- ===========================================================================---instance Default Bool where-    def = False--instance Default (Program DebugToCSemanticInfo) where-    def = Empty ((0,0),(0,0)) ((0,0),(0,0))--instance Combine Bool where-    combine l1 l2 = l1 || l2--instance Combine (Program DebugToCSemanticInfo) where-    combine Empty{} p2 = p2-    combine p1      _  = p1----------------------------------------------------------- GetPrg plugin for ParLoop--------------------------------------------------------data GetPrgParLoop = GetPrgParLoop--instance Transformation GetPrgParLoop where-    type From GetPrgParLoop    = DebugToCSemanticInfo-    type To GetPrgParLoop      = DebugToCSemanticInfo-    type Down GetPrgParLoop    = (Int, Int)  -    type Up GetPrgParLoop      = (Bool, Program DebugToCSemanticInfo)-    type State GetPrgParLoop   = ()---instance Plugin GetPrgParLoop where-    type ExternalInfo GetPrgParLoop = (Int, Int)-    executePlugin GetPrgParLoop (line, col) procedure =-        result $ transform GetPrgParLoop () (line, col) procedure--getPrgParLoop :: (Int, Int) -> Module DebugToCSemanticInfo -> (Bool, Program DebugToCSemanticInfo)-getPrgParLoop (line, col) procedure = up res where-    res = transform GetPrgParLoop () (line, col) procedure        --instance Transformable GetPrgParLoop Program where-    transform t () (line, col) pl@(ParLoop _ _ _ prog inf1 _) = Result pl () info where-        info  = case contains (line, col) inf1  of-                    True -> infoCr where-                        res = transform t () (line, col) prog-                        infoCr = if fst $ up res then up res else (True, pl)-                    _    -> def-    transform t () (line, col) pr = defaultTransform t () (line, col) pr----------------------------------------------------------- GetPrg plugin for Assign--------------------------------------------------------data GetPrgAssign = GetPrgAssign--instance Transformation GetPrgAssign where-    type From GetPrgAssign    = DebugToCSemanticInfo-    type To GetPrgAssign      = DebugToCSemanticInfo-    type Down GetPrgAssign    = (Int, Int)  -    type Up GetPrgAssign      = (Bool, Program DebugToCSemanticInfo)-    type State GetPrgAssign   = ()---instance Plugin GetPrgAssign where-    type ExternalInfo GetPrgAssign = (Int, Int)-    executePlugin GetPrgAssign (line, col) procedure =-        result $ transform GetPrgAssign () (line, col) procedure--getPrgAssign :: (Int, Int) -> Module DebugToCSemanticInfo -> (Bool, Program DebugToCSemanticInfo)-getPrgAssign (line, col) procedure = up res where-    res = transform GetPrgAssign () (line, col) procedure        --instance Transformable GetPrgAssign Program where-    transform _ () (line, col) assign@(Assign _ _ inf1 _) = Result assign () info where-        info  = if contains (line, col) inf1 then (True, assign) else def-    transform t () (line, col) pr = defaultTransform t () (line, col) pr------------------------------------------------------------ GetPrg plugin for Branch--------------------------------------------------------data GetPrgBranch = GetPrgBranch--instance Transformation GetPrgBranch where-    type From GetPrgBranch    = DebugToCSemanticInfo-    type To GetPrgBranch     = DebugToCSemanticInfo-    type Down GetPrgBranch   = (Int, Int)  -    type Up GetPrgBranch      = (Bool, Program DebugToCSemanticInfo)-    type State GetPrgBranch   = ()---instance Plugin GetPrgBranch where-    type ExternalInfo GetPrgBranch = (Int, Int)-    executePlugin GetPrgBranch (line, col) procedure =-        result $ transform GetPrgBranch () (line, col) procedure--getPrgBranch :: (Int, Int) -> Module DebugToCSemanticInfo -> (Bool, Program DebugToCSemanticInfo)-getPrgBranch (line, col) procedure = up res where-    res = transform GetPrgBranch () (line, col) procedure        --instance Transformable GetPrgBranch Program where-    transform t () (line, col) br@(Branch _ prog1 prog2 inf1 _) = Result br () info where-        info  = case contains (line, col) inf1  of-                    True -> infoCr where-                        res1 = transform t () (line, col) prog1-                        res2 = transform t () (line, col) prog2-                        res = combine (up res1) (up res2)-                        infoCr = if fst res then res else (True,br)-                    _    -> def--    transform t () (line, col) pr = defaultTransform t () (line, col) pr----------------------------------------------------------- GetPrg plugin for ProcedureCall--------------------------------------------------------data GetPrgProcCall = GetPrgProcCall--instance Transformation GetPrgProcCall where-    type From GetPrgProcCall    = DebugToCSemanticInfo-    type To GetPrgProcCall      = DebugToCSemanticInfo-    type Down GetPrgProcCall    = (Int, Int)  -    type Up GetPrgProcCall      = (Bool, Program DebugToCSemanticInfo)-    type State GetPrgProcCall   = ()---instance Plugin GetPrgProcCall where-    type ExternalInfo GetPrgProcCall = (Int, Int)-    executePlugin GetPrgProcCall (line, col) procedure =-        result $ transform GetPrgProcCall () (line, col) procedure--getPrgProcCall :: (Int, Int) -> Module DebugToCSemanticInfo -> (Bool, Program DebugToCSemanticInfo)-getPrgProcCall (line, col) procedure = up res where-    res = transform GetPrgProcCall () (line, col) procedure        --instance Transformable GetPrgProcCall Program where-    transform _ () (line, col) pc@(ProcedureCall _ _ inf1 _) = Result pc () info where-        info  = if contains (line,col) inf1 then (True,pc) else def-    transform t () (line, col) pr = defaultTransform t () (line, col) pr----------------------------------------------------------- GetPrg plugin for SeqLoop--------------------------------------------------------data GetPrgSeqLoop = GetPrgSeqLoop--instance Transformation GetPrgSeqLoop where-    type From GetPrgSeqLoop    = DebugToCSemanticInfo-    type To GetPrgSeqLoop      = DebugToCSemanticInfo-    type Down GetPrgSeqLoop    = (Int, Int)  -    type Up GetPrgSeqLoop      = (Bool, Program DebugToCSemanticInfo)-    type State GetPrgSeqLoop   = ()---instance Plugin GetPrgSeqLoop where-    type ExternalInfo GetPrgSeqLoop = (Int, Int)-    executePlugin GetPrgSeqLoop (line, col) procedure =-        result $ transform GetPrgSeqLoop () (line, col) procedure--getPrgSeqLoop :: (Int, Int) -> Module DebugToCSemanticInfo -> (Bool, Program DebugToCSemanticInfo)-getPrgSeqLoop (line, col) procedure = up res where-    res = transform GetPrgSeqLoop () (line, col) procedure--instance Transformable GetPrgSeqLoop Program where-    transform t () (line, col) sl@(SeqLoop _ _ prog inf1 _) = Result sl () info where-        info  = case contains (line, col) inf1  of-                    True -> infoCr where-                        res = transform t () (line, col) prog-                        infoCr = if fst $ up res then up res else (True, sl)-                    _    -> def-    transform t () (line, col) pr = defaultTransform t () (line, col) pr----------------------------------------------------------- Helper functions----------------------------------------------------contains :: (Ord a, Ord b) => (a,b) -> ((a,b),(a,b)) -> Bool-contains (line, col) ((bl, bc), (el, ec)) = (line == bl && bc <= col) || (bl < line && line < el) || (line == el && col <= ec)--myShow :: Program DebugToCSemanticInfo -> String-myShow (Assign l r inf1 _) = "Assign \n" ++ ind show l ++ "\n=\n" ++ ind show r ++ "\n" ++ show inf1 ++ "\n"-myShow (Sequence progs inf1 _) = "Sequence\n" ++ ind (listprint myShow "\n") progs ++ "\n" ++ show inf1 ++ "\n"-myShow (Branch _ tb eb inf1 _) = "Branch\n" ++ ind myShowB tb ++ "\nelse\n" ++ ind myShowB eb ++ "\n" ++ show inf1 ++ "\n"-myShow (ParLoop count bound step block inf1 _)-    = "ParLoop\n count: " ++ show count ++ "\n bound: " ++ show bound ++ "\n step: " ++ show step ++ "\n" ++ ind myShowB block ++ "\n" ++ show inf1 ++ "\n"-myShow x = show x--myShowB :: Block DebugToCSemanticInfo -> String-myShowB (Block ls prg inf) = "Block\n" ++ ind show ls ++"\n" ++ ind myShow prg ++ show inf-

@@ -1,714 +0,0 @@------ Copyright (c) 2009-2011, ERICSSON AB--- All rights reserved.--- --- Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are met:--- ---     * Redistributions of source code must retain the above copyright notice, ---       this list of conditions and the following disclaimer.---     * Redistributions in binary form must reproduce the above copyright---       notice, this list of conditions and the following disclaimer in the---       documentation and/or other materials provided with the distribution.---     * Neither the name of the ERICSSON AB nor the names of its contributors---       may be used to endorse or promote products derived from this software---       without specific prior written permission.--- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"--- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE--- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE --- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE--- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL--- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR--- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER--- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,--- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE--- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-----{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module Feldspar.Compiler.Backend.C.Plugin.PrettyPrint where--import Feldspar.Transformation-import Feldspar.Compiler.Backend.C.CodeGeneration-import Feldspar.Compiler.Backend.C.Options--import qualified Data.List as List (find, intercalate)-import qualified Control.Monad.State as StateMonad (get, put, runState)---- ===========================================================================---  == DebugToC plugin--- ===========================================================================--data DebugToC = DebugToC--data DebugToCSemanticInfo--instance Annotation DebugToCSemanticInfo Module where-    type Label DebugToCSemanticInfo Module = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Entity where-    type Label DebugToCSemanticInfo Entity = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Struct where-    type Label DebugToCSemanticInfo Struct = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo ProcDef where-    type Label DebugToCSemanticInfo ProcDef = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo ProcDecl where-    type Label DebugToCSemanticInfo ProcDecl = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo StructMember where-    type Label DebugToCSemanticInfo StructMember = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Block where-    type Label DebugToCSemanticInfo Block = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Program where-    type Label DebugToCSemanticInfo Program = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Empty where-    type Label DebugToCSemanticInfo Empty = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Assign where-    type Label DebugToCSemanticInfo Assign = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo ProcedureCall where-    type Label DebugToCSemanticInfo ProcedureCall = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Spawn where-    type Label DebugToCSemanticInfo Spawn = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Run where-    type Label DebugToCSemanticInfo Run = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Sequence where-    type Label DebugToCSemanticInfo Sequence = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Branch where-    type Label DebugToCSemanticInfo Branch = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo SeqLoop where-    type Label DebugToCSemanticInfo SeqLoop = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo ParLoop where-    type Label DebugToCSemanticInfo ParLoop = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo ActualParameter where-    type Label DebugToCSemanticInfo ActualParameter = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Declaration where-    type Label DebugToCSemanticInfo Declaration = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Expression where-    type Label DebugToCSemanticInfo Expression = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo FunctionCall where-    type Label DebugToCSemanticInfo FunctionCall = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo SizeOf where-    type Label DebugToCSemanticInfo SizeOf = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo ArrayElem where-    type Label DebugToCSemanticInfo ArrayElem = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo StructField where-    type Label DebugToCSemanticInfo StructField = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Constant where-    type Label DebugToCSemanticInfo Constant = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo IntConst where-    type Label DebugToCSemanticInfo IntConst = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo FloatConst where-    type Label DebugToCSemanticInfo FloatConst = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo BoolConst where-    type Label DebugToCSemanticInfo BoolConst = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo ArrayConst where-    type Label DebugToCSemanticInfo ArrayConst = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo ComplexConst where-    type Label DebugToCSemanticInfo ComplexConst = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Variable where-    type Label DebugToCSemanticInfo Variable = ((Int, Int), (Int, Int))--instance Annotation DebugToCSemanticInfo Cast where-    type Label DebugToCSemanticInfo Cast = ((Int, Int), (Int, Int))-    -instance Annotation DebugToCSemanticInfo Comment where-    type Label DebugToCSemanticInfo Comment = ((Int, Int), (Int, Int))---instance Transformation DebugToC where-    type From DebugToC    = ()-    type To DebugToC      = DebugToCSemanticInfo-    type Down DebugToC    = (Options, Place, Int)  -- Platform, Place and Indentation-    type Up DebugToC      = String-    type State DebugToC   = (Int, Int)--instance Plugin DebugToC where-    type ExternalInfo DebugToC = ((Options, Place), Int)-    executePlugin DebugToC ((options, place), line) procedure =-        result $ transform DebugToC (line, 0) (options, place, 0) procedure--compToC :: ((Options, Place), Int) -> Module () -> (String, (Int, Int))-compToC ((options, place), line) procedure = (up res, state res) where-    res = transform DebugToC (line, 0) (options, place, 0) procedure--compToCWithInfos :: ((Options, Place), Int) -> Module () -> (Module DebugToCSemanticInfo, (String, (Int, Int)))-compToCWithInfos ((options, place), line) procedure = (result res, (up res, state res)) where-    res = transform DebugToC (line, 0) (options, place, 0) procedure--instance Transformable DebugToC Variable where-    transform _ (line, col) (options, place, _) x@(Variable vname typ role _) = Result (Variable vname typ role newInf) (snd newInf) cRep-        where-            (newInf, (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                code $ toC options place x-                (_, nl, nc) <- StateMonad.get-                return ((line, col), (nl, nc))--instance Transformable1 DebugToC [] Constant where-    transform1 t pos down l = transform1' t pos down l ", " 0--instance Transformable DebugToC Constant where-    transform t pos down cnst@(IntConst c _ _ _) = transformConst t pos down cnst (show c)--    transform t pos down cnst@(FloatConst c _ _) = transformConst t pos down cnst (show c ++ "f")--    transform t pos down cnst@(BoolConst False _ _) = transformConst t pos down cnst "0"--    transform t pos down cnst@(BoolConst True _ _) = transformConst t pos down cnst "1"--    transform t (line, col) (options, place, indent) cnst@(ComplexConst real im _ _)-        = case List.find (\(t',_) -> t' == typeof cnst) $ values $ platform options of-            Just (_,f) -> -                Result (ComplexConst (result newReal) (result newIm) newInf newInf) (snd newInf) cRep -                    where-                        ((newReal, newIm, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                            nr <- complexTransform t (options, place, indent) real-                            ni <- complexTransform t (options, place, indent) im-                            code $ f cnst-                            (_, nl, nc) <- StateMonad.get-                            return (nr, ni, ((line,col),(nl,nc)))-            Nothing    -> -                Result (ComplexConst (result newReal) (result newIm) newInf newInf) (snd newInf) cRep-                    where-                        ((newReal, newIm, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                            code "complex("-                            nr <- monadicTransform' t (options, place, indent) real-                            code ","-                            ni <- monadicTransform' t (options, place, indent) im-                            code ")"-                            (_, nl, nc) <- StateMonad.get-                            return (nr, ni, ((line,col),(nl,nc)))--instance Transformable DebugToC ActualParameter where-    transform t pos down act@(In (VarExpr (Variable _ StructType{} _ _) _) _) =-        transformActParam t pos down act AddressNeed_pl-    transform t pos down act@(In (VarExpr (Variable _ ArrayType{} _ _) _) _) =-        transformActParam t pos down act AddressNeed_pl-    transform t pos down act@In{}            = transformActParam t pos down act FunctionCallIn_pl-    transform t pos down act@Out{}           = transformActParam t pos down act AddressNeed_pl-    transform t pos down act@TypeParameter{} = transformActParam t pos down act MainParameter_pl-    transform t pos down act@FunParameter{}  = transformActParam t pos down act FunctionCallIn_pl--instance Transformable1 DebugToC [] Expression where-    transform1 t pos down l = transform1' t pos down l ", " 0--instance Transformable DebugToC Expression where-    transform t (line, col) (options, place, indent) (VarExpr val _) = Result (VarExpr (result newVal) newInf) (snd newInf) cRep-        where-            ((newVal, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                nv <- monadicTransform' t (options, place, indent) val-                (_, nl, nc) <- StateMonad.get-                return (nv, ((line,col),(nl,nc)))--    transform t (line, col) (options, place, indent) e@(ArrayElem n index _ _) = Result (ArrayElem (result newName) (result newIndex) newInf newInf) (snd newInf) cRep -        where-            ((newName, newIndex, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                let prefix = case (place, typeof e) of-                       (AddressNeed_pl, _) -> "&"-                       (_, ArrayType _ _)  -> "&" -- TODO the call site should set the place to AddressNeed_pl for Arrays-                       _                   -> ""-                code $ prefix ++ "at(" ++ showType options Value Declaration_pl (typeof e) NoRestrict ++ ","-                nn <- monadicTransform' t (options, AddressNeed_pl, indent) n-                code ","-                ni <- monadicTransform' t (options, ValueNeed_pl, indent) index-                code ")"-                (_, nl, nc) <- StateMonad.get-                return (nn, ni, ((line,col),(nl,nc)))--    transform t pos down expr@(StructField _ field _ _) = transformExpr pos down ('.' : field) ValueNeed_pl-      where-          transformExpr (line, col) (options, place, indent) str paramType = Result (newExpr expr) (snd newInf) cRep-            where-                newExpr (StructField _ s _ _ ) = StructField (result newTarget) s newInf newInf-                getExpr (StructField e _ _ _ ) = e-                prefix = case (place, typeof expr) of-                       (AddressNeed_pl, _) -> "&"-                       (_, ArrayType _ _)  -> "&"-                       _                   -> ""-                ((newTarget, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                    code prefix-                    nt <- monadicTransform' t (options, paramType, indent)  (getExpr expr)-                    code str-                    (_, nl, nc) <- StateMonad.get-                    return (nt, ((line,col),(nl,nc)))---    transform t (line, col) (options, place, indent) (ConstExpr val _) = Result (ConstExpr (result newVal) newInf) (snd newInf) cRep-        where-            ((newVal, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                nv <- monadicTransform' t (options, place, indent) val-                (_, nl, nc) <- StateMonad.get-                return (nv, ((line,col),(nl,nc)))--    transform t pos down fc@(FunctionCall f [_,_] _ _)-        | funName f == "!" = transformFuncCall t pos down fc "at(" "," ")"--    transform t pos down fc@(FunctionCall f [_,_] _ _)-        | funMode f == Infix = transformFuncCall t pos down fc "(" (" " ++ funName f ++ " ") ")"--    transform t (line, col) (options, _, indent) (FunctionCall f paramlist _ _) =-                Result (FunctionCall f (result1 newParamlist) newInf newInf) (snd newInf) cRep -        where-            ((newParamlist, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                code $ funName f ++ "("-                npl <- monadicListTransform' t (options, FunctionCallIn_pl, indent) paramlist-                code ")"-                (_, nl, nc) <- StateMonad.get-                return (npl, ((line,col),(nl,nc)))--    transform t (line, col) (options, place, indent) (Cast typ e _ _) =  Result (Cast typ (result newExp) newInf newInf) (snd newInf) cRep -        where-            ((newExp, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                code $ concat ["((", toC options place typ, ")("]-                ne <- monadicTransform' t (options, place, indent) e-                code "))"-                (_, nl, nc) <- StateMonad.get-                return (ne, ((line,col),(nl,nc)))--    transform _ (line, col) (options, place, _) (SizeOf (Left typ) _ _) = Result (SizeOf (Left typ) newInf newInf) (snd newInf) cRep -        where-            (newInf, (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                code ("sizeof(" ++ toC options place typ ++ ")")-                (_, nl, nc) <- StateMonad.get-                return ((line, col), (nl, nc))--    transform t (line, col) (options, place, indent) (SizeOf (Right e) _ _) = Result (SizeOf (Right (result newExp)) newInf newInf) (newLine, newCol) cRep -        where-            ((newExp, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do-                code "sizeof"-                ne <- monadicTransform' t (options, place, indent) e-                code ")"-                (_, nl, nc) <- StateMonad.get-                return (ne, ((line,col),(nl,nc)))--instance Transformable1 DebugToC [] Entity where-    transform1 t pos down l = transform1' t pos down l "" 0--instance Transformable DebugToC Module where-    transform t (line, col) (options, place, indent) (Module defList _) = Result (Module (result1 newDefList) newInf) (snd newInf) cRep -        where-            ((newDefList, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                ndl <- monadicListTransform' t (options, place, indent) defList-                (_, nl, nc) <- StateMonad.get-                return (ndl, ((line,col),(nl,nc)))--instance Transformable1 DebugToC [] Variable where-    transform1 t pos down l = transform1' t pos down l ", " 0--instance Transformable1 DebugToC [] StructMember where-    transform1 _ (line, col) _ [] = Result1 [] (line, col) ""-    transform1 t (line, col) (options, place, indent) (x:xs) = Result1 (result newX : result1 newXs) (state1 newXs) cRep where-        ((newX, newXs), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-            indenter indent-            nx  <- monadicTransform' t (options, place, indent) x-            nxs <- monadicListTransform' t (options, place, indent) xs-            return (nx, nxs)---instance Transformable DebugToC Entity where-    transform t (line, col) (options, place, indent) (StructDef n members _ _) = Result (StructDef n (result1 newMembers) newInf newInf) (snd newInf) cRep-        where-            ((newMembers, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                code $ n ++ " {\n"-                (crep, cl, cc) <- StateMonad.get-                StateMonad.put (crep, cl, cc + addIndent indent)-                nms <- monadicListTransform' t (options, place, addIndent indent) members-                indenter indent-                code "};\n"-                (crep, cl, _) <- StateMonad.get-                StateMonad.put (crep, cl, indent)-                return (nms, ((line,col),(cl,indent)))--    transform _ (line, col) (options, place, indent) (TypeDef typ n _) = Result (TypeDef typ n newInf) (snd newInf) cRep-        where-            (newInf, (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                code $ unwords [ "typedef"-                               , showType options Value place typ NoRestrict-                               , n-                               ]-                code ";\n"-                (crep, cl, _) <- StateMonad.get-                StateMonad.put (crep, cl, indent)-                return ((line, col), (cl, indent))--    transform t (line, col) (options, place, indent) (ProcDef n inp outp body _ _) =-      Result (ProcDef n (result1 newInParam) (result1 newOutParam) (result newBody) newInf newInf) (snd newInf) cRep-        where-            ((newInParam, newOutParam, newBody, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                indenter indent-                code $ "void " ++ n ++ "("-                ninp <- monadicListTransform' t (options, MainParameter_pl, indent) inp-                let str-                        | null inp || null outp = ""-                        | otherwise             = ", "-                code str-                noutp <- monadicListTransform' t (options, MainParameter_pl, indent) outp-                code ")\n"-                indenter indent-                code "{\n"-                (crep, al, _) <- StateMonad.get-                StateMonad.put (crep, al, addIndent indent)-                nb <- monadicTransform' t (options, Declaration_pl, addIndent indent) body-                indenter indent-                code "}\n"-                (_, nl, _) <- StateMonad.get-                return (ninp, noutp, nb, ((line,col),(nl,indent)))--    transform t (line, col) (options, _, indent) (ProcDecl n inp outp _ _) =-      Result (ProcDecl n (result1 newInParam) (result1 newOutParam) newInf newInf) (snd newInf) cRep-        where-            ((newInParam, newOutParam, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                indenter indent-                code $ "void " ++ n ++ "("-                ninp <- monadicListTransform' t (options, MainParameter_pl, indent) inp-                let str-                        | null inp || null outp = ""-                        | otherwise             = ", "-                code str-                noutp <- monadicListTransform' t (options, MainParameter_pl, indent) outp-                code ");\n"-                (_, nl, _) <- StateMonad.get-                return (ninp, noutp, ((line,col),(nl,indent)))--displayComment :: Int -> [String] -> String-displayComment indent = unlines . map (putIndent indent ++) . (["/*"] ++) . (++ [" */"]) . map (" * " ++)--displayMemInfo :: String -> [Type] -> String-displayMemInfo n []   = n ++ ": none"-displayMemInfo n info = n ++ ": " ++ List.intercalate ", " (map displayType info)--displayType :: Type -> String-displayType (Alias t _) = displayType t-displayType (ArrayType (LiteralLen n) (ArrayType (LiteralLen m) t)) =-    unwords [displayType t, concat ["array(", show n, "x", show m, ")"]]-displayType (ArrayType (LiteralLen n) t) = unwords [displayType t, concat ["array(", show n, ")"]]-displayType (ArrayType UndefinedLen t) = unwords [displayType t, "array"]-displayType (IVarType t) = unwords ["ivar(", displayType t, ")"]-displayType VoidType = "void"-displayType BoolType = "Boolean"-displayType BitType = "bit"-displayType FloatType = "float"-displayType (NumType signed size) = unwords [sg signed, sz size ++ "-bit", "integer"]-  where-    sg Signed   = "signed"-    sg Unsigned = "unsigned"-    sz S8  = "8"-    sz S16 = "16"-    sz S32 = "32"-    sz S40 = "40"-    sz S64 = "64"-displayType (ComplexType t) = unwords ["complex", displayType t]-displayType (UserType s)    = s-displayType (StructType _)  = "struct"--instance Transformable DebugToC StructMember where-    transform _ (line, col) (options, place, _) dsm@(StructMember str typ _) = Result (StructMember str typ newInf) (snd newInf) cRep -        where-            (newInf, (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                let t = case structMemberType dsm of-                     ArrayType{} -> showVariable options place Value (structMemberType dsm) (structMemberName dsm) ++ ";"-                     _           -> toC options place (structMemberType dsm) ++ " " ++ structMemberName dsm ++ ";"-                code $ t ++ "\n"-                (_, nl, nc) <- StateMonad.get-                return ((line, col), (nl, nc))--instance Transformable1 DebugToC [] Declaration where-    transform1 _ (line, col) _ [] = Result1 [] (line, col) ""-    transform1 t (line, col) (options, place, indent) (x:xs) = Result1 (result newX : result1 newXs) (state1 newXs) ((putIndent indent ++ up newX ++ ";\n" ) ++ up1 newXs) where-        newX = transform t (line, col) (options, place, indent) x-        (line2, _) =  state newX-        newSt = (line2 + 1, indent) -        newXs = transform1 t newSt (options, place, indent) xs--instance Transformable DebugToC Block where-    transform t (line, col) (options, place, indent) (Block locs body _) = Result (Block (result1 newLocs) (result newBody) newInf) (snd newInf) cRep-        where-            ((newLocs, newBody, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                nlocs <- monadicListTransform' t (options, Declaration_pl, indent) locs-                let str = case up1 newLocs of -                     "" -> ""-                     _  -> "\n"-                code str-                nbody <- monadicTransform' t (options, place, indent) body-                (_, nl, _) <- StateMonad.get-                return (nlocs, nbody, ((line,col),(nl,indent)))--instance Transformable DebugToC Declaration where-    transform t (line, col) (options, _, indent) (Declaration dv Nothing _) = Result (Declaration (result newDeclVar) Nothing newInf) (snd newInf) cRep-        where-            ((newDeclVar, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                ndv <- monadicTransform' t (options, Declaration_pl, indent) dv-                case varType dv of-                    (ArrayType _ _) -> code " = {0}"-                    _               -> code ""-                (_, nl, nc) <- StateMonad.get-                return (ndv, ((line,col),(nl,nc)))--    transform t (line, col) (options, _, indent) (Declaration dv (Just e) _) = Result (Declaration (result newDeclVar) (Just (result newExpr)) newInf) (snd newInf) cRep -        where-            ((newDeclVar, newExpr, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                ndv <- monadicTransform' t (options, Declaration_pl, indent) dv-                code " = "-                ne <- monadicTransform' t (options, ValueNeed_pl, indent) e-                (_, nl, nc) <- StateMonad.get-                return (ndv, ne, ((line,col),(nl,nc)))--instance Transformable1 DebugToC [] ActualParameter where-    transform1 t pos down l = transform1' t pos down l ", " 0--instance Transformable1 DebugToC [] Program where-    transform1 t pos down l = transform1' t pos down l "" 0---instance Transformable DebugToC Program where-    transform _ (line, col) _ (Empty _ _) = Result (Empty newInf newInf) newSt cRep where -        newSt = (line, col)-        newInf = ((line, col), newSt)-        cRep = ""--    transform _ (line, col) (_, _, indent) (Comment True comment _ _) = Result (Comment True comment newInf newInf) (snd newInf) cRep -        where-            (newInf, (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                indenter indent-                code $ "/* " ++ comment ++ " */\n"-                (_, nl, nc) <- StateMonad.get-                return ((line, col), (nl, nc))--    transform _ (line, col) (_, _, indent) (Comment False comment _ _) = Result (Comment False comment newInf newInf) (snd newInf) cRep -        where -            (newInf, (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                indenter indent-                code $ "// " ++ comment ++ "\n"-                (_, nl, nc) <- StateMonad.get-                return ((line, col), (nl, nc))--    transform t (line, col) (options, _, indent) (Assign lh rh _ _) = Result (Assign (result newLhs) (result newRhs) newInf newInf) (snd newInf) cRep-        where-            ((newLhs, newRhs, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                indenter indent-                nlhs <- monadicTransform' t (options, ValueNeed_pl, indent) lh-                code " = "-                nrhs <- monadicTransform' t (options, ValueNeed_pl, indent) rh-                code ";\n"-                (_, nl, _) <- StateMonad.get-                return (nlhs, nrhs, ((line,col),(nl,indent)))--    transform t (line, col) (options, place, indent) (ProcedureCall n param _ _) = Result (ProcedureCall n (result1 newParam) newInf newInf) (snd newInf) cRep -        where-            ((newParam, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                indenter indent-                code $ n ++ "("-                np <- monadicListTransform' t (options, place, indent) param-                code ");\n"-                (_, nl, _) <- StateMonad.get-                return (np, ((line,col),(nl,indent)))--    transform t (line, col) (options, place, indent) (Sequence prog _ _) = Result (Sequence (result1 newProg) newInf newInf) (snd newInf) cRep -        where-            ((newProg, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                np <- monadicListTransform' t (options, place, indent) prog-                return (np, ((line,col),state1 newProg))--    transform t (line, col) (options, place, indent) (Branch con tPrg ePrg _ _) = Result (Branch (result newCon) (result newTPrg) (result newEPrg) newInf newInf) (snd newInf) cRep -        where -            ((newCon, newTPrg, newEPrg, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                indenter indent-                code "if("-                ncon <- monadicTransform' t (options, ValueNeed_pl, indent) con-                code ")\n" -                indenter indent-                code "{\n"-                ntPrg <- monadicTransform' t (options, place, addIndent indent) tPrg-                indenter indent-                code "}\n" -                indenter indent -                code "else\n" -                indenter indent -                code "{\n"-                nePrg <- monadicTransform' t (options, place, addIndent indent) ePrg-                indenter indent -                code "}\n"-                (_, nl, nc) <- StateMonad.get-                return (ncon, ntPrg, nePrg, ((line,col),(nl,nc)))--    transform t (line, col) (options, place, indent) (SeqLoop con conPrg blockPrg _ _) = Result (SeqLoop (result newCon) (result newConPrg) (result newBlockPrg) newInf newInf) (snd newInf) cRep -        where-            ((newCon, newConPrg, newBlockPrg, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                indenter indent-                code "{\n"-                ncp <- monadicTransform' t (options, place, addIndent indent) conPrg-                indenter $ addIndent indent-                code "while("-                ncon <- monadicTransform' t (options, ValueNeed_pl, addIndent indent) con-                code ")\n" -                indenter $ addIndent indent-                code "{\n"-                nbp <- monadicTransform' t (options, place, addIndent $ addIndent indent) blockPrg-                monadicTransform' t (options, place, addIndent $ addIndent indent) (blockBody conPrg)-                indenter $ addIndent indent-                code "}\n" -                indenter indent -                code "}\n"-                (_, nl, nc) <- StateMonad.get-                return (ncon, ncp, nbp, ((line,col),(nl,nc)))--    transform t (line, col) (options, place, indent) (ParLoop count bound step prog _ _) = Result (ParLoop (result newCount) (result newBound) step (result newProg) newInf newInf) (snd newInf) cRep -        where-            ((newCount, newBound, newProg, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                indenter indent-                code "for("-                _ <- monadicTransform' t (options, Declaration_pl, addIndent indent) count-                code " = 0; "-                loopVariable <- monadicTransform' t (options, ValueNeed_pl, addIndent indent) count-                code " < "-                nb <- monadicTransform' t (options, ValueNeed_pl, addIndent indent) bound-                code $ "; " ++ up loopVariable ++ " += " ++ show step ++ ")\n" -                indenter indent-                code "{\n"-                np <- monadicTransform' t (options, place, addIndent indent) prog-                indenter indent-                code "}\n" -                (_, nl, nc) <- StateMonad.get-                return (loopVariable, nb, np, ((line,col),(nl,nc)))--    transform t (line, col) (options, place, indent) (BlockProgram prog _) = Result (BlockProgram (result newProg) newInf) (snd newInf) cRep -        where-            ((newProg, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-                indenter indent -                code "{\n"-                np <- monadicTransform' t (options, place, addIndent indent) prog-                indenter indent -                code "}\n"-                (_, nl, nc) <- StateMonad.get-                return (np, ((line,col),(nl,nc)))--putIndent :: Int -> String-putIndent = concat . flip replicate " "--addIndent :: Int -> Int-addIndent indent = indent + 4--transform1' _ (line, col) _ [] _ _ = Result1 [] (line, col) ""-transform1' t (line, col) (options, place, indent) (x:[]) _ _ = Result1 [result newX] (state newX) (up newX) where-    newX = transform t (line, col) (options, place, indent) x-transform1' t (line, col) (options, place, indent) (x:xs) str num = Result1 (result newX : result1 newXs) (state1 newXs) (up newX ++ str ++ up1 newXs) where-    newX = transform t (line, col) (options, place, indent) x-    (line2, col2) =  state newX-    newSt = (line2 + num, col2 + length str) -    newXs = transform1 t newSt (options, place, indent) xs--transformConst _ (line, col) (options, _, _) (cnst :: Constant ()) str = Result (newConst cnst) (line, newCol) cRep -    where-        newConst (IntConst c t _ _) = IntConst c t newInf newInf-        newConst (FloatConst c _ _) = FloatConst c newInf newInf-        newConst (BoolConst c _ _)  = BoolConst c newInf newInf-        newInf = ((line, col), (line, newCol))-        (cRep, _, newCol) = snd $ flip StateMonad.runState (defaultState line col) $ do-        let s = case List.find (\(t',_) -> t' == typeof cnst) $ values $ platform options of-             Just (_,f) -> f cnst-             Nothing    -> str-        code s--transformActParam _ (line, col) (options, _, _) (TypeParameter typ mode _) _ = Result newParam (snd newInf) cRep -    where-        newParam = TypeParameter typ mode newInf-        place Auto = MainParameter_pl-        place Scalar = Declaration_pl-        (newInf, (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-            code $ showType options Value (place mode) typ NoRestrict-            (_, nl, nc) <- StateMonad.get-            return ((line,col),(nl,nc))--transformActParam _ (line, col) _ (FunParameter n addr _) _ = Result newParam (snd newInf) cRep -    where-        newParam = FunParameter n addr newInf-        (newInf, (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-            let addrOp-                    | addr      = "&"-                    | otherwise = ""-            code $ addrOp ++ n-            (_, nl, nc) <- StateMonad.get-            return ((line, col), (nl, nc))--transformActParam t (line, col) (options, _, indent) act paramType = Result (newActParam act) (snd newInf) cRep -    where-        newActParam Out{} = Out (result newParam) newInf-        newActParam In{}  = In  (result newParam) newInf-        getParam (In param _)  = param-        getParam (Out param _) = param-        ((newParam, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-            np <- monadicTransform' t (options, paramType, indent) (getParam act)-            (_, nl, nc) <- StateMonad.get-            return (np, ((line,col),(nl,nc)))--transformFuncCall t (line, col) (options, place, indent)-                  (FunctionCall f [a, b] _ _) str1 str2 str3 =-                  Result (FunctionCall f [result newA, result newB] newInf newInf) (snd newInf) cRep-    where-        ((newA, newB, newInf), (cRep, _, _)) = flip StateMonad.runState (defaultState line col) $ do-            code str1-            na <- monadicTransform' t (options, place, indent) a-            code str2-            nb <- monadicTransform' t (options, place, indent) b-            code str3-            (_, nl, nc) <- StateMonad.get-            return (na, nb, ((line,col),(nl,nc)))--code s = do-    (str, line, col) <- StateMonad.get-    let numEOF = length (filter (=='\n') s)-    StateMonad.put (str++s,line + numEOF, (if numEOF == 0 then col else 0) + length (takeWhile (/='\n') $ reverse s))--indenter n = do-    (str, line, col) <- StateMonad.get-    StateMonad.put (str ++ concat (replicate n " "), line, col)--monadicTransform' t down d = do-    (_, line, col) <- StateMonad.get-    let res = transform t (line, col) down d-    code $ up res-    return res--complexTransform t down d = do-    (_, line, col) <- StateMonad.get-    return $ transform t (line, col) down d--monadicListTransform' t down l = do-    (_, line, col) <- StateMonad.get-    let resList = transform1 t (line, col) down l-    code $ up1 resList-    return resList--defaultState :: Int -> Int -> (String, Int, Int)-defaultState line col = ("", line, col)

@@ -26,6 +26,7 @@ -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- +{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -56,7 +57,13 @@     type ExternalInfo RulePlugin = Options     executePlugin _ externalInfo = result . transform RulePlugin 0 externalInfo -instance (DefaultTransformable RulePlugin t, Typeable1 t) => Transformable RulePlugin t where+instance ( DefaultTransformable RulePlugin t+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708+         , Typeable t+#else+         , Typeable1 t+#endif+         ) => Transformable RulePlugin t where     transform t s d orig = recurse { result = x'', up = pr1 ++ pr2 ++ pr3, state = newID2 }       where         recurse = defaultTransform t s d orig

@@ -1,199 +0,0 @@------ Copyright (c) 2009-2011, ERICSSON AB--- All rights reserved.--- --- Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are met:--- ---     * Redistributions of source code must retain the above copyright notice, ---       this list of conditions and the following disclaimer.---     * Redistributions in binary form must reproduce the above copyright---       notice, this list of conditions and the following disclaimer in the---       documentation and/or other materials provided with the distribution.---     * Neither the name of the ERICSSON AB nor the names of its contributors---       may be used to endorse or promote products derived from this software---       without specific prior written permission.--- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"--- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE--- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE --- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE--- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL--- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR--- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER--- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,--- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE--- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-----{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module Feldspar.Compiler.Backend.C.Plugin.TypeCorrector where--import qualified Data.Map as Map-import Feldspar.Transformation-import Feldspar.Compiler.Backend.C.CodeGeneration-import Feldspar.Compiler.Error---- ===========================================================================---  == Type corrector plugin--- ===========================================================================--- TODO: IS THIS STILL NEEDED? --typeCorrectorError :: String -> a-typeCorrectorError = handleError "PluginArch/TypeCorrector" InternalError--type TypeCatalog = Map.Map String Type--instance Default TypeCatalog where-    def = Map.empty---- first collect types of global variables-data GlobalCollector = GlobalCollector-instance Transformation GlobalCollector where-    type From GlobalCollector = ()-    type To GlobalCollector = ()-    type Down GlobalCollector = Bool -- variable is global-    type Up GlobalCollector = ()-    type State GlobalCollector = TypeCatalog---instance Transformable GlobalCollector Entity where-        transform t s _ = defaultTransform t s False--instance Transformable GlobalCollector Variable where-        transform _ s d v@(Variable name typ _ ()) = Result v s' () where-            s'-             | d            = Map.insert name typ s-             | otherwise    = s--data TypeCheckDown = TypeCheckDown-    { globals       :: TypeCatalog-    , inDeclaration :: Bool-    }--inDecl :: TypeCheckDown -> Bool -> TypeCheckDown-inDecl d b = d {inDeclaration = b}--instance Default [String] where-    def = []-instance Combine [String] where-    combine = (++)---- get globals as state collect types of variables in a procedure, then corrert types-data TypeCheck = TypeCheck-instance Transformation TypeCheck where-    type From TypeCheck = ()-    type To TypeCheck = ()-    type Down TypeCheck = TypeCheckDown     -- globals variable's type, in a declaration-    type Up TypeCheck = [String]                -- errors-    type State TypeCheck = TypeCatalog          -- local variable's types-    -instance Transformable TypeCheck Entity where-        transform t _ d p@ProcDef{} = defaultTransform t s' d' p where-            s' = def                       -- start with an empty local variable type catalog-            d' = inDecl d True             --input parameters are declarations (block will correct where it isn't good)-        transform _ s _ p = Result p s def -- just definitions, not implementation, not need check/correct-                -instance Transformable TypeCheck Block where-    transform t s d b = tr-        { result = (result tr)-            { blockBody = mkSeq (err (up tr)) $ blockBody $ result tr-            }-        , state = s -- forget locals-        , up = []-        }-        where-            tr = defaultTransform t s (inDecl d False) b   -- we are'n in declaration (correct the procedure's change)-            mkSeq (Empty _ _) x = x-            mkSeq p (Sequence ps _ _) = Sequence (p:ps) () ()-            mkSeq p p2 = Sequence [p, p2] () ()-            err [] = Empty () ()-            err x  = Comment True (listprint id "\n " $ uniq x) () ()-            uniq [] = []-            uniq (x:xs) = x : uniq (filter (/= x) xs)--instance Transformable TypeCheck Declaration where-        transform t s d (Declaration v i inf) = Result (Declaration (result tr1) (result1 tr2) $ convert inf) (state1 tr2) (combine (up tr1) (up1 tr2)) where-            tr1 = transform t s (inDecl d True) v-            tr2 = transform1 t (state tr1) d i--instance Transformable TypeCheck Program where-        transform t s d (ParLoop v b i p inf1 inf2) = Result (ParLoop (result tr1) (result tr2) i (result tr3) (convert inf1) $ convert inf2) s' (foldl combine (up tr1) [up tr2, up tr3]) where-            tr1 = transform t s (inDecl d True) v     -- loop variable is an undeclared local-            tr2 = transform t (state tr1) d b-            tr3 = transform t (state tr2) d p-            s' = s                                    -- forget loop variable (no other new var can be here, other news deleted at block)-        transform t s d p = defaultTransform t s d p--instance Transformable TypeCheck Variable where-        transform _ s d v@(Variable name typ _ ()) -            | inDeclaration d = Result v (Map.insert name typ s) def-            | otherwise       = Result v s u' where-                u' = case Map.lookup name allVar of-                    Just typ2-                        | typ == typ2 -> []-                        | otherwise   -> ["Inconsistent types: " ++ name ++ " (actual type: " ++show typ ++ ", declared type: " ++ show typ2 ++ ")"]-                    Nothing -> ["Undeclared variable: " ++ name]-                allVar :: TypeCatalog-                allVar = Map.unionWith const (globals d) s--data TypeCorrector = TypeCorrector-instance Transformation TypeCorrector where-    type From TypeCorrector = ()-    type To TypeCorrector = ()-    type Down TypeCorrector = TypeCatalog     -- global variable's type, in a declaration-    type Up TypeCorrector = ()-    type State TypeCorrector = TypeCatalog    -- local variable's types--instance Transformable TypeCorrector Entity where-    transform t _ d p@ProcDef{} = defaultTransform t (state tr) d p where-        tr = defaultTransform t def d p -- start with an empty local variable type catalog-    transform _ s _ p = Result p s def -- just definitions, not implementation, not need check/correct--instance Transformable TypeCorrector Variable where-    transform _ ls gs v@(Variable name typ _ ()) = Result v' (Map.insert name typ' ls) def where-        v' = v {varType = typ'}-        typ' = case Map.lookup name allVar of-            Just typ2-                | typ == typ2 -> typ2-                | otherwise   -> select typ typ2-            Nothing -> typ-        allVar = Map.unionWith const gs ls--select :: Type -> Type -> Type-select act decl-    | ok        = typ-    | otherwise = decl-    where-        (ok,typ) = select' act decl-        select' (ComplexType t1) (ComplexType t2) = (o, ComplexType t) where-            (o,t) = select' t1 t2-        select' (ArrayType l1 t1) (ArrayType l2 t2) = (o && o2, ArrayType l t) where-            (o,t) = select' t1 t2-            (o2,l) = select'' l1 l2-            select'' UndefinedLen x = (True, x)-            select'' x UndefinedLen = (True, x)-            select'' (LiteralLen a) (LiteralLen b) = (a==b, LiteralLen b)-        select' (StructType t1) (StructType t2) = (o, StructType t) where-            (o,t) = select'' t1 t2-            select'' [] [] = (True, [])-            select'' [] _ = (False, undefined)-            select'' _ [] = (False, undefined)-            select'' ((a,st1):ts1) ((b,st2):ts2) = ( a==b && oo && ooo, (a,tt):tts) where-                (oo,tt) = select' st1 st2-                (ooo,tts) = select'' ts1 ts2-        select' t1 t2-            | t1 == t2 = (True, t1)-            | otherwise = (False, undefined)--instance Plugin TypeCorrector where-    type ExternalInfo TypeCorrector = Bool-    executePlugin TypeCorrector showErr procedure = -        result $ transform TypeCorrector def gs x where-            gs = state $ transform GlobalCollector def False procedure-            x -                | showErr = result $ transform TypeCheck def (TypeCheckDown gs False) procedure-                | otherwise = procedure

@@ -1,87 +0,0 @@------ Copyright (c) 2009-2011, ERICSSON AB--- All rights reserved.--- --- Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are met:--- ---     * Redistributions of source code must retain the above copyright notice, ---       this list of conditions and the following disclaimer.---     * Redistributions in binary form must reproduce the above copyright---       notice, this list of conditions and the following disclaimer in the---       documentation and/or other materials provided with the distribution.---     * Neither the name of the ERICSSON AB nor the names of its contributors---       may be used to endorse or promote products derived from this software---       without specific prior written permission.--- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"--- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE--- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE --- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE--- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL--- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR--- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER--- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,--- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE--- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-----{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module Feldspar.Compiler.Backend.C.Plugin.TypeDefinitionGenerator where--import Data.List-import Feldspar.Transformation-import Feldspar.Compiler.Backend.C.CodeGeneration-import Feldspar.Compiler.Backend.C.Options-import Feldspar.Compiler.Error---- ===========================================================================---  == Type definition generator plugin--- ===========================================================================--typeDefGenError :: ErrorClass -> String -> a-typeDefGenError = handleError "PluginArch/TypeDefinitionGenerator"--data TypeDefinitionGenerator = TypeDefinitionGenerator--getTypes :: Options -> Type -> [Entity ()]-getTypes options typ = {-trace ("DEBUG: "show typ) $-} case typ of-    StructType members -> concatMap (\(_,t) -> getTypes options t) members-                       ++ [StructDef {-                               structName      = toC options Declaration_pl (StructType members),-                               structMembers   = map (\(n,t) -> StructMember n t ()) members,-                               structLabel     = (),-                               definitionLabel = ()-                          }]-    ArrayType _ baseType -> getTypes options baseType-    _ -> []-    -- XXX complexType?--instance Transformation TypeDefinitionGenerator where-    type From TypeDefinitionGenerator = ()-    type To TypeDefinitionGenerator = ()-    type Down TypeDefinitionGenerator = Options-    type Up TypeDefinitionGenerator = ()-    type State TypeDefinitionGenerator = [Entity ()]--instance Transformable TypeDefinitionGenerator Module where-    transform selfpointer origState fromAbove origModule = defaultTransformationResult {-        result = (result defaultTransformationResult) {-            entities = nub (state defaultTransformationResult)-                     ++ entities (result defaultTransformationResult)-        }-    } where-        defaultTransformationResult = defaultTransform selfpointer origState fromAbove origModule--instance Transformable TypeDefinitionGenerator Variable where-    transform selfpointer origState fromAbove origVariable = defaultTransformationResult {-        state = state defaultTransformationResult ++ getTypes fromAbove (varType origVariable)-    } where-        defaultTransformationResult = defaultTransform selfpointer origState fromAbove origVariable--instance Plugin TypeDefinitionGenerator where-    type ExternalInfo TypeDefinitionGenerator = Options-    executePlugin TypeDefinitionGenerator externalInfo procedure = result-        $ transform TypeDefinitionGenerator [{-state-}] externalInfo procedure

@@ -1,76 +0,0 @@------ Copyright (c) 2009-2011, ERICSSON AB--- All rights reserved.--- --- Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are met:--- ---     * Redistributions of source code must retain the above copyright notice, ---       this list of conditions and the following disclaimer.---     * Redistributions in binary form must reproduce the above copyright---       notice, this list of conditions and the following disclaimer in the---       documentation and/or other materials provided with the distribution.---     * Neither the name of the ERICSSON AB nor the names of its contributors---       may be used to endorse or promote products derived from this software---       without specific prior written permission.--- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"--- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE--- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE --- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE--- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL--- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR--- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER--- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,--- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE--- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-----{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module Feldspar.Compiler.Backend.C.Plugin.VariableRoleAssigner where--import Feldspar.Transformation--data VariableRoleAssigner = VariableRoleAssigner--data Parameters = Parameters-    { inParametersVRA  :: [String]-    , outParametersVRA :: [String]-    }--instance Transformation VariableRoleAssigner where-    type From VariableRoleAssigner = ()-    type To VariableRoleAssigner = ()-    type Down VariableRoleAssigner = Parameters-    type Up VariableRoleAssigner = ()-    type State VariableRoleAssigner = ()--instance Transformable VariableRoleAssigner Variable where-        transform _ _ d v = Result v' () () where-            v' = v { varRole = if (varName v `elem` outParametersVRA d) ||-                            (isComposite v && (varName v `elem` inParametersVRA d))-                        then Pointer else Value-                   , varLabel = ()-                   }--instance Transformable VariableRoleAssigner Entity where-        transform t s _ p@(ProcDef _ i o _ _ _) = defaultTransform t s d' p where-            d' = Parameters-                    { inParametersVRA = map varName i-                    , outParametersVRA = map varName o-                    }-        transform t s d p = defaultTransform t s d p--instance Plugin VariableRoleAssigner where-    type ExternalInfo VariableRoleAssigner = ()-    executePlugin self@VariableRoleAssigner _ procedure = -        result $ transform self ({-state-}) (Parameters [] []) procedure--isComposite :: Variable () -> Bool-isComposite v = case varType v of-    ArrayType{}  -> True-    StructType{} -> True-    _            -> False-

@@ -0,0 +1,65 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++-- | Type rewriting for Feldspar programs+module Feldspar.Compiler.CallConv+  ( rewriteType+  , buildHaskellType+  , buildCType+  )+  where+++import Language.Haskell.TH++import System.Plugins.MultiStage++import Foreign.Ptr (Ptr)++import Feldspar (Syntactic(..))++-- | Normalize the type (expand type synonyms and type families)+rewriteType :: Type -> Q Type+rewriteType t = applyTF ''Internal t >>= expandTF++haskellCC :: CallConv+haskellCC = CallConv { arg  = return+                     , res  = appT (conT ''IO) . return+                     }++feldsparCC :: CallConv+feldsparCC = CallConv { arg = ref . rep . return+                      , res = toIO . appT (conT ''Ptr) . rep . return+                      }+  where+    ref    = appT (conT ''Ref)+    rep    = appT (conT ''Rep)+    toIO t = appT (appT arrowT t) (appT (conT ''IO) (tupleT 0))++-- | Construct the corresponding Haskell type of a foreign Feldspar+-- function+--+-- > prog1 :: Data Index -> Vector1 Index+-- >+-- > sigD (mkName "h_prog1") $ loadFunType 'prog1 >>= rewriteType >>= buildHaskellType+--+-- becomes+--+-- > h_prog1 :: Index -> IO [Index]+--+buildHaskellType :: Type -> Q Type+buildHaskellType = buildType haskellCC++-- | Construct the corresponding C type of a compiled Feldspar function+--+-- > sigD (mkName "c_prog1_fun") $ loadFunType 'prog1 >>= rewriteType+--                                                    >>= buildCType+--+-- becomes+--+-- > c_prog1_fun :: Word32 -> Ptr (SA Word32) -> IO ()+--+buildCType :: Type -> Q Type+buildCType = buildType feldsparCC+

@@ -1,11 +1,11 @@ -- -- Copyright (c) 2009-2011, ERICSSON AB -- All rights reserved.--- +-- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are met:--- ---     * Redistributions of source code must retain the above copyright notice, +--+--     * Redistributions of source code must retain the above copyright notice, --       this list of conditions and the following disclaimer. --     * Redistributions in binary form must reproduce the above copyright --       notice, this list of conditions and the following disclaimer in the@@ -13,10 +13,10 @@ --     * Neither the name of the ERICSSON AB nor the names of its contributors --       may be used to endorse or promote products derived from this software --       without specific prior written permission.--- +-- -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE--- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR@@ -26,138 +26,93 @@ -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- -{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ExistentialQuantification #-}  module Feldspar.Compiler.Compiler where -import System.FilePath-import Data.Typeable as DT-import Control.Arrow+import Data.List (partition)+import Data.Maybe (fromMaybe) import Control.Applicative  import Feldspar.Transformation-import qualified Feldspar.NameExtractor as NameExtractor+import Feldspar.Core.Constructs (SyntacticFeld)+import Feldspar.Core.Interpretation (defaultFeldOpts) import Feldspar.Compiler.Backend.C.Library import Feldspar.Compiler.Backend.C.Options import Feldspar.Compiler.Backend.C.Platforms import Feldspar.Compiler.Backend.C.Plugin.Rule-import Feldspar.Compiler.Backend.C.Plugin.TypeDefinitionGenerator-import Feldspar.Compiler.Backend.C.Plugin.VariableRoleAssigner-import Feldspar.Compiler.Backend.C.Plugin.BlockProgramHandler-import Feldspar.Compiler.Backend.C.Plugin.TypeCorrector-import Feldspar.Compiler.Backend.C.Plugin.PrettyPrint+import Feldspar.Compiler.Backend.C.CodeGeneration import Feldspar.Compiler.Imperative.FromCore-import Feldspar.Compiler.Imperative.Plugin.ConstantFolding-import Feldspar.Compiler.Imperative.Plugin.Free import Feldspar.Compiler.Imperative.Plugin.IVars-import Feldspar.Compiler.Imperative.Plugin.Naming-import Feldspar.Compiler.Imperative.Plugin.Unroll -data SomeCompilable = forall a internal . Compilable a internal => SomeCompilable a-    deriving (DT.Typeable)--type Position = (Int, Int)+data SplitModuleDescriptor = SplitModuleDescriptor+    { smdSource :: Module ()+    , smdHeader :: Module ()+    } -data SplitModuleDescriptor = SplitModuleDescriptor {-    smdSource :: Module (),-    smdHeader :: Module ()-}+data SplitCompToCCoreResult = SplitCompToCCoreResult+    { sctccrSource :: CompToCCoreResult ()+    , sctccrHeader :: CompToCCoreResult ()+    } -data CompToCCoreResult = CompToCCoreResult {+data CompToCCoreResult t = CompToCCoreResult {     sourceCode      :: String,-    endPosition     :: Position,-    debugModule     :: Module DebugToCSemanticInfo-}--data SplitCompToCCoreResult = SplitCompToCCoreResult {-    sctccrSource :: CompToCCoreResult,-    sctccrHeader :: CompToCCoreResult+    debugModule     :: Module t } -data IncludesNeeded = IncludesNeeded | NoIncludesNeeded { incneedLineNum :: Int }- moduleSplitter :: Module () -> SplitModuleDescriptor moduleSplitter m = SplitModuleDescriptor {-    smdHeader = Module (filter belongsToHeader (entities m) ++ createProcDecls (entities m)) (moduleLabel m),-    smdSource = Module (filter (not . belongsToHeader) $ entities m) (moduleLabel m)+    smdHeader = Module (hdr ++ createProcDecls (entities m)),+    smdSource = Module body } where+    (hdr, body) = partition belongsToHeader (entities m)     belongsToHeader :: Entity () -> Bool-    belongsToHeader StructDef{} = True-    belongsToHeader ProcDecl{}  = True-    belongsToHeader _           = False+    belongsToHeader StructDef{}                     = True+    belongsToHeader Proc{..} | Nothing <- procBody  = True+    belongsToHeader _                               = False+    -- TODO These only belongs in the header iff the types are used in a+    -- function interface     createProcDecls :: [Entity ()] -> [Entity ()]-    createProcDecls = foldr ((++) . convertProcDefToProcDecl) []-    convertProcDefToProcDecl :: Entity () -> [Entity ()]-    convertProcDefToProcDecl e = case e of-        ProcDef n inparams outparams _ label1 label2 -> [ProcDecl n inparams outparams label1 label2]-        _ -> []--separateAndCompileToCCore :: (Compilable t internal)-  => (Module ()-  -> [Module ()])-  -> CompilationMode -> t -> IncludesNeeded-  -> NameExtractor.OriginalFunctionSignature -> Options-  -> [(CompToCCoreResult, Module ())]-separateAndCompileToCCore-  moduleSeparator-  compMode prg needed-  functionSignature coreOptions =-    pack <$> separatedModules-      where-        pack = compToCWithInfo &&& id--        separatedModules =-          moduleSeparator $-          executePluginChain' compMode prg functionSignature coreOptions--        compToCWithInfo = moduleToCCore needed coreOptions+    createProcDecls = concatMap defToDecl+    defToDecl :: Entity () -> [Entity ()]+    defToDecl (Proc n inp outp _) = [Proc n inp outp Nothing]+    defToDecl _ = [] -moduleToCCore-  :: IncludesNeeded -> Options -> Module ()-  -> CompToCCoreResult-moduleToCCore needed opts mdl =-  CompToCCoreResult {-    sourceCode      = incls ++ moduleSrc-  , endPosition     = endPos-  , debugModule     = dbgModule-  }+moduleToCCore :: Options -> Module () -> CompToCCoreResult ()+moduleToCCore opts mdl = CompToCCoreResult { sourceCode  = incls ++ res+                                           , debugModule = mdl+                                           }   where-    (incls, lineNum) = genInclude needed+    res = compToCWithInfos opts mdl+    incls = genIncludeLines opts Nothing -    (dbgModule, (moduleSrc, endPos)) =-      compToCWithInfos ((opts,Declaration_pl), lineNum) mdl -    genInclude IncludesNeeded         = genIncludeLines opts Nothing-    genInclude (NoIncludesNeeded ln)  = ("", ln)- -- | Compiler core -- This functionality should not be duplicated. Instead, everything should call this and only do a trivial interface adaptation. compileToCCore-  :: (Compilable t internal) => CompilationMode -> t -> Maybe String -> IncludesNeeded-  -> NameExtractor.OriginalFunctionSignature -> Options-  -> SplitCompToCCoreResult-compileToCCore compMode prg _ includesNeeded-  funSig coreOptions =-    createSplit $ fst <$> separateAndCompileToCCore headerAndSource-      compMode prg includesNeeded funSig coreOptions-  where-    headerAndSource modules = [header, source]-      where (SplitModuleDescriptor header source) = moduleSplitter modules+  :: SyntacticFeld c => String -> Options -> c -> SplitCompToCCoreResult+compileToCCore funSig coreOptions prg =+    createSplit $ moduleToCCore coreOptions <$> separatedModules+      where+        separatedModules = moduleSeparator+                         $ executePluginChain funSig coreOptions prg -    createSplit [header, source] = SplitCompToCCoreResult header source+        moduleSeparator modules = [header, source]+          where (SplitModuleDescriptor header source) = moduleSplitter modules -genIncludeLinesCore :: [String] -> (String, Int)-genIncludeLinesCore []   = ("", 1)-genIncludeLinesCore (x:xs) = ("#include " ++ x ++ "\n" ++ str, linenum + 1) where-    (str, linenum) = genIncludeLinesCore xs+        createSplit [header, source] = SplitCompToCCoreResult header source -genIncludeLines :: Options -> Maybe String -> (String, Int)-genIncludeLines coreOptions mainHeader = (str ++ "\n\n", linenum + 2) where-    (str, linenum)  = genIncludeLinesCore $ includes (platform coreOptions) ++ mainHeaderCore-    mainHeaderCore = case mainHeader of-        Nothing -> []-        Just filename -> ["\"" ++ takeFileName filename ++ ".h\""]+genIncludeLines :: Options -> Maybe String -> String+genIncludeLines opts mainHeader = concatMap include incs ++ "\n\n"+  where+    include []            = ""+    include fname@('<':_) = "#include " ++ fname ++ "\n"+    include fname         = "#include \"" ++ fname ++ "\"\n"+    incs = includes (platform opts) ++ [fromMaybe "" mainHeader]  -- | Predefined options @@ -168,12 +123,18 @@     , unroll            = NoUnroll     , debug             = NoDebug     , memoryInfoVisible = True+    , printHeader       = False     , rules             = []+    , frontendOpts      = defaultFeldOpts+    , nestSize          = 2     }  c99PlatformOptions :: Options c99PlatformOptions              = defaultOptions +c99OpenMpPlatformOptions :: Options+c99OpenMpPlatformOptions        = defaultOptions { platform = c99OpenMp }+ tic64xPlatformOptions :: Options tic64xPlatformOptions           = defaultOptions { platform = tic64x } @@ -191,58 +152,19 @@ pluginChain :: ExternalInfoCollection -> Module () -> Module () pluginChain externalInfo     = executePlugin RulePlugin (ruleExternalInfo externalInfo)-    . executePlugin TypeDefinitionGenerator (typeDefinitionGeneratorExternalInfo externalInfo)-    . executePlugin ConstantFolding ()-    . executePlugin UnrollPlugin (unrollExternalInfo externalInfo)-    . executePlugin Precompilation (precompilationExternalInfo externalInfo)     . executePlugin RulePlugin (primitivesExternalInfo externalInfo)-    . executePlugin Free ()     . executePlugin IVarPlugin ()-    . executePlugin VariableRoleAssigner (variableRoleAssignerExternalInfo externalInfo)-    . executePlugin TypeCorrector (typeCorrectorExternalInfo externalInfo)-    . executePlugin BlockProgramHandler () -data ExternalInfoCollection = ExternalInfoCollection {-      precompilationExternalInfo          :: ExternalInfo Precompilation-    , unrollExternalInfo                  :: ExternalInfo UnrollPlugin-    , primitivesExternalInfo              :: ExternalInfo RulePlugin-    , ruleExternalInfo                    :: ExternalInfo RulePlugin-    , typeDefinitionGeneratorExternalInfo :: ExternalInfo TypeDefinitionGenerator-    , variableRoleAssignerExternalInfo    :: ExternalInfo VariableRoleAssigner-    , typeCorrectorExternalInfo           :: ExternalInfo TypeCorrector-}--executePluginChain' :: (Compilable c internal)-  => CompilationMode -> c -> NameExtractor.OriginalFunctionSignature-  -> Options -> Module ()-executePluginChain' compMode prg originalFunctionSignatureParam opt =-  pluginChain ExternalInfoCollection {-    precompilationExternalInfo = PrecompilationExternalInfo {-        originalFunctionSignature = fixedOriginalFunctionSignature-      , inputParametersDescriptor = buildInParamDescriptor prg-      , numberOfFunctionArguments = numArgs prg-      , compilationMode           = compMode-      }-    , unrollExternalInfo                  = unroll opt-    , primitivesExternalInfo              = opt{ rules = platformRules $ platform opt }-    , ruleExternalInfo                    = opt-    , typeDefinitionGeneratorExternalInfo = opt-    , variableRoleAssignerExternalInfo    = ()-    , typeCorrectorExternalInfo           = False-    } $ fromCore "PLACEHOLDER" prg-  where-    ofn = NameExtractor.originalFunctionName-    fixedOriginalFunctionSignature = originalFunctionSignatureParam {-      NameExtractor.originalFunctionName =-        fixFunctionName $ ofn originalFunctionSignatureParam+data ExternalInfoCollection = ExternalInfoCollection+    { primitivesExternalInfo :: ExternalInfo RulePlugin+    , ruleExternalInfo       :: ExternalInfo RulePlugin     } -executePluginChain :: (Compilable c internal)-                   => CompilationMode-                   -> c-                   -> NameExtractor.OriginalFunctionSignature-                   -> Options-                   -> SplitModuleDescriptor-executePluginChain cm f sig opts =-  moduleSplitter $ executePluginChain' cm f sig opts+executePluginChain :: SyntacticFeld c+                   => String -> Options -> c -> Module ()+executePluginChain originalFunctionName opt prg =+  pluginChain ExternalInfoCollection+    { primitivesExternalInfo = opt{ rules = platformRules $ platform opt }+    , ruleExternalInfo       = opt+    } $ fromCore opt (encodeFunctionName originalFunctionName) prg 

@@ -1,3 +1,7 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+ -- -- Copyright (c) 2009-2011, ERICSSON AB -- All rights reserved.@@ -28,48 +32,31 @@  module Feldspar.Compiler.Frontend.Interactive.Interface where +import Feldspar.Core.Constructs (SyntacticFeld) import Feldspar.Compiler.Compiler import Feldspar.Compiler.Imperative.FromCore import Feldspar.Compiler.Backend.C.Options-import qualified Feldspar.NameExtractor as NameExtractor import Feldspar.Compiler.Backend.C.Library-import Feldspar.Compiler.Imperative.Representation-import Feldspar.Compiler.Backend.C.Plugin.PrettyPrint-import Feldspar.Compiler.Backend.C.Plugin.Locator+import Feldspar.Compiler.Imperative.Representation (Module)  import Data.Char+import Control.Monad (when)+import System.FilePath (takeFileName)  -- ================================================================================================ --  == Interactive compilation -- ================================================================================================ -data PrgType = ForType | AssignType | IfType--forPrg = ForType-ifPrg  = IfType-assignPrg = AssignType--getProgram :: (Int, Int) -> PrgType -> Module DebugToCSemanticInfo -> IO ()-getProgram (line, col) prgtype prg = res where-     res = if find then putStrLn $ myShow code-                   else putStrLn "Not found appropriate code part!"-     (find, code) = case prgtype of-                        ForType     -> getPrgParLoop (line, col) prg-                        AssignType  -> getPrgAssign (line, col) prg-                        IfType      -> getPrgBranch (line, col) prg---compile :: (Compilable t internal) => t -> FilePath -> String -> Options -> IO ()+compile :: (SyntacticFeld t) => t -> FilePath -> String -> Options -> IO () compile prg fileName functionName opts = do-    writeFile cfile $ unlines [ "#include \"" ++ hfile ++ "\""+    writeFile cfile $ unlines [ "#include \"" ++ takeFileName hfile ++ "\""                               , sourceCode $ sctccrSource compilationResult                               ]     writeFile hfile $ withIncludeGuard $ sourceCode $ sctccrHeader compilationResult   where     hfile = makeHFileName fileName     cfile = makeCFileName fileName-    compilationResult = compileToCCore Interactive prg (Just fileName) IncludesNeeded-                                       (NameExtractor.OriginalFunctionSignature functionName []) opts+    compilationResult = compileToCCore functionName opts prg      withIncludeGuard code = unlines [ "#ifndef " ++ guardName                                     , "#define " ++ guardName@@ -84,19 +71,25 @@         toBeChanged = "./\\"  -icompile :: (Compilable t internal) => t -> IO ()-icompile prg = icompile' prg "test" defaultOptions+icompile :: (SyntacticFeld t) => t -> IO ()+icompile = icompileWith defaultOptions -icompile' :: (Compilable t internal) => t -> String -> Options -> IO ()-icompile' prg functionName opts = do-    putStrLn "=============== Header ================"-    putStrLn $ sourceCode $ sctccrHeader compilationResult-    putStrLn "=============== Source ================"-    putStrLn $ sourceCode $ sctccrSource compilationResult-  where-    compilationResult = compileToCCore Interactive prg Nothing IncludesNeeded-                                       (NameExtractor.OriginalFunctionSignature functionName []) opts+icompileWith :: (SyntacticFeld t) => Options -> t -> IO ()+icompileWith opts = icompile' opts "test" -icompileWithInfos :: (Compilable t internal) => t -> String -> Options -> SplitCompToCCoreResult-icompileWithInfos prg functionName = compileToCCore Interactive prg Nothing IncludesNeeded-                                                          (NameExtractor.OriginalFunctionSignature functionName [])+icompile' :: (SyntacticFeld t) => Options -> String -> t -> IO ()+icompile' opts functionName prg = do+    let res = compileToCCore functionName opts prg+    when (printHeader opts) $ do+      putStrLn "=============== Header ================"+      putStrLn $ sourceCode $ sctccrHeader res+      putStrLn "=============== Source ================"+    putStrLn $ sourceCode $ sctccrSource res++-- | Get the generated core for a program.+getCore :: (SyntacticFeld t) => t -> Module ()+getCore = getCore' defaultOptions++-- | Print the generated core for a program.+printCore :: (SyntacticFeld t) => t -> IO ()+printCore prog = print $ getCore' defaultOptions prog

@@ -1,5 +1,3 @@-{-# LANGUAGE ConstraintKinds #-}- -- -- Copyright (c) 2009-2011, ERICSSON AB -- All rights reserved.@@ -30,15 +28,18 @@  {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}  module Feldspar.Compiler.Imperative.FromCore where  +import Data.List (nub)+import Data.Typeable+ import Control.Monad.RWS  import Language.Syntactic@@ -48,14 +49,26 @@ import Feldspar.Core.Types import Feldspar.Core.Interpretation import Feldspar.Core.Constructs+import Feldspar.Core.Constructs.Literal import Feldspar.Core.Constructs.Binding import Feldspar.Core.Frontend -import Feldspar.Compiler.Imperative.Representation (Module)-import Feldspar.Compiler.Imperative.Frontend hiding (Type)+import Feldspar.Range (upperBound)++import qualified Feldspar.Compiler.Imperative.Representation as Rep (Variable(..), Type(..))+import Feldspar.Compiler.Imperative.Representation+         ( ActualParameter(..)+         , Block(..)+         , Declaration(..)+         , Entity(..)+         , Expression(..)+         , Module(..)+         , Program(..)+         )+import Feldspar.Compiler.Imperative.Frontend import Feldspar.Compiler.Imperative.FromCore.Interpretation import Feldspar.Compiler.Imperative.FromCore.Array ()-import Feldspar.Compiler.Imperative.FromCore.Binding ()+import Feldspar.Compiler.Imperative.FromCore.Binding (compileBind) import Feldspar.Compiler.Imperative.FromCore.Condition () import Feldspar.Compiler.Imperative.FromCore.ConditionM () import Feldspar.Compiler.Imperative.FromCore.Error ()@@ -70,63 +83,86 @@ import Feldspar.Compiler.Imperative.FromCore.Primitive () import Feldspar.Compiler.Imperative.FromCore.Save () import Feldspar.Compiler.Imperative.FromCore.SizeProp ()+import Feldspar.Compiler.Imperative.FromCore.Switch () import Feldspar.Compiler.Imperative.FromCore.SourceInfo () import Feldspar.Compiler.Imperative.FromCore.Tuple () -instance Compile FeldDomain FeldDomain+import Feldspar.Compiler.Backend.C.Options (Options(..))++instance Compile FeldDom FeldDom   where     compileProgSym (C' a) = compileProgSym a     compileExprSym (C' a) = compileExprSym a -instance Compile Empty FeldDomain+instance Compile Empty dom   where     compileProgSym _ = error "Can't compile Empty"     compileExprSym _ = error "Can't compile Empty" -compileProgTop :: (Compile dom dom, Project (CLambda Type) dom) =>-    String -> [Var] -> ASTF (Decor Info dom) a -> Mod-compileProgTop funname args (lam :$ body)+compileProgTop :: ( Compile dom dom+                  , Project (CLambda Type) dom+                  , Project Let dom+                  , Project (Literal :|| Type) dom+                  , ConstrainedBy dom Typeable+                  ) =>+    Options -> String -> [(VarId, ASTB (Decor Info dom) Type)] ->+    ASTF (Decor Info dom) a -> CodeWriter (Rep.Variable ())+compileProgTop opt funname bs (lam :$ body)     | Just (SubConstr2 (Lambda v)) <- prjLambda lam-    = let ta  = argType $ infoType $ getInfo lam-          sa  = defaultSize ta-          var = mkVariable (compileTypeRep ta sa) v-       in compileProgTop funname (var:args) body-compileProgTop funname args a = Mod defs+    = do+         let ta  = argType $ infoType $ getInfo lam+             sa  = fst $ infoSize $ getInfo lam+             typ = compileTypeRep ta sa+             arg | Rep.StructType{} <- typ = mkPointer typ v+                 | otherwise               = mkVariable typ v+         tell $ mempty {params=[arg]}+         withAlias v (varToExpr arg) $+           compileProgTop opt funname bs body+compileProgTop opt funname bs (lt :$ e :$ (lam :$ body))+  | Just (SubConstr2 (Lambda v)) <- prjLambda lam+  , Just Let <- prj lt+  , Just (C' Literal{}) <- prjF e -- Input on form let x = n in e+  , [ProcedureCall "copy" [ValueParameter (VarExpr vr), ValueParameter (ConstExpr c)]] <- bd+  , freshName Prelude.== vName vr -- Ensure that compiled result is on form x = n+  = do tellDef [ValueDef var c]+       withAlias v (varToExpr var) $+         compileProgTop opt funname bs body   where-    ins      = reverse args-    info     = getInfo a-    outType  = compileTypeRep (infoType info) (infoSize info)-    outParam = Pointer outType "out"-    outLoc   = Ptr outType "out"-    results  = snd $ evalRWS (compileProg outLoc a) initReader initState-    Bl ds p  = block results-    defs     = def results ++ [ProcDf funname ins [outParam] (Block ds p)]--class    SyntacticFeld a => Compilable a internal | a -> internal-instance SyntacticFeld a => Compilable a ()-  -- TODO This class should be replaced by (Syntactic a FeldDomainAll) (or a-  --      similar alias) everywhere. The second parameter is not needed.--fromCore :: SyntacticFeld a => String -> a -> Module ()-fromCore funname-    = fromInterface-    . compileProgTop funname []-    . reifyFeld N32+    info     = getInfo e+    outType  = case compileTypeRep (infoType info) (infoSize info) of+                 Rep.ArrayType rs t -> Rep.NativeArray (Just $ upperBound rs) t+                 t -> t+    var@(Rep.Variable _ freshName) = case prjLambda lam of+               Just (SubConstr2 (Lambda v)) -> mkVariable outType v+    bd = sequenceProgs $ blockBody $ block $ snd $+          evalRWS (compileProg (Just $ varToExpr var) e) (initReader opt) initState+compileProgTop opt funname bs e@(lt :$ _ :$ _)+  | Just Let <- prj lt+  , (bs', body) <- collectLetBinders e+  = compileProgTop opt funname (reverse bs' ++ bs) body+compileProgTop _ _ bs a = do+    let+        info       = getInfo a+        outType    = Rep.Pointer $ compileTypeRep (infoType info) (infoSize info)+        outParam   = Rep.Variable outType "out"+        outLoc     = varToExpr outParam+    mapM_ compileBind (reverse bs)+    compileProg (Just outLoc) a+    return outParam --- | Create a list where each element represents the number of variables needed--- to as arguments-buildInParamDescriptor :: SyntacticFeld a => a -> [Int]-buildInParamDescriptor = go . reifyFeld N32+fromCore :: SyntacticFeld a => Options -> String -> a -> Module ()+fromCore opt funname prog = Module defs   where-    go :: (Project (CLambda Type) dom) => ASTF (Decor info dom) a -> [Int]-    go (lam :$ body)-      | Just (SubConstr2 (Lambda _)) <- prjLambda lam-      = 1 : go body-  -- TODO the 1 above is valid as long as we represent tuples as structs-  -- When we convert a struct to a set of variables the 1 has to replaced-  -- with an implementation that calculates the apropriate value.-    go _ = []--numArgs :: SyntacticFeld a => a -> Int-numArgs = length . buildInParamDescriptor+    (outParam,results) = evalRWS (compileProgTop opt funname [] ast) (initReader opt) initState+    ast        = reifyFeld (frontendOpts opt) N32 prog+    decls      = decl results+    ins        = params results+    post       = epilogue results+    Block ds p = block results+    paramTypes = getTypes opt $ Declaration outParam Nothing:map (`Declaration` Nothing) ins+    defs       =  nub (def results ++ paramTypes)+               ++ [Proc funname ins [outParam] $ Just (Block (ds ++ decls) (Sequence (p:post)))] +-- | Get the generated core for a program.+getCore' :: SyntacticFeld a => Options -> a -> Module ()+getCore' opts = fromCore opts "test"

@@ -28,6 +28,7 @@  {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -35,7 +36,10 @@ module Feldspar.Compiler.Imperative.FromCore.Array where  +import Data.Typeable +import Control.Applicative+ import Language.Syntactic import Language.Syntactic.Constructs.Binding import Language.Syntactic.Constructs.Binding.HigherOrder@@ -43,11 +47,17 @@ import Feldspar.Core.Types as Core import Feldspar.Core.Interpretation import Feldspar.Core.Constructs.Array+import Feldspar.Core.Constructs.Tuple import Feldspar.Core.Constructs.Binding import Feldspar.Core.Constructs.Literal -import Feldspar.Compiler.Imperative.Frontend hiding (Type)+import Feldspar.Compiler.Imperative.Frontend+import qualified Feldspar.Compiler.Imperative.Representation as Rep (Type(..))+import Feldspar.Compiler.Imperative.Representation (Expression(..), Program(..),+                                                    Block(..), Size(..),+                                                    Signedness(..), typeof) import Feldspar.Compiler.Imperative.FromCore.Interpretation+import Feldspar.Compiler.Imperative.FromCore.Binding (compileBind)   @@ -55,6 +65,11 @@          , Project (CLambda Type) dom          , Project (Literal  :|| Type) dom          , Project (Variable :|| Type) dom+         , Project Let dom+         , Project (Array :|| Type) dom+         , Project (Tuple :|| Type) dom+         , ConstrainedBy dom Typeable+         , AlphaEq dom dom (Decor Info dom) [(VarId, VarId)]          )       => Compile (Array :|| Type) dom   where@@ -62,47 +77,103 @@         | Just (SubConstr2 (Lambda v)) <- prjLambda lam         = do             let ta = argType $ infoType $ getInfo lam-            let sa = defaultSize ta-            let ix@(Var _ name) = mkVar (compileTypeRep ta sa) v-            len' <- mkLength len-            (_, Bl ds body) <- confiscateBlock $ compileProg (loc :!: ix) ixf+            let sa = fst $ infoSize $ getInfo lam+            let ix = mkVar (compileTypeRep ta sa) v+            len' <- mkLength len (infoType $ getInfo len) sa+            (_, b) <- confiscateBlock $ compileProg (ArrayElem <$> loc <*> pure ix) ixf             tellProg [initArray loc len']-            tellProg [For name len' 1 (Block ds body)]+            tellProg [for True (lName ix) len' (litI32 1) b]  -    compileProgSym (C' Sequential) _ loc (len :* st :* (lam1 :$ (lam2 :$ step)) :* Nil)+    compileProgSym (C' Sequential) _ loc (len :* init' :* (lam1 :$ lt1) :* Nil)         | Just (SubConstr2 (Lambda v)) <- prjLambda lam1+        , (bs1, lam2 :$ l)             <- collectLetBinders lt1         , Just (SubConstr2 (Lambda s)) <- prjLambda lam2+        , (bs, tup :$ a :$ b)          <- collectLetBinders l+        , Just (C' Tup2)               <- prjF tup+        , not $ null bs+        , (e, ASTB step)               <- last bs+        , Just (C' (Variable t1))      <- prjF a+        , Just (C' (Variable t2))      <- prjF b+        , t1 == e+        , t2 == e         = do+            blocks <- mapM (confiscateBlock . compileBind) (bs1 ++ init bs)+            let tix = argType $ infoType $ getInfo lam1+                six = fst $ infoSize $ getInfo lam1+                tst = infoType $ getInfo step+                sst = infoSize $ getInfo step+                (dss, lets) = unzip $ map (\(_, Block ds (Sequence body)) -> (ds, body)) blocks+            let ix = mkVar (compileTypeRep tix six) v+            len' <- mkLength len (infoType $ getInfo len) six+            st1 <- freshVar "st" tst sst+            let st = mkRef (compileTypeRep tst sst) s+            declareAlias st+            (_, Block ds (Sequence body)) <- confiscateBlock $ withAlias s st $ compileProg (ArrayElem <$> loc <*> pure ix) step+            withAlias s st $ compileProg (Just st1) init'+            tellProg [ Assign st st1+                     , initArray loc len']+            tellProg [toProg $ Block (concat dss ++ ds) $+                      for False (lName ix) len' (litI32 1) $+                                    toBlock $ Sequence (concat lets ++ body ++ maybe [] (\arr -> [Assign st (ArrayElem arr ix)]) loc)]++    compileProgSym (C' Sequential) _ loc (len :* st :* (lam1 :$ lt1) :* Nil)+        | Just (SubConstr2 (Lambda v)) <- prjLambda lam1+        , (bs1, lam2 :$ step)          <- collectLetBinders lt1+        , Just (SubConstr2 (Lambda s)) <- prjLambda lam2+        = do+            blocks <- mapM (confiscateBlock . compileBind) bs1             let t = argType $ infoType $ getInfo lam1-            let sz = defaultSize t-            let ta' = argType $ infoType $ getInfo lam2-            let sa' = defaultSize ta'+            let sz = fst $ infoSize $ getInfo lam1             let tr' = resType $ infoType $ getInfo lam2-            let sr' = defaultSize tr'-            let ix@(Var _ name) = mkVar (compileTypeRep t sz) v-            let stv = mkVar (compileTypeRep ta' sa') s-            len' <- mkLength len-            tmp       <- freshVar "seq" tr' sr'-            initSt    <- compileExpr st-            (_, Bl ds (Seq body)) <- confiscateBlock $ compileProg tmp step+            let sr' = snd $ infoSize $ getInfo lam2+            let ix = mkVar (compileTypeRep t sz) v+                (dss, lets) = unzip $ map (\(_, Block ds (Sequence body)) -> (ds, body)) blocks+            len' <- mkLength len (infoType $ getInfo len) sz+            tmp  <- freshVar "seq" tr' sr'+            (_, Block ds (Sequence body)) <- confiscateBlock $ withAlias s (StructField tmp "member2") $ compileProg (Just tmp) step             tellProg [initArray loc len']-            tellProg [Block (ds ++ [toIni stv initSt]) $-                      For name len' 1 $-                                    Seq (body ++-                                         [assignProg (loc :!: ix) (tmp :.: "member1")-                                         ,assignProg stv (tmp :.: "member2")+            compileProg (Just $ StructField tmp "member2") st+            tellProg [toProg $ Block (concat dss ++ ds) $+                      for False (lName ix) len' (litI32 1) $+                                    toBlock $ Sequence (concat lets ++ body +++                                         [copyProg (ArrayElem <$> loc <*> pure ix) [StructField tmp "member1"]                                          ])]-      where toIni (Var ty str) = Init ty str +    -- TODO: This optimization contains a bug+    -- The result array is initialized to length l, when it should be 2*l+    -- It is easy enough to fix by multiplying the length with 2 like this:+    --+    -- > tellprog [initArray loc $ binop (Rep.NumType Unsigned S32) "*" len (litI32 2)]+    --+    -- However, in many cases the resulting length expression could be+    -- optimized further if the calculation had been performed in the core+    -- language instead of the imperative langauge.+    --+    --+    -- -- loc = parallel l f ++ parallel l g ==> for l (\i -> loc[i] = f i; loc[i+l] = g i)+    -- compileProgSym (C' Append) _ loc ((arr1 :$ l1 :$ (lam1 :$ body1)) :* (arr2 :$ l2 :$ (lam2 :$ body2)) :* Nil)+    --     | Just (C' Parallel) <- prjF arr1+    --     , Just (C' Parallel) <- prjF arr2+    --     , Just (SubConstr2 (Lambda v1)) <- prjLambda lam1+    --     , Just (SubConstr2 (Lambda v2)) <- prjLambda lam2+    --     , alphaEq l1 l2+    --     = do+    --         let t   = argType $ infoType $ getInfo lam1+    --             sz  = fst $ infoSize $ getInfo lam1+    --             ix1 = mkVar (compileTypeRep t sz) v1+    --             ix2 = mkVar (compileTypeRep t sz) v2+    --         len <- mkLength l1 (infoType $ getInfo l1) sz+    --         (_, Block ds1 (Sequence b1)) <- confiscateBlock $ withAlias v1 ix1 $ compileProg (ArrayElem <$> loc <*> pure ix1) body1+    --         (_, Block ds2 (Sequence b2)) <- confiscateBlock $ withAlias v2 ix1 $ compileProg (ArrayElem <$> loc <*> pure ix2) body2+    --         tellProg [initArray loc len]+    --         assign (Just ix2) len+    --         tellProg [for True (lName ix1) len (litI32 1) (Block (ds1++ds2) (Sequence $ b1 ++ b2 ++ [copyProg (Just ix2) [binop (Rep.NumType Unsigned S32) "+" ix2 (litI32 1)]]))]+     compileProgSym (C' Append) _ loc (a :* b :* Nil) = do         a' <- compileExpr a         b' <- compileExpr b-        let aLen = arrayLength a'-        let bLen = arrayLength b'-        tellProg [initArray loc $ Binop U32 "+" [aLen, bLen]]-        tellProg [copyProg loc a']-        tellProg [copyProgPos loc aLen b']+        tellProg [copyProg loc [a', b']]         -- TODO: Optimize by writing to directly to 'loc' instead of 'a'' and 'b''!         --       But take care of array initialization:         --       compiling 'a' and 'b' might do initialization itself...@@ -110,24 +181,32 @@     compileProgSym (C' SetIx) _ loc (arr :* i :* a :* Nil) = do         compileProg loc arr         i' <- compileExpr i-        compileProg (loc :!: i') a+        compileProg (ArrayElem <$> loc <*> pure i') a +    compileProgSym (C' GetIx) _ (Just loc) (arr :* i :* Nil) = do+        a' <- compileExpr arr+        i' <- compileExpr i+        let el = ArrayElem a' i'+        tellProg $ if isArray $ typeof el+                     then [Assign loc el]+                     else [copyProg (Just loc) [el]]+     compileProgSym (C' SetLength) _ loc (len :* arr :* Nil) = do         len' <- compileExpr len-        tellProg [setLength loc len']         compileProg loc arr+        tellProg [setLength loc len']       -- TODO Optimize by using copyProgLen (compare to 0.4)      compileProgSym a info loc args = compileExprLoc a info loc args -    compileExprSym (C' GetLength) info (a :* Nil) = do+    compileExprSym (C' GetLength) _ (a :* Nil) = do         aExpr <- compileExpr a-        return $ Fun (compileTypeRep (infoType info) (infoSize info)) "getLength" [aExpr]+        return $ arrayLength aExpr      compileExprSym (C' GetIx) _ (arr :* i :* Nil) = do         a' <- compileExpr arr         i' <- compileExpr i-        return $ a' :!: i'+        return $ ArrayElem a' i'      compileExprSym a info args = compileProgFresh a info args