feldspar-compiler 0.5.0.1 → 0.6.0.2
raw patch · 120 files changed
+13884/−12290 lines, 120 filesdep +feldspar-compilerdep ~basedep ~feldspar-languagedep ~haskell-src-extsnew-uploader
Dependencies added: feldspar-compiler
Dependency ranges changed: base, feldspar-language, haskell-src-exts, syntactic
Files
- Feldspar/C/feldspar_array.c +0/−61
- Feldspar/C/feldspar_array.h +0/−112
- Feldspar/C/feldspar_c99.c +0/−1893
- Feldspar/C/feldspar_c99.h +0/−356
- Feldspar/C/feldspar_tic64x.c +0/−2364
- Feldspar/C/feldspar_tic64x.h +0/−443
- Feldspar/Compiler.hs +0/−44
- Feldspar/Compiler/Backend/C/CodeGeneration.hs +0/−157
- Feldspar/Compiler/Backend/C/Library.hs +0/−85
- Feldspar/Compiler/Backend/C/Options.hs +0/−99
- Feldspar/Compiler/Backend/C/Platforms.hs +0/−268
- Feldspar/Compiler/Backend/C/Plugin/AllocationEliminator.hs +0/−207
- Feldspar/Compiler/Backend/C/Plugin/BlockProgramHandler.hs +0/−80
- Feldspar/Compiler/Backend/C/Plugin/Locator.hs +0/−242
- Feldspar/Compiler/Backend/C/Plugin/PrettyPrint.hs +0/−722
- Feldspar/Compiler/Backend/C/Plugin/Rule.hs +0/−89
- Feldspar/Compiler/Backend/C/Plugin/TypeCorrector.hs +0/−196
- Feldspar/Compiler/Backend/C/Plugin/TypeDefinitionGenerator.hs +0/−87
- Feldspar/Compiler/Backend/C/Plugin/VariableRoleAssigner.hs +0/−74
- Feldspar/Compiler/Compiler.hs +0/−259
- Feldspar/Compiler/Error.hs +0/−35
- Feldspar/Compiler/Frontend/CommandLine/API.hs +0/−151
- Feldspar/Compiler/Frontend/CommandLine/API/Constants.hs +0/−36
- Feldspar/Compiler/Frontend/CommandLine/API/Library.hs +0/−72
- Feldspar/Compiler/Frontend/CommandLine/API/Options.hs +0/−135
- Feldspar/Compiler/Frontend/CommandLine/Main.hs +0/−220
- Feldspar/Compiler/Frontend/Interactive/Interface.hs +0/−94
- Feldspar/Compiler/Imperative/FromCore.hs +0/−109
- Feldspar/Compiler/Imperative/FromCore/Array.hs +0/−124
- Feldspar/Compiler/Imperative/FromCore/Binding.hs +0/−78
- Feldspar/Compiler/Imperative/FromCore/Condition.hs +0/−54
- Feldspar/Compiler/Imperative/FromCore/ConditionM.hs +0/−53
- Feldspar/Compiler/Imperative/FromCore/Error.hs +0/−61
- Feldspar/Compiler/Imperative/FromCore/FFI.hs +0/−46
- Feldspar/Compiler/Imperative/FromCore/Interpretation.hs +0/−325
- Feldspar/Compiler/Imperative/FromCore/Literal.hs +0/−138
- Feldspar/Compiler/Imperative/FromCore/Loop.hs +0/−101
- Feldspar/Compiler/Imperative/FromCore/Mutable.hs +0/−129
- Feldspar/Compiler/Imperative/FromCore/MutableToPure.hs +0/−85
- Feldspar/Compiler/Imperative/FromCore/Par.hs +0/−105
- Feldspar/Compiler/Imperative/FromCore/Primitive.hs +0/−82
- Feldspar/Compiler/Imperative/FromCore/Save.hs +0/−48
- Feldspar/Compiler/Imperative/FromCore/SizeProp.hs +0/−51
- Feldspar/Compiler/Imperative/FromCore/SourceInfo.hs +0/−53
- Feldspar/Compiler/Imperative/FromCore/Tuple.hs +0/−104
- Feldspar/Compiler/Imperative/Frontend.hs +0/−353
- Feldspar/Compiler/Imperative/Plugin/ConstantFolding.hs +0/−68
- Feldspar/Compiler/Imperative/Plugin/Naming.hs +0/−161
- Feldspar/Compiler/Imperative/Plugin/Unroll.hs +0/−270
- Feldspar/Compiler/Imperative/Representation.hs +0/−571
- Feldspar/Compiler/Imperative/TransformationInstance.hs +0/−171
- Feldspar/NameExtractor.hs +0/−147
- Feldspar/Transformation.hs +0/−49
- Feldspar/Transformation/Framework.hs +0/−140
- LICENSE +2/−0
- feldspar-compiler.cabal +63/−33
- lib/Feldspar/C/feldspar_array.c +61/−0
- lib/Feldspar/C/feldspar_array.h +225/−0
- lib/Feldspar/C/feldspar_c99.c +1894/−0
- lib/Feldspar/C/feldspar_c99.h +356/−0
- lib/Feldspar/C/feldspar_future.h +30/−0
- lib/Feldspar/C/feldspar_tic64x.c +2364/−0
- lib/Feldspar/C/feldspar_tic64x.h +443/−0
- lib/Feldspar/C/ivar.c +204/−0
- lib/Feldspar/C/ivar.h +93/−0
- lib/Feldspar/C/log.h +50/−0
- lib/Feldspar/C/taskpool.c +164/−0
- lib/Feldspar/C/taskpool.h +372/−0
- lib/Feldspar/Compiler.hs +43/−0
- lib/Feldspar/Compiler/Backend/C/CodeGeneration.hs +144/−0
- lib/Feldspar/Compiler/Backend/C/Library.hs +85/−0
- lib/Feldspar/Compiler/Backend/C/Options.hs +101/−0
- lib/Feldspar/Compiler/Backend/C/Platforms.hs +280/−0
- lib/Feldspar/Compiler/Backend/C/Plugin/BlockProgramHandler.hs +78/−0
- lib/Feldspar/Compiler/Backend/C/Plugin/Locator.hs +232/−0
- lib/Feldspar/Compiler/Backend/C/Plugin/PrettyPrint.hs +714/−0
- lib/Feldspar/Compiler/Backend/C/Plugin/Rule.hs +85/−0
- lib/Feldspar/Compiler/Backend/C/Plugin/TypeCorrector.hs +199/−0
- lib/Feldspar/Compiler/Backend/C/Plugin/TypeDefinitionGenerator.hs +87/−0
- lib/Feldspar/Compiler/Backend/C/Plugin/VariableRoleAssigner.hs +76/−0
- lib/Feldspar/Compiler/Compiler.hs +248/−0
- lib/Feldspar/Compiler/Error.hs +35/−0
- lib/Feldspar/Compiler/Frontend/Interactive/Interface.hs +102/−0
- lib/Feldspar/Compiler/Imperative/FromCore.hs +132/−0
- lib/Feldspar/Compiler/Imperative/FromCore/Array.hs +133/−0
- lib/Feldspar/Compiler/Imperative/FromCore/Binding.hs +83/−0
- lib/Feldspar/Compiler/Imperative/FromCore/Condition.hs +55/−0
- lib/Feldspar/Compiler/Imperative/FromCore/ConditionM.hs +54/−0
- lib/Feldspar/Compiler/Imperative/FromCore/Error.hs +70/−0
- lib/Feldspar/Compiler/Imperative/FromCore/FFI.hs +51/−0
- lib/Feldspar/Compiler/Imperative/FromCore/Future.hs +75/−0
- lib/Feldspar/Compiler/Imperative/FromCore/Interpretation.hs +342/−0
- lib/Feldspar/Compiler/Imperative/FromCore/Literal.hs +151/−0
- lib/Feldspar/Compiler/Imperative/FromCore/Loop.hs +110/−0
- lib/Feldspar/Compiler/Imperative/FromCore/Mutable.hs +134/−0
- lib/Feldspar/Compiler/Imperative/FromCore/MutableToPure.hs +89/−0
- lib/Feldspar/Compiler/Imperative/FromCore/NoInline.hs +65/−0
- lib/Feldspar/Compiler/Imperative/FromCore/Par.hs +132/−0
- lib/Feldspar/Compiler/Imperative/FromCore/Primitive.hs +86/−0
- lib/Feldspar/Compiler/Imperative/FromCore/Save.hs +51/−0
- lib/Feldspar/Compiler/Imperative/FromCore/SizeProp.hs +53/−0
- lib/Feldspar/Compiler/Imperative/FromCore/SourceInfo.hs +57/−0
- lib/Feldspar/Compiler/Imperative/FromCore/Tuple.hs +108/−0
- lib/Feldspar/Compiler/Imperative/Frontend.hs +476/−0
- lib/Feldspar/Compiler/Imperative/Plugin/CollectFreeVars.hs +82/−0
- lib/Feldspar/Compiler/Imperative/Plugin/ConstantFolding.hs +69/−0
- lib/Feldspar/Compiler/Imperative/Plugin/Free.hs +61/−0
- lib/Feldspar/Compiler/Imperative/Plugin/IVars.hs +82/−0
- lib/Feldspar/Compiler/Imperative/Plugin/Naming.hs +194/−0
- lib/Feldspar/Compiler/Imperative/Plugin/Unroll.hs +285/−0
- lib/Feldspar/Compiler/Imperative/Representation.hs +620/−0
- lib/Feldspar/Compiler/Imperative/TransformationInstance.hs +180/−0
- lib/Feldspar/NameExtractor.hs +159/−0
- lib/Feldspar/Transformation.hs +47/−0
- lib/Feldspar/Transformation/Framework.hs +151/−0
- src/Feldspar/Compiler/Frontend/CommandLine/API.hs +155/−0
- src/Feldspar/Compiler/Frontend/CommandLine/API/Constants.hs +36/−0
- src/Feldspar/Compiler/Frontend/CommandLine/API/Library.hs +72/−0
- src/Feldspar/Compiler/Frontend/CommandLine/API/Options.hs +135/−0
- src/Feldspar/Compiler/Frontend/CommandLine/Main.hs +219/−0
− Feldspar/C/feldspar_array.c
@@ -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>--/* Deep array copy with a given length */-void copyArrayLen(struct array *to, struct array *from, int32_t len)-{- assert(to);- assert(from);- if( from->elemSize < 0 )- {- unsigned i;- for( i = 0; i < len; ++i )- copyArray( &at(struct array, to, i), &at(struct array, from, i) );- }- else- {- assert(to->buffer);- assert(from->buffer);- memcpy( to->buffer, from->buffer, len * from->elemSize );- }-}---/* Reset array length by increasing it */-void increaseLength(struct array *arr, int32_t len)-{- assert(arr);- assert(arr->bytes >= abs(arr->elemSize) * (len + arr->length));- arr->length += len;-}-
− Feldspar/C/feldspar_array.h
@@ -1,112 +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.-//--#ifndef FELDSPAR_ARRAY_H-#define FELDSPAR_ARRAY_H--#include <stdint.h>-#include <string.h>-#include <assert.h>-#include <stdlib.h>--// TODO qualify the names to avoid clashes with Haskell names--struct array-{- void* buffer; /* pointer to the buffer of elements */- 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 */-};--/* Indexing into an array: */-/* Result: element of type 'type' */-#define at(type,arr,idx) (((type*)((arr)->buffer))[idx])---/* Deep array copy */-static inline void copyArray(struct array *to, struct array *from)-{- assert(to);- assert(from);- if( from->elemSize < 0 )- {- unsigned i;- for( i = 0; i < from->length; ++i )- copyArray( &at(struct array, to, i), &at(struct array, from, i) );- }- else- {- assert(to->buffer);- assert(from->buffer);- memcpy( to->buffer, from->buffer, to->length * to->elemSize );- }-}--/* Deep array copy to a given position */-static inline void copyArrayPos(struct array *to, unsigned pos, struct array *from)-{- assert(to);- assert(from);- if( from->elemSize < 0 )- {- unsigned i;- for( i = 0; i < from->length; ++i )- copyArray( &at(struct array, to, i + pos), &at(struct array, from, i) );- }- else- {- assert(to->buffer);- assert(from->buffer);- memcpy( (char*)(to->buffer) + pos * to->elemSize, from->buffer, to->length * to->elemSize );- }-}---/* 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)-{- assert(arr);- return arr->length;-}--/* (Re)set array length */-static inline void setLength(struct array *arr, int32_t len)-{- assert(arr);- assert(arr->bytes >= arr->length * abs(arr->elemSize));- arr->length = len;-}--/* Reset array length by increasing it */-void increaseLength(struct array *arr, int32_t len);--#endif
− Feldspar/C/feldspar_c99.c
@@ -1,1893 +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_c99.h"--#include <stdint.h>-#include <stdio.h>-#include <stdlib.h>-#include <math.h>-#include <complex.h>--#if defined(WIN32)- #include <windows.h>-#else- #include <sys/time.h>- #include <time.h>-#endif /* WIN32 */----/*--------------------------------------------------------------------------*- * pow(), abs(), signum(), logBase() *- *--------------------------------------------------------------------------*/--int8_t pow_fun_int8( int8_t a, int8_t b )-{- int8_t r = 1;- int i;- if (b < 0) {- fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);- exit(1);- }- for(i = 0; i < b; ++i)- r *= a;- return r;-}--int16_t pow_fun_int16( int16_t a, int16_t b )-{- int16_t r = 1;- int i;- if (b < 0) {- fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);- exit(1);- }- for(i = 0; i < b; ++i)- r *= a;- return r;-}--int32_t pow_fun_int32( int32_t a, int32_t b )-{- int32_t r = 1;- int i;- if (b < 0) {- fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);- exit(1);- }- for(i = 0; i < b; ++i)- r *= a;- return r;-}--int64_t pow_fun_int64( int64_t a, int64_t b )-{- int64_t r = 1;- int i;- if (b < 0) {- fprintf(stderr, "Negative exponent in function pow_fun_(): %lld `pow` %lld", a, b);- exit(1);- }- for(i = 0; i < b; ++i)- r *= a;- return r;-}--uint8_t pow_fun_uint8( uint8_t a, uint8_t b )-{- uint8_t r = 1;- int i;- for(i = 0; i < b; ++i)- r *= a;- return r;-}--uint16_t pow_fun_uint16( uint16_t a, uint16_t b )-{- uint16_t r = 1;- int i;- for(i = 0; i < b; ++i)- r *= a;- return r;-}--uint32_t pow_fun_uint32( uint32_t a, uint32_t b )-{- uint32_t r = 1;- int i;- for(i = 0; i < b; ++i)- r *= a;- return r;-}--uint64_t pow_fun_uint64( uint64_t a, uint64_t b )-{- uint64_t r = 1;- int i;- for(i = 0; i < b; ++i)- r *= a;- return r;-}----int8_t abs_fun_int8( int8_t a )-{- // From Bit Twiddling Hacks:- // "Compute the integer absolute value (abs) without branching"- int8_t mask = a >> 7;- return (a + mask) ^ mask;-}--int16_t abs_fun_int16( int16_t a )-{- // From Bit Twiddling Hacks:- // "Compute the integer absolute value (abs) without branching"- int16_t mask = a >> 15;- return (a + mask) ^ mask;-}--int32_t abs_fun_int32( int32_t a )-{- // From Bit Twiddling Hacks:- // "Compute the integer absolute value (abs) without branching"- int32_t mask = a >> 31;- return (a + mask) ^ mask;-}--int64_t abs_fun_int64( int64_t a )-{- // From Bit Twiddling Hacks:- // "Compute the integer absolute value (abs) without branching"- int64_t mask = a >> 63;- return (a + mask) ^ mask;-}----int8_t signum_fun_int8( 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 )-{- // From Bit Twiddling Hacks: "Compute the sign of an integer"- return (a != 0) | (a >> 15);-}--int32_t signum_fun_int32( 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 )-{- // From Bit Twiddling Hacks: "Compute the sign of an integer"- return (a != 0) | (a >> 63);-}--uint8_t signum_fun_uint8( uint8_t a )-{- return (a > 0);-}--uint16_t signum_fun_uint16( uint16_t a )-{- return (a > 0);-}--uint32_t signum_fun_uint32( uint32_t a )-{- return (a > 0);-}--uint64_t signum_fun_uint64( uint64_t a )-{- return (a > 0);-}--float signum_fun_float( float a )-{- // From Bit Twiddling Hacks: "Compute the sign of an integer"- return (a > 0) - (a < 0);-}----float logBase_fun_float( float a, float b )-{- return logf(b) / logf(a);-}----/*--------------------------------------------------------------------------*- * Bit operations *- *--------------------------------------------------------------------------*/--int8_t setBit_fun_int8( int8_t x, uint32_t i )-{- return x | 1 << i;-}--int16_t setBit_fun_int16( int16_t x, uint32_t i )-{- return x | 1 << i;-}--int32_t setBit_fun_int32( int32_t x, uint32_t i )-{- return x | 1 << i;-}--int64_t setBit_fun_int64( int64_t x, uint32_t i )-{- return x | 1 << i;-}--uint8_t setBit_fun_uint8( uint8_t x, uint32_t i )-{- return x | 1 << i;-}--uint16_t setBit_fun_uint16( uint16_t x, uint32_t i )-{- return x | 1 << i;-}--uint32_t setBit_fun_uint32( uint32_t x, uint32_t i )-{- return x | 1 << i;-}--uint64_t setBit_fun_uint64( uint64_t x, uint32_t i )-{- return x | 1 << i;-}----int8_t clearBit_fun_int8( int8_t x, uint32_t i )-{- return x & ~(1 << i);-}--int16_t clearBit_fun_int16( int16_t x, uint32_t i )-{- return x & ~(1 << i);-}--int32_t clearBit_fun_int32( int32_t x, uint32_t i )-{- return x & ~(1 << i);-}--int64_t clearBit_fun_int64( int64_t x, uint32_t i )-{- return x & ~(1 << i);-}--uint8_t clearBit_fun_uint8( uint8_t x, uint32_t i )-{- return x & ~(1 << i);-}--uint16_t clearBit_fun_uint16( uint16_t x, uint32_t i )-{- return x & ~(1 << i);-}--uint32_t clearBit_fun_uint32( uint32_t x, uint32_t i )-{- return x & ~(1 << i);-}--uint64_t clearBit_fun_uint64( uint64_t x, uint32_t i )-{- return x & ~(1 << i);-}----int8_t complementBit_fun_int8( int8_t x, uint32_t i )-{- return x ^ 1 << i;-}--int16_t complementBit_fun_int16( int16_t x, uint32_t i )-{- return x ^ 1 << i;-}--int32_t complementBit_fun_int32( int32_t x, uint32_t i )-{- return x ^ 1 << i;-}--int64_t complementBit_fun_int64( int64_t x, uint32_t i )-{- return x ^ 1 << i;-}--uint8_t complementBit_fun_uint8( uint8_t x, uint32_t i )-{- return x ^ 1 << i;-}--uint16_t complementBit_fun_uint16( uint16_t x, uint32_t i )-{- return x ^ 1 << i;-}--uint32_t complementBit_fun_uint32( uint32_t x, uint32_t i )-{- return x ^ 1 << i;-}--uint64_t complementBit_fun_uint64( uint64_t x, uint32_t i )-{- return x ^ 1 << i;-}----int testBit_fun_int8( int8_t x, uint32_t i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_int16( int16_t x, uint32_t i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_int32( int32_t x, uint32_t i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_int64( int64_t x, uint32_t i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_uint8( uint8_t x, uint32_t i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_uint16( uint16_t x, uint32_t i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_uint32( uint32_t x, uint32_t i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_uint64( uint64_t x, uint32_t i )-{- return (x & 1 << i) != 0;-}----int8_t rotateL_fun_int8( 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 )-{- 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 )-{- 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 )-{- 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 )-{- if ((i %= 8) == 0) return x;- return (x << i) | (x >> (8 - i));-}--uint16_t rotateL_fun_uint16( 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 )-{- if ((i %= 32) == 0) return x;- return (x << i) | (x >> (32 - i));-}--uint64_t rotateL_fun_uint64( uint64_t x, int32_t i )-{- if ((i %= 64) == 0) return x;- return (x << i) | (x >> (64 - i));-}----int8_t rotateR_fun_int8( 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 )-{- 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 )-{- 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 )-{- 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 )-{- if ((i %= 8) == 0) return x;- return (x << (8 - i)) | (x >> i);-}--uint16_t rotateR_fun_uint16( 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 )-{- if ((i %= 32) == 0) return x;- return (x << (32 - i)) | (x >> i);-}--uint64_t rotateR_fun_uint64( uint64_t x, int32_t i )-{- if ((i %= 64) == 0) return x;- return (x << (64 - i)) | (x >> i);-}----int8_t reverseBits_fun_int8( int8_t x )-{- int8_t r = x;- int i = 7;- for (x = x >> 1 & 0x7f; x; x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--int16_t reverseBits_fun_int16( int16_t x )-{- int16_t r = x;- int i = 15;- for (x = x >> 1 & 0x7fff; x; x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--int32_t reverseBits_fun_int32( int32_t x )-{- int32_t r = x;- int i = 31;- for (x = x >> 1 & 0x7fffffff; x; x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--int64_t reverseBits_fun_int64( int64_t x )-{- int64_t r = x;- int i = 63;- for (x = x >> 1 & 0x7fffffffffffffffll; x; x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--uint8_t reverseBits_fun_uint8( uint8_t x )-{- uint8_t r = x;- int i = 7;- while (x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--uint16_t reverseBits_fun_uint16( uint16_t x )-{- uint16_t r = x;- int i = 15;- while (x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--uint32_t reverseBits_fun_uint32( uint32_t x )-{- uint32_t r = x;- int i = 31;- while (x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--uint64_t reverseBits_fun_uint64( uint64_t x )-{- uint64_t r = x;- int i = 63;- while (x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}----uint32_t bitScan_fun_int8( int8_t x )-{- uint32_t r = 0;- int8_t s = (x & 0x80);- if (x == 0) return 7;- while ((int8_t)((x <<= 1) & 0x80) == s)- ++r;- return r;-}--uint32_t bitScan_fun_int16( int16_t x )-{- uint32_t r = 0;- int16_t s = (x & 0x8000);- if (x == 0) return 15;- while ((int16_t)((x <<= 1) & 0x8000) == s)- ++r;- return r;-}--uint32_t bitScan_fun_int32( int32_t x )-{- uint32_t r = 0;- int32_t s = (x & 0x80000000);- if (x == 0) return 31;- while ((int32_t)((x <<= 1) & 0x80000000) == s)- ++r;- return r;-}--uint32_t bitScan_fun_int64( int64_t x )-{- uint32_t r = 0;- int64_t s = (x & 0x8000000000000000ll);- if (x == 0) return 63;- while ((int64_t)((x <<= 1) & 0x8000000000000000ll) == s)- ++r;- return r;-}--uint32_t bitScan_fun_uint8( uint8_t x )-{- uint32_t r = 8;- while (x)- {- --r;- x >>= 1;- }- return r;-}--uint32_t bitScan_fun_uint16( uint16_t x )-{- uint32_t r = 16;- while (x)- {- --r;- x >>= 1;- }- return r;-}--uint32_t bitScan_fun_uint32( uint32_t x )-{- uint32_t r = 32;- while (x)- {- --r;- x >>= 1;- }- return r;-}--uint32_t bitScan_fun_uint64( uint64_t x )-{- uint32_t r = 64;- while (x)- {- --r;- x >>= 1;- }- return r;-}----uint32_t bitCount_fun_int8( int8_t x )-{- uint32_t r = x & 1;- for (x = x >> 1 & 0x7f; x; x >>= 1)- r += x & 1;- return r;-}--uint32_t bitCount_fun_int16( int16_t x )-{- uint32_t r = x & 1;- for (x = x >> 1 & 0x7fff; x; x >>= 1)- r += x & 1;- return r;-}--uint32_t bitCount_fun_int32( int32_t x )-{- uint32_t r = x & 1;- for (x = x >> 1 & 0x7fffffff; x; x >>= 1)- r += x & 1;- return r;-}--uint32_t bitCount_fun_int64( int64_t x )-{- uint32_t r = x & 1;- for (x = x >> 1 & 0x7fffffffffffffffll; x; x >>= 1)- r += x & 1;- return r;-}--uint32_t bitCount_fun_uint8( uint8_t x )-{- uint32_t r = x & 1;- while (x >>= 1)- r += x & 1;- return r;-}--uint32_t bitCount_fun_uint16( uint16_t x )-{- uint32_t r = x & 1;- while (x >>= 1)- r += x & 1;- return r;-}--uint32_t bitCount_fun_uint32( uint32_t x )-{- uint32_t r = x & 1;- while (x >>= 1)- r += x & 1;- return r;-}--uint32_t bitCount_fun_uint64( uint64_t x )-{- uint32_t r = x & 1;- while (x >>= 1)- r += x & 1;- return r;-}----/*--------------------------------------------------------------------------*- * Complex numbers *- *--------------------------------------------------------------------------*/--int equal_fun_complexOf_int8( complexOf_int8 a, complexOf_int8 b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_int16( complexOf_int16 a, complexOf_int16 b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_int32( complexOf_int32 a, complexOf_int32 b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_int64( complexOf_int64 a, complexOf_int64 b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_uint8( complexOf_uint8 a, complexOf_uint8 b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_uint16( complexOf_uint16 a, complexOf_uint16 b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_uint32( complexOf_uint32 a, complexOf_uint32 b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_uint64( complexOf_uint64 a, complexOf_uint64 b )-{- return a.re == b.re && a.im == b.im;-}----complexOf_int8 negate_fun_complexOf_int8( complexOf_int8 a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_int16 negate_fun_complexOf_int16( complexOf_int16 a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_int32 negate_fun_complexOf_int32( complexOf_int32 a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_int64 negate_fun_complexOf_int64( complexOf_int64 a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_uint8 negate_fun_complexOf_uint8( complexOf_uint8 a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_uint16 negate_fun_complexOf_uint16( complexOf_uint16 a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_uint32 negate_fun_complexOf_uint32( complexOf_uint32 a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_uint64 negate_fun_complexOf_uint64( complexOf_uint64 a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}----complexOf_int8 abs_fun_complexOf_int8( complexOf_int8 a )-{- a.re = magnitude_fun_complexOf_int8(a);- a.im = 0;- return a;-}--complexOf_int16 abs_fun_complexOf_int16( complexOf_int16 a )-{- a.re = magnitude_fun_complexOf_int16(a);- a.im = 0;- return a;-}--complexOf_int32 abs_fun_complexOf_int32( complexOf_int32 a )-{- a.re = magnitude_fun_complexOf_int32(a);- a.im = 0;- return a;-}--complexOf_int64 abs_fun_complexOf_int64( complexOf_int64 a )-{- a.re = magnitude_fun_complexOf_int64(a);- a.im = 0;- return a;-}--complexOf_uint8 abs_fun_complexOf_uint8( complexOf_uint8 a )-{- a.re = magnitude_fun_complexOf_uint8(a);- a.im = 0;- return a;-}--complexOf_uint16 abs_fun_complexOf_uint16( complexOf_uint16 a )-{- a.re = magnitude_fun_complexOf_uint16(a);- a.im = 0;- return a;-}--complexOf_uint32 abs_fun_complexOf_uint32( complexOf_uint32 a )-{- a.re = magnitude_fun_complexOf_uint32(a);- a.im = 0;- return a;-}--complexOf_uint64 abs_fun_complexOf_uint64( complexOf_uint64 a )-{- a.re = magnitude_fun_complexOf_uint64(a);- a.im = 0;- return a;-}----complexOf_int8 signum_fun_complexOf_int8( complexOf_int8 a )-{- int8_t m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_int8(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_int16 signum_fun_complexOf_int16( complexOf_int16 a )-{- int16_t m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_int16(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_int32 signum_fun_complexOf_int32( complexOf_int32 a )-{- int32_t m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_int32(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_int64 signum_fun_complexOf_int64( complexOf_int64 a )-{- int64_t m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_int64(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_uint8 signum_fun_complexOf_uint8( complexOf_uint8 a )-{- uint8_t m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_uint8(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_uint16 signum_fun_complexOf_uint16( complexOf_uint16 a )-{- uint16_t m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_uint16(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_uint32 signum_fun_complexOf_uint32( complexOf_uint32 a )-{- uint32_t m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_uint32(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_uint64 signum_fun_complexOf_uint64( complexOf_uint64 a )-{- uint64_t m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_uint64(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--float complex signum_fun_complexOf_float( float complex a )-{- float 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 )-{- 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 )-{- 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 )-{- 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 )-{- 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 )-{- 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 )-{- 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 )-{- 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 )-{- a.re = a.re + b.re;- a.im = a.im + b.im;- return a;-}----complexOf_int8 sub_fun_complexOf_int8( complexOf_int8 a, complexOf_int8 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 )-{- 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 )-{- 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 )-{- 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 )-{- 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 )-{- 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 )-{- 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 )-{- a.re = a.re - b.re;- a.im = a.im - b.im;- return a;-}----complexOf_int8 mult_fun_complexOf_int8( complexOf_int8 a, complexOf_int8 b )-{- complexOf_int8 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 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 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 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 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 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 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 r;- r.re = a.re * b.re - a.im * b.im;- r.im = a.im * b.re + a.re * b.im;- return r;-}--#ifdef __FreeBSD__-float complex clogf( float complex x )-{- return (I * atan2f(cimagf(x), crealf(x))) + logf(cabsf(x));-}-#endif---float complex logBase_fun_complexOf_float( float complex a, float complex b )-{- return clogf(b) / clogf(a);-}----complexOf_int8 complex_fun_int8( int8_t re, int8_t im )-{- complexOf_int8 r;- r.re = re;- r.im = im;- return r;-}--complexOf_int16 complex_fun_int16( int16_t re, int16_t im )-{- complexOf_int16 r;- r.re = re;- r.im = im;- return r;-}--complexOf_int32 complex_fun_int32( int32_t re, int32_t im )-{- complexOf_int32 r;- r.re = re;- r.im = im;- return r;-}--complexOf_int64 complex_fun_int64( int64_t re, int64_t im )-{- complexOf_int64 r;- r.re = re;- r.im = im;- return r;-}--complexOf_uint8 complex_fun_uint8( uint8_t re, uint8_t im )-{- complexOf_uint8 r;- r.re = re;- r.im = im;- return r;-}--complexOf_uint16 complex_fun_uint16( uint16_t re, uint16_t im )-{- complexOf_uint16 r;- r.re = re;- r.im = im;- return r;-}--complexOf_uint32 complex_fun_uint32( uint32_t re, uint32_t im )-{- complexOf_uint32 r;- r.re = re;- r.im = im;- return r;-}--complexOf_uint64 complex_fun_uint64( uint64_t re, uint64_t im )-{- complexOf_uint64 r;- r.re = re;- r.im = im;- return r;-}--float complex complex_fun_float( float re, float im )-{- return ( re + im * I );-}----int8_t creal_fun_complexOf_int8( complexOf_int8 a )-{- return a.re;-}--int16_t creal_fun_complexOf_int16( complexOf_int16 a )-{- return a.re;-}--int32_t creal_fun_complexOf_int32( complexOf_int32 a )-{- return a.re;-}--int64_t creal_fun_complexOf_int64( complexOf_int64 a )-{- return a.re;-}--uint8_t creal_fun_complexOf_uint8( complexOf_uint8 a )-{- return a.re;-}--uint16_t creal_fun_complexOf_uint16( complexOf_uint16 a )-{- return a.re;-}--uint32_t creal_fun_complexOf_uint32( complexOf_uint32 a )-{- return a.re;-}--uint64_t creal_fun_complexOf_uint64( complexOf_uint64 a )-{- return a.re;-}----int8_t cimag_fun_complexOf_int8( complexOf_int8 a )-{- return a.im;-}--int16_t cimag_fun_complexOf_int16( complexOf_int16 a )-{- return a.im;-}--int32_t cimag_fun_complexOf_int32( complexOf_int32 a )-{- return a.im;-}--int64_t cimag_fun_complexOf_int64( complexOf_int64 a )-{- return a.im;-}--uint8_t cimag_fun_complexOf_uint8( complexOf_uint8 a )-{- return a.im;-}--uint16_t cimag_fun_complexOf_uint16( complexOf_uint16 a )-{- return a.im;-}--uint32_t cimag_fun_complexOf_uint32( complexOf_uint32 a )-{- return a.im;-}--uint64_t cimag_fun_complexOf_uint64( complexOf_uint64 a )-{- return a.im;-}----complexOf_int8 conj_fun_complexOf_int8( complexOf_int8 a )-{- a.im = -a.im;- return a;-}--complexOf_int16 conj_fun_complexOf_int16( complexOf_int16 a )-{- a.im = -a.im;- return a;-}--complexOf_int32 conj_fun_complexOf_int32( complexOf_int32 a )-{- a.im = -a.im;- return a;-}--complexOf_int64 conj_fun_complexOf_int64( complexOf_int64 a )-{- a.im = -a.im;- return a;-}--complexOf_uint8 conj_fun_complexOf_uint8( complexOf_uint8 a )-{- a.im = -a.im;- return a;-}--complexOf_uint16 conj_fun_complexOf_uint16( complexOf_uint16 a )-{- a.im = -a.im;- return a;-}--complexOf_uint32 conj_fun_complexOf_uint32( complexOf_uint32 a )-{- a.im = -a.im;- return a;-}--complexOf_uint64 conj_fun_complexOf_uint64( complexOf_uint64 a )-{- a.im = -a.im;- return a;-}----int8_t magnitude_fun_complexOf_int8( complexOf_int8 a )-{- return lroundf(hypotf(a.re, a.im));-}--int16_t magnitude_fun_complexOf_int16( complexOf_int16 a )-{- return lroundf(hypotf(a.re, a.im));-}--int32_t magnitude_fun_complexOf_int32( complexOf_int32 a )-{- return lroundf(hypotf(a.re, a.im));-}--int64_t magnitude_fun_complexOf_int64( complexOf_int64 a )-{- return llroundf(hypotf(a.re, a.im));-}--uint8_t magnitude_fun_complexOf_uint8( complexOf_uint8 a )-{- return lroundf(hypotf(a.re, a.im));-}--uint16_t magnitude_fun_complexOf_uint16( complexOf_uint16 a )-{- return lroundf(hypotf(a.re, a.im));-}--uint32_t magnitude_fun_complexOf_uint32( complexOf_uint32 a )-{- return lroundf(hypotf(a.re, a.im));-}--uint64_t magnitude_fun_complexOf_uint64( complexOf_uint64 a )-{- return llroundf(hypotf(a.re, a.im));-}----int8_t phase_fun_complexOf_int8( complexOf_int8 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 )-{- 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 )-{- 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 )-{- 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 )-{- 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 )-{- 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 )-{- 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 )-{- if (a.re == 0 && a.im == 0) return 0;- else return llroundf(atan2f(a.im, a.re));-}----complexOf_int8 mkPolar_fun_int8( int8_t r, int8_t t )-{- complexOf_int8 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 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 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 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 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 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 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 a;- a.re = llroundf(r * cosf(t));- a.im = llroundf(r * sinf(t));- return a;-}--float complex mkPolar_fun_float( float r, float t )-{- return r * cosf(t) + r * sinf(t) * I;-}----complexOf_int8 cis_fun_int8( int8_t t )-{- complexOf_int8 r;- r.re = lroundf(cosf(t));- r.im = lroundf(sinf(t));- return r;-}--complexOf_int16 cis_fun_int16( int16_t t )-{- complexOf_int16 r;- r.re = lroundf(cosf(t));- r.im = lroundf(sinf(t));- return r;-}--complexOf_int32 cis_fun_int32( int32_t t )-{- complexOf_int32 r;- r.re = lroundf(cosf(t));- r.im = lroundf(sinf(t));- return r;-}--complexOf_int64 cis_fun_int64( int64_t t )-{- complexOf_int64 r;- r.re = llroundf(cosf(t));- r.im = llroundf(sinf(t));- return r;-}--complexOf_uint8 cis_fun_uint8( uint8_t t )-{- complexOf_uint8 r;- r.re = lroundf(cosf(t));- r.im = lroundf(sinf(t));- return r;-}--complexOf_uint16 cis_fun_uint16( uint16_t t )-{- complexOf_uint16 r;- r.re = lroundf(cosf(t));- r.im = lroundf(sinf(t));- return r;-}--complexOf_uint32 cis_fun_uint32( uint32_t t )-{- complexOf_uint32 r;- r.re = lroundf(cosf(t));- r.im = lroundf(sinf(t));- return r;-}--complexOf_uint64 cis_fun_uint64( uint64_t t )-{- complexOf_uint64 r;- r.re = llroundf(cosf(t));- r.im = llroundf(sinf(t));- return r;-}--float complex cis_fun_float( float t )-{- return cosf(t) + sinf(t) * I;-}----/*--------------------------------------------------------------------------*- * Trace functions *- *--------------------------------------------------------------------------*/--static FILE *trace_log_file;--#if defined(WIN32)--static DWORD trace_start_time;--void traceStart()-{- SYSTEMTIME lt;- GetLocalTime(<);- char str [256];- sprintf(str, "trace-%04d%02d%02d-%02d%02d%02d.log",- lt.wYear, lt.wMonth, lt.wDay, lt.wHour, lt.wMinute, lt.wSecond);- trace_log_file = fopen(str, "a");- if (trace_log_file == NULL) {- fprintf(stderr,"Can not open trace file.\n");- exit (8);- }- fprintf(trace_log_file,- "Logging started at %02d-%02d-%04d %02d:%02d:%02d.\n",- lt.wDay, lt.wMonth, lt.wYear, lt.wHour, lt.wMinute, lt.wSecond);- fflush(trace_log_file);- trace_start_time = GetTickCount();-}--void elapsedTimeString( char* str )-{- DWORD diff_ms = GetTickCount() - trace_start_time;- DWORD diff = diff_ms / 1000;- diff_ms = diff_ms % 1000;- sprintf(str, "%d.%.3d", diff, diff_ms);-}--#else--static struct timeval trace_start_time;--void traceStart()-{- gettimeofday(&trace_start_time, NULL);- struct tm * timeinfo = localtime(&(trace_start_time.tv_sec));- char timestr [80];- char str [256];- strftime(timestr, 80, "%Y%m%d-%H%M%S", timeinfo);- sprintf(str, "trace-%s.log", timestr);- trace_log_file = fopen(str, "a");- if (trace_log_file == NULL) {- fprintf(stderr,"Can not open trace file.\n");- exit (8);- }- strftime(timestr, 80, "%d-%b-%Y %H:%M:%S", timeinfo);- fprintf(trace_log_file, "Logging started at %s.\n", timestr);- fflush(trace_log_file);- gettimeofday(&trace_start_time, NULL);-}--void elapsedTimeString( char* str )-{- struct timeval tv;- gettimeofday (&tv, NULL);- if (trace_start_time.tv_usec <= tv.tv_usec) {- tv.tv_sec = tv.tv_sec - trace_start_time.tv_sec;- tv.tv_usec = tv.tv_usec - trace_start_time.tv_usec;- } else {- tv.tv_sec = tv.tv_sec - trace_start_time.tv_sec - 1;- tv.tv_usec = 1000000 + tv.tv_usec - trace_start_time.tv_usec;- }- sprintf(str, "%ld.%06d", tv.tv_sec, tv.tv_usec);-}--#endif /* WIN32 */--void traceEnd()-{- fprintf(trace_log_file, "Logging finished.\n");- fclose(trace_log_file);-}--void trace_int8( int8_t val, int32_t id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%d\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_int16( int16_t val, int32_t id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%d\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_int32( int32_t val, int32_t id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%d\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_int64( int64_t val, int32_t id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%lld\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_uint8( uint8_t val, int32_t id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%u\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_uint16( uint16_t val, int32_t id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%u\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_uint32( uint32_t val, int32_t id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%u\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_uint64( uint64_t val, int32_t id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%llu\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_float( float 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( complexOf_int8 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 )-{- 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_int32( complexOf_int32 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_int64( complexOf_int64 val, int32_t id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%lld+%lld*I\n", id, timestr, val.re, val.im);- fflush(trace_log_file);-}--void trace_complexOf_uint8( complexOf_uint8 val, int32_t id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%u+%u*I\n", id, timestr, val.re, val.im);- fflush(trace_log_file);-}--void trace_complexOf_uint16( complexOf_uint16 val, int32_t id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%u+%u*I\n", id, timestr, val.re, val.im);- fflush(trace_log_file);-}--void trace_complexOf_uint32( complexOf_uint32 val, int32_t id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%u+%u*I\n", id, timestr, val.re, val.im);- fflush(trace_log_file);-}--void trace_complexOf_uint64( complexOf_uint64 val, int32_t id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%llu+%llu*I\n", id, timestr, val.re, val.im);- fflush(trace_log_file);-}--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);-}-
− Feldspar/C/feldspar_c99.h
@@ -1,356 +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.-//--#ifndef FELDSPAR_C99_H-#define FELDSPAR_C99_H--#include <stdint.h>-#include <complex.h>----#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 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 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 );-float signum_fun_float( float );--float logBase_fun_float( float, float );----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 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 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 );--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 );--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 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 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 );--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 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 );----typedef struct {- int8_t re;- int8_t im;-} complexOf_int8;--typedef struct {- int16_t re;- int16_t im;-} complexOf_int16;--typedef struct {- int32_t re;- int32_t im;-} complexOf_int32;--typedef struct {- int64_t re;- int64_t im;-} complexOf_int64;--typedef struct {- uint8_t re;- uint8_t im;-} complexOf_uint8;--typedef struct {- uint16_t re;- uint16_t im;-} complexOf_uint16;--typedef struct {- uint32_t re;- uint32_t im;-} complexOf_uint32;--typedef struct {- uint64_t re;- uint64_t im;-} complexOf_uint64;--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 );--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 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 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 );-float complex signum_fun_complexOf_float( float 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 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 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 );--float complex logBase_fun_complexOf_float( float complex, float 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 );-float complex complex_fun_float( float, float );--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 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 );--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 );--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 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 );--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 );-float complex mkPolar_fun_float( float, float );--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 );-float complex cis_fun_float( float );----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_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_complexOf_float( float complex, int32_t );--#endif /* FELDSPAR_C99_H */
− Feldspar/C/feldspar_tic64x.c
@@ -1,2364 +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_tic64x.h"--#include <stdio.h>-#include <stdlib.h>-#include <math.h>-#include <time.h>--float hypotf(float x, float y) {- return sqrtf(x * x + y * y);-}----/*--------------------------------------------------------------------------*- * pow(), abs(), signum(), logBase() *- *--------------------------------------------------------------------------*/--char pow_fun_char( char a, char b )-{- char r = 1;- int i;- if (b < 0) {- fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);- exit(1);- }- for(i = 0; i < b; ++i)- r *= a;- return r;-}--short pow_fun_short( short a, short b )-{- short r = 1;- int i;- if (b < 0) {- fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);- exit(1);- }- for(i = 0; i < b; ++i)- r *= a;- return r;-}--int pow_fun_int( int a, int b )-{- int r = 1;- int i;- if (b < 0) {- fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);- exit(1);- }- for(i = 0; i < b; ++i)- r *= a;- return r;-}--long pow_fun_long( long a, long b )-{- long r = 1;- int i;- if (b < 0) {- fprintf(stderr, "Negative exponent in function pow_fun_(): %ld `pow` %ld", a, b);- exit(1);- }- for(i = 0; i < b; ++i)- r *= a;- return r;-}--long long pow_fun_llong( long long a, long long b )-{- long long r = 1;- int i;- if (b < 0) {- fprintf(stderr, "Negative exponent in function pow_fun_(): %lld `pow` %lld", a, b);- exit(1);- }- for(i = 0; i < b; ++i)- r *= a;- return r;-}--unsigned char pow_fun_uchar( unsigned char a, unsigned char b )-{- unsigned char r = 1;- int i;- for(i = 0; i < b; ++i)- r *= a;- return r;-}--unsigned short pow_fun_ushort( unsigned short a, unsigned short b )-{- unsigned short r = 1;- int i;- for(i = 0; i < b; ++i)- r *= a;- return r;-}--unsigned pow_fun_uint( unsigned a, unsigned b )-{- unsigned r = 1;- int i;- for(i = 0; i < b; ++i)- r *= a;- return r;-}--unsigned long pow_fun_ulong( unsigned long a, unsigned long b )-{- unsigned long r = 1;- int i;- for(i = 0; i < b; ++i)- r *= a;- return r;-}--unsigned long long pow_fun_ullong( unsigned long long a, unsigned long long b )-{- unsigned long long r = 1;- int i;- for(i = 0; i < b; ++i)- r *= a;- return r;-}----char abs_fun_char( char a )-{- // From Bit Twiddling Hacks:- // "Compute the integer absolute value (abs) without branching"- char mask = a >> 7;- return (a + mask) ^ mask;-}--short abs_fun_short( short a )-{- // From Bit Twiddling Hacks:- // "Compute the integer absolute value (abs) without branching"- short mask = a >> 15;- return (a + mask) ^ mask;-}--long abs_fun_long( long a )-{- // From Bit Twiddling Hacks:- // "Compute the integer absolute value (abs) without branching"- long mask = a >> 39;- return (a + mask) ^ mask;-}--long long abs_fun_llong( long long a )-{- // From Bit Twiddling Hacks:- // "Compute the integer absolute value (abs) without branching"- long long mask = a >> 63;- return (a + mask) ^ mask;-}----char signum_fun_char( char a )-{- // From Bit Twiddling Hacks: "Compute the sign of an integer"- return (a != 0) | (a >> 7);-}--short signum_fun_short( short a )-{- // From Bit Twiddling Hacks: "Compute the sign of an integer"- return (a != 0) | (a >> 15);-}--int signum_fun_int( int a )-{- // From Bit Twiddling Hacks: "Compute the sign of an integer"- return (a != 0) | (a >> 31);-}--long signum_fun_long( long a )-{- // From Bit Twiddling Hacks: "Compute the sign of an integer"- return (a != 0) | (a >> 39);-}--long long signum_fun_llong( long long a )-{- // From Bit Twiddling Hacks: "Compute the sign of an integer"- return (a != 0) | (a >> 63);-}--unsigned char signum_fun_uchar( unsigned char a )-{- return (a > 0);-}--unsigned short signum_fun_ushort( unsigned short a )-{- return (a > 0);-}--unsigned signum_fun_uint( unsigned a )-{- return (a > 0);-}--unsigned long signum_fun_ulong( unsigned long a )-{- return (a > 0);-}--unsigned long long signum_fun_ullong( unsigned long long a )-{- return (a > 0);-}--float signum_fun_float( float a )-{- // From Bit Twiddling Hacks: "Compute the sign of an integer"- return (a > 0) - (a < 0);-}----float logBase_fun_float( float a, float b )-{- return logf(b) / logf(a);-}----/*--------------------------------------------------------------------------*- * Bit operations *- *--------------------------------------------------------------------------*/--char setBit_fun_char( char x, unsigned i )-{- return x | 1 << i;-}--short setBit_fun_short( short x, unsigned i )-{- return x | 1 << i;-}--int setBit_fun_int( int x, unsigned i )-{- return x | 1 << i;-}--long setBit_fun_long( long x, unsigned i )-{- return x | 1 << i;-}--long long setBit_fun_llong( long long x, unsigned i )-{- return x | 1 << i;-}--unsigned char setBit_fun_uchar( unsigned char x, unsigned i )-{- return x | 1 << i;-}--unsigned short setBit_fun_ushort( unsigned short x, unsigned i )-{- return x | 1 << i;-}--unsigned setBit_fun_uint( unsigned x, unsigned i )-{- return x | 1 << i;-}--unsigned long setBit_fun_ulong( unsigned long x, unsigned i )-{- return x | 1 << i;-}--unsigned long long setBit_fun_ullong( unsigned long long x, unsigned i )-{- return x | 1 << i;-}----char clearBit_fun_char( char x, unsigned i )-{- return x & ~(1 << i);-}--short clearBit_fun_short( short x, unsigned i )-{- return x & ~(1 << i);-}--int clearBit_fun_int( int x, unsigned i )-{- return x & ~(1 << i);-}--long clearBit_fun_long( long x, unsigned i )-{- return x & ~(1 << i);-}--long long clearBit_fun_llong( long long x, unsigned i )-{- return x & ~(1 << i);-}--unsigned char clearBit_fun_uchar( unsigned char x, unsigned i )-{- return x & ~(1 << i);-}--unsigned short clearBit_fun_ushort( unsigned short x, unsigned i )-{- return x & ~(1 << i);-}--unsigned clearBit_fun_uint( unsigned x, unsigned i )-{- return x & ~(1 << i);-}--unsigned long clearBit_fun_ulong( unsigned long x, unsigned i )-{- return x & ~(1 << i);-}--unsigned long long clearBit_fun_ullong( unsigned long long x, unsigned i )-{- return x & ~(1 << i);-}----char complementBit_fun_char( char x, unsigned i )-{- return x ^ 1 << i;-}--short complementBit_fun_short( short x, unsigned i )-{- return x ^ 1 << i;-}--int complementBit_fun_int( int x, unsigned i )-{- return x ^ 1 << i;-}--long complementBit_fun_long( long x, unsigned i )-{- return x ^ 1 << i;-}--long long complementBit_fun_llong( long long x, unsigned i )-{- return x ^ 1 << i;-}--unsigned char complementBit_fun_uchar( unsigned char x, unsigned i )-{- return x ^ 1 << i;-}--unsigned short complementBit_fun_ushort( unsigned short x, unsigned i )-{- return x ^ 1 << i;-}--unsigned complementBit_fun_uint( unsigned x, unsigned i )-{- return x ^ 1 << i;-}--unsigned long complementBit_fun_ulong( unsigned long x, unsigned i )-{- return x ^ 1 << i;-}--unsigned long long complementBit_fun_ullong( unsigned long long x, unsigned i )-{- return x ^ 1 << i;-}----int testBit_fun_char( char x, unsigned i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_short( short x, unsigned i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_int( int x, unsigned i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_long( long x, unsigned i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_llong( long long x, unsigned i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_uchar( unsigned char x, unsigned i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_ushort( unsigned short x, unsigned i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_uint( unsigned x, unsigned i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_ulong( unsigned long x, unsigned i )-{- return (x & 1 << i) != 0;-}--int testBit_fun_ullong( unsigned long long x, unsigned i )-{- return (x & 1 << i) != 0;-}----char rotateL_fun_char( char x, int i )-{- if ((i %= 8) == 0) return x;- return (x << i) | ((0x7f >> (7 - i)) & (x >> (8 - i)));-}--short rotateL_fun_short( short x, int i )-{- if ((i %= 16) == 0) return x;- return (x << i) | ((0x7fff >> (15 - i)) & (x >> (16 - i)));-}--long rotateL_fun_long( long x, int i )-{- if ((i %= 40) == 0) return x;- return (x << i) | ((0x7fffffffffl >> (39 - i)) & (x >> (40 - i)));-}--long long rotateL_fun_llong( long long x, int i )-{- if ((i %= 64) == 0) return x;- return (x << i) | ((0x7fffffffffffffffll >> (63 - i)) & (x >> (64 - i)));-}--int rotateL_fun_int( int x, int i )-{- return (int)_rotl((unsigned)x, (unsigned)i);-}--unsigned char rotateL_fun_uchar( unsigned char x, int i )-{- if ((i %= 8) == 0) return x;- return (x << i) | (x >> (8 - i));-}--unsigned short rotateL_fun_ushort( unsigned short x, int i )-{- if ((i %= 16) == 0) return x;- return (x << i) | (x >> (16 - i));-}--unsigned long rotateL_fun_ulong( unsigned long x, int i )-{- if ((i %= 40) == 0) return x;- return (x << i) | (x >> (40 - i));-}--unsigned long long rotateL_fun_ullong( unsigned long long x, int i )-{- if ((i %= 64) == 0) return x;- return (x << i) | (x >> (64 - i));-}----char rotateR_fun_char( char x, int i )-{- if ((i %= 8) == 0) return x;- return (x << (8 - i)) | ((0x7f >> (i - 1)) & (x >> i));-}--short rotateR_fun_short( short x, int i )-{- if ((i %= 16) == 0) return x;- return (x << (16 - i)) | ((0x7fff >> (i - 1)) & (x >> i));-}--int rotateR_fun_int( int x, int i )-{- if ((i %= 32) == 0) return x;- return (x << (32 - i)) | ((0x7fffffff >> (i - 1)) & (x >> i));-}--long rotateR_fun_long( long x, int i )-{- if ((i %= 40) == 0) return x;- return (x << (40 - i)) | ((0x7fffffffffl >> (i - 1)) & (x >> i));-}--long long rotateR_fun_llong( long long x, int i )-{- if ((i %= 64) == 0) return x;- return (x << (64 - i)) | ((0x7fffffffffffffffll >> (i - 1)) & (x >> i));-}--unsigned char rotateR_fun_uchar( unsigned char x, int i )-{- if ((i %= 8) == 0) return x;- return (x << (8 - i)) | (x >> i);-}--unsigned short rotateR_fun_ushort( unsigned short x, int i )-{- if ((i %= 16) == 0) return x;- return (x << (16 - i)) | (x >> i);-}--unsigned rotateR_fun_uint( unsigned x, int i )-{- if ((i %= 32) == 0) return x;- return (x << (32 - i)) | (x >> i);-}--unsigned long rotateR_fun_ulong( unsigned long x, int i )-{- if ((i %= 40) == 0) return x;- return (x << (40 - i)) | (x >> i);-}--unsigned long long rotateR_fun_ullong( unsigned long long x, int i )-{- if ((i %= 64) == 0) return x;- return (x << (64 - i)) | (x >> i);-}----char reverseBits_fun_char( char x )-{- char r = x;- int i = 7;- for (x = x >> 1 & 0x7f; x; x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--short reverseBits_fun_short( short x )-{- short r = x;- int i = 15;- for (x = x >> 1 & 0x7fff; x; x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--int reverseBits_fun_int( int x )-{- int r = x;- int i = 31;- for (x = x >> 1 & 0x7fffffff; x; x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--long reverseBits_fun_long( long x )-{- long r = x;- int i = 39;- for (x = x >> 1 & 0x7fffffffffl; x; x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--long long reverseBits_fun_llong( long long x )-{- long long r = x;- int i = 63;- for (x = x >> 1 & 0x7fffffffffffffffll; x; x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--unsigned char reverseBits_fun_uchar( unsigned char x )-{- unsigned char r = x;- int i = 7;- while (x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--unsigned short reverseBits_fun_ushort( unsigned short x )-{- unsigned short r = x;- int i = 15;- while (x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--unsigned long reverseBits_fun_ulong( unsigned long x )-{- unsigned long r = x;- int i = 39;- while (x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}--unsigned long long reverseBits_fun_ullong( unsigned long long x )-{- unsigned long long r = x;- int i = 63;- while (x >>= 1)- {- r = (r << 1) | (x & 1);- --i;- }- return r << i;-}----unsigned bitScan_fun_char( char x )-{- unsigned r = 0;- char s = (x & 0x80);- if (x == 0) return 7;- while (((x <<= 1) & 0x80) == s)- ++r;- return r;-}--unsigned bitScan_fun_short( short x )-{- unsigned r = 0;- short s = (x & 0x8000);- if (x == 0) return 15;- while (((x <<= 1) & 0x8000) == s)- ++r;- return r;-}--unsigned bitScan_fun_int( int x )-{- unsigned r = 0;- int s = (x & 0x80000000);- if (x == 0) return 31;- while (((x <<= 1) & 0x80000000) == s)- ++r;- return r;-}--unsigned bitScan_fun_long( long x )-{- unsigned r = 0;- long s = (x & 0x8000000000l);- if (x == 0) return 39;- while (((x <<= 1) & 0x8000000000l) == s)- ++r;- return r;-}--unsigned bitScan_fun_llong( long long x )-{- unsigned r = 0;- long long s = (x & 0x8000000000000000ll);- if (x == 0) return 63;- while (((x <<= 1) & 0x8000000000000000ll) == s)- ++r;- return r;-}--unsigned bitScan_fun_uchar( unsigned char x )-{- unsigned r = 8;- while (x)- {- --r;- x >>= 1;- }- return r;-}--unsigned bitScan_fun_ushort( unsigned short x )-{- unsigned r = 16;- while (x)- {- --r;- x >>= 1;- }- return r;-}--unsigned bitScan_fun_uint( unsigned x )-{- unsigned r = 32;- while (x)- {- --r;- x >>= 1;- }- return r;-}--unsigned bitScan_fun_ulong( unsigned long x )-{- unsigned r = 40;- while (x)- {- --r;- x >>= 1;- }- return r;-}--unsigned bitScan_fun_ullong( unsigned long long x )-{- unsigned r = 64;- while (x)- {- --r;- x >>= 1;- }- return r;-}----unsigned bitCount_fun_char( char x )-{- unsigned r = x & 1;- for (x = x >> 1 & 0x7f; x; x >>= 1)- r += x & 1;- return r;-}--unsigned bitCount_fun_short( short x )-{- unsigned r = x & 1;- for (x = x >> 1 & 0x7fff; x; x >>= 1)- r += x & 1;- return r;-}--unsigned bitCount_fun_int( int x )-{- unsigned r = x & 1;- for (x = x >> 1 & 0x7fffffff; x; x >>= 1)- r += x & 1;- return r;-}--unsigned bitCount_fun_long( long x )-{- unsigned r = x & 1;- for (x = x >> 1 & 0x7fffffffffl; x; x >>= 1)- r += x & 1;- return r;-}--unsigned bitCount_fun_llong( long long x )-{- unsigned r = x & 1;- for (x = x >> 1 & 0x7fffffffffffffffll; x; x >>= 1)- r += x & 1;- return r;-}--unsigned bitCount_fun_uchar( unsigned char x )-{- unsigned r = x & 1;- while (x >>= 1)- r += x & 1;- return r;-}--unsigned bitCount_fun_ushort( unsigned short x )-{- unsigned r = x & 1;- while (x >>= 1)- r += x & 1;- return r;-}--unsigned bitCount_fun_ulong( unsigned long x )-{- unsigned r = x & 1;- while (x >>= 1)- r += x & 1;- return r;-}--unsigned bitCount_fun_ullong( unsigned long long x )-{- unsigned r = x & 1;- while (x >>= 1)- r += x & 1;- return r;-}----/*--------------------------------------------------------------------------*- * Complex numbers *- *--------------------------------------------------------------------------*/--int equal_fun_complexOf_char( complexOf_char a, complexOf_char b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_int( complexOf_int a, complexOf_int b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_long( complexOf_long a, complexOf_long b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_llong( complexOf_llong a, complexOf_llong b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_uchar( complexOf_uchar a, complexOf_uchar b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_uint( complexOf_uint a, complexOf_uint b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_ulong( complexOf_ulong a, complexOf_ulong b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_ullong( complexOf_ullong a, complexOf_ullong b )-{- return a.re == b.re && a.im == b.im;-}--int equal_fun_complexOf_float( complexOf_float a, complexOf_float b )-{- return a.re == b.re && a.im == b.im;-}----complexOf_char negate_fun_complexOf_char( complexOf_char a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_int negate_fun_complexOf_int( complexOf_int a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_long negate_fun_complexOf_long( complexOf_long a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_llong negate_fun_complexOf_llong( complexOf_llong a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_uchar negate_fun_complexOf_uchar( complexOf_uchar a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_uint negate_fun_complexOf_uint( complexOf_uint a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_ulong negate_fun_complexOf_ulong( complexOf_ulong a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_ullong negate_fun_complexOf_ullong( complexOf_ullong a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}--complexOf_float negate_fun_complexOf_float( complexOf_float a )-{- a.re = -a.re;- a.im = -a.im;- return a;-}----complexOf_char abs_fun_complexOf_char( complexOf_char a )-{- a.re = magnitude_fun_complexOf_char(a);- a.im = 0;- return a;-}--complexOf_int abs_fun_complexOf_int( complexOf_int a )-{- a.re = magnitude_fun_complexOf_int(a);- a.im = 0;- return a;-}--complexOf_long abs_fun_complexOf_long( complexOf_long a )-{- a.re = magnitude_fun_complexOf_long(a);- a.im = 0;- return a;-}--complexOf_llong abs_fun_complexOf_llong( complexOf_llong a )-{- a.re = magnitude_fun_complexOf_llong(a);- a.im = 0;- return a;-}--complexOf_uchar abs_fun_complexOf_uchar( complexOf_uchar a )-{- a.re = magnitude_fun_complexOf_uchar(a);- a.im = 0;- return a;-}--complexOf_uint abs_fun_complexOf_uint( complexOf_uint a )-{- a.re = magnitude_fun_complexOf_uint(a);- a.im = 0;- return a;-}--complexOf_ulong abs_fun_complexOf_ulong( complexOf_ulong a )-{- a.re = magnitude_fun_complexOf_ulong(a);- a.im = 0;- return a;-}--complexOf_ullong abs_fun_complexOf_ullong( complexOf_ullong a )-{- a.re = magnitude_fun_complexOf_ullong(a);- a.im = 0;- return a;-}--complexOf_float abs_fun_complexOf_float( complexOf_float a )-{- a.re = magnitude_fun_complexOf_float(a);- a.im = 0;- return a;-}--unsigned abs_fun_complexOf_short( unsigned a )-{- return _pack2(magnitude_fun_complexOf_short(a), 0);-}--unsigned abs_fun_complexOf_ushort( unsigned a )-{- return _pack2(magnitude_fun_complexOf_ushort(a), 0);-}----complexOf_char signum_fun_complexOf_char( complexOf_char a )-{- char m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_char(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_int signum_fun_complexOf_int( complexOf_int a )-{- int m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_int(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_long signum_fun_complexOf_long( complexOf_long a )-{- long m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_long(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_llong signum_fun_complexOf_llong( complexOf_llong a )-{- long long m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_llong(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_uchar signum_fun_complexOf_uchar( complexOf_uchar a )-{- unsigned char m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_uchar(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_uint signum_fun_complexOf_uint( complexOf_uint a )-{- unsigned m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_uint(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_ulong signum_fun_complexOf_ulong( complexOf_ulong a )-{- unsigned long m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_ulong(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_ullong signum_fun_complexOf_ullong( complexOf_ullong a )-{- unsigned long long m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_ullong(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--complexOf_float signum_fun_complexOf_float( complexOf_float a )-{- float m;- if (a.re == 0 && a.im == 0) {- return a;- } else {- m = magnitude_fun_complexOf_float(a);- a.re = a.re / m;- a.im = a.im / m;- return a;- }-}--unsigned signum_fun_complexOf_short( unsigned a )-{- short m;- if (a == 0) {- return a;- } else {- m = magnitude_fun_complexOf_short(a);- return _pack2((a >> 16) / m, (a & 0x0000ffff) / m);- }-}--unsigned signum_fun_complexOf_ushort( unsigned a )-{- unsigned short m;- if (a == 0) {- return a;- } else {- m = magnitude_fun_complexOf_ushort(a);- return _pack2((a >> 16) / m, (a & 0x0000ffff) / m);- }-}----complexOf_char add_fun_complexOf_char( complexOf_char a, complexOf_char b )-{- a.re = a.re + b.re;- a.im = a.im + b.im;- return a;-}--complexOf_int add_fun_complexOf_int( complexOf_int a, complexOf_int b )-{- a.re = a.re + b.re;- a.im = a.im + b.im;- return a;-}--complexOf_long add_fun_complexOf_long( complexOf_long a, complexOf_long b )-{- a.re = a.re + b.re;- a.im = a.im + b.im;- return a;-}--complexOf_llong add_fun_complexOf_llong( complexOf_llong a, complexOf_llong b )-{- a.re = a.re + b.re;- a.im = a.im + b.im;- return a;-}--complexOf_uchar add_fun_complexOf_uchar( complexOf_uchar a, complexOf_uchar b )-{- a.re = a.re + b.re;- a.im = a.im + b.im;- return a;-}--complexOf_uint add_fun_complexOf_uint( complexOf_uint a, complexOf_uint b )-{- a.re = a.re + b.re;- a.im = a.im + b.im;- return a;-}--complexOf_ulong add_fun_complexOf_ulong( complexOf_ulong a, complexOf_ulong b )-{- a.re = a.re + b.re;- a.im = a.im + b.im;- return a;-}--complexOf_ullong add_fun_complexOf_ullong( complexOf_ullong a, complexOf_ullong b )-{- a.re = a.re + b.re;- a.im = a.im + b.im;- return a;-}--complexOf_float add_fun_complexOf_float( complexOf_float a, complexOf_float b )-{- a.re = a.re + b.re;- a.im = a.im + b.im;- return a;-}----complexOf_char sub_fun_complexOf_char( complexOf_char a, complexOf_char b )-{- a.re = a.re - b.re;- a.im = a.im - b.im;- return a;-}--complexOf_int sub_fun_complexOf_int( complexOf_int a, complexOf_int b )-{- a.re = a.re - b.re;- a.im = a.im - b.im;- return a;-}--complexOf_long sub_fun_complexOf_long( complexOf_long a, complexOf_long b )-{- a.re = a.re - b.re;- a.im = a.im - b.im;- return a;-}--complexOf_llong sub_fun_complexOf_llong( complexOf_llong a, complexOf_llong b )-{- a.re = a.re - b.re;- a.im = a.im - b.im;- return a;-}--complexOf_uchar sub_fun_complexOf_uchar( complexOf_uchar a, complexOf_uchar b )-{- a.re = a.re - b.re;- a.im = a.im - b.im;- return a;-}--complexOf_uint sub_fun_complexOf_uint( complexOf_uint a, complexOf_uint b )-{- a.re = a.re - b.re;- a.im = a.im - b.im;- return a;-}--complexOf_ulong sub_fun_complexOf_ulong( complexOf_ulong a, complexOf_ulong b )-{- a.re = a.re - b.re;- a.im = a.im - b.im;- return a;-}--complexOf_ullong sub_fun_complexOf_ullong( complexOf_ullong a, complexOf_ullong b )-{- a.re = a.re - b.re;- a.im = a.im - b.im;- return a;-}--complexOf_float sub_fun_complexOf_float( complexOf_float a, complexOf_float b )-{- a.re = a.re - b.re;- a.im = a.im - b.im;- return a;-}----complexOf_char mult_fun_complexOf_char( complexOf_char a, complexOf_char b )-{- complexOf_char r;- r.re = a.re * b.re - a.im * b.im;- r.im = a.im * b.re + a.re * b.im;- return r;-}--complexOf_int mult_fun_complexOf_int( complexOf_int a, complexOf_int b )-{- complexOf_int r;- r.re = a.re * b.re - a.im * b.im;- r.im = a.im * b.re + a.re * b.im;- return r;-}--complexOf_long mult_fun_complexOf_long( complexOf_long a, complexOf_long b )-{- complexOf_long r;- r.re = a.re * b.re - a.im * b.im;- r.im = a.im * b.re + a.re * b.im;- return r;-}--complexOf_llong mult_fun_complexOf_llong( complexOf_llong a, complexOf_llong b )-{- complexOf_llong r;- r.re = a.re * b.re - a.im * b.im;- r.im = a.im * b.re + a.re * b.im;- return r;-}--complexOf_uchar mult_fun_complexOf_uchar( complexOf_uchar a, complexOf_uchar b )-{- complexOf_uchar r;- r.re = a.re * b.re - a.im * b.im;- r.im = a.im * b.re + a.re * b.im;- return r;-}--complexOf_uint mult_fun_complexOf_uint( complexOf_uint a, complexOf_uint b )-{- complexOf_uint r;- r.re = a.re * b.re - a.im * b.im;- r.im = a.im * b.re + a.re * b.im;- return r;-}--complexOf_ulong mult_fun_complexOf_ulong( complexOf_ulong a, complexOf_ulong b )-{- complexOf_ulong r;- r.re = a.re * b.re - a.im * b.im;- r.im = a.im * b.re + a.re * b.im;- return r;-}--complexOf_ullong mult_fun_complexOf_ullong( complexOf_ullong a, complexOf_ullong b )-{- complexOf_ullong r;- r.re = a.re * b.re - a.im * b.im;- r.im = a.im * b.re + a.re * b.im;- return r;-}--complexOf_float mult_fun_complexOf_float( complexOf_float a, complexOf_float b )-{- complexOf_float r;- r.re = a.re * b.re - a.im * b.im;- r.im = a.im * b.re + a.re * b.im;- return r;-}--unsigned mult_fun_complexOf_short( unsigned a, unsigned b )-{- short are = (short)(a >> 16);- short aim = (short)(a & 0x0000ffff);- short bre = (short)(b >> 16);- short bim = (short)(b & 0x0000ffff);- return _pack2(are * bre - aim * bim, aim * bre + are * bim);-}--unsigned mult_fun_complexOf_ushort( unsigned a, unsigned b )-{- unsigned short are = (unsigned short)(a >> 16);- unsigned short aim = (unsigned short)(a & 0x0000ffff);- unsigned short bre = (unsigned short)(b >> 16);- unsigned short bim = (unsigned short)(b & 0x0000ffff);- return _pack2(are * bre - aim * bim, aim * bre + are * bim);-}----complexOf_float div_fun_complexOf_float( complexOf_float a, complexOf_float b )-{- float x = b.re * b.re + b.im * b.im;- complexOf_float r;- r.re = (a.re * b.re + a.im * b.im) / x;- r.im = (a.im * b.re - a.re * b.im) / x;- return r;-}----complexOf_float exp_fun_complexOf_float( complexOf_float a )-{- float expre = expf(a.re);- a.re = expre * cosf(a.im);- a.im = expre * sinf(a.im);- return a;-}----complexOf_float sqrt_fun_complexOf_float( complexOf_float a )-{- float magare = magnitude_fun_complexOf_float(a) + a.re;- a.re = sqrtf(magare / 2);- a.im = a.im / sqrtf(2 * magare);- return a;-}----complexOf_float log_fun_complexOf_float( complexOf_float a )-{- complexOf_float r;- r.re = logf(magnitude_fun_complexOf_float(a));- r.im = phase_fun_complexOf_float(a);- return r;-}----complexOf_float pow_fun_complexOf_float( complexOf_float a, complexOf_float b )-{- return exp_fun_complexOf_float(mult_fun_complexOf_float(log_fun_complexOf_float(a), b));-}----complexOf_float logBase_fun_complexOf_float( complexOf_float a, complexOf_float b )-{- return div_fun_complexOf_float(log_fun_complexOf_float(b), log_fun_complexOf_float(a));-}----complexOf_float sin_fun_complexOf_float( complexOf_float a )-{- complexOf_float r;- r.re = sinf(a.re) * coshf(a.im);- r.im = cosf(a.re) * sinhf(a.im);- return r;-}----complexOf_float cos_fun_complexOf_float( complexOf_float a )-{- complexOf_float r;- r.re = cosf(a.re) * coshf(a.im);- r.im = - sinf(a.re) * sinhf(a.im);- return r;-}----complexOf_float tan_fun_complexOf_float( complexOf_float a )-{- return div_fun_complexOf_float(sin_fun_complexOf_float(a), cos_fun_complexOf_float(a));-}----complexOf_float sinh_fun_complexOf_float( complexOf_float a )-{- complexOf_float r;- r.re = sinhf(a.re) * cosf(a.im);- r.im = coshf(a.re) * sinf(a.im);- return r;-}----complexOf_float cosh_fun_complexOf_float( complexOf_float a )-{- complexOf_float r;- r.re = cosf(a.re) * coshf(a.im);- r.im = sinhf(a.re) * sinf(a.im);- return r;-}----complexOf_float tanh_fun_complexOf_float( complexOf_float a )-{- return div_fun_complexOf_float(sinh_fun_complexOf_float(a), cosh_fun_complexOf_float(a));-}----complexOf_float asin_fun_complexOf_float( complexOf_float a )-{- complexOf_float b = add_fun_complexOf_float(log_fun_complexOf_float(complex_fun_float(-a.im, a.re)), sqrt_fun_complexOf_float(sub_fun_complexOf_float(complex_fun_float(1, 0), mult_fun_complexOf_float(a, a))));- a.re = b.im;- a.im = -b.re;- return a;-}----complexOf_float acos_fun_complexOf_float( complexOf_float a )-{- complexOf_float b = sqrt_fun_complexOf_float(sub_fun_complexOf_float(complex_fun_float(1, 0), mult_fun_complexOf_float(a, a)));- complexOf_float c = log_fun_complexOf_float(add_fun_complexOf_float(a, complex_fun_float(-b.im, b.re)));- a.re = c.im;- a.im = -c.re;- return a;-}----complexOf_float atan_fun_complexOf_float( complexOf_float a )-{- complexOf_float b = log_fun_complexOf_float(div_fun_complexOf_float(complex_fun_float(1 - a.im, a.re), sqrt_fun_complexOf_float(add_fun_complexOf_float(complex_fun_float(1, 0), mult_fun_complexOf_float(a, a)))));- a.re = b.im;- a.im = -b.re;- return a;-}----complexOf_float asinh_fun_complexOf_float( complexOf_float a )-{- return log_fun_complexOf_float(add_fun_complexOf_float(a, sqrt_fun_complexOf_float(add_fun_complexOf_float(complex_fun_float(1, 0), mult_fun_complexOf_float(a, a)))));-}----complexOf_float acosh_fun_complexOf_float( complexOf_float a )-{- complexOf_float b = {1, 0};- complexOf_float c = add_fun_complexOf_float(a, b);- return log_fun_complexOf_float(add_fun_complexOf_float(a, mult_fun_complexOf_float(c, sqrt_fun_complexOf_float(div_fun_complexOf_float(sub_fun_complexOf_float(a, b), c)))));-}----complexOf_float atanh_fun_complexOf_float( complexOf_float a )-{- complexOf_float b = {1, 0};- return log_fun_complexOf_float(div_fun_complexOf_float(add_fun_complexOf_float(b, a), sqrt_fun_complexOf_float(sub_fun_complexOf_float(b, mult_fun_complexOf_float(a, a)))));-}----complexOf_char complex_fun_char( char re, char im )-{- complexOf_char r;- r.re = re;- r.im = im;- return r;-}--complexOf_int complex_fun_int( int re, int im )-{- complexOf_int r;- r.re = re;- r.im = im;- return r;-}--complexOf_long complex_fun_long( long re, long im )-{- complexOf_long r;- r.re = re;- r.im = im;- return r;-}--complexOf_llong complex_fun_llong( long long re, long long im )-{- complexOf_llong r;- r.re = re;- r.im = im;- return r;-}--complexOf_uchar complex_fun_uchar( unsigned char re, unsigned char im )-{- complexOf_uchar r;- r.re = re;- r.im = im;- return r;-}--complexOf_uint complex_fun_uint( unsigned re, unsigned im )-{- complexOf_uint r;- r.re = re;- r.im = im;- return r;-}--complexOf_ulong complex_fun_ulong( unsigned long re, unsigned long im )-{- complexOf_ulong r;- r.re = re;- r.im = im;- return r;-}--complexOf_ullong complex_fun_ullong( unsigned long long re, unsigned long long im )-{- complexOf_ullong r;- r.re = re;- r.im = im;- return r;-}--complexOf_float complex_fun_float( float re, float im )-{- complexOf_float r;- r.re = re;- r.im = im;- return r;-}----char creal_fun_complexOf_char( complexOf_char a )-{- return a.re;-}--int creal_fun_complexOf_int( complexOf_int a )-{- return a.re;-}--long creal_fun_complexOf_long( complexOf_long a )-{- return a.re;-}--long long creal_fun_complexOf_llong( complexOf_llong a )-{- return a.re;-}--unsigned char creal_fun_complexOf_uchar( complexOf_uchar a )-{- return a.re;-}--unsigned creal_fun_complexOf_uint( complexOf_uint a )-{- return a.re;-}--unsigned long creal_fun_complexOf_ulong( complexOf_ulong a )-{- return a.re;-}--unsigned long long creal_fun_complexOf_ullong( complexOf_ullong a )-{- return a.re;-}--float creal_fun_complexOf_float( complexOf_float a )-{- return a.re;-}--short creal_fun_complexOf_short( unsigned a )-{- return a >> 16;-}--unsigned short creal_fun_complexOf_ushort( unsigned a )-{- return a >> 16;-}----char cimag_fun_complexOf_char( complexOf_char a )-{- return a.im;-}--int cimag_fun_complexOf_int( complexOf_int a )-{- return a.im;-}--long cimag_fun_complexOf_long( complexOf_long a )-{- return a.im;-}--long long cimag_fun_complexOf_llong( complexOf_llong a )-{- return a.im;-}--unsigned char cimag_fun_complexOf_uchar( complexOf_uchar a )-{- return a.im;-}--unsigned cimag_fun_complexOf_uint( complexOf_uint a )-{- return a.im;-}--unsigned long cimag_fun_complexOf_ulong( complexOf_ulong a )-{- return a.im;-}--unsigned long long cimag_fun_complexOf_ullong( complexOf_ullong a )-{- return a.im;-}--float cimag_fun_complexOf_float( complexOf_float a )-{- return a.im;-}--short cimag_fun_complexOf_short( unsigned a )-{- return a & 0x0000ffff;-}--unsigned short cimag_fun_complexOf_ushort( unsigned a )-{- return a & 0x0000ffff;-}----complexOf_char conj_fun_complexOf_char( complexOf_char a )-{- a.im = -a.im;- return a;-}--complexOf_int conj_fun_complexOf_int( complexOf_int a )-{- a.im = -a.im;- return a;-}--complexOf_long conj_fun_complexOf_long( complexOf_long a )-{- a.im = -a.im;- return a;-}--complexOf_llong conj_fun_complexOf_llong( complexOf_llong a )-{- a.im = -a.im;- return a;-}--complexOf_uchar conj_fun_complexOf_uchar( complexOf_uchar a )-{- a.im = -a.im;- return a;-}--complexOf_uint conj_fun_complexOf_uint( complexOf_uint a )-{- a.im = -a.im;- return a;-}--complexOf_ulong conj_fun_complexOf_ulong( complexOf_ulong a )-{- a.im = -a.im;- return a;-}--complexOf_ullong conj_fun_complexOf_ullong( complexOf_ullong a )-{- a.im = -a.im;- return a;-}--complexOf_float conj_fun_complexOf_float( complexOf_float a )-{- a.im = -a.im;- return a;-}--unsigned conj_fun_complexOf_short( unsigned a )-{- return _pack2(a >> 16, -(a & 0x0000ffff));-}--unsigned conj_fun_complexOf_ushort( unsigned a )-{- return _pack2(a >> 16, -(a & 0x0000ffff));-}----char magnitude_fun_complexOf_char( complexOf_char a )-{- return roundf(hypotf(a.re, a.im));-}--int magnitude_fun_complexOf_int( complexOf_int a )-{- return roundf(hypotf(a.re, a.im));-}--long magnitude_fun_complexOf_long( complexOf_long a )-{- return roundf(hypotf(a.re, a.im));-}--long long magnitude_fun_complexOf_llong( complexOf_llong a )-{- return roundf(hypotf(a.re, a.im));-}--unsigned char magnitude_fun_complexOf_uchar( complexOf_uchar a )-{- return roundf(hypotf(a.re, a.im));-}--unsigned magnitude_fun_complexOf_uint( complexOf_uint a )-{- return roundf(hypotf(a.re, a.im));-}--unsigned long magnitude_fun_complexOf_ulong( complexOf_ulong a )-{- return roundf(hypotf(a.re, a.im));-}--unsigned long long magnitude_fun_complexOf_ullong( complexOf_ullong a )-{- return roundf(hypotf(a.re, a.im));-}--float magnitude_fun_complexOf_float( complexOf_float a )-{- return (hypotf(a.re, a.im));-}--short magnitude_fun_complexOf_short( unsigned a )-{- return roundf(hypotf((a >> 16), (a & 0x0000ffff)));-}--unsigned short magnitude_fun_complexOf_ushort( unsigned a )-{- return roundf(hypotf((a >> 16), (a & 0x0000ffff)));-}----char phase_fun_complexOf_char( complexOf_char a )-{- if (a.re == 0 && a.im == 0) return 0;- else return roundf(atan2f(a.im, a.re));-}--int phase_fun_complexOf_int( complexOf_int a )-{- if (a.re == 0 && a.im == 0) return 0;- else return roundf(atan2f(a.im, a.re));-}--long phase_fun_complexOf_long( complexOf_long a )-{- if (a.re == 0 && a.im == 0) return 0;- else return roundf(atan2f(a.im, a.re));-}--long long phase_fun_complexOf_llong( complexOf_llong a )-{- if (a.re == 0 && a.im == 0) return 0;- else return roundf(atan2f(a.im, a.re));-}--unsigned char phase_fun_complexOf_uchar( complexOf_uchar a )-{- if (a.re == 0 && a.im == 0) return 0;- else return roundf(atan2f(a.im, a.re));-}--unsigned phase_fun_complexOf_uint( complexOf_uint a )-{- if (a.re == 0 && a.im == 0) return 0;- else return roundf(atan2f(a.im, a.re));-}--unsigned long phase_fun_complexOf_ulong( complexOf_ulong a )-{- if (a.re == 0 && a.im == 0) return 0;- else return roundf(atan2f(a.im, a.re));-}--unsigned long long phase_fun_complexOf_ullong( complexOf_ullong a )-{- if (a.re == 0 && a.im == 0) return 0;- else return roundf(atan2f(a.im, a.re));-}--float phase_fun_complexOf_float( complexOf_float a )-{- if (a.re == 0 && a.im == 0) return 0;- else return (atan2f(a.im, a.re));-}--short phase_fun_complexOf_short( unsigned a )-{- short re = (a >> 16);- short im = (a & 0x0000ffff);- if (re == 0 && im == 0) return 0;- else return roundf(atan2f(im, re));-}--unsigned short phase_fun_complexOf_ushort( unsigned a )-{- unsigned short re = (a >> 16);- unsigned short im = (a & 0x0000ffff);- if (re == 0 && im == 0) return 0;- else return roundf(atan2f(im, re));-}----complexOf_char mkPolar_fun_char( char r, char t )-{- complexOf_char a;- a.re = roundf(r * cosf(t));- a.im = roundf(r * sinf(t));- return a;-}--complexOf_int mkPolar_fun_int( int r, int t )-{- complexOf_int a;- a.re = roundf(r * cosf(t));- a.im = roundf(r * sinf(t));- return a;-}--complexOf_long mkPolar_fun_long( long r, long t )-{- complexOf_long a;- a.re = roundf(r * cosf(t));- a.im = roundf(r * sinf(t));- return a;-}--complexOf_llong mkPolar_fun_llong( long long r, long long t )-{- complexOf_llong a;- a.re = roundf(r * cosf(t));- a.im = roundf(r * sinf(t));- return a;-}--complexOf_uchar mkPolar_fun_uchar( unsigned char r, unsigned char t )-{- complexOf_uchar a;- a.re = roundf(r * cosf(t));- a.im = roundf(r * sinf(t));- return a;-}--complexOf_uint mkPolar_fun_uint( unsigned r, unsigned t )-{- complexOf_uint a;- a.re = roundf(r * cosf(t));- a.im = roundf(r * sinf(t));- return a;-}--complexOf_ulong mkPolar_fun_ulong( unsigned long r, unsigned long t )-{- complexOf_ulong a;- a.re = roundf(r * cosf(t));- a.im = roundf(r * sinf(t));- return a;-}--complexOf_ullong mkPolar_fun_ullong( unsigned long long r, unsigned long long t )-{- complexOf_ullong a;- a.re = roundf(r * cosf(t));- a.im = roundf(r * sinf(t));- return a;-}--complexOf_float mkPolar_fun_float( float r, float t )-{- complexOf_float a;- a.re = (r * cosf(t));- a.im = (r * sinf(t));- return a;-}--unsigned mkPolar_fun_short( short r, short t )-{- return _pack2(roundf(r * cosf(t)), roundf(r * sinf(t)));-}--unsigned mkPolar_fun_ushort( unsigned short r, unsigned short t )-{- return _pack2(roundf(r * cosf(t)), roundf(r * sinf(t)));-}----complexOf_char cis_fun_char( char t )-{- complexOf_char r;- r.re = roundf(cosf(t));- r.im = roundf(sinf(t));- return r;-}--complexOf_int cis_fun_int( int t )-{- complexOf_int r;- r.re = roundf(cosf(t));- r.im = roundf(sinf(t));- return r;-}--complexOf_long cis_fun_long( long t )-{- complexOf_long r;- r.re = roundf(cosf(t));- r.im = roundf(sinf(t));- return r;-}--complexOf_llong cis_fun_llong( long long t )-{- complexOf_llong r;- r.re = roundf(cosf(t));- r.im = roundf(sinf(t));- return r;-}--complexOf_uchar cis_fun_uchar( unsigned char t )-{- complexOf_uchar r;- r.re = roundf(cosf(t));- r.im = roundf(sinf(t));- return r;-}--complexOf_uint cis_fun_uint( unsigned t )-{- complexOf_uint r;- r.re = roundf(cosf(t));- r.im = roundf(sinf(t));- return r;-}--complexOf_ulong cis_fun_ulong( unsigned long t )-{- complexOf_ulong r;- r.re = roundf(cosf(t));- r.im = roundf(sinf(t));- return r;-}--complexOf_ullong cis_fun_ullong( unsigned long long t )-{- complexOf_ullong r;- r.re = roundf(cosf(t));- r.im = roundf(sinf(t));- return r;-}--complexOf_float cis_fun_float( float t )-{- complexOf_float r;- r.re = (cosf(t));- r.im = (sinf(t));- return r;-}--unsigned cis_fun_short( short t )-{- return _pack2(roundf(cosf(t)), roundf(sinf(t)));-}--unsigned cis_fun_ushort( unsigned short t )-{- return _pack2(roundf(cosf(t)), roundf(sinf(t)));-}----/*--------------------------------------------------------------------------*- * Trace functions *- *--------------------------------------------------------------------------*/--static FILE *trace_log_file;-static time_t trace_start_time;--void traceStart()-{- char timestr [80];- char str [256];- struct tm * timeinfo;- trace_start_time = time(NULL);- timeinfo = localtime(&(trace_start_time));- strftime(timestr, 80, "%Y%m%d-%H%M%S", timeinfo);- sprintf(str, "trace-%s.log", timestr);- trace_log_file = fopen(str, "a");- if (trace_log_file == NULL) {- fprintf(stderr,"Can not open trace file.\n");- exit (8);- }- strftime(timestr, 80, "%d-%b-%Y %H:%M:%S", timeinfo);- fprintf(trace_log_file, "Logging started at %s.\n", timestr);- fflush(trace_log_file);- trace_start_time = time(NULL);-}--void elapsedTimeString( char* str )-{- sprintf(str, "%ld.000", time(NULL) - trace_start_time);-}--void traceEnd()-{- fprintf(trace_log_file, "Logging finished.\n");- fclose(trace_log_file);-}--void trace_char( char val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%d\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_short( short val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%d\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_int( int val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%d\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_long( long val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%ld\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_llong( long long val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%lld\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_uchar( unsigned char val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%u\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_ushort( unsigned short val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%u\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_uint( unsigned val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%u\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_ulong( unsigned long val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%lu\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_ullong( unsigned long long val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%llu\n", id, timestr, val);- fflush(trace_log_file);-}--void trace_float( float val, int 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_char( complexOf_char val, int 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_short( unsigned val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%d+%d*I\n", id, timestr, (short)(val >> 16), (short)(val & 0x0000ffff));- fflush(trace_log_file);-}--void trace_complexOf_int( complexOf_int val, int 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_long( complexOf_long val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%ld+%ld*I\n", id, timestr, val.re, val.im);- fflush(trace_log_file);-}--void trace_complexOf_llong( complexOf_llong val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%lld+%lld*I\n", id, timestr, val.re, val.im);- fflush(trace_log_file);-}--void trace_complexOf_uchar( complexOf_uchar val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%u+%u*I\n", id, timestr, val.re, val.im);- fflush(trace_log_file);-}--void trace_complexOf_ushort( unsigned val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%u+%u*I\n", id, timestr, (val >> 16), (val & 0x0000ffff));- fflush(trace_log_file);-}--void trace_complexOf_uint( complexOf_uint val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%u+%u*I\n", id, timestr, val.re, val.im);- fflush(trace_log_file);-}--void trace_complexOf_ulong( complexOf_ulong val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%lu+%lu*I\n", id, timestr, val.re, val.im);- fflush(trace_log_file);-}--void trace_complexOf_ullong( complexOf_ullong val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%llu+%llu*I\n", id, timestr, val.re, val.im);- fflush(trace_log_file);-}--void trace_complexOf_float( complexOf_float val, int id )-{- char timestr [80];- elapsedTimeString(timestr);- fprintf(trace_log_file, "id=%d, time=%s, value=%f+%f*I\n", id, timestr, val.re, val.im);- fflush(trace_log_file);-}-
− Feldspar/C/feldspar_tic64x.h
@@ -1,443 +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.-//--#ifndef FELDSPAR_TI_C64X_H-#define FELDSPAR_TI_C64X_H----char pow_fun_char( char, char );-short pow_fun_short( short, short );-int pow_fun_int( int, int );-long pow_fun_long( long, long );-long long pow_fun_llong( long long, long long );-unsigned char pow_fun_uchar( unsigned char, unsigned char );-unsigned short pow_fun_ushort( unsigned short, unsigned short );-unsigned pow_fun_uint( unsigned, unsigned );-unsigned long pow_fun_ulong( unsigned long, unsigned long );-unsigned long long pow_fun_ullong( unsigned long long, unsigned long long );--char abs_fun_char( char );-short abs_fun_short( short );-long abs_fun_long( long );-long long abs_fun_llong( long long );--char signum_fun_char( char );-short signum_fun_short( short );-int signum_fun_int( int );-long signum_fun_long( long );-long long signum_fun_llong( long long );-unsigned char signum_fun_uchar( unsigned char );-unsigned short signum_fun_ushort( unsigned short );-unsigned signum_fun_uint( unsigned );-unsigned long signum_fun_ulong( unsigned long );-unsigned long long signum_fun_ullong( unsigned long long );-float signum_fun_float( float );--float logBase_fun_float( float, float );----char setBit_fun_char( char, unsigned );-short setBit_fun_short( short, unsigned );-int setBit_fun_int( int, unsigned );-long setBit_fun_long( long, unsigned );-long long setBit_fun_llong( long long, unsigned );-unsigned char setBit_fun_uchar( unsigned char, unsigned );-unsigned short setBit_fun_ushort( unsigned short, unsigned );-unsigned setBit_fun_uint( unsigned, unsigned );-unsigned long setBit_fun_ulong( unsigned long, unsigned );-unsigned long long setBit_fun_ullong( unsigned long long, unsigned );--char clearBit_fun_char( char, unsigned );-short clearBit_fun_short( short, unsigned );-int clearBit_fun_int( int, unsigned );-long clearBit_fun_long( long, unsigned );-long long clearBit_fun_llong( long long, unsigned );-unsigned char clearBit_fun_uchar( unsigned char, unsigned );-unsigned short clearBit_fun_ushort( unsigned short, unsigned );-unsigned clearBit_fun_uint( unsigned, unsigned );-unsigned long clearBit_fun_ulong( unsigned long, unsigned );-unsigned long long clearBit_fun_ullong( unsigned long long, unsigned );--char complementBit_fun_char( char, unsigned );-short complementBit_fun_short( short, unsigned );-int complementBit_fun_int( int, unsigned );-long complementBit_fun_long( long, unsigned );-long long complementBit_fun_llong( long long, unsigned );-unsigned char complementBit_fun_uchar( unsigned char, unsigned );-unsigned short complementBit_fun_ushort( unsigned short, unsigned );-unsigned complementBit_fun_uint( unsigned, unsigned );-unsigned long complementBit_fun_ulong( unsigned long, unsigned );-unsigned long long complementBit_fun_ullong( unsigned long long, unsigned );--int testBit_fun_char( char, unsigned );-int testBit_fun_short( short, unsigned );-int testBit_fun_int( int, unsigned );-int testBit_fun_long( long, unsigned );-int testBit_fun_llong( long long, unsigned );-int testBit_fun_uchar( unsigned char, unsigned );-int testBit_fun_ushort( unsigned short, unsigned );-int testBit_fun_uint( unsigned, unsigned );-int testBit_fun_ulong( unsigned long, unsigned );-int testBit_fun_ullong( unsigned long long, unsigned );--char rotateL_fun_char( char, int );-short rotateL_fun_short( short, int );-long rotateL_fun_long( long, int );-long long rotateL_fun_llong( long long, int );-int rotateL_fun_int( int, int );-unsigned char rotateL_fun_uchar( unsigned char, int );-unsigned short rotateL_fun_ushort( unsigned short, int );-unsigned long rotateL_fun_ulong( unsigned long, int );-unsigned long long rotateL_fun_ullong( unsigned long long, int );--char rotateR_fun_char( char, int );-short rotateR_fun_short( short, int );-int rotateR_fun_int( int, int );-long rotateR_fun_long( long, int );-long long rotateR_fun_llong( long long, int );-unsigned char rotateR_fun_uchar( unsigned char, int );-unsigned short rotateR_fun_ushort( unsigned short, int );-unsigned rotateR_fun_uint( unsigned, int );-unsigned long rotateR_fun_ulong( unsigned long, int );-unsigned long long rotateR_fun_ullong( unsigned long long, int );--char reverseBits_fun_char( char );-short reverseBits_fun_short( short );-int reverseBits_fun_int( int );-long reverseBits_fun_long( long );-long long reverseBits_fun_llong( long long );-unsigned char reverseBits_fun_uchar( unsigned char );-unsigned short reverseBits_fun_ushort( unsigned short );-unsigned long reverseBits_fun_ulong( unsigned long );-unsigned long long reverseBits_fun_ullong( unsigned long long );--unsigned bitScan_fun_char( char );-unsigned bitScan_fun_short( short );-unsigned bitScan_fun_int( int );-unsigned bitScan_fun_long( long );-unsigned bitScan_fun_llong( long long );-unsigned bitScan_fun_uchar( unsigned char );-unsigned bitScan_fun_ushort( unsigned short );-unsigned bitScan_fun_uint( unsigned );-unsigned bitScan_fun_ulong( unsigned long );-unsigned bitScan_fun_ullong( unsigned long long );--unsigned bitCount_fun_char( char );-unsigned bitCount_fun_short( short );-unsigned bitCount_fun_int( int );-unsigned bitCount_fun_long( long );-unsigned bitCount_fun_llong( long long );-unsigned bitCount_fun_uchar( unsigned char );-unsigned bitCount_fun_ushort( unsigned short );-unsigned bitCount_fun_ulong( unsigned long );-unsigned bitCount_fun_ullong( unsigned long long );----typedef struct {- char re;- char im;-} complexOf_char;--typedef struct {- int re;- int im;-} complexOf_int;--typedef struct {- long re;- long im;-} complexOf_long;--typedef struct {- long long re;- long long im;-} complexOf_llong;--typedef struct {- unsigned char re;- unsigned char im;-} complexOf_uchar;--typedef struct {- unsigned re;- unsigned im;-} complexOf_uint;--typedef struct {- unsigned long re;- unsigned long im;-} complexOf_ulong;--typedef struct {- unsigned long long re;- unsigned long long im;-} complexOf_ullong;--typedef struct {- float re;- float im;-} complexOf_float;--int equal_fun_complexOf_char( complexOf_char, complexOf_char );-int equal_fun_complexOf_int( complexOf_int, complexOf_int );-int equal_fun_complexOf_long( complexOf_long, complexOf_long );-int equal_fun_complexOf_llong( complexOf_llong, complexOf_llong );-int equal_fun_complexOf_uchar( complexOf_uchar, complexOf_uchar );-int equal_fun_complexOf_uint( complexOf_uint, complexOf_uint );-int equal_fun_complexOf_ulong( complexOf_ulong, complexOf_ulong );-int equal_fun_complexOf_ullong( complexOf_ullong, complexOf_ullong );-int equal_fun_complexOf_float( complexOf_float, complexOf_float );--complexOf_char negate_fun_complexOf_char( complexOf_char );-complexOf_int negate_fun_complexOf_int( complexOf_int );-complexOf_long negate_fun_complexOf_long( complexOf_long );-complexOf_llong negate_fun_complexOf_llong( complexOf_llong );-complexOf_uchar negate_fun_complexOf_uchar( complexOf_uchar );-complexOf_uint negate_fun_complexOf_uint( complexOf_uint );-complexOf_ulong negate_fun_complexOf_ulong( complexOf_ulong );-complexOf_ullong negate_fun_complexOf_ullong( complexOf_ullong );-complexOf_float negate_fun_complexOf_float( complexOf_float );--complexOf_char abs_fun_complexOf_char( complexOf_char );-complexOf_int abs_fun_complexOf_int( complexOf_int );-complexOf_long abs_fun_complexOf_long( complexOf_long );-complexOf_llong abs_fun_complexOf_llong( complexOf_llong );-complexOf_uchar abs_fun_complexOf_uchar( complexOf_uchar );-complexOf_uint abs_fun_complexOf_uint( complexOf_uint );-complexOf_ulong abs_fun_complexOf_ulong( complexOf_ulong );-complexOf_ullong abs_fun_complexOf_ullong( complexOf_ullong );-complexOf_float abs_fun_complexOf_float( complexOf_float );-unsigned abs_fun_complexOf_short( unsigned );-unsigned abs_fun_complexOf_ushort( unsigned );--complexOf_char signum_fun_complexOf_char( complexOf_char );-complexOf_int signum_fun_complexOf_int( complexOf_int );-complexOf_long signum_fun_complexOf_long( complexOf_long );-complexOf_llong signum_fun_complexOf_llong( complexOf_llong );-complexOf_uchar signum_fun_complexOf_uchar( complexOf_uchar );-complexOf_uint signum_fun_complexOf_uint( complexOf_uint );-complexOf_ulong signum_fun_complexOf_ulong( complexOf_ulong );-complexOf_ullong signum_fun_complexOf_ullong( complexOf_ullong );-complexOf_float signum_fun_complexOf_float( complexOf_float );-unsigned signum_fun_complexOf_short( unsigned );-unsigned signum_fun_complexOf_ushort( unsigned );--complexOf_char add_fun_complexOf_char( complexOf_char, complexOf_char );-complexOf_int add_fun_complexOf_int( complexOf_int, complexOf_int );-complexOf_long add_fun_complexOf_long( complexOf_long, complexOf_long );-complexOf_llong add_fun_complexOf_llong( complexOf_llong, complexOf_llong );-complexOf_uchar add_fun_complexOf_uchar( complexOf_uchar, complexOf_uchar );-complexOf_uint add_fun_complexOf_uint( complexOf_uint, complexOf_uint );-complexOf_ulong add_fun_complexOf_ulong( complexOf_ulong, complexOf_ulong );-complexOf_ullong add_fun_complexOf_ullong( complexOf_ullong, complexOf_ullong );-complexOf_float add_fun_complexOf_float( complexOf_float, complexOf_float );--complexOf_char sub_fun_complexOf_char( complexOf_char, complexOf_char );-complexOf_int sub_fun_complexOf_int( complexOf_int, complexOf_int );-complexOf_long sub_fun_complexOf_long( complexOf_long, complexOf_long );-complexOf_llong sub_fun_complexOf_llong( complexOf_llong, complexOf_llong );-complexOf_uchar sub_fun_complexOf_uchar( complexOf_uchar, complexOf_uchar );-complexOf_uint sub_fun_complexOf_uint( complexOf_uint, complexOf_uint );-complexOf_ulong sub_fun_complexOf_ulong( complexOf_ulong, complexOf_ulong );-complexOf_ullong sub_fun_complexOf_ullong( complexOf_ullong, complexOf_ullong );-complexOf_float sub_fun_complexOf_float( complexOf_float, complexOf_float );--complexOf_char mult_fun_complexOf_char( complexOf_char, complexOf_char );-complexOf_int mult_fun_complexOf_int( complexOf_int, complexOf_int );-complexOf_long mult_fun_complexOf_long( complexOf_long, complexOf_long );-complexOf_llong mult_fun_complexOf_llong( complexOf_llong, complexOf_llong );-complexOf_uchar mult_fun_complexOf_uchar( complexOf_uchar, complexOf_uchar );-complexOf_uint mult_fun_complexOf_uint( complexOf_uint, complexOf_uint );-complexOf_ulong mult_fun_complexOf_ulong( complexOf_ulong, complexOf_ulong );-complexOf_ullong mult_fun_complexOf_ullong( complexOf_ullong, complexOf_ullong );-complexOf_float mult_fun_complexOf_float( complexOf_float, complexOf_float );-unsigned mult_fun_complexOf_short( unsigned, unsigned );-unsigned mult_fun_complexOf_ushort( unsigned, unsigned );--complexOf_float div_fun_complexOf_float( complexOf_float, complexOf_float );--complexOf_float exp_fun_complexOf_float( complexOf_float );--complexOf_float sqrt_fun_complexOf_float( complexOf_float );--complexOf_float log_fun_complexOf_float( complexOf_float );--complexOf_float pow_fun_complexOf_float( complexOf_float, complexOf_float );--complexOf_float logBase_fun_complexOf_float( complexOf_float, complexOf_float );--complexOf_float sin_fun_complexOf_float( complexOf_float );--complexOf_float cos_fun_complexOf_float( complexOf_float );--complexOf_float tan_fun_complexOf_float( complexOf_float );--complexOf_float sinh_fun_complexOf_float( complexOf_float );--complexOf_float cosh_fun_complexOf_float( complexOf_float );--complexOf_float tanh_fun_complexOf_float( complexOf_float );--complexOf_float asin_fun_complexOf_float( complexOf_float );--complexOf_float acos_fun_complexOf_float( complexOf_float );--complexOf_float atan_fun_complexOf_float( complexOf_float );--complexOf_float asinh_fun_complexOf_float( complexOf_float );--complexOf_float acosh_fun_complexOf_float( complexOf_float );--complexOf_float atanh_fun_complexOf_float( complexOf_float );--complexOf_char complex_fun_char( char, char );-complexOf_int complex_fun_int( int, int );-complexOf_long complex_fun_long( long, long );-complexOf_llong complex_fun_llong( long long, long long );-complexOf_uchar complex_fun_uchar( unsigned char, unsigned char );-complexOf_uint complex_fun_uint( unsigned, unsigned );-complexOf_ulong complex_fun_ulong( unsigned long, unsigned long );-complexOf_ullong complex_fun_ullong( unsigned long long, unsigned long long );-complexOf_float complex_fun_float( float, float );--char creal_fun_complexOf_char( complexOf_char );-int creal_fun_complexOf_int( complexOf_int );-long creal_fun_complexOf_long( complexOf_long );-long long creal_fun_complexOf_llong( complexOf_llong );-unsigned char creal_fun_complexOf_uchar( complexOf_uchar );-unsigned creal_fun_complexOf_uint( complexOf_uint );-unsigned long creal_fun_complexOf_ulong( complexOf_ulong );-unsigned long long creal_fun_complexOf_ullong( complexOf_ullong );-float creal_fun_complexOf_float( complexOf_float );-short creal_fun_complexOf_short( unsigned );-unsigned short creal_fun_complexOf_ushort( unsigned );--char cimag_fun_complexOf_char( complexOf_char );-int cimag_fun_complexOf_int( complexOf_int );-long cimag_fun_complexOf_long( complexOf_long );-long long cimag_fun_complexOf_llong( complexOf_llong );-unsigned char cimag_fun_complexOf_uchar( complexOf_uchar );-unsigned cimag_fun_complexOf_uint( complexOf_uint );-unsigned long cimag_fun_complexOf_ulong( complexOf_ulong );-unsigned long long cimag_fun_complexOf_ullong( complexOf_ullong );-float cimag_fun_complexOf_float( complexOf_float );-short cimag_fun_complexOf_short( unsigned );-unsigned short cimag_fun_complexOf_ushort( unsigned );--complexOf_char conj_fun_complexOf_char( complexOf_char );-complexOf_int conj_fun_complexOf_int( complexOf_int );-complexOf_long conj_fun_complexOf_long( complexOf_long );-complexOf_llong conj_fun_complexOf_llong( complexOf_llong );-complexOf_uchar conj_fun_complexOf_uchar( complexOf_uchar );-complexOf_uint conj_fun_complexOf_uint( complexOf_uint );-complexOf_ulong conj_fun_complexOf_ulong( complexOf_ulong );-complexOf_ullong conj_fun_complexOf_ullong( complexOf_ullong );-complexOf_float conj_fun_complexOf_float( complexOf_float );-unsigned conj_fun_complexOf_short( unsigned );-unsigned conj_fun_complexOf_ushort( unsigned );--char magnitude_fun_complexOf_char( complexOf_char );-int magnitude_fun_complexOf_int( complexOf_int );-long magnitude_fun_complexOf_long( complexOf_long );-long long magnitude_fun_complexOf_llong( complexOf_llong );-unsigned char magnitude_fun_complexOf_uchar( complexOf_uchar );-unsigned magnitude_fun_complexOf_uint( complexOf_uint );-unsigned long magnitude_fun_complexOf_ulong( complexOf_ulong );-unsigned long long magnitude_fun_complexOf_ullong( complexOf_ullong );-float magnitude_fun_complexOf_float( complexOf_float );-short magnitude_fun_complexOf_short( unsigned );-unsigned short magnitude_fun_complexOf_ushort( unsigned );--char phase_fun_complexOf_char( complexOf_char );-int phase_fun_complexOf_int( complexOf_int );-long phase_fun_complexOf_long( complexOf_long );-long long phase_fun_complexOf_llong( complexOf_llong );-unsigned char phase_fun_complexOf_uchar( complexOf_uchar );-unsigned phase_fun_complexOf_uint( complexOf_uint );-unsigned long phase_fun_complexOf_ulong( complexOf_ulong );-unsigned long long phase_fun_complexOf_ullong( complexOf_ullong );-float phase_fun_complexOf_float( complexOf_float );-short phase_fun_complexOf_short( unsigned );-unsigned short phase_fun_complexOf_ushort( unsigned );--complexOf_char mkPolar_fun_char( char, char );-complexOf_int mkPolar_fun_int( int, int );-complexOf_long mkPolar_fun_long( long, long );-complexOf_llong mkPolar_fun_llong( long long, long long );-complexOf_uchar mkPolar_fun_uchar( unsigned char, unsigned char );-complexOf_uint mkPolar_fun_uint( unsigned, unsigned );-complexOf_ulong mkPolar_fun_ulong( unsigned long, unsigned long );-complexOf_ullong mkPolar_fun_ullong( unsigned long long, unsigned long long );-complexOf_float mkPolar_fun_float( float, float );-unsigned mkPolar_fun_short( short, short );-unsigned mkPolar_fun_ushort( unsigned short, unsigned short );--complexOf_char cis_fun_char( char );-complexOf_int cis_fun_int( int );-complexOf_long cis_fun_long( long );-complexOf_llong cis_fun_llong( long long );-complexOf_uchar cis_fun_uchar( unsigned char );-complexOf_uint cis_fun_uint( unsigned );-complexOf_ulong cis_fun_ulong( unsigned long );-complexOf_ullong cis_fun_ullong( unsigned long long );-complexOf_float cis_fun_float( float );-unsigned cis_fun_short( short );-unsigned cis_fun_ushort( unsigned short );----void traceStart();-void traceEnd();--void trace_char( char, int );-void trace_short( short, int );-void trace_int( int, int );-void trace_long( long, int );-void trace_llong( long long, int );-void trace_uchar( unsigned char, int );-void trace_ushort( unsigned short, int );-void trace_uint( unsigned, int );-void trace_ulong( unsigned long, int );-void trace_ullong( unsigned long long, int );-void trace_float( float, int );-void trace_complexOf_char( complexOf_char, int );-void trace_complexOf_short( unsigned, int );-void trace_complexOf_int( complexOf_int, int );-void trace_complexOf_long( complexOf_long, int );-void trace_complexOf_llong( complexOf_llong, int );-void trace_complexOf_uchar( complexOf_uchar, int );-void trace_complexOf_ushort( unsigned, int );-void trace_complexOf_uint( complexOf_uint, int );-void trace_complexOf_ulong( complexOf_ulong, int );-void trace_complexOf_ullong( complexOf_ullong, int );-void trace_complexOf_float( complexOf_float, int );--#endif /* FELDSPAR_TI_C64X_H */
− Feldspar/Compiler.hs
@@ -1,44 +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.-----module Feldspar.Compiler- ( defaultOptions- , c99PlatformOptions- , tic64xPlatformOptions- , unrollOptions- , noPrimitiveInstructionHandling- , noMemoryInformation- , module Feldspar.Compiler.Frontend.Interactive.Interface- , module Feldspar.Compiler.Backend.C.Options- , module Feldspar.Compiler.Imperative.Frontend- ) where--import Feldspar.Compiler.Compiler-import Feldspar.Compiler.Frontend.Interactive.Interface-import Feldspar.Compiler.Backend.C.Options -- hiding (Var, Fun)-import Feldspar.Compiler.Imperative.Frontend hiding (Type)
− Feldspar/Compiler/Backend/C/CodeGeneration.hs
@@ -1,157 +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 FlexibleInstances #-}--module Feldspar.Compiler.Backend.C.CodeGeneration where--import Feldspar.Compiler.Imperative.Representation-import Feldspar.Compiler.Error-import Feldspar.Compiler.Backend.C.Options-import Feldspar.Compiler.Backend.C.Library-import Feldspar.Compiler.Backend.C.Plugin.AllocationEliminator--import qualified Data.List as List (last,find)---- =======================--- == C code generation ==--- =======================--codeGenerationError = handleError "CodeGeneration"--defaultMemberName = "member"--data Place =- Declaration_pl- --value of var, need type, type array-style- --declare variables- | MainParameter_pl- --value of var need type, type pointer-style- --main fun parameters- | ValueNeed_pl- --value of var, not need type -- --in Expressions- | AddressNeed_pl- --access of var, not need type -- --output of fun- | FunctionCallIn_pl- --value of var, not need type - SPEC ARRAY FORMAT- --input of fun- deriving (Eq,Show)--class ToC a where- toC :: Options -> Place -> a -> String--getStructTypeName :: Options -> Place -> Type -> String-getStructTypeName options place t@(StructType types) =- "_" ++ concat (map ((++"_") . getStructTypeName options place . snd) types)-getStructTypeName options place t@(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--instance ToC Type where- toC options place VoidType = "void"- toC options place t@(StructType types) = "struct s" ++ getStructTypeName options place t- toC options place (UserType u) = u- -- arraytype handled in variable- 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 ToC (Variable AllocationEliminatorSemanticInfo) where- toC options place a@(Variable name typ role _) = show_variable options place role typ name--show_variable :: Options -> Place -> VariableRole -> Type -> String -> String-show_variable options place role typ name = listprint id " " [variableType, show_name role place typ name] where- variableType = show_type options place typ restr- restr- | place == MainParameter_pl = isRestrict $ platform options- | otherwise = NoRestrict--show_type :: Options -> Place -> Type -> IsRestrict -> String-show_type options Declaration_pl (ArrayType s t) restr = arrayTypeName-show_type options MainParameter_pl (ArrayType s t) restr = arrayTypeName-show_type options Declaration_pl t _ = toC options Declaration_pl t-show_type options MainParameter_pl t _ = toC options MainParameter_pl t-show_type options _ _ _ = ""--arrayTypeName = "struct array"--show_name :: VariableRole -> Place -> Type -> String -> String-show_name Value place t n- | place == AddressNeed_pl = "&" ++ n- | otherwise = n-show_name Pointer MainParameter_pl (ArrayType _ _) n = "* " ++ n-show_name Pointer p (ArrayType _ _) n = n-show_name Pointer place t n- | place == AddressNeed_pl && List.last n == ']' = "&" ++ n- | place == AddressNeed_pl && List.last n /= ']' = n- | place == Declaration_pl = codeGenerationError InternalError $ "Output variable of the function declared!"- | place == MainParameter_pl = "* " ++ n- | List.last n == ']' = n- | otherwise = "(* " ++ n ++ ")"---- show_array_in_fun :: (HasType a, ToC a) => Options -> Place -> a -> String--- show_array_in_fun options place exp = case typeof exp of- -- t@(ArrayType _ _) -> concat["&(", toC options place exp, genIndex t, ")"]- -- _ -> toC options place exp---- genIndex :: Type -> String--- genIndex (ArrayType _ t) = "[0]" ++ genIndex t--- genIndex _ = ""--------------------------- Helper functions ---------------------------ind :: (a-> String) -> a -> String-ind f x = unlines $ map (\a -> " " ++ a) $ lines $ f x--listprint :: (a->String) -> String -> [a] -> String-listprint f s xs = listprint' s $ filter (\a -> a /= "") $ map f xs where- listprint' _ [] = ""- listprint' _ [x] = x- listprint' s (x:xs) = x ++ s ++ listprint' s (xs)--decrArrayDepth :: Type -> Type-decrArrayDepth (ArrayType _ t) = t-decrArrayDepth t = codeGenerationError InternalError $ "Non-array variable of type " ++ show t ++ " is indexed!"--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--structFieldNotFound f = codeGenerationError InternalError $ "Not found struct field with this name: " ++ f
− Feldspar/Compiler/Backend/C/Library.hs
@@ -1,85 +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.-----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--data CompilationMode = Interactive | Standalone- deriving (Show, Eq)--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)- | otherwise = [head s] ++ (replace (tail s) find repl)--fixFunctionName :: String -> String-fixFunctionName functionName = replace (replace functionName "_" "__") "'" "_prime"--makeDebugHFileName :: String -> String-makeDebugHFileName = (<.> "h.dbg.txt")--makeDebugCFileName :: String -> String-makeDebugCFileName = (<.> "c.dbg.txt")--makeHFileName :: String -> String-makeHFileName = (<.> "h")--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]
− Feldspar/Compiler/Backend/C/Options.hs
@@ -1,99 +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 TypeSynonymInstances #-}--module Feldspar.Compiler.Backend.C.Options where--import Data.Typeable--import Feldspar.Compiler.Imperative.Representation-import Feldspar.Compiler.Imperative.Frontend hiding (UserType, Type, Var)-import Feldspar.Compiler.Backend.C.Plugin.AllocationEliminator--data Options =- Options- { platform :: Platform- , unroll :: UnrollStrategy- , debug :: DebugOption- , memoryInfoVisible :: Bool- , rules :: [Rule]- } deriving (Eq, Show)--data UnrollStrategy = NoUnroll | Unroll Int- deriving (Eq, Show)--data DebugOption = NoDebug | NoPrimitiveInstructionHandling- deriving (Eq, Show)--data Platform = Platform {- name :: String,- types :: [(Type, String, String)],- values :: [(Type, ShowValue)],- includes :: [String],- platformRules :: [Rule],- isRestrict :: IsRestrict-} deriving (Eq, Show)--type ShowValue = Constant AllocationEliminatorSemanticInfo -> String--instance Eq ShowValue where- (==) _ _ = True--instance Show ShowValue where- show _ = "<<ShowValue>>"--data IsRestrict = Restrict | NoRestrict- deriving (Show,Eq)---- * Actions and rules--data Action t- = Replace t- | Propagate Rule- | WithId (Int -> [Action t])- | WithOptions (Options -> [Action t])- deriving Typeable--data Rule where- Rule :: (Typeable t) => (t -> [Action t]) -> Rule--instance Show Rule where- show _ = "Transformation rule."- -instance Eq Rule where- _ == _ = False--rule :: (Interface t, Typeable (Repr t)) => (t -> [Action (Repr t)]) -> Rule-rule f = Rule $ \x -> f $ toInterface x--replaceWith :: (Interface t) => t -> Action (Repr t)-replaceWith = Replace . fromInterface--propagate :: (Interface t, Typeable (Repr t)) => (t -> [Action (Repr t)]) -> Action t'-propagate = Propagate . rule
− Feldspar/Compiler/Backend/C/Platforms.hs
@@ -1,268 +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 ViewPatterns #-}--module Feldspar.Compiler.Backend.C.Platforms- ( availablePlatforms- , c99- , tic64x- , c99Rules- , tic64xRules- , traceRules- ) where---import Feldspar.Compiler.Backend.C.Options-import qualified Feldspar.Compiler.Backend.C.Options as Opts-import Feldspar.Compiler.Imperative.Representation hiding (Type, Cast, In, Out, Block)-import Feldspar.Compiler.Imperative.Frontend--availablePlatforms :: [Platform]-availablePlatforms = [ c99, tic64x ]--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")- ] ,- values =- [ (ComplexType FloatType,- (\cx -> "(" ++ showRe cx ++ "+" ++ showIm cx ++ "i)"))- , (BoolType,- (\b -> if boolValue b then "true" else "false"))- ] ,- includes = ["\"feldspar_c99.h\"", "\"feldspar_array.h\"", "<stdint.h>", "<string.h>", "<math.h>", "<stdbool.h>", "<complex.h>"],- platformRules = c99Rules ++ traceRules,- isRestrict = NoRestrict-}--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")- ] ,- values = - [ (ComplexType FloatType,- (\cx -> "complex_fun_float(" ++ 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>"],- platformRules = tic64xRules ++ c99Rules ++ traceRules,- isRestrict = Restrict-}--showRe = showConstant . realPartComplexValue -showIm = showConstant . imagPartComplexValue--showConstant (IntConst c _ _ _) = show c-showConstant (FloatConst c _ _) = show c ++ "f"--c99Rules = [rule copy, rule c99]- where- copy (Call "copy" [Out arg1, In arg2])- | isArray (typeof arg1) = [replaceWith $ Call "copyArray" [Out arg1,In arg2]]- | otherwise = [replaceWith $ arg1 := arg2]- copy _ = []- c99 (Fun t "(!)" [arg1,arg2]) = [replaceWith $ arg1 :!: arg2]- c99 (Fun t "getFst" [arg]) = [replaceWith $ arg :.: first]- c99 (Fun t "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 t "bitSize" [intWidth . typeof -> Just n]) = [replaceWith $ LitI U32 n]- c99 (Fun t "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 _ = []--tic64xRules = [rule tic64x]- 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 name [arg@(typeof -> Complex _)])- | name `elem` ["sin","tan","cos","asin","atan","acos","sinh","tanh","cosh","asinh","atanh","acosh","creal","cimag","conjugate","magnitude","phase"]- = [replaceWith $ Fun t (extend name $ 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 name [arg@(typeof -> Complex _)]) = [replaceWith $ Fun t (extend "creal" $ typeof arg) [arg]]- tic64x _ = []--traceRules = [rule trace]- where- trace (Fun t "trace" [lab, val]) = [WithId acts]- where- acts i = [replaceWith trcVar, propagate decl, propagate trc, propagate frame]- where- trcVar = Var t trcVarName- 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 [init,trcCall,instr]]- trcCall = Call (extend' "trace" t) [In trcVar, In lab]- init = trcVar := val- frame (ProcDf pname ins outs prg) = [replaceWith $ ProcDf pname ins outs prg']- where- prg' = case prg of- Seq (Call "traceStart" [] : _) -> prg- Block _ (Seq (Call "traceStart" [] : _)) -> prg- _ -> Seq [Call "traceStart" [], prg, Call "traceEnd" []]- trace _ = []--extend :: String -> Type -> String-extend s t = s ++ "_fun_" ++ show t--extend' :: String -> Type -> String-extend' s t = s ++ "_" ++ show t--log2 :: Integer -> Maybe Integer-log2 n- | n == 2 Prelude.^ l = Just l- | otherwise = Nothing- where- l = toInteger $ length $ takeWhile (<=n) $ map (2 Prelude.^) [1..]--first = "member1"-second = "member2"
− Feldspar/Compiler/Backend/C/Plugin/AllocationEliminator.hs
@@ -1,207 +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.-----module Feldspar.Compiler.Backend.C.Plugin.AllocationEliminator where--import Data.Map (Map)-import qualified Data.Map as Map-import Feldspar.Transformation-import Feldspar.Compiler.Backend.C.Library--data AllocationEliminator = AllocationEliminator--data AllocationEliminatorSemanticInfo--instance Annotation AllocationEliminatorSemanticInfo Module where- type Label AllocationEliminatorSemanticInfo Module = ()--instance Annotation AllocationEliminatorSemanticInfo Entity where- type Label AllocationEliminatorSemanticInfo Entity = ()--instance Annotation AllocationEliminatorSemanticInfo Struct where- type Label AllocationEliminatorSemanticInfo Struct = ()--instance Annotation AllocationEliminatorSemanticInfo ProcDef where- type Label AllocationEliminatorSemanticInfo ProcDef = AllocationInfo--instance Annotation AllocationEliminatorSemanticInfo ProcDecl where- type Label AllocationEliminatorSemanticInfo ProcDecl = AllocationInfo--instance Annotation AllocationEliminatorSemanticInfo StructMember where- type Label AllocationEliminatorSemanticInfo StructMember = ()--instance Annotation AllocationEliminatorSemanticInfo Block where- type Label AllocationEliminatorSemanticInfo Block = ()--instance Annotation AllocationEliminatorSemanticInfo Program where- type Label AllocationEliminatorSemanticInfo Program = ()--instance Annotation AllocationEliminatorSemanticInfo Empty where- type Label AllocationEliminatorSemanticInfo Empty = ()--instance Annotation AllocationEliminatorSemanticInfo Assign where- type Label AllocationEliminatorSemanticInfo Assign = ()--instance Annotation AllocationEliminatorSemanticInfo ProcedureCall where- type Label AllocationEliminatorSemanticInfo ProcedureCall = ()--instance Annotation AllocationEliminatorSemanticInfo Sequence where- type Label AllocationEliminatorSemanticInfo Sequence = ()--instance Annotation AllocationEliminatorSemanticInfo Branch where- type Label AllocationEliminatorSemanticInfo Branch = ()--instance Annotation AllocationEliminatorSemanticInfo SeqLoop where- type Label AllocationEliminatorSemanticInfo SeqLoop = ()--instance Annotation AllocationEliminatorSemanticInfo ParLoop where- type Label AllocationEliminatorSemanticInfo ParLoop = ()--instance Annotation AllocationEliminatorSemanticInfo ActualParameter where- type Label AllocationEliminatorSemanticInfo ActualParameter = ()--instance Annotation AllocationEliminatorSemanticInfo Declaration where- type Label AllocationEliminatorSemanticInfo Declaration = ()--instance Annotation AllocationEliminatorSemanticInfo Expression where- type Label AllocationEliminatorSemanticInfo Expression = ()--instance Annotation AllocationEliminatorSemanticInfo FunctionCall where- type Label AllocationEliminatorSemanticInfo FunctionCall = ()--instance Annotation AllocationEliminatorSemanticInfo SizeOf where- type Label AllocationEliminatorSemanticInfo SizeOf = ()--instance Annotation AllocationEliminatorSemanticInfo ArrayElem where- type Label AllocationEliminatorSemanticInfo ArrayElem = ()--instance Annotation AllocationEliminatorSemanticInfo StructField where- type Label AllocationEliminatorSemanticInfo StructField = ()--instance Annotation AllocationEliminatorSemanticInfo Constant where- type Label AllocationEliminatorSemanticInfo Constant = ()--instance Annotation AllocationEliminatorSemanticInfo IntConst where- type Label AllocationEliminatorSemanticInfo IntConst = ()--instance Annotation AllocationEliminatorSemanticInfo FloatConst where- type Label AllocationEliminatorSemanticInfo FloatConst = ()--instance Annotation AllocationEliminatorSemanticInfo BoolConst where- type Label AllocationEliminatorSemanticInfo BoolConst = ()--instance Annotation AllocationEliminatorSemanticInfo ArrayConst where- type Label AllocationEliminatorSemanticInfo ArrayConst = ()--instance Annotation AllocationEliminatorSemanticInfo ComplexConst where- type Label AllocationEliminatorSemanticInfo ComplexConst = ()--instance Annotation AllocationEliminatorSemanticInfo Variable where- type Label AllocationEliminatorSemanticInfo Variable = ()--instance Annotation AllocationEliminatorSemanticInfo Cast where- type Label AllocationEliminatorSemanticInfo Cast = ()--instance Annotation AllocationEliminatorSemanticInfo Comment where- type Label AllocationEliminatorSemanticInfo Comment = ()---instance Transformation AllocationEliminator- where- type From AllocationEliminator = ()- type To AllocationEliminator = AllocationEliminatorSemanticInfo- type Down AllocationEliminator = ()- type Up AllocationEliminator = ()- type State AllocationEliminator = (Integer, Map String (Integer, Type))--instance Transformable AllocationEliminator Entity- where- transform t s d proc@(ProcDef _ _ _ _ _ _) = Result proc'- { inParams = mem : ins'- , procDefLabel = (localsOf s', typesOf ins', typesOf outs')- }- (0,Map.empty) u'- where- Result proc' s' u' = defaultTransform t s d proc- mem = Variable- { varName = "mem"- , varType = ArrayType UndefinedLen $ ArrayType UndefinedLen VoidType- , varRole = Pointer- , varLabel = ()- }- ins' = inParams proc'- outs' = outParams proc'- localsOf = map (\(_,(_,t)) -> t) . Map.toList . snd- typesOf = map varType-- transform t s d x = defaultTransform t s d x--instance Transformable AllocationEliminator Expression- where- transform t s@(idx,m) d e@(VarExpr v lab) = case Map.lookup (varName v) m of- Nothing -> defaultTransform t s d e- Just (i,_) -> Result ArrayElem- { array = VarExpr- { var = Variable- { varName = "mem"- , varType = ArrayType UndefinedLen $ varType v- , varRole = Pointer- , varLabel = ()- }- , exprLabel = ()- }- , arrayIndex = ConstExpr- { constExpr = IntConst- { intValue = i- , intType = NumType Signed S32- , intConstLabel = ()- , constLabel = ()- }- , exprLabel = ()- }- , arrayLabel = ()- , exprLabel = ()- } s ()- transform t s d e = defaultTransform t s d e--instance Transformable1 AllocationEliminator [] Declaration- where- transform1 t s d [] = Result1 [] s ()- transform1 t s@(idx,m) d (x:xs) = case varType $ declVar x of- ArrayType _ _ -> transform1 t (idx + 1, Map.insert (varName $ declVar x) (idx, varType $ declVar x) m) d xs- _ -> Result1 (x':xs') s'' ()- where- Result1 xs' s'' () = transform1 t s' d xs- Result x' s' () = transform t s d x--instance Plugin AllocationEliminator- where- type ExternalInfo AllocationEliminator = ()- executePlugin self@AllocationEliminator externalInfo procedure = - result $ transform self (0,Map.empty) () procedure-
− Feldspar/Compiler/Backend/C/Plugin/BlockProgramHandler.hs
@@ -1,80 +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 EmptyDataDecls, TypeFamilies #-}--module Feldspar.Compiler.Backend.C.Plugin.BlockProgramHandler 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--- ===========================================================================--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 externalInfo procedure = - result $ transform BlockProgramHandler ({-state-}) () procedure
− Feldspar/Compiler/Backend/C/Plugin/Locator.hs
@@ -1,242 +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 #-}--module Feldspar.Compiler.Backend.C.Plugin.Locator where--import Feldspar.Transformation-import Feldspar.Compiler.Backend.C.CodeGeneration-import Feldspar.Compiler.Backend.C.Plugin.PrettyPrint-import Feldspar.Compiler.Backend.C.Platforms-import Feldspar.Compiler.Backend.C.Options-import Feldspar.Compiler.Error----- ===========================================================================--- == 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 inf2) = Result pl () info where - info = case contains (line, col) inf1 of- True -> infoCr where- res = transform t () (line, col) prog- infoCr = case (fst $ up res) of- True -> up res- _ -> (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 t () (line, col) assign@(Assign _ _ inf1 inf2) = Result assign () info where - info = case contains (line, col) inf1 of- True -> (True, assign) - _ -> 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 inf2) = 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 = case (fst res) of- True -> res- _ -> (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 t () (line, col) pc@(ProcedureCall _ _ inf1 inf2) = Result pc () info where - info = case contains (line, col) inf1 of- True -> (True, pc)- _ -> 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 inf2) = Result sl () info where - info = case contains (line, col) inf1 of- True -> infoCr where- res = transform t () (line, col) prog- infoCr = case (fst $ up res) of- True -> up res- _ -> (True, sl) - _ -> def- transform t () (line, col) pr = defaultTransform t () (line, col) pr ----------------------------------------------------------- Helper functions-------------------------------------------------- - -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 lhs rhs inf1 inf2) = "Assign \n" ++ ind show lhs ++ "\n=\n" ++ ind show rhs ++ "\n" ++ show inf1 ++ "\n" -myShow (Sequence progs inf1 inf2) = "Sequence\n" ++ ind (listprint myShow "\n") progs ++ "\n" ++ show inf1 ++ "\n"-myShow (Branch cond thenBlock elseBlock inf1 inf2) = "Branch\n" ++ ind myShowB thenBlock ++ "\nelse\n" ++ ind myShowB elseBlock ++ "\n" ++ show inf1 ++ "\n"-myShow (ParLoop count bound step block inf1 inf2) - = "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 locals prg inf) = "Block\n" ++ ind show locals ++"\n" ++ ind myShow prg ++ show inf-
− Feldspar/Compiler/Backend/C/Plugin/PrettyPrint.hs
@@ -1,722 +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 #-}--module Feldspar.Compiler.Backend.C.Plugin.PrettyPrint where--import Feldspar.Transformation-import Feldspar.Compiler.Backend.C.CodeGeneration-import Feldspar.Compiler.Backend.C.Plugin.AllocationEliminator-import Feldspar.Compiler.Backend.C.Platforms-import Feldspar.Compiler.Backend.C.Options-import Feldspar.Compiler.Backend.C.Library-import Feldspar.Compiler.Error--import qualified Data.List as List (last,find, intersperse)-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 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 = AllocationEliminatorSemanticInfo- 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 AllocationEliminatorSemanticInfo -> (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 AllocationEliminatorSemanticInfo -> (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 t (line, col) (options, ValueNeed_pl, indent) x@(Variable name typ@(ArrayType _ _) role inf) = Result (Variable name typ role newInf) (snd newInf) cRep- where- ((newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- code $ toC options AddressNeed_pl x- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return newInf- transform t (line, col) (options, place, indent) x@(Variable name typ role inf) = Result (Variable name typ role newInf) (snd newInf) cRep- where- ((newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- code $ toC options place x- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return newInf--instance Transformable1 DebugToC [] Constant where- transform1 t pos@(line, col) down@(options, place, indent) l = transform1' t pos down l ", " 0--instance Transformable DebugToC Constant where- transform t pos@(line, col) down@(options, place, indent) const@(IntConst c _ inf1 inf2) = transformConst t pos down const (show c)-- transform t pos@(line, col) down@(options, place, indent) const@(FloatConst c inf1 inf2) = transformConst t pos down const (show c ++ "f")-- transform t pos@(line, col) down@(options, place, indent) const@(BoolConst False inf1 inf2) = transformConst t pos down const "0"-- transform t pos@(line, col) down@(options, place, indent) const@(BoolConst True inf1 inf2) = transformConst t pos down const "1"-- transform t (line, col) (options, place, indent) const@(ComplexConst real im inf1 inf2) - = case (List.find (\(t',_) -> t' == typeof const) $ values $ platform options) of- Just (_,f) -> - Result (ComplexConst (result newReal) (result newIm) newInf newInf) (snd newInf) cRep - where- ((newReal, newIm, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- newReal <- complexTransform t (options, place, indent) real- newIm <- complexTransform t (options, place, indent) im- code $ f const- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newReal, newIm, newInf)- Nothing -> - Result (ComplexConst (result newReal) (result newIm) newInf newInf) (snd newInf) cRep - where- ((newReal, newIm, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- code "complex("- newReal <- monadicTransform' t (options, place, indent) real- code ","- newIm <- monadicTransform' t (options, place, indent) im- code ")"- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newReal, newIm, newInf)--instance Transformable DebugToC ActualParameter where- transform t pos@(line, col) down@(options, place, indent) act@(In param@(VarExpr (Variable _ (StructType _) _ _) _) inf) =- transformActParam t pos down act AddressNeed_pl- transform t pos@(line, col) down@(options, place, indent) act@(In param@(VarExpr (Variable _ (ArrayType _ _) _ _) _) inf) =- transformActParam t pos down act AddressNeed_pl- transform t pos@(line, col) down@(options, place, indent) act@(In _ _) = transformActParam t pos down act FunctionCallIn_pl- transform t pos@(line, col) down@(options, place, indent) act@(Out _ _) = transformActParam t pos down act AddressNeed_pl--instance Transformable1 DebugToC [] Expression where- transform1 t pos@(line, col) down@(options, place, indent) l = transform1' t pos down l ", " 0--instance Transformable DebugToC Expression where- transform t (line, col) (options, place, indent) (VarExpr val inf) = Result (VarExpr (result newVal) newInf) (snd newInf) cRep- where- ((newVal, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- newVal <- monadicTransform' t (options, place, indent) val- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newVal, newInf)-- transform t (line, col) (options, place, indent) e@(ArrayElem name index inf1 inf2) = Result (ArrayElem (result newName) (result newIndex) newInf newInf) (snd newInf) cRep - where- ((newName, newIndex, newInf), (cRep, newLine, newCol)) = 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(" ++ show_type options MainParameter_pl (typeof e) NoRestrict ++ ","- newName <- monadicTransform' t (options, AddressNeed_pl, indent) name- code ","- newIndex <- monadicTransform' t (options, ValueNeed_pl, indent) index- code ")"- (_, newLine, newCol) <- StateMonad.get- let newInf = ((line, col), (newLine, newCol))- return (newName, newIndex, newInf)-- transform t pos@(line, col) down@(options, place, indent) expr@(StructField str field inf1 inf2) = transformExpr t pos down expr ("." ++ field) field ValueNeed_pl-- transform t (line, col) (options, place, indent) (ConstExpr val inf) = Result (ConstExpr (result newVal) newInf) (snd newInf) cRep- where- ((newVal, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- newVal <- monadicTransform' t (options, place, indent) val- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newVal, newInf)-- transform t pos@(line, col) down@(options, place, indent)- fc@(FunctionCall f [a,b] inf1 inf2) | funName f == "!" =- transformFuncCall t pos down fc "at(" "," ")"-- transform t pos@(line, col) down@(options, place, indent)- fc@(FunctionCall f [a,b] inf1 inf2) | funMode f == Infix =- transformFuncCall t pos down fc "(" (" " ++ funName f ++ " ") ")"-- transform t (line, col) (options, place, indent)- (FunctionCall f paramlist inf1 inf2) =- Result (FunctionCall f (result1 newParamlist) newInf newInf) (snd newInf) cRep - where- ((newParamlist, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- code $ funName f ++ "("- newParamlist <- monadicListTransform' t (options, place, indent) paramlist- code ")"- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newParamlist, newInf)-- transform t (line, col) (options, place, indent) (Cast typ exp inf1 inf2) = Result (Cast typ (result newExp) newInf newInf) (snd newInf) cRep - where- ((newExp, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- code $ concat ["(", toC options place typ, ")("]- newExp <- monadicTransform' t (options, place, indent) exp- code ")"- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newExp, newInf)-- transform t (line, col) (options, place, indent) (SizeOf (Left typ) inf1 inf2) = Result (SizeOf (Left typ) newInf newInf) (snd newInf) cRep - where- ((newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- code ("sizeof(" ++ toC options place typ ++ ")")- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return newInf-- transform t (line, col) (options, place, indent) (SizeOf (Right exp) inf1 inf2) = 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"- newExp <- monadicTransform' t (options, place, indent) exp- code ")"- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newExp, newInf)--instance Transformable1 DebugToC [] Entity where- transform1 t pos@(line, col) down@(options, place, indent) l = transform1' t pos down l "" 0--instance Transformable DebugToC Module where- transform t (line, col) (options, place, indent) (Module defList inf) = Result (Module (result1 newDefList) newInf) (snd newInf) cRep - where- ((newDefList, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- newDefList <- monadicListTransform' t (options, place, indent) defList- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newDefList, newInf)--instance Transformable1 DebugToC [] Variable where- transform1 t pos@(line, col) down@(options, place, indent) l = transform1' t pos down l ", " 0--instance Transformable1 DebugToC [] StructMember where- transform1 t (line, col) (options, place, indent) [] = Result1 [] (line, col) ""- transform1 t (line, col) (options, place, indent) (x:xs) = Result1 ((result newX):(result1 newXs)) (state1 newXs) (cRep) where- ((newX, newXs), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- indenter indent- newX <- monadicTransform' t (options, place, indent) x- newXs <- monadicListTransform' t (options, place, indent) xs- return (newX, newXs)---instance Transformable DebugToC Entity where- transform t (line, col) (options, place, indent) (StructDef name members inf1 inf2) = Result (StructDef name (result1 newMembers) newInf newInf) (snd newInf) cRep- where- ((newMembers, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- code $ name ++ " {\n"- (crep, cl, cc) <- StateMonad.get- StateMonad.put (crep, cl, cc + (addIndent indent))- newMembers <- monadicListTransform' t (options, place, addIndent indent) members- indenter indent- code "};\n"- (crep, cl, _) <- StateMonad.get- StateMonad.put (crep, cl, indent)- let newInf = ((line, col), (cl, indent))- return (newMembers, newInf)--- transform t (line, col) (options, place, indent) (ProcDef name inParam outParam body inf1 inf2) =- Result (ProcDef name (result1 newInParam) (result1 newOutParam) (result newBody) newInf newInf) (snd newInf) cRep- where- ((newInParam, newOutParam, newBody, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- code $ memoryInformation options indent inf1- indenter indent- -- code "#include <stdio.h>\n"- code $ "void " ++ name ++ "("- newInParam <- monadicListTransform' t (options, MainParameter_pl, indent) inParam- let str = case up1 newInParam of- "" -> ""- otherwise -> ", "- code str- newOutParam <- monadicListTransform' t (options, MainParameter_pl, indent) outParam- code $ ")\n"- indenter indent- -- code "{\nprintf(\"enter\\n\");\n"- -- code "printf(\"out:%p buffer:%p len:%d esize:%d\\n\", out, out->buffer, out->length, out->elemSize);\n"- code "{\n"- (crep, al, _) <- StateMonad.get- StateMonad.put (crep, al, addIndent indent)- newBody <- monadicTransform' t (options, Declaration_pl, addIndent indent) body- indenter indent- code "}\n"- -- code "printf(\"leave\\n\");\n}\n"- (_, nl, _) <- StateMonad.get- let newInf = ((line, col), (nl, indent))- return (newInParam, newOutParam, newBody, newInf)-- transform t (line, col) (options, place, indent) (ProcDecl name inParam outParam inf1 inf2) =- Result (ProcDecl name (result1 newInParam) (result1 newOutParam) newInf newInf) (snd newInf) cRep- where- ((newInParam, newOutParam, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- code $ memoryInformation options indent inf1- indenter indent- code $ "void " ++ name ++ "("- newInParam <- monadicListTransform' t (options, MainParameter_pl, indent) inParam- let str = case up1 newInParam of- "" -> ""- otherwise -> ", "- code str- newOutParam <- monadicListTransform' t (options, MainParameter_pl, indent) outParam- code $ ");\n"- (_, nl, _) <- StateMonad.get- let newInf = ((line, col), (nl, indent))- return (newInParam, newOutParam, newInf)--memoryInformation :: Options -> Int -> AllocationInfo -> String-memoryInformation options indent inf1- | (memoryInfoVisible options) = displayComment indent $ ["Memory information", "" ] ++- (zipWith displayMemInfo ["Local", "Input", "Output"] [localMI, inputMI, outputMI]) ++ [ "" ]- | otherwise = ""- where (localMI, inputMI, outputMI) = inf1--displayComment :: Int -> [String] -> String-displayComment indent = unlines . map (putIndent indent ++) . (["/*"] ++) . (++ [" */"]) . map (" * " ++)--displayMemInfo :: String -> [Type] -> String-displayMemInfo name [] = name ++ ": none"-displayMemInfo name info = name ++ ": " ++ (concat $ List.intersperse ", " $ map displayType info)--displayType :: Type -> String-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 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 fields) = "struct"--instance Transformable DebugToC StructMember where- transform t (line, col) (options, place, indent) dsm@(StructMember str typ inf) = Result (StructMember str typ newInf) (snd newInf) cRep - where- ((newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- let t = case structMemberType dsm of- ArrayType len innerType -> show_variable options place Value (structMemberType dsm)- (structMemberName dsm) ++ ";"- otherwise -> (toC options place $ structMemberType dsm) ++ " " ++ structMemberName dsm ++ ";"- code t- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return newInf--instance Transformable1 DebugToC [] Declaration where- transform1 t (line, col) (options, place, indent) [] = 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, col2) = 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 inf) = Result (Block (result1 newLocs) (result newBody) newInf) (snd newInf) cRep- where- ((newLocs, newBody, newInf), (cRep, newLine, newcol)) = flip StateMonad.runState (defaultState line col) $ do- newLocs <- monadicListTransform' t (options, Declaration_pl, indent) locs- let str = case up1 newLocs of - "" -> ""- otherwise -> "\n"- code str- newBody <- monadicTransform' t (options, place, indent) body- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, indent))- return (newLocs, newBody, newInf)--instance Transformable DebugToC Declaration where- transform t (line, col) (options, place, indent) (Declaration declVar Nothing inf) = Result (Declaration (result newDeclVar) Nothing newInf) (snd newInf) cRep- where- ((newDeclVar, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- newDeclVar <- monadicTransform' t (options, Declaration_pl, indent) declVar- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newDeclVar, newInf)-- transform t (line, col) (options, place, indent) (Declaration declVar (Just expr) inf) = Result (Declaration (result newDeclVar) (Just (result newExpr)) newInf) (snd newInf) cRep - where- ((newDeclVar, newExpr, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- newDeclVar <- monadicTransform' t (options, Declaration_pl, indent) declVar- code " = "- newExpr <- monadicTransform' t (options, ValueNeed_pl, indent) expr- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newDeclVar, newExpr, newInf)--instance Transformable1 DebugToC [] ActualParameter where- transform1 t pos@(line, col) down@(options, place, indent) l = transform1' t pos down l ", " 0--instance Transformable1 DebugToC [] Program where- transform1 t pos@(line, col) down@(options, place, indent) l = transform1' t pos down l "" 0---instance Transformable DebugToC Program where- transform t (line, col) (options, place, indent) (Empty inf1 inf2) = Result (Empty newInf newInf) newSt cRep where - newSt = (line, col)- newInf = ((line, col), newSt)- cRep = ""-- transform t (line, col) (options, place, indent) (Comment True comment inf1 inf2) = Result (Comment True comment newInf newInf) (snd newInf) cRep - where- ((newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- indenter indent- code $ "/* " ++ comment ++ " */\n"- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newInf)-- transform t (line, col) (options, place, indent) (Comment False comment inf1 inf2) = Result (Comment False comment newInf newInf) (snd newInf) cRep - where - ((newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- indenter indent- code $ "// " ++ comment ++ "\n"- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newInf)-- transform t (line, col) (options, place, indent) (Assign lhs rhs inf1 inf2) = Result (Assign (result newLhs) (result newRhs) newInf newInf) (snd newInf) cRep- where- ((newLhs, newRhs, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- indenter indent- newLhs <- monadicTransform' t (options, ValueNeed_pl, indent) lhs- code " = "- newRhs <- monadicTransform' t (options, ValueNeed_pl, indent) rhs- code ";\n"- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, indent))- return (newLhs, newRhs, newInf)-- transform t (line, col) (options, place, indent) (ProcedureCall name param inf1 inf2) = Result (ProcedureCall name (result1 newParam) newInf newInf) (snd newInf) cRep - where- ((newParam, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- indenter indent- code $ name ++ "("- newParam <- monadicListTransform' t (options, place, indent) param- code ");\n"- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, indent))- return (newParam, newInf)-- transform t (line, col) (options, place, indent) (Sequence prog inf1 inf2) = Result (Sequence (result1 newProg) newInf newInf) (snd newInf) cRep - where- ((newProg, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- newProg <- monadicListTransform' t (options, place, indent) prog- let newInf = ((line, col), state1 newProg)- return (newProg, newInf)-- transform t (line, col) (options, place, indent) (Branch con tPrg ePrg inf1 inf2) = Result (Branch (result newCon) (result newTPrg) (result newEPrg) newInf newInf) (snd newInf) cRep - where - ((newCon, newTPrg, newEPrg, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- indenter indent- code "if("- newCon <- monadicTransform' t (options, ValueNeed_pl, indent) con- code ")\n" - indenter indent- code "{\n"- newTPrg <- monadicTransform' t (options, place, addIndent indent) tPrg- indenter indent- code "}\n" - indenter indent - code "else\n" - indenter indent - code "{\n"- newEPrg <- monadicTransform' t (options, place, addIndent indent) ePrg- indenter indent - code "}\n"- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newCon, newTPrg, newEPrg, newInf)-- transform t (line, col) (options, place, indent) (SeqLoop con conPrg blockPrg inf1 inf2) = Result (SeqLoop (result newCon) (result newConPrg) (result newBlockPrg) newInf newInf) (snd newInf) cRep - where- ((newCon, newConPrg, newBlockPrg, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- indenter indent- code "{\n"- newConPrg <- monadicTransform' t (options, place, addIndent indent) conPrg- indenter $ addIndent indent- code "while("- newCon <- monadicTransform' t (options, ValueNeed_pl, addIndent indent) con- code $ ")\n" - indenter $ addIndent indent- code "{\n"- newBlockPrg <- 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- let newInf = ((line, col), (nl, nc))- return (newCon, newConPrg, newBlockPrg, newInf)-- transform t (line, col) (options, place, indent) (ParLoop count bound step prog inf1 inf2) = Result (ParLoop (result newCount) (result newBound) step (result newProg) newInf newInf) (snd newInf) cRep - where- ((newCount, newBound, newProg, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- indenter indent- code "for("- newCount <- monadicTransform' t (options, Declaration_pl, addIndent indent) count- code $ " = 0; "- loopVariable <- monadicTransform' t (options, ValueNeed_pl, addIndent indent) count- code $ " < "- newBound <- monadicTransform' t (options, ValueNeed_pl, addIndent indent) bound- code $ "; " ++ up loopVariable ++ " += " ++ show step ++ ")\n" - indenter indent- code "{\n"- -- code "printf(\"before\\n\");\n"- newProg <- monadicTransform' t (options, place, addIndent indent) prog- -- code "printf(\"after\\n\");\n"- indenter indent- code "}\n" - (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (loopVariable, newBound, newProg, newInf)-- transform t (line, col) (options, place, indent) (BlockProgram prog inf) = Result (BlockProgram (result newProg) newInf) (snd newInf) cRep - where- ((newProg, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- indenter indent - code "{\n"- newProg <- monadicTransform' t (options, place, addIndent indent) prog- indenter indent - code "}\n"- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (newLine, newCol))- return (newProg, newInf)--putIndent ind = concat $ replicate ind " "--addIndent :: Int -> Int-addIndent indent = indent + 4--transform1' t (line, col) (options, place, indent) [] str num = Result1 [] (line, col) ""-transform1' t (line, col) (options, place, indent) (x:[]) str num = 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 t (line, col) (options, place, indent) const str = Result (newConst const) (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, newLine, newCol) = snd $ flip StateMonad.runState (defaultState line col) $ do- let s = case (List.find (\(t',_) -> t' == typeof const) $ values $ platform options) of- Just (_,f) -> f const- Nothing -> str- code s--transformActParam t (line, col) (options, place, indent) act paramType = Result (newActParam act) (snd newInf) cRep - where- newActParam (Out _ _) = (Out (result newParam) newInf)- newActParam _ = (In (result newParam) newInf)- getParam (In param _) = param- getParam (Out param _) = param- ((newParam, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- newParam <- monadicTransform' t (options, paramType, indent) (getParam act)- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newParam, newInf)--transformFuncCall t (line, col) (options, place, indent)- (FunctionCall f [a, b] inf1 inf2) str1 str2 str3 =- Result (FunctionCall f [result newA, result newB] newInf newInf) (snd newInf) cRep- where- ((newA, newB, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- code str1- newA <- monadicTransform' t (options, place, indent) a- code str2- newB <- monadicTransform' t (options, place, indent) b- code str3- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newA, newB, newInf)--transformExpr t (line, col) (options, place, indent) expr str field paramType = Result (newExpr expr) (snd newInf) cRep - where- newExpr (StructField e s _ _ ) = (StructField (result newTarget) s newInf newInf)- getExpr (StructField e _ _ _ ) = e- ((newTarget, newInf), (cRep, newLine, newCol)) = flip StateMonad.runState (defaultState line col) $ do- newTarget <- monadicTransform' t (options, paramType, indent) (getExpr expr)- code str- (_, nl, nc) <- StateMonad.get- let newInf = ((line, col), (nl, nc))- return (newTarget, newInf)---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@(options, place, indent) d = do- (cRep, line, col) <- StateMonad.get- let res = transform t (line, col) down d- code $ up res- return res--complexTransform t down@(options, place, indent) d = do- (cRep, line, col) <- StateMonad.get- let res = transform t (line, col) down d- return res--monadicListTransform' t down@(options, place, indent) 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)
− Feldspar/Compiler/Backend/C/Plugin/Rule.hs
@@ -1,89 +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 UndecidableInstances #-}--module Feldspar.Compiler.Backend.C.Plugin.Rule- ( RulePlugin(..)- ) where--import Data.Maybe-import Data.Typeable--import Feldspar.Compiler.Imperative.Representation-import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Transformation-import Feldspar.Compiler.Backend.C.Options-import Feldspar.Compiler.Error--userError = handleError "Feldspar.Compiler.Backend.C.Plugin.Rule" InternalError--data RulePlugin = RulePlugin--instance Transformation RulePlugin- where- type From RulePlugin = ()- type To RulePlugin = ()- type Down RulePlugin = Options- type Up RulePlugin = [Rule]- type State RulePlugin = Int--instance Plugin RulePlugin- where- type ExternalInfo RulePlugin = Options- executePlugin _ externalInfo = result . transform RulePlugin (0{-initial ID-}) externalInfo--instance (DefaultTransformable RulePlugin t, Typeable1 t) => 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- applyRule :: t () -> Int -> [Rule] -> (t (), [Rule], [Rule], Int)- applyRule c s rs = foldl applyRuleFun (c,[],[],s) rs- where- applyRuleFun :: (t (), [Rule], [Rule], Int) -> Rule -> (t (), [Rule], [Rule], Int) - applyRuleFun (cc,incomp,prop,currentID) (Rule r) = case cast r of- Just r' -> (cc',incomp,prop ++ prop', newID)- where- (cc',prop', newID) = applyAction cc currentID (r' cc)- applyAction :: t () -> Int -> [Action (t ())] -> (t (), [Rule], Int)- applyAction ccc currentID actions = foldl applyActionFun (ccc,[],currentID) actions- where- applyActionFun :: (t (), [Rule], Int) -> Action (t ()) -> (t (), [Rule], Int)- applyActionFun (_, prop'', currentID) (Replace newConstr) = (newConstr, prop'', currentID)- applyActionFun (ccc', prop'', currentID) (Propagate pr) = (ccc', prop'' ++ [pr], currentID)- applyActionFun (constr, ruleList, currentID) (WithId f) - = applyAction constr (currentID + 1) (f currentID)- applyActionFun (constr, ruleList, currentID) (WithOptions f)- = applyAction constr currentID (f d)- Nothing -> (cc,incomp ++ [Rule r],prop, currentID)- (x',_,pr1,newID1) = applyRule (result recurse) (state recurse) (rules d)- (x'',pr3,pr2,newID2) = applyRule x' newID1 (up recurse)---instance Combine [Rule] where- combine = (++)
− Feldspar/Compiler/Backend/C/Plugin/TypeCorrector.hs
@@ -1,196 +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 EmptyDataDecls, TypeFamilies #-}--module Feldspar.Compiler.Backend.C.Plugin.TypeCorrector where--import Data.List-import qualified Data.Map as Map-import Feldspar.Transformation-import Feldspar.Compiler.Backend.C.CodeGeneration-import Feldspar.Compiler.Backend.C.Options-import Feldspar.Compiler.Error---- ===========================================================================--- == Type corrector plugin--- ===========================================================================--- TODO: IS THIS STILL NEEDED? --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 d p = defaultTransform t s False p--instance Transformable GlobalCollector Variable where- transform t s d v@(Variable name typ role ()) = Result v s' () where- s'- | d = Map.insert name typ s- | otherwise = s--data TypeCheckDown = TypeCheckDown- { globals :: TypeCatalog- , inDeclaration :: Bool- }--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 s 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 t s d 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 t s d v@(Variable name typ role ()) - | 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 (\global local -> local) (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 s d p@(ProcDef n i o _ _ _) = defaultTransform t (state tr) d p where- tr = defaultTransform t def d p -- start with an empty local variable type catalog- transform t s d p = Result p s def -- just definitions, not implementation, not need check/correct--instance Transformable TypeCorrector Variable where- transform t locals globals v@(Variable name typ role ()) = Result v' (Map.insert name typ' locals) 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 (\global local -> local) globals locals--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 globals x where- globals = {- Map.insert defaultArraySizeConstantName (NumType Unsigned S32) $ -} state $ transform GlobalCollector def False procedure- x - | showErr = result $ transform TypeCheck def (TypeCheckDown globals False) procedure- | otherwise = procedure
− Feldspar/Compiler/Backend/C/Plugin/TypeDefinitionGenerator.hs
@@ -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 EmptyDataDecls, TypeFamilies #-}--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--import Debug.Trace---- ===========================================================================--- == Type definition generator plugin--- ===========================================================================--typeDefGenError = handleError "PluginArch/TypeDefinitionGenerator"--data TypeDefinitionGenerator = TypeDefinitionGenerator--getTypes :: Options -> Type -> [Entity ()]-getTypes options typ = {-trace ("DEBUG: "show typ) $-} case typ of- StructType members -> concatMap (getTypes options . snd) members- ++ [StructDef {- structName = toC options Declaration_pl (StructType members),- structMembers = map (\(name,typ) -> StructMember name typ ()) members,- structLabel = (),- definitionLabel = ()- }]- ArrayType len 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
− Feldspar/Compiler/Backend/C/Plugin/VariableRoleAssigner.hs
@@ -1,74 +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.-----module Feldspar.Compiler.Backend.C.Plugin.VariableRoleAssigner where--import Data.List-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 t s d v = Result v' () () where- v' = v { varRole = if (varName v `elem` outParametersVRA d) ||- (isComposite v && (varName v `elem` "mem" : inParametersVRA d))- then Pointer else Value- , varLabel = ()- }--instance Transformable VariableRoleAssigner Entity where- transform t s d p@(ProcDef n i o pr inf1 inf2) = 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 externalInfo procedure = - result $ transform self ({-state-}) (Parameters [] []) procedure--isComposite :: Variable () -> Bool-isComposite v = case varType v of- (ArrayType _ _) -> True- (StructType _) -> True- otherwise -> False-
− Feldspar/Compiler/Compiler.hs
@@ -1,259 +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.-----module Feldspar.Compiler.Compiler where--import System.IO-import System.FilePath-import Data.Typeable as DT-import Control.Arrow-import Control.Applicative--import Feldspar.Core.Types-import Feldspar.Transformation-import qualified Feldspar.NameExtractor as NameExtractor-import Feldspar.Compiler.Backend.C.Options-import Feldspar.Compiler.Backend.C.Platforms-import Feldspar.Compiler.Backend.C.Library-import Feldspar.Compiler.Imperative.Plugin.Naming-import Feldspar.Compiler.Backend.C.Plugin.Rule-import Feldspar.Compiler.Imperative.Plugin.Unroll-import Feldspar.Compiler.Backend.C.Plugin.TypeDefinitionGenerator-import Feldspar.Compiler.Backend.C.Plugin.VariableRoleAssigner-import Feldspar.Compiler.Imperative.Plugin.ConstantFolding-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.Plugin.Locator-import Feldspar.Compiler.Backend.C.Plugin.AllocationEliminator-import Feldspar.Compiler.Backend.C.CodeGeneration-import Feldspar.Compiler.Imperative.FromCore--data SomeCompilable = forall a internal . Compilable a internal => SomeCompilable a- deriving (DT.Typeable)---- ================================================================================================--- == Compiler core--- ================================================================================================--type Position = (Int, Int)--data SplitModuleDescriptor = SplitModuleDescriptor {- smdSource :: Module AllocationEliminatorSemanticInfo,- smdHeader :: Module AllocationEliminatorSemanticInfo-}--data CompToCCoreResult = CompToCCoreResult {- sourceCode :: String,- endPosition :: Position,- debugModule :: Module DebugToCSemanticInfo,- allocationInfo :: AllocationInfo-}--data SplitCompToCCoreResult = SplitCompToCCoreResult {- sctccrSource :: CompToCCoreResult,- sctccrHeader :: CompToCCoreResult-}--data IncludesNeeded = IncludesNeeded | NoIncludesNeeded { incneedLineNum :: Int }--moduleSplitter :: Module AllocationEliminatorSemanticInfo -> SplitModuleDescriptor-moduleSplitter m = SplitModuleDescriptor {- smdHeader = Module ((filter belongsToHeader $ entities m) ++ (createProcDecls $ entities m)) (moduleLabel m),- smdSource = Module (filter (not . belongsToHeader) $ entities m) (moduleLabel m)-} where- belongsToHeader :: Entity AllocationEliminatorSemanticInfo -> Bool- belongsToHeader (StructDef _ _ _ _) = True- belongsToHeader (ProcDecl _ _ _ _ _) = True- belongsToHeader _ = False- createProcDecls :: [Entity AllocationEliminatorSemanticInfo] -> [Entity AllocationEliminatorSemanticInfo]- createProcDecls [] = []- createProcDecls (e:es) = convertProcDefToProcDecl e ++ createProcDecls es- convertProcDefToProcDecl :: Entity AllocationEliminatorSemanticInfo -> [Entity AllocationEliminatorSemanticInfo]- convertProcDefToProcDecl e = case e of- ProcDef name inparams outparams body label1 label2 -> [ProcDecl name inparams outparams label1 label2]- anythingelse -> []--mergeAllocationInfos :: [AllocationInfo] -> AllocationInfo-mergeAllocationInfos = foldr plus ([],[],[])--(x1,y1,z1) `plus` (x2,y2,z2) = (x1 ++ x2, y1 ++ y2, z1 ++ z2)--separateAndCompileToCCore :: (Compilable t internal)- => (Module AllocationEliminatorSemanticInfo- -> [Module AllocationEliminatorSemanticInfo])- -> CompilationMode -> t -> IncludesNeeded- -> NameExtractor.OriginalFunctionSignature -> Options- -> [(CompToCCoreResult, Module AllocationEliminatorSemanticInfo)]-separateAndCompileToCCore- moduleSeparator- compilationMode prg needed- functionSignature coreOptions =- pack <$> separatedModules- where- pack = compToCWithInfo &&& id-- separatedModules =- moduleSeparator $- executePluginChain' compilationMode prg functionSignature coreOptions-- compToCWithInfo = moduleToCCore needed coreOptions--moduleToCCore- :: IncludesNeeded -> Options -> Module AllocationEliminatorSemanticInfo- -> CompToCCoreResult-moduleToCCore needed opts mdl =- CompToCCoreResult {- sourceCode = includes ++ moduleSrc- , endPosition = endPos- , debugModule = dbgModule- , allocationInfo = extractAllocations mdl- }- where- (includes, lineNum) = genInclude needed-- (dbgModule, (moduleSrc, endPos)) =- compToCWithInfos ((opts,Declaration_pl), lineNum) mdl-- genInclude IncludesNeeded = genIncludeLines opts Nothing- genInclude (NoIncludesNeeded ln) = ("", ln)-- extractAllocations =- entities >>>- filter isProcedure >>>- (procDefLabel <$>) >>>- mergeAllocationInfos- where- isProcedure (ProcDef _ _ _ _ _ _) = True- isProcedure _ = False---- ===========================================================--- ___ ... --- === ::: [ 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 compilationMode prg outputFileName includesNeeded- originalFunctionSignature coreOptions =- createSplit $ fst <$> separateAndCompileToCCore headerAndSource- compilationMode prg includesNeeded originalFunctionSignature coreOptions- where- headerAndSource modules = [header, source]- where (SplitModuleDescriptor header source) = moduleSplitter modules-- createSplit [header, source] = SplitCompToCCoreResult header source--genIncludeLinesCore :: [String] -> (String, Int)-genIncludeLinesCore [] = ("", 1)-genIncludeLinesCore (x:xs) = ("#include " ++ x ++ "\n" ++ str, linenum + 1) where- (str, linenum) = genIncludeLinesCore xs--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\""]----------------------------- Predefined options -----------------------------defaultOptions- = Options- { platform = c99- , unroll = NoUnroll- , debug = NoDebug- , memoryInfoVisible = True- , rules = []- }--c99PlatformOptions = defaultOptions-tic64xPlatformOptions = defaultOptions { platform = tic64x }-unrollOptions = defaultOptions { unroll = Unroll 8 }-noPrimitiveInstructionHandling = defaultOptions { debug = NoPrimitiveInstructionHandling }-noMemoryInformation = defaultOptions { memoryInfoVisible = False }---- ===========================================================================--- == Plugin system--- ===========================================================================--pluginChain :: ExternalInfoCollection -> Module () -> Module AllocationEliminatorSemanticInfo-pluginChain externalInfo- = (executePlugin AllocationEliminator ())- . (executePlugin RulePlugin (ruleExternalInfo externalInfo))- . (executePlugin TypeDefinitionGenerator (typeDefinitionGeneratorExternalInfo externalInfo))- . (executePlugin ConstantFolding ())- . (executePlugin UnrollPlugin (unrollExternalInfo externalInfo))- . (executePlugin Precompilation (precompilationExternalInfo externalInfo))- . (executePlugin RulePlugin (primitivesExternalInfo externalInfo)) - . (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 AllocationEliminatorSemanticInfo-executePluginChain' compilationMode prg originalFunctionSignatureParam opt =- pluginChain ExternalInfoCollection {- precompilationExternalInfo = PrecompilationExternalInfo {- originalFunctionSignature = fixedOriginalFunctionSignature- , inputParametersDescriptor = buildInParamDescriptor prg- , numberOfFunctionArguments = numArgs prg- , compilationMode = compilationMode- }- , unrollExternalInfo = unroll opt- , primitivesExternalInfo = opt{ rules = platformRules $ platform opt }- , ruleExternalInfo = opt- , typeDefinitionGeneratorExternalInfo = opt- , variableRoleAssignerExternalInfo = ()- , typeCorrectorExternalInfo = False- } $ fromCore "PLACEHOLDER" prg- where- ofn = NameExtractor.originalFunctionName- errorPEI =- (error "There is no defaultArraySize any more", debug opt, platform opt)- fixedOriginalFunctionSignature = originalFunctionSignatureParam {- NameExtractor.originalFunctionName =- fixFunctionName $ ofn originalFunctionSignatureParam- }--executePluginChain cm f sig opts =- moduleSplitter $ executePluginChain' cm f sig opts
− Feldspar/Compiler/Error.hs
@@ -1,35 +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.-----module Feldspar.Compiler.Error where--data ErrorClass = InvariantViolation | InternalError | Warning- deriving (Show, Eq)--handleError :: String -> ErrorClass -> String -> a-handleError place errorClass message = error $ "[" ++ show errorClass ++ " @ " ++ place ++ "]: " ++ message
− Feldspar/Compiler/Frontend/CommandLine/API.hs
@@ -1,151 +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 CPP #-}-module Feldspar.Compiler.Frontend.CommandLine.API where--import qualified Feldspar.NameExtractor as NameExtractor-import Feldspar.Compiler.Backend.C.Options-import Feldspar.Compiler.Compiler-import Feldspar.Compiler.Imperative.FromCore-import Feldspar.Compiler.Frontend.CommandLine.API.Library-import Feldspar.Compiler.Backend.C.Library-import Language.Haskell.Interpreter-import qualified Data.Typeable as T-import Control.Monad---- ====================================== System imports ==================================-import System.Directory-import System.FilePath-import System.IO-import System.Exit-import System.Environment-import System.Console.GetOpt--data CompilationResult- = CompilationSuccess- | CompilationFailure- deriving (Eq, Show, T.Typeable)--#ifdef RELEASE-releaseMode = True-#else-releaseMode = False-#endif-- -- A general interpreter body for interpreting an expression-generalInterpreterBody :: forall a . (T.Typeable (IO a))- => String -- the expression to interpret- -> Interpreter (IO a)-generalInterpreterBody expression = interpret expression (as::IO a)---- A high-level interface for calling the interpreter-highLevelInterpreter :: T.Typeable (IO a)- => String -- the module name (for example My.Module)- -> String -- the input file name (for example "My/Module.hs")- -> [String] -- globalImportList- -> Bool -- need to import global modules qualified?- -> Interpreter (IO a) -- ^ an interpreter body- -> IO CompilationResult-highLevelInterpreter moduleName inputFileName importList needQualify interpreterBody = do- actionToExecute <- runInterpreter $ do- set [ languageExtensions := [GADTs, ScopedTypeVariables, TypeSynonymInstances, StandaloneDeriving,- DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,- FunctionalDependencies, ExistentialQuantification, Rank2Types, TypeOperators,- EmptyDataDecls, GeneralizedNewtypeDeriving, TypeFamilies,- UnknownExtension "ImplicitPrelude"]- ]- -- in relesae mode, globalImportList modules are package modules and shouldn't be loaded, only imported- -- in normal mode, we need to load them before importing them- loadModules $ [inputFileName] ++ if not releaseMode then importList else []- setTopLevelModules [moduleName]- -- Import modules qualified to prevent name collisions with user defined entities- if needQualify- then setImportsQ $ zip importList $ map Just importList- else setImports importList- interpreterBody- case actionToExecute of- Left err -> do- printInterpreterError err- return CompilationFailure- Right action -> do- action- return CompilationSuccess- -- either printInterpreterError id actionToExecute--printInterpreterError :: InterpreterError -> IO ()-printInterpreterError (WontCompile []) = return ()-printInterpreterError (WontCompile (x:xs)) = do- printGhcError x- printInterpreterError (WontCompile xs)- where- printGhcError (GhcError {errMsg=s}) = hPutStrLn stderr s-printInterpreterError e = hPutStrLn stderr $ "Code generation failed: " ++ show e--handleOptions :: [OptDescr (a -> IO a)] -> a -> String -> IO (a, String)-handleOptions descriptors startOptions helpHeader = do- args <- getArgs-- when (length args == 0) (do- putStrLn $ usageInfo helpHeader descriptors- exitWith ExitSuccess)-- -- Parse options, getting a list of option actions- let (actions, nonOptions, errors) = getOpt Permute descriptors args-- when (length errors > 0) (do- putStrLn $ concat errors- putStrLn $ usageInfo helpHeader descriptors- exitWith (ExitFailure 1))-- -- Here we thread startOptions through all supplied option actions- opts <- foldl (>>=) (return startOptions) actions-- when (length nonOptions /= 1) (do- putStrLn "ERROR: Exactly one input file expected."- exitWith (ExitFailure 1))-- let inputFileName = replace (head nonOptions) "\\" "/" -- change it for multi-file operation-- return (opts, inputFileName)--removeFileIfPossible :: String -> IO ()-removeFileIfPossible filename = removeFile filename `Prelude.catch` (const $ return())--prepareInputFile :: String -> IO ()-prepareInputFile inputFileName = do- removeFileIfPossible $ replaceExtension inputFileName ".hi"- removeFileIfPossible $ replaceExtension inputFileName ".o"--standaloneCompile :: (Compilable t internal) =>- t -> FilePath -> FilePath -> NameExtractor.OriginalFunctionSignature -> Options -> IO ()-standaloneCompile prg inputFileName outputFileName originalFunctionSignature opts = do- appendFile (makeCFileName outputFileName) $ sourceCode $ sctccrSource compilationResult- appendFile (makeHFileName outputFileName) $ sourceCode $ sctccrHeader compilationResult- where- compilationResult = compileToCCore Standalone prg (Just outputFileName) IncludesNeeded originalFunctionSignature opts
− Feldspar/Compiler/Frontend/CommandLine/API/Constants.hs
@@ -1,36 +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.-----module Feldspar.Compiler.Frontend.CommandLine.API.Constants where--globalImportList = ["Feldspar.Compiler.Compiler"]--warningPrefix = "[WARNING]: "-errorPrefix = "[ERROR ]: "--
− Feldspar/Compiler/Frontend/CommandLine/API/Library.hs
@@ -1,72 +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.-----module Feldspar.Compiler.Frontend.CommandLine.API.Library where--import qualified Feldspar.Compiler.Backend.C.Options as CoreOptions-import Feldspar.Compiler.Backend.C.Platforms--import Data.Char-import Language.Haskell.Interpreter-import System.Console.ANSI-import Feldspar.Compiler.Backend.C.Library--lowerFirst :: String -> String-lowerFirst (first:rest) = (toLower first : rest)--upperFirst :: String -> String-upperFirst (first:rest) = (toUpper first : rest)--formatStringListCore :: [String] -> String-formatStringListCore [] = ""-formatStringListCore [x] = x-formatStringListCore (x:xs) = x ++ " | " ++ (formatStringListCore xs)--formatStringList :: [String] -> String-formatStringList list | length list > 0 = "(" ++ (formatStringListCore list) ++ ")"-formatStringList _ = error "This list should not be empty."--rpad :: Int -> String -> String-rpad target s = rpadWith target ' ' s--rpadWith :: Int -> Char -> String -> String-rpadWith target padchar s- | length s >= target = s- | otherwise = rpadWith target padchar (s ++ [padchar])- -iPutStrLn :: String -> Interpreter ()-iPutStrLn = liftIO . putStrLn--iPutStr :: String -> Interpreter ()-iPutStr = liftIO . putStr--fancyWrite :: String -> IO ()-fancyWrite s = do- withColor Blue $ putStr "=== [ "- withColor Cyan $ putStr $ rpad 70 s- withColor Blue $ putStrLn " ] ==="
− Feldspar/Compiler/Frontend/CommandLine/API/Options.hs
@@ -1,135 +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.-----module Feldspar.Compiler.Frontend.CommandLine.API.Options where--import qualified Feldspar.Compiler.Backend.C.Options as CompilerCoreOptions-import qualified Feldspar.Compiler.Compiler as CompilerCore-import qualified Feldspar.Compiler.Frontend.CommandLine.API.Library as StandaloneLib-import Feldspar.Compiler.Frontend.CommandLine.API.Constants-import Feldspar.Compiler.Backend.C.Platforms--import Data.List-import Data.Char--import System.Console.GetOpt-import System.Exit-import System.Environment-import System.IO-import System.Process-import System.Info-import System.Directory--availablePlatformsStrRep = StandaloneLib.formatStringList $- map (StandaloneLib.upperFirst . CompilerCoreOptions.name) availablePlatforms--data StandaloneMode = SingleFunction String | MultiFunction--data Options = Options { optStandaloneMode :: StandaloneMode- , optOutputFileName :: Maybe String- , optCompilerMode :: CompilerCoreOptions.Options- }---- | Default options-startOptions :: Options-startOptions = Options { optStandaloneMode = MultiFunction- , optOutputFileName = Nothing- , optCompilerMode = CompilerCore.defaultOptions- }--helpHeader = "Standalone Feldspar Compiler\nUsage: feldspar [options] inputfile\n" ++- "Notes: \n" ++- " * When no output file name is specified, the input file's name with .c extension is used\n" ++- " * The inputfile parameter is always needed, even in single-function mode\n" ++- "\nAvailable options: \n"---- | Option descriptions for getOpt-optionDescriptors :: [ OptDescr (Options -> IO Options) ]-optionDescriptors =- [ Option "f" ["singlefunction"]- (ReqArg- (\arg opt -> return opt { optStandaloneMode = SingleFunction arg })- "FUNCTION")- "Enables single-function compilation"- , Option "o" ["output"]- (ReqArg- (\arg opt -> return opt { optOutputFileName = Just arg })- "outputfile")- "Overrides the file names for the generated output code"-- , Option "p" ["platform"]- (ReqArg- (\arg opt -> return opt { optCompilerMode = (optCompilerMode opt)- { CompilerCoreOptions.platform = decodePlatform arg } })- "<platform>")- ("Overrides the target platform " ++ availablePlatformsStrRep)- , Option "u" ["unroll"]- (ReqArg- (\arg opt -> return opt {- optCompilerMode = (optCompilerMode opt) {- CompilerCoreOptions.unroll = CompilerCoreOptions.Unroll (parseInt arg "Invalid unroll count")- }- })- "<unrollCount>")- "Enables loop unrolling"- , Option "D" ["debuglevel"]- (ReqArg- (\arg opt -> return opt { optCompilerMode = (optCompilerMode opt)- { CompilerCoreOptions.debug = decodeDebug arg } })- "<level>")- "Specifies debug level (currently the only possible option is NoPrimitiveInstructionHandling)"- , Option "h" ["help"]- (NoArg- (\_ -> do- --prg <- getProgName- hPutStrLn stderr (usageInfo helpHeader optionDescriptors)- exitWith ExitSuccess))- "Show this help message"- ]---- ==============================================================================--- == Option Decoders--- ==============================================================================--findPlatformByName :: String -> Maybe CompilerCoreOptions.Platform-findPlatformByName platformName = -- Finds a platform by name using case-insensitive comparison- find (\platform -> (map toLower platformName) == (map toLower $ CompilerCoreOptions.name platform))- availablePlatforms--decodePlatform :: String -> CompilerCoreOptions.Platform-decodePlatform s = case (findPlatformByName s) of- Just platform -> platform- Nothing -> error $ "Invalid platform specified. Valid platforms are: " ++ availablePlatformsStrRep--decodeDebug "NoPrimitiveInstructionHandling" = CompilerCoreOptions.NoPrimitiveInstructionHandling-decodeDebug _ = error "Invalid debug level specified"--parseInt :: String -> String -> Int-parseInt arg message = case reads arg of- [(x, "")] -> x- _ -> error message
− Feldspar/Compiler/Frontend/CommandLine/Main.hs
@@ -1,220 +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.-----module Main where--- ====================================== Feldspar imports ==================================-import Feldspar.NameExtractor-import Feldspar.Compiler.Compiler-import qualified Feldspar.Compiler.Compiler as CompilerCore-import Feldspar.Compiler.Backend.C.Options-import qualified Feldspar.Compiler.Backend.C.Options as CoreOptions-import Feldspar.Compiler.Frontend.CommandLine.API.Options as StandaloneOptions-import Feldspar.Compiler.Frontend.CommandLine.API.Constants-import Feldspar.Compiler.Frontend.CommandLine.API.Library as StandaloneLib-import Feldspar.Compiler.Backend.C.Library-import Feldspar.Compiler.Frontend.CommandLine.API-import Feldspar.Compiler.Imperative.Representation-import Feldspar.Compiler.Backend.C.CodeGeneration-import Feldspar.Compiler.Error-import Feldspar.Compiler.Backend.C.Plugin.AllocationEliminator-import Feldspar.Compiler.Backend.C.Plugin.PrettyPrint--- ====================================== System imports ==================================-import System.IO-import System.Exit-import System.Info-import System.Process-import System.IO.Error-import System.FilePath-import System.Directory-import System.Environment-import System.Console.GetOpt--- ====================================== Control imports ==================================-import Control.Monad-import Control.Exception-import Control.Monad.Error-import Control.Monad.CatchIO--- ====================================== Other imports ==================================-import Data.List-import Debug.Trace-import Language.Haskell.Interpreter---data CompilationError =- InterpreterError InterpreterError- | InternalErrorCall String--compileFunction :: String -> String -> CoreOptions.Options -> OriginalFunctionSignature- -> Interpreter (String, Either SplitModuleDescriptor CompilationError)-compileFunction inFileName outFileName coreOptions originalFunctionSignature = do- let functionName = originalFunctionName originalFunctionSignature- (SomeCompilable prg) <- interpret ("SomeCompilable " ++ functionName) (as::SomeCompilable)- let splitModuleDescriptor = executePluginChain Standalone prg originalFunctionSignature coreOptions- -- XXX force evaluation in order to be able to catch the exceptions- -- liftIO $ evaluate $ compToC coreOptions compilationUnit -- XXX somehow not enough(?!) -- counter-example: structexamples- result <- liftIO $ do- tempdir <- System.IO.Error.catch (getTemporaryDirectory) (\_ -> return ".")- (tempfile, temph) <- openTempFile tempdir "feldspar-temp.txt"- let core = compileToCCore Standalone prg (Just outFileName) IncludesNeeded originalFunctionSignature coreOptions- Control.Exception.finally (do hPutStrLn temph $ sourceCode $ sctccrSource core- hPutStrLn temph $ sourceCode $ sctccrHeader core)- (do hClose temph- removeFileIfPossible tempfile)- return $ (functionName, Left splitModuleDescriptor)- return result--compileAllFunctions :: String -> String -> CoreOptions.Options -> [OriginalFunctionSignature]- -> Interpreter [(String, Either SplitModuleDescriptor CompilationError)]-compileAllFunctions inFileName outFileName options [] = return []-compileAllFunctions inFileName outFileName options (x:xs) = do- let functionName = originalFunctionName x- resultCurrent <- (catchError (compileFunction inFileName outFileName options x)- (\(e::InterpreterError) -> return $ (functionName, Right $ InterpreterError e)))- `Control.Monad.CatchIO.catch`- (\msg -> return $ (functionName,- Right $ InternalErrorCall $ errorPrefix ++ show (msg::Control.Exception.ErrorCall)))- resultRest <- compileAllFunctions inFileName outFileName options xs- return $ resultCurrent : resultRest---- | Interpreter body for single-function compilation-singleFunctionCompilationBody :: String -> String -> CoreOptions.Options -> OriginalFunctionSignature- -> Interpreter (IO ())-singleFunctionCompilationBody inFileName outFileName coreOptions originalFunctionSignature = do- liftIO $ fancyWrite $ "Compiling function " ++ (originalFunctionName originalFunctionSignature) ++ "..."- (SomeCompilable prg) <-- interpret ("SomeCompilable " ++ originalFunctionName originalFunctionSignature) (as::SomeCompilable)- liftIO $ standaloneCompile prg inFileName outFileName originalFunctionSignature coreOptions- return $ return ()--mergeModules :: [Module AllocationEliminatorSemanticInfo] -> Module AllocationEliminatorSemanticInfo-mergeModules [] = handleError "Standalone" InvariantViolation "Called mergeModules with an empty list"-mergeModules [x] = x-mergeModules l@(x:xs) = Module {- entities = nub $ entities x ++ (entities $ mergeModules xs), -- nub is in fact a "global plugin" here- moduleLabel = ()-}--padFunctionName :: String -> String-padFunctionName n = StandaloneLib.rpadWith 50 '.' $ "Function " ++ n--writeErrors :: (String, Either a CompilationError) -> IO ()-writeErrors (functionName, Left x) = return ()-writeErrors (functionName, Right err) = case err of - InterpreterError ie -> do- withColor Red $ putStrLn $ "Error in function " ++ functionName ++ ":"- printInterpreterError ie- InternalErrorCall ec -> do- withColor Red $ putStrLn $ "Error in function " ++ functionName ++ ":"- withColor Red $ putStrLn ec--writeSummary :: (String, Either a CompilationError) -> IO ()-writeSummary (functionName, Left x) = do- withColor Cyan $ putStr $ padFunctionName functionName- withColor Green $ putStrLn "[OK]"-writeSummary (functionName, Right msg) = do- withColor Cyan $ putStr $ padFunctionName functionName- withColor Red $ putStrLn "[FAILED]"--filterLefts :: [(String, Either a b)] -> [a]-filterLefts [] = []-filterLefts [(_,Left x)] = [x]-filterLefts [(_,Right _)] = []-filterLefts ((_,Left x):xs) = x : filterLefts xs-filterLefts ((_,Right _):xs) = filterLefts xs---- | Interpreter body for multi-function compilation-multiFunctionCompilationBody :: String -> String -> CoreOptions.Options -> [OriginalFunctionSignature] -> Interpreter (IO ())-multiFunctionCompilationBody inFileName outFileName coreOptions declarationList = do- let (hIncludes, hLineNum) = genIncludeLines coreOptions Nothing- let (cIncludes, cLineNum) = genIncludeLines coreOptions (Just outFileName)- liftIO $ appendFile (makeHFileName outFileName) $ hIncludes- liftIO $ appendFile (makeCFileName outFileName) $ cIncludes- modules <- compileAllFunctions inFileName outFileName coreOptions declarationList- liftIO $ do- mapM writeErrors modules- withColor Blue $ putStrLn "\n================= [ Summary of compilation results ] =================\n"- mapM writeSummary modules- let mergedCModules = mergeModules $ map smdSource $ filterLefts modules- let mergedHModules = mergeModules $ map smdHeader $ filterLefts modules- let cCompToCResult = compToCWithInfos ((coreOptions, Declaration_pl), cLineNum) mergedCModules- let hCompToCResult = compToCWithInfos ((coreOptions, Declaration_pl), hLineNum) mergedHModules- (appendFile (makeCFileName outFileName) $ fst $ snd cCompToCResult) `Control.Exception.catch` errorHandler- (appendFile (makeHFileName outFileName) $ fst $ snd hCompToCResult) `Control.Exception.catch` errorHandler- (writeFile (makeDebugCFileName outFileName) $ show $ fst cCompToCResult) `Control.Exception.catch` errorHandler- (writeFile (makeDebugHFileName outFileName) $ show $ fst hCompToCResult) `Control.Exception.catch` errorHandler- return $ return ()- where- errorHandler = (\msg -> withColor Red $ putStrLn $ errorPrefix ++ show (msg::Control.Exception.ErrorCall))---- | Calculates the output file name.-convertOutputFileName :: String -> Maybe String -> String-convertOutputFileName inputFileName maybeOutputFileName = case maybeOutputFileName of- Nothing -> takeFileName $ dropExtension inputFileName -- remove takeFileName to return the full path- Just overriddenFileName -> overriddenFileName--makeBackup :: String -> IO ()-makeBackup filename = renameFile filename (filename ++ ".bak") `Prelude.catch` (const $ return())--main = do- (opts, inputFileName) <- handleOptions optionDescriptors startOptions helpHeader- let outputFileName = convertOutputFileName inputFileName (optOutputFileName opts)-- prepareInputFile inputFileName- makeBackup $ makeHFileName outputFileName- makeBackup $ makeCFileName outputFileName- makeBackup $ makeDebugHFileName outputFileName- makeBackup $ makeDebugCFileName outputFileName-- fileDescriptor <- openFile inputFileName ReadMode- fileContents <- hGetContents fileDescriptor-- let declarationList = getExtendedDeclarationList inputFileName fileContents- let moduleName = getModuleName inputFileName fileContents- fancyWrite $ "Compilation target: module " ++ moduleName- fancyWrite $ "Output file: " ++ outputFileName-- let highLevelInterpreterWithModuleInfo body = - highLevelInterpreter moduleName inputFileName globalImportList False body-- -- C code generation- case optStandaloneMode opts of- MultiFunction - | length declarationList == 0 -> putStrLn "No functions to compile."- | otherwise -> do- fancyWrite $ "Number of functions to compile: " ++ (show $ length declarationList)- highLevelInterpreterWithModuleInfo- (multiFunctionCompilationBody inputFileName outputFileName (optCompilerMode opts) declarationList)- return ()- SingleFunction funName -> do- let originalFunctionSignatureNeeded = - case filter ((==funName).originalFunctionName) declarationList of- [a] -> a- [] -> error $ "Function " ++ funName ++ " not found"- _ -> error "Unexpected error SC/01" - highLevelInterpreterWithModuleInfo- (singleFunctionCompilationBody inputFileName outputFileName (optCompilerMode opts) originalFunctionSignatureNeeded)- return ()
− Feldspar/Compiler/Frontend/Interactive/Interface.hs
@@ -1,94 +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.-----module Feldspar.Compiler.Frontend.Interactive.Interface where - -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 - --- ================================================================================================ --- == 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 = case find of - True -> putStrLn $ myShow code - _ -> 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 prg fileName functionName opts = do - writeFile (makeCFileName fileName) $ sourceCode $ sctccrSource compilationResult - writeFile (makeHFileName fileName) $ sourceCode $ sctccrHeader compilationResult - where - compilationResult = compileToCCore Interactive prg (Just fileName) IncludesNeeded - (NameExtractor.OriginalFunctionSignature functionName []) opts - -icompile :: (Compilable t internal) => t -> IO () -icompile prg = icompile' prg "test" 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 - -info :: (Compilable t internal) => t -> IO () -info = flip info' defaultOptions - -info' :: (Compilable t internal) => t -> Options -> IO () -info' prg opts = print $ mergeAllocationInfos $ [ allocationInfo $ sctccrSource compilationResult - , allocationInfo $ sctccrHeader compilationResult ] - where - compilationResult = compileToCCore Interactive prg Nothing IncludesNeeded - (NameExtractor.OriginalFunctionSignature "test" []) opts - -icompileWithInfos :: (Compilable t internal) => t -> String -> Options -> SplitCompToCCoreResult -icompileWithInfos prg functionName opts = compileToCCore Interactive prg Nothing IncludesNeeded - (NameExtractor.OriginalFunctionSignature functionName []) opts
− Feldspar/Compiler/Imperative/FromCore.hs
@@ -1,109 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore where----import Control.Monad.RWS--import Language.Syntactic-import Language.Syntactic.Constructs.Binding-import Language.Syntactic.Sharing.SimpleCodeMotion--import Feldspar.Core.Types-import Feldspar.Core.Interpretation-import Feldspar.Core.Constructs-import Feldspar.Core.Frontend--import Feldspar.Compiler.Imperative.Representation (Module)-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.Condition-import Feldspar.Compiler.Imperative.FromCore.ConditionM-import Feldspar.Compiler.Imperative.FromCore.Error-import Feldspar.Compiler.Imperative.FromCore.FFI-import Feldspar.Compiler.Imperative.FromCore.Literal-import Feldspar.Compiler.Imperative.FromCore.Loop-import Feldspar.Compiler.Imperative.FromCore.Mutable-import Feldspar.Compiler.Imperative.FromCore.Par-import Feldspar.Compiler.Imperative.FromCore.MutableToPure-import Feldspar.Compiler.Imperative.FromCore.Primitive-import Feldspar.Compiler.Imperative.FromCore.Save-import Feldspar.Compiler.Imperative.FromCore.SizeProp-import Feldspar.Compiler.Imperative.FromCore.SourceInfo-import Feldspar.Compiler.Imperative.FromCore.Tuple----instance Compile FeldDomain (Lambda TypeCtx :+: (Variable TypeCtx :+: FeldDomain))- where- compileProgSym (FeldDomain a) = compileProgSym a- compileExprSym (FeldDomain a) = compileExprSym a--compileProgTop :: (Compile dom dom, Lambda TypeCtx :<: dom) =>- String -> [Var] -> ASTF (Decor Info dom) a -> Mod-compileProgTop name args (lam :$ body)- | Just (info, Lambda v) <- prjDecorCtx typeCtx lam- = let ta = argType $ infoType info- sa = defaultSize ta- var = mkVariable (compileTypeRep ta sa) v- in compileProgTop name (var:args) body-compileProgTop name args a = Mod defs- 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- body = Seq $ block $ results- defs = def results ++ [ProcDf name ins [outParam] body]--class Syntactic a FeldDomainAll => Compilable a internal | a -> internal-instance Syntactic a FeldDomainAll => Compilable a ()- -- TODO This class should be replaced by (Syntactic a FeldDomainAll) (or a- -- similar alias) everywhere. The second parameter is not needed.--fromCore :: Syntactic a FeldDomainAll => String -> a -> Module ()-fromCore name- = fromInterface- . compileProgTop name []- . reifyFeld N32--buildInParamDescriptor :: Syntactic a FeldDomainAll => a -> [Int]-buildInParamDescriptor _ = []- -- TODO--numArgs :: Syntactic a FeldDomainAll => a -> Int-numArgs = length . buildInParamDescriptor-
− Feldspar/Compiler/Imperative/FromCore/Array.hs
@@ -1,124 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.Array where----import Control.Monad.RWS--import Language.Syntactic-import Language.Syntactic.Constructs.Binding--import Feldspar.Core.Types-import Feldspar.Core.Interpretation-import Feldspar.Core.Constructs.Array-import Feldspar.Core.Constructs.Literal--import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Compiler.Imperative.FromCore.Interpretation----instance ( Compile dom dom- , Lambda TypeCtx :<: dom- , Literal TypeCtx :<: dom- , Variable TypeCtx :<: dom- )- => Compile Array dom- where- compileProgSym Parallel _ loc (len :* (lam :$ ixf) :* Nil)- | Just (info, Lambda v) <- prjDecorCtx typeCtx lam- = do- let ta = argType $ infoType info- let sa = defaultSize ta- let ix@(Var _ name) = mkVar (compileTypeRep ta sa) v- len' <- mkLength len- (e, body) <- confiscateProg $ compileProg (loc :!: ix) ixf- tellProg [For name len' 1 $ Seq body]- tellProg [setLength loc len']-- compileProgSym Sequential _ loc (len :* st :* (lam1 :$ (lam2 :$ step)) :* Nil)- | Just (info1, Lambda v) <- prjDecorCtx typeCtx lam1- , Just (info2, Lambda s) <- prjDecorCtx typeCtx lam2- = do- let t = argType $ infoType info1- let sz = defaultSize t- let ta' = argType $ infoType info2- let sa' = defaultSize ta'- let tr' = resType $ infoType info2- 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- (e, body) <- confiscateProg $ compileProg tmp step- tellProg [Block [ini stv initSt, def tmp] $- For name len' 1 $- Seq (body ++- [loc :!: ix := (tmp :.: "member1")- ,stv := (tmp :.: "member2")- ])]- tellProg [setLength loc len']- where def (Var ty str) = Def ty str- ini (Var ty str) e = Init ty str e-- compileProgSym Append _ loc (a :* b :* Nil) = do- a' <- compileExpr a- b' <- compileExpr b- let offset = Fun U32 "getLength" [a']- tellProg [copyProg loc a']- tellProg [copyProgPos loc offset b']-- compileProgSym SetIx info loc (arr :* i :* a :* Nil) = do- compileProg loc arr- i' <- compileExpr i- compileProg (loc :!: i') a-- compileProgSym SetLength _ loc (len :* arr :* Nil) = do- len' <- compileExpr len- tellProg [setLength loc len']- compileProg loc arr- -- TODO Optimize by using copyProgLen (compare to 0.4)-- compileProgSym a info loc args = compileExprLoc a info loc args-- compileExprSym GetLength info (a :* Nil) = do- aExpr <- compileExpr a- return $ Fun (compileTypeRep (infoType info) (infoSize info)) "getLength" [aExpr]-- compileExprSym GetIx info (arr :* i :* Nil) = do- a' <- compileExpr arr- i' <- compileExpr i- return $ a' :!: i'-- compileExprSym a info args = compileProgFresh a info args-
− Feldspar/Compiler/Imperative/FromCore/Binding.hs
@@ -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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.Binding where--import Control.Monad.RWS--import Language.Syntactic--import Feldspar.Core.Types-import Feldspar.Core.Interpretation-import Feldspar.Core.Constructs.Binding-import qualified Feldspar.Core.Constructs.Binding as Core--import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Compiler.Imperative.FromCore.Interpretation----instance Compile (Core.Variable TypeCtx) dom- where- compileExprSym (Core.Variable v) info Nil = do- env <- ask- case lookup v (alias env) of- Nothing -> return $ Var (compileTypeRep (infoType info) (infoSize info)) ("v" ++ show v)- Just e -> return e--instance Compile (Lambda TypeCtx) dom- where- compileProgSym = error "Can only compile top-level Lambda"--instance (Compile dom dom, Lambda TypeCtx :<: dom) => Compile (Let TypeCtx TypeCtx) dom- where- compileProgSym Let _ loc (a :* (lam :$ body) :* Nil)- | Just (info, Lambda v) <- prjDecorCtx typeCtx lam- = do- let ta = argType $ infoType info- let sa = defaultSize ta- let var = mkVar (compileTypeRep ta sa) v- compileProg var a- withDecl var $ compileProg loc body-- compileExprSym Let _ (a :* (lam :$ body) :* Nil)- | Just (info, Lambda v) <- prjDecorCtx typeCtx lam- = do- let ta = argType $ infoType info- let sa = defaultSize ta- let var = mkVar (compileTypeRep ta sa) v- compileProg var a- withDecl var $ compileExpr body-
− Feldspar/Compiler/Imperative/FromCore/Condition.hs
@@ -1,54 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.Condition where----import Control.Monad.RWS--import Language.Syntactic--import Feldspar.Core.Types-import Feldspar.Core.Constructs.Condition--import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Compiler.Imperative.FromCore.Interpretation----instance Compile dom dom => Compile (Condition TypeCtx) dom- where- compileProgSym Condition _ loc (cond :* tHEN :* eLSE :* Nil) = do- condExpr <- compileExpr cond- (_,thenProg) <- confiscateProg $ compileProg loc tHEN- (_,elseProg) <- confiscateProg $ compileProg loc eLSE- tellProg [If condExpr (Seq thenProg) (Seq elseProg)]-
− Feldspar/Compiler/Imperative/FromCore/ConditionM.hs
@@ -1,53 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.ConditionM where----import Control.Monad.RWS--import Language.Syntactic--import Feldspar.Core.Types-import Feldspar.Core.Constructs.ConditionM--import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Compiler.Imperative.FromCore.Interpretation----instance Compile dom dom => Compile (ConditionM m) dom- where- compileProgSym ConditionM _ loc (cond :* tHEN :* eLSE :* Nil) = do- condExpr <- compileExpr cond- (_,thenProg) <- confiscateProg $ compileProg loc tHEN- (_,elseProg) <- confiscateProg $ compileProg loc eLSE- tellProg [If condExpr (Seq thenProg) (Seq elseProg)]
− Feldspar/Compiler/Imperative/FromCore/Error.hs
@@ -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.-----{-# LANGUAGE UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.Error where----import Control.Monad.RWS--import Language.Syntactic--import Feldspar.Core.Constructs.Error--import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Compiler.Imperative.FromCore.Interpretation----instance (Compile dom dom) => Compile Error dom- where- compileProgSym Undefined _ loc Nil = return ()- compileProgSym (Assert msg) _ loc (cond :* a :* Nil) = do- condExpr <- compileExpr cond- tellProg [Call "assert" [In condExpr]]- when (length msg > 0) $ tellProg [Comment $ "{" ++ msg ++ "}"]- compileProg loc a-- compileExprSym (Assert msg) _ (cond :* a :* Nil) = do- condExpr <- compileExpr cond- tellProg [Call "assert" [In condExpr]]- when (length msg > 0) $ tellProg [Comment $ "{" ++ msg ++ "}"]- compileExpr a- compileExprSym a info args = compileProgFresh a info args-
− Feldspar/Compiler/Imperative/FromCore/FFI.hs
@@ -1,46 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.FFI where--import Language.Syntactic--import Feldspar.Core.Interpretation-import Feldspar.Core.Constructs.FFI--import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Compiler.Imperative.FromCore.Interpretation--instance (Compile dom dom) => Compile FFI dom- where- compileExprSym (ForeignImport name _) info args = do- argExprs <- sequence $ listArgs compileExpr args- return $ Fun (compileTypeRep (infoType info) (infoSize info)) name argExprs-
− Feldspar/Compiler/Imperative/FromCore/Interpretation.hs
@@ -1,325 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.Interpretation where---import Control.Arrow-import Control.Monad.RWS--import Language.Syntactic-import Language.Syntactic.Constructs.Binding (VarId)--import Feldspar.Range-import Feldspar.Core.Types hiding (Type)-import Feldspar.Core.Interpretation-import qualified Feldspar.Core.Constructs.Binding as Core-import qualified Feldspar.Core.Constructs.Literal as Core--import Feldspar.Compiler.Imperative.Frontend------ | Code generation monad-type CodeWriter = RWS Readers Writers States--data Readers = Readers { alias :: [(VarId, Expr)] -- ^ variable aliasing- , sourceInfo :: SourceInfo -- ^ Surrounding source info- }--initReader = Readers [] ""--data Writers = Writers { -- | collects code within one block- block :: [Prog]-- -- | collects top level definitions- , def :: [Ent]- }--instance Monoid Writers- where- mempty = Writers { block = mempty- , def = mempty- }- mappend a b = Writers { block = mappend (block a) (block b)- , def = mappend (def a) (def b)- }--type Task = [Prog]--data States = States { -- | the first fresh variable- fresh :: Integer- , tasks :: [Task] -- ^ suspended programs- }--initState = States 0 []---- | Where to place the program result-type Location = Expr---- | A minimal complete instance has to define either 'compileProgSym' or--- 'compileExprSym'.-class Compile sub dom- where- compileProgSym- :: sub a- -> Info (DenResult a)- -> Location- -> Args (AST (Decor Info dom)) a- -> CodeWriter ()- compileProgSym = compileExprLoc-- compileExprSym- :: sub a- -> Info (DenResult a)- -> Args (AST (Decor Info dom)) a- -> CodeWriter Expr- compileExprSym = compileProgFresh--instance (Compile sub1 dom, Compile sub2 dom) =>- Compile (sub1 :+: sub2) dom- where- compileProgSym (InjL a) = compileProgSym a- compileProgSym (InjR a) = compileProgSym a-- compileExprSym (InjL a) = compileExprSym a- compileExprSym (InjR a) = compileExprSym a------ | Implementation of 'compileExprSym' that assigns an expression to the given--- location.-compileExprLoc :: Compile sub dom- => sub a- -> Info (DenResult a)- -> Location- -> Args (AST (Decor Info dom)) a- -> CodeWriter ()-compileExprLoc a info loc args = do- expr <- compileExprSym a info args- assign loc expr---- | Implementation of 'compileProgSym' that generates code into a fresh--- variable.-compileProgFresh :: Compile sub dom- => sub a- -> Info (DenResult a)- -> Args (AST (Decor Info dom)) a- -> CodeWriter Expr-compileProgFresh a info args = do- loc <- freshVar "e" (infoType info) (infoSize info)- withDecl loc $ compileProgSym a info loc args- return loc--compileProgDecor :: Compile dom dom- => Location- -> Decor Info dom a- -> Args (AST (Decor Info dom)) a- -> CodeWriter ()-compileProgDecor result (Decor info a) args = do- let src = infoSource info- aboveSrc <- asks sourceInfo- unless (null src || src==aboveSrc) $ tellProg [BComment src]- local (\env -> env {sourceInfo = src}) $ compileProgSym a info result args--compileExprDecor :: Compile dom dom- => Decor Info dom a- -> Args (AST (Decor Info dom)) a- -> CodeWriter Expr-compileExprDecor (Decor info a) args = do- let src = infoSource info- aboveSrc <- asks sourceInfo- unless (null src || src==aboveSrc) $ tellProg [BComment src]- local (\env -> env {sourceInfo = src}) $ compileExprSym a info args--compileProg :: Compile dom dom =>- Location -> ASTF (Decor Info dom) a -> CodeWriter ()-compileProg result = queryNodeSimple (compileProgDecor result)--compileExpr :: Compile dom dom => ASTF (Decor Info dom) a -> CodeWriter Expr-compileExpr = queryNodeSimple compileExprDecor--------------------------------------------------------------------------------------- * Utility functions-----------------------------------------------------------------------------------compileNumType :: Signedness a -> BitWidth n -> Type-compileNumType U N8 = U8-compileNumType S N8 = I8-compileNumType U N16 = U16-compileNumType S N16 = I16-compileNumType U N32 = U32-compileNumType S N32 = I32-compileNumType U N64 = U64-compileNumType S N64 = I64-compileNumType U NNative = U32 -- TODO-compileNumType S NNative = I32 -- TODO--compileTypeRep :: TypeRep a -> Size a -> Type-compileTypeRep UnitType _ = Void-compileTypeRep BoolType _ = Boolean-compileTypeRep (IntType s n) _ = compileNumType s n-compileTypeRep FloatType _ = Floating-compileTypeRep (ComplexType t) _ = Complex (compileTypeRep t (defaultSize t))-compileTypeRep (Tup2Type a b) (sa,sb) = Struct- [ ("member1", compileTypeRep a sa)- , ("member2", compileTypeRep b sb)- ]-compileTypeRep (Tup3Type a b c) (sa,sb,sc) = Struct- [ ("member1", compileTypeRep a sa)- , ("member2", compileTypeRep b sb)- , ("member3", compileTypeRep c sc)- ]-compileTypeRep (Tup4Type a b c d) (sa,sb,sc,sd) = Struct- [ ("member1", compileTypeRep a sa)- , ("member2", compileTypeRep b sb)- , ("member3", compileTypeRep c sc)- , ("member4", compileTypeRep d sd)- ]-compileTypeRep (Tup5Type a b c d e) (sa,sb,sc,sd,se) = Struct- [ ("member1", compileTypeRep a sa)- , ("member2", compileTypeRep b sb)- , ("member3", compileTypeRep c sc)- , ("member4", compileTypeRep d sd)- , ("member5", compileTypeRep e se)- ]-compileTypeRep (Tup6Type a b c d e f) (sa,sb,sc,sd,se,sf) = Struct- [ ("member1", compileTypeRep a sa)- , ("member2", compileTypeRep b sb)- , ("member3", compileTypeRep c sc)- , ("member4", compileTypeRep d sd)- , ("member5", compileTypeRep e se)- , ("member6", compileTypeRep f sf)- ]-compileTypeRep (Tup7Type a b c d e f g) (sa,sb,sc,sd,se,sf,sg) = Struct- [ ("member1", compileTypeRep a sa)- , ("member2", compileTypeRep b sb)- , ("member3", compileTypeRep c sc)- , ("member4", compileTypeRep d sd)- , ("member5", compileTypeRep e se)- , ("member6", compileTypeRep f sf)- , ("member7", compileTypeRep g sg)- ]-compileTypeRep (MutType a) _ = compileTypeRep a (defaultSize a)-compileTypeRep (RefType a) _ = compileTypeRep a (defaultSize a)-compileTypeRep (ArrayType a) (rs :> es) = if unboundedLength- then Array $ compileTypeRep a es- else SizedArray (fromEnum $ upperBound rs) $ compileTypeRep a es- where- unboundedLength- = upperBound rs > fromIntegral (maxBound :: Int)- -- This ensures that `fromEnum` succeeds- || upperBound rs == maxBound- -- This `maxBound` might be smaller than `maxBound :: Int`-compileTypeRep (MArrType a) _ = Array (compileTypeRep a (defaultSize a))-compileTypeRep (ParType a) _ = compileTypeRep a (defaultSize a)-compileTypeRep (IVarType a) _ = compileTypeRep a (defaultSize a)-compileTypeRep (FunType _ b) sz = compileTypeRep b sz-compileTypeRep typ _ = error $ "compileTypeRep: missing " ++ show typ -- TODO--mkVar :: Type -> VarId -> Expr-mkVar t = Var t . ("v" ++) . show--mkVariable :: Type -> VarId -> Var-mkVariable t = Variable t . ("v" ++) . show--freshVar :: String -> TypeRep a -> Size a -> CodeWriter Expr -- TODO take just info instead of TypeRep and Size?-freshVar base t size = do- s <- get- let v = fresh s- put $ s {fresh = (v + 1)}- return $ Var (compileTypeRep t size) (base ++ show v)--tellProg :: [Prog] -> CodeWriter ()-tellProg ps = tell $ mempty {block = ps}--addTask :: Task -> CodeWriter ()-addTask t = do- s <- get- let ts = tasks s- put $ s {tasks = ts ++ [t]}- return ()--assign :: Location -> Expr -> CodeWriter ()-assign lhs rhs = tellProg [copyProg lhs rhs]--suspendProg :: CodeWriter a -> CodeWriter a-suspendProg m = do- (a, ps) <- censor (\rec -> rec {block = []}) $ listen m- addTask $ block ps- return a--releaseProgs :: CodeWriter ()-releaseProgs = do- s <- get- let ts = tasks s- mapM_ tellProg $ reverse ts- put $ s {tasks = []}---- | Like 'listen', but also prevents the program from being written in the--- monad.-confiscateProg :: CodeWriter a -> CodeWriter (a, [Prog])-confiscateProg m- = liftM (id *** block)- $ censor (\rec -> rec {block = []})- $ listen m--withDecl :: Location -> CodeWriter a -> CodeWriter a-withDecl (Var Void _) ma = ma -- don't declace void variables-withDecl (Var t name) ma = do- (e,prog) <- confiscateProg ma- tellProg [Block [Def t name] (Seq prog)]- return e- -- TODO Could probably use only censor--withDeclInit :: Location -> Expr -> CodeWriter a -> CodeWriter a-withDeclInit (Var t name) init ma = do- (e,prog) <- confiscateProg ma- tellProg [Block [Init t name init] (Seq prog)]- return e- -- TODO Needed?--withAlias :: VarId -> Expr -> CodeWriter a -> CodeWriter a-withAlias v0 expr action = do- local (\e -> e {alias = (v0,expr) : alias e}) $ action--isVariableOrLiteral (prjDecorCtx typeCtx -> Just (_, Core.Literal l)) = True-isVariableOrLiteral (prjDecorCtx typeCtx -> Just (_, Core.Variable v)) = True-isVariableOrLiteral _ = False--mkLength a | isVariableOrLiteral a = compileExpr a- | otherwise = do- let lentyp = IntType U N32- lenvar <- freshVar "len" lentyp (defaultSize lentyp)- withDecl lenvar $ compileProg lenvar a- return lenvar-
− Feldspar/Compiler/Imperative/FromCore/Literal.hs
@@ -1,138 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.Literal where----import Control.Monad.RWS-import Data.Complex-import GHC.Float (float2Double)--import Language.Syntactic--import Feldspar.Core.Types-import Feldspar.Core.Interpretation-import Feldspar.Core.Constructs.Literal--import Feldspar.Range (upperBound)--import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Compiler.Imperative.FromCore.Interpretation--instance Compile (Literal TypeCtx) dom- where- compileExprSym (Literal a) info Nil = literal (infoType info) (infoSize info) a-- compileProgSym (Literal a) info loc Nil = literalLoc loc (infoType info) (infoSize info) a--literal :: TypeRep a -> Size a -> a -> CodeWriter Expr-literal UnitType _ () = return $ LitI I32 0-literal BoolType _ a = return $ boolToExpr a-literal trep@(IntType _ _) sz a = return $ LitI (compileTypeRep trep sz) (toInteger a)-literal FloatType _ a = return $ LitF $ float2Double a-literal (ComplexType t) sz (r:+i) = do re <- literal t (defaultSize t) r- ie <- literal t (defaultSize t) i- return $ LitC re ie-literal t s a = do loc <- freshVar "x" t s- withDecl loc $ literalLoc loc t s a- return loc--literalLoc :: Location -> TypeRep a -> Size a -> a -> CodeWriter ()-literalLoc loc ty@(ArrayType t) (rs :> es) e- = do- tellProg [setLength loc $ LitI I32 $ toInteger $ upperBound rs]- zipWithM_ (writeElement loc t es) (map (LitI I32) [0..]) e- where writeElement :: Expr -> TypeRep a -> Size a -> Expr -> a -> CodeWriter ()- writeElement loc ty sz ix e = do expr <- literal ty sz e- tellProg [loc :!: ix := expr]-literalLoc loc t@(Tup2Type ta tb) (sa,sb) (a,b) =- do aExpr <- literal ta sa a- bExpr <- literal tb sb b- tellProg [loc :.: "member1" := aExpr- ,loc :.: "member2" := bExpr]-literalLoc loc t@(Tup3Type ta tb tc) (sa,sb,sc) (a,b,c) =- do aExpr <- literal ta sa a- bExpr <- literal tb sb b- cExpr <- literal tc sc c- tellProg [loc :.: "member1" := aExpr- ,loc :.: "member2" := bExpr- ,loc :.: "member3" := cExpr]-literalLoc loc t@(Tup4Type ta tb tc td) (sa,sb,sc,sd) (a,b,c,d) =- do aExpr <- literal ta sa a- bExpr <- literal tb sb b- cExpr <- literal tc sc c- dExpr <- literal td sd d- tellProg [loc :.: "member1" := aExpr- ,loc :.: "member2" := bExpr- ,loc :.: "member3" := cExpr- ,loc :.: "member4" := dExpr]-literalLoc loc t@(Tup5Type ta tb tc td te) (sa,sb,sc,sd,se) (a,b,c,d,e) =- do aExpr <- literal ta sa a- bExpr <- literal tb sb b- cExpr <- literal tc sc c- dExpr <- literal td sd d- eExpr <- literal te se e- tellProg [loc :.: "member1" := aExpr- ,loc :.: "member2" := bExpr- ,loc :.: "member3" := cExpr- ,loc :.: "member4" := dExpr- ,loc :.: "member5" := eExpr]-literalLoc loc t@(Tup6Type ta tb tc td te tf) (sa,sb,sc,sd,se,sf) (a,b,c,d,e,f) =- do aExpr <- literal ta sa a- bExpr <- literal tb sb b- cExpr <- literal tc sc c- dExpr <- literal td sd d- eExpr <- literal te se e- fExpr <- literal tf sf f- tellProg [loc :.: "member1" := aExpr- ,loc :.: "member2" := bExpr- ,loc :.: "member3" := cExpr- ,loc :.: "member4" := dExpr- ,loc :.: "member5" := eExpr- ,loc :.: "member5" := fExpr]-literalLoc loc t@(Tup7Type ta tb tc td te tf tg) (sa,sb,sc,sd,se,sf,sg) (a,b,c,d,e,f,g) =- do aExpr <- literal ta sa a- bExpr <- literal tb sb b- cExpr <- literal tc sc c- dExpr <- literal td sd d- eExpr <- literal te se e- fExpr <- literal tf sf f- gExpr <- literal tg sg g- tellProg [loc :.: "member1" := aExpr- ,loc :.: "member2" := bExpr- ,loc :.: "member3" := cExpr- ,loc :.: "member4" := dExpr- ,loc :.: "member5" := eExpr- ,loc :.: "member5" := fExpr- ,loc :.: "member5" := gExpr]-literalLoc loc t sz a = do rhs <- literal t sz a- tellProg [loc := rhs]-
− Feldspar/Compiler/Imperative/FromCore/Loop.hs
@@ -1,101 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.Loop where----import Control.Monad.RWS--import Language.Syntactic-import Language.Syntactic.Constructs.Binding--import Feldspar.Core.Types-import Feldspar.Core.Interpretation-import Feldspar.Core.Constructs.Loop hiding (For, While)-import Feldspar.Core.Constructs.Literal-import qualified Feldspar.Core.Constructs.Loop as Core--import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Compiler.Imperative.FromCore.Interpretation---instance ( Compile dom dom- , Lambda TypeCtx :<: dom- , Literal TypeCtx :<: dom- , Variable TypeCtx :<: dom- )- => Compile Loop dom- where- compileProgSym ForLoop _ loc (len :* init :* (lam1 :$ (lam2 :$ ixf)) :* Nil)- | Just (info1, Lambda ix) <- prjDecorCtx typeCtx lam1- , Just (info2, Lambda st) <- prjDecorCtx typeCtx lam2- = do- let ixvar@(Var _ name) = mkVar (compileTypeRep (infoType info1) (infoSize info1)) ix- let stvar = mkVar (compileTypeRep (infoType info2) (infoSize info2)) st- len' <- mkLength len- compileProg loc init- (_, body) <- withAlias st loc $ confiscateProg $ compileProg stvar ixf >> assign loc stvar- withDecl stvar $ tellProg [For name len' 1 $ Seq body]-- compileProgSym WhileLoop _ loc (init :* (lam1 :$ cond) :* (lam2 :$ body) :* Nil)- | Just (info1, Lambda cv) <- prjDecorCtx typeCtx lam1- , Just (info2, Lambda cb) <- prjDecorCtx typeCtx lam2- = do- let stvar = mkVar (compileTypeRep (infoType info2) (infoSize info2)) cb- compileProg loc init- cond' <- withAlias cv loc $ compileExpr cond- (_, body') <- withAlias cb loc $ confiscateProg $ compileProg stvar body >> assign loc stvar- withDecl stvar $ tellProg [While Skip cond' $ Seq body']--instance ( Compile dom dom- , Lambda TypeCtx :<: dom- , Literal TypeCtx :<: dom- , Variable TypeCtx :<: dom- )- => Compile (LoopM Mut) dom- where- compileProgSym Core.For _ loc (len :* (lam :$ ixf) :* Nil)- | Just (info, Lambda v) <- prjDecorCtx typeCtx lam- = do- let ta = argType $ infoType info- let sa = defaultSize ta- let ix@(Var _ name) = mkVar (compileTypeRep ta sa) v- len' <- mkLength len- (e, body) <- confiscateProg $ compileProg loc ixf- tellProg [For name len' 1 $ Seq body]---- TODO Missing While- compileProgSym Core.While _ loc (cond :* step :* Nil)- = do- cond' <- compileExpr cond- (_,step') <- confiscateProg $ compileProg loc step- tellProg [While Skip cond' $ Seq step']-
− Feldspar/Compiler/Imperative/FromCore/Mutable.hs
@@ -1,129 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.Mutable where----import Control.Monad.RWS--import Language.Syntactic-import Language.Syntactic.Constructs.Binding--import Feldspar.Core.Types-import Feldspar.Core.Interpretation-import Feldspar.Core.Constructs.Mutable-import Feldspar.Core.Constructs.MutableArray-import Feldspar.Core.Constructs.MutableReference--import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Compiler.Imperative.FromCore.Interpretation----instance (Compile dom dom, Lambda TypeCtx :<: dom) => Compile (MONAD Mut) dom- where- compileProgSym Bind _ loc (ma :* (lam :$ body) :* Nil)- | Just (_, Lambda v) <- prjDecorCtx typeCtx lam- = do- e <- compileExpr ma- withAlias v e $ compileProg loc body--{- TODO reenable this implementation! The case above inlines too much if v is used more than once in the body- compileProgSym Bind _ loc (ma :* (Symbol (Decor info lam) :$ body) :* Nil)- | Just (Lambda v) <- prjCtx typeCtx lam- = do- let var = mkVar (compileTypeRep $ argType $ infoType info) v- withDecl var $ do- compileProg var ma- compileProg loc body--}-- compileProgSym Then _ loc (ma :* mb :* Nil) = do- compileExpr ma- compileProg loc mb-- compileProgSym Return info loc (a :* Nil)- | MutType UnitType <- infoType info = return ()- | otherwise = compileProg loc a-- compileProgSym When _ loc (c :* action :* Nil) = do- c' <- compileExpr c- (_, body) <- confiscateProg $ compileProg loc action- tellProg [If c' (Seq body) Skip]--instance (Compile dom dom, Lambda TypeCtx :<: dom) => Compile Mutable dom- where- compileProgSym Run _ loc (ma :* Nil) = compileProg loc ma-- compileExprSym Run info (ma :* Nil) = compileExpr ma--instance (Compile dom dom, Lambda TypeCtx :<: dom) => Compile MutableReference dom- where- compileProgSym NewRef _ loc (a :* Nil) = compileProg loc a- compileProgSym GetRef _ loc (r :* Nil) = compileProg loc r- compileProgSym SetRef _ loc (r :* a :* Nil) = do- var <- compileExpr r- compileProg var a-- compileExprSym GetRef _ (r :* Nil) = compileExpr r- compileExprSym feat info args = compileProgFresh feat info args--instance (Compile dom dom, Lambda TypeCtx :<: dom) => Compile MutableArray dom- where- compileProgSym NewArr_ _ loc (length :* Nil) = do- len <- compileExpr length- tellProg [Call "setLength" [In loc,In len]]-- compileProgSym NewArr _ loc (length :* a :* Nil) = do- let ix = Var U32 "i"- a' <- compileExpr a- len <- compileExpr length- tellProg [For "i" len 1 (Seq [loc :!: ix := a'])]-- compileProgSym GetArr _ loc (arr :* i :* Nil) = do- arr' <- compileExpr arr- i' <- compileExpr i- assign loc (arr' :!: i')-- compileProgSym SetArr _ _ (arr :* i :* a :* Nil) = do- arr' <- compileExpr arr- i' <- compileExpr i- a' <- compileExpr a- assign (arr' :!: i') a'-- compileProgSym a info loc args = compileExprLoc a info loc args-- compileExprSym ArrLength info (arr :* Nil) = do- a' <- compileExpr arr- return $ Fun (compileTypeRep (infoType info) (infoSize info)) "getLength" [a']-- compileExprSym a info args = compileProgFresh a info args-
− Feldspar/Compiler/Imperative/FromCore/MutableToPure.hs
@@ -1,85 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.MutableToPure where----import Control.Monad.RWS--import Language.Syntactic-import Language.Syntactic.Constructs.Binding--import Feldspar.Core.Types-import Feldspar.Core.Interpretation-import Feldspar.Core.Constructs.MutableToPure--import Feldspar.Compiler.Imperative.Frontend hiding (Variable)-import Feldspar.Compiler.Imperative.FromCore.Interpretation----instance ( Compile dom dom- , Lambda TypeCtx :<: dom- , Variable TypeCtx :<: dom- )- => Compile MutableToPure dom- where- compileProgSym WithArray _ loc (marr :* (lam :$ body) :* Nil)- | Just (_, Variable v0) <- prjDecorCtx typeCtx marr- , Just (info, Lambda v1) <- prjDecorCtx typeCtx lam- = do- e <- compileExpr marr- withAlias v1 e $ do- e <- compileExpr body- tellProg [copyProg loc e]-- compileProgSym WithArray _ loc (marr :* (lam :$ body) :* Nil)- | Just (info, Lambda v) <- prjDecorCtx typeCtx lam- = do- let ta = argType $ infoType info- let sa = defaultSize ta- let var = mkVar (compileTypeRep ta sa) v- withDecl var $ do- compileProg var marr- e <- compileExpr body- tellProg [copyProg loc e]-- compileProgSym RunMutableArray _ loc (marr :* Nil) = compileProg loc marr--{- NOTES:--The trick of doing a copy at the end, i.e. `tellProg [copyProg loc-e]`, when compiling WithArray is important. It allows us to safely-return the pure array that is passed in as input. This is nice because-it allows us to implement `freezeArray` in terms of `withArray`.-In most cases I expect `withArray` to return a scalar as its final-result and then the copyProg is harmless.--}
− Feldspar/Compiler/Imperative/FromCore/Par.hs
@@ -1,105 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.Par where--import Language.Syntactic-import Language.Syntactic.Constructs.Monad-import Language.Syntactic.Constructs.Binding--import Feldspar.Core.Types-import Feldspar.Core.Interpretation-import Feldspar.Core.Constructs.Par--import Feldspar.Compiler.Imperative.Frontend hiding (Variable)-import Feldspar.Compiler.Imperative.FromCore.Interpretation--instance ( Compile dom dom- , Lambda TypeCtx :<: dom- , ParFeature :<: dom- )- => Compile (MONAD Par) dom- where- compileProgSym Bind _ loc (ma :* (lam :$ body) :* Nil)- | Just (_, Lambda v) <- prjDecorCtx typeCtx lam- , Just (info, ParNew) <- prjDecor ma- -- TODO add helper function :: Info (Par a) -> Info a- = do- let var = mkVar (compileTypeRep (infoType info) (infoSize info)) v- withDecl var $ compileProg loc body-- compileProgSym Bind _ loc (ma :* (lam :$ body) :* Nil)- | Just (_, Lambda v) <- prjDecorCtx typeCtx lam- = do- e <- compileExpr ma- withAlias v e $ compileProg loc body-- compileProgSym Then _ loc (ma :* mb :* Nil) = do- compileExpr ma- compileProg loc mb-- compileProgSym Return info loc (a :* Nil)- | ParType UnitType <- infoType info = return ()- | otherwise = compileProg loc a-- compileProgSym When _ loc (c :* action :* Nil) = do- c' <- compileExpr c- (_, body) <- confiscateProg $ compileProg loc action- tellProg [If c' (Seq body) Skip]--instance ( Compile dom dom- , Variable TypeCtx :<: dom- )- => Compile ParFeature dom- where- compileExprSym ParGet _ (r :* Nil) = do- releaseProgs- compileExpr r-- compileExprSym a info args = compileProgFresh a info args-- compileProgSym ParRun _ loc (p :* Nil) = compileProg loc p-- compileProgSym ParGet _ loc (r :* Nil) = do- releaseProgs- compileProg loc r-- compileProgSym ParPut _ loc (r :* a :* Nil)- | Just (info, Variable v) <- prjDecorCtx typeCtx r- = do- let var = mkVar (compileTypeRep (infoType info) (infoSize info)) v- compileProg var a-- compileProgSym ParFork _ loc (p :* Nil) = do- suspendProg $ compileProg loc p-- compileProgSym ParYield _ loc Nil = return ()--
− Feldspar/Compiler/Imperative/FromCore/Primitive.hs
@@ -1,82 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.Primitive where----import Language.Syntactic-import Language.Syntactic.Interpretation.Semantics--import Feldspar.Core.Interpretation-import Feldspar.Core.Constructs.Bits-import Feldspar.Core.Constructs.Complex-import Feldspar.Core.Constructs.Conversion-import Feldspar.Core.Constructs.Eq-import Feldspar.Core.Constructs.Floating-import Feldspar.Core.Constructs.Fractional-import Feldspar.Core.Constructs.Integral-import Feldspar.Core.Constructs.Logic-import Feldspar.Core.Constructs.Num-import Feldspar.Core.Constructs.Ord-import Feldspar.Core.Constructs.Trace--import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Compiler.Imperative.FromCore.Interpretation------ | Converts symbols to primitive function calls-instance Compile dom dom => Compile Semantics dom- where- compileExprSym (Sem name _) info args = do- argExprs <- sequence $ listArgs compileExpr args- return $ Fun (compileTypeRep (infoType info) (infoSize info)) name argExprs---- | Convenient implementation of 'compileExprSym' for primitive functions-compilePrim :: (Semantic expr, Compile dom dom)- => expr a- -> Info (DenResult a)- -> Args (AST (Decor Info dom)) a- -> CodeWriter Expr-compilePrim = compileExprSym . semantics--instance Compile dom dom => Compile BITS dom where compileExprSym = compilePrim-instance Compile dom dom => Compile COMPLEX dom where compileExprSym = compilePrim-instance Compile dom dom => Compile Conversion dom where compileExprSym = compilePrim-instance Compile dom dom => Compile EQ dom where compileExprSym = compilePrim-instance Compile dom dom => Compile FLOATING dom where compileExprSym = compilePrim-instance Compile dom dom => Compile FRACTIONAL dom where compileExprSym = compilePrim-instance Compile dom dom => Compile INTEGRAL dom where compileExprSym = compilePrim-instance Compile dom dom => Compile Logic dom where compileExprSym = compilePrim-instance Compile dom dom => Compile NUM dom where compileExprSym = compilePrim-instance Compile dom dom => Compile ORD dom where compileExprSym = compilePrim-instance Compile dom dom => Compile Trace dom where compileExprSym = compilePrim-
− Feldspar/Compiler/Imperative/FromCore/Save.hs
@@ -1,48 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.Save where----import Language.Syntactic--import Feldspar.Core.Types-import Feldspar.Core.Constructs.Save--import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Compiler.Imperative.FromCore.Interpretation----instance Compile dom dom => Compile Save dom- where- compileProgSym Save _ loc (a :* Nil) = compileProg loc a-
− Feldspar/Compiler/Imperative/FromCore/SizeProp.hs
@@ -1,51 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.SizeProp where----import Control.Monad.RWS--import Language.Syntactic--import Feldspar.Core.Constructs.SizeProp--import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Compiler.Imperative.FromCore.Interpretation----instance Compile dom dom => Compile PropSize dom- where- compileProgSym (PropSize _) _ loc (_ :* b :* Nil) = compileProg loc b-- compileExprSym (PropSize _) _ (_ :* b :* Nil) = compileExpr b-
− Feldspar/Compiler/Imperative/FromCore/SourceInfo.hs
@@ -1,53 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.SourceInfo where----import Language.Syntactic--import Feldspar.Core.Types-import Feldspar.Core.Constructs.SourceInfo--import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Compiler.Imperative.FromCore.Interpretation----instance Compile dom dom => Compile (Decor SourceInfo1 (Identity TypeCtx)) dom- where- compileProgSym (Decor (SourceInfo1 info) Id) _ loc (a :* Nil) = do- tellProg [BComment info]- compileProg loc a- compileExprSym (Decor (SourceInfo1 info) Id) _ (a :* Nil) = do- tellProg [BComment info]- compileExpr a-
− Feldspar/Compiler/Imperative/FromCore/Tuple.hs
@@ -1,104 +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 UndecidableInstances #-}--module Feldspar.Compiler.Imperative.FromCore.Tuple where----import Language.Syntactic--import Feldspar.Core.Types-import Feldspar.Core.Constructs.Tuple--import Feldspar.Compiler.Imperative.Frontend-import Feldspar.Compiler.Imperative.FromCore.Interpretation----instance Compile dom dom => Compile (Tuple TypeCtx) dom- where- compileProgSym Tup2 _ loc (m1 :* m2 :* Nil) = do- compileExpr m1 >>= assign (loc :.: "member1")- compileExpr m2 >>= assign (loc :.: "member2")- compileProgSym Tup3 _ loc (m1 :* m2 :* m3 :* Nil) = do- compileExpr m1 >>= assign (loc :.: "member1")- compileExpr m2 >>= assign (loc :.: "member2")- compileExpr m3 >>= assign (loc :.: "member3")- compileProgSym Tup4 _ loc (m1 :* m2 :* m3 :* m4 :* Nil) = do- compileExpr m1 >>= assign (loc :.: "member1")- compileExpr m2 >>= assign (loc :.: "member2")- compileExpr m3 >>= assign (loc :.: "member3")- compileExpr m4 >>= assign (loc :.: "member4")- compileProgSym Tup5 _ loc (m1 :* m2 :* m3 :* m4 :* m5 :* Nil) = do- compileExpr m1 >>= assign (loc :.: "member1")- compileExpr m2 >>= assign (loc :.: "member2")- compileExpr m3 >>= assign (loc :.: "member3")- compileExpr m4 >>= assign (loc :.: "member4")- compileExpr m5 >>= assign (loc :.: "member5")- compileProgSym Tup6 _ loc (m1 :* m2 :* m3 :* m4 :* m5 :* m6 :* Nil) = do- compileExpr m1 >>= assign (loc :.: "member1")- compileExpr m2 >>= assign (loc :.: "member2")- compileExpr m3 >>= assign (loc :.: "member3")- compileExpr m4 >>= assign (loc :.: "member4")- compileExpr m5 >>= assign (loc :.: "member5")- compileExpr m6 >>= assign (loc :.: "member6")- compileProgSym Tup7 _ loc (m1 :* m2 :* m3 :* m4 :* m5 :* m6 :* m7 :* Nil) = do- compileExpr m1 >>= assign (loc :.: "member1")- compileExpr m2 >>= assign (loc :.: "member2")- compileExpr m3 >>= assign (loc :.: "member3")- compileExpr m4 >>= assign (loc :.: "member4")- compileExpr m5 >>= assign (loc :.: "member5")- compileExpr m6 >>= assign (loc :.: "member6")- compileExpr m7 >>= assign (loc :.: "member7")--instance Compile dom dom => Compile (Select TypeCtx) dom- where- compileExprSym Sel1 _ (tup :* Nil) = do- tupExpr <- compileExpr tup- return $ tupExpr :.: "member1"- compileExprSym Sel2 _ (tup :* Nil) = do- tupExpr <- compileExpr tup- return $ tupExpr :.: "member2"- compileExprSym Sel3 _ (tup :* Nil) = do- tupExpr <- compileExpr tup- return $ tupExpr :.: "member3"- compileExprSym Sel4 _ (tup :* Nil) = do- tupExpr <- compileExpr tup- return $ tupExpr :.: "member4"- compileExprSym Sel5 _ (tup :* Nil) = do- tupExpr <- compileExpr tup- return $ tupExpr :.: "member5"- compileExprSym Sel6 _ (tup :* Nil) = do- tupExpr <- compileExpr tup- return $ tupExpr :.: "member6"- compileExprSym Sel7 _ (tup :* Nil) = do- tupExpr <- compileExpr tup- return $ tupExpr :.: "member7"-
− Feldspar/Compiler/Imperative/Frontend.hs
@@ -1,353 +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 ViewPatterns #-}--module Feldspar.Compiler.Imperative.Frontend where--import Data.List--import Feldspar.Compiler.Imperative.Representation hiding (Type, UserType, Cast, In, Out, Variable, Block, Pointer, Comment)-import qualified Feldspar.Compiler.Imperative.Representation as AIR--import Feldspar.Core.Types hiding (Type)---- * Frontend data types--data Mod = Mod [Ent]- deriving (Show)--data Ent- = StructD String [(String, Type)]- | ProcDf String [Var] [Var] Prog- | ProcDcl String [Var] [Var]- deriving (Show)--data Type- = Void- | Boolean- | Bit- | Floating- | I8 | I16 | I32 | I40 | I64- | U8 | U16 | U32 | U40 | U64- | Complex Type- | UserType String- | Array Type- | SizedArray Int Type- | Struct [(String, Type)]- deriving Eq--data Expr- = Var Type String- | Ptr Type String- | Tr- | Fl- | LitI Type Integer- | LitF Double- | LitC Expr Expr- | Expr :!: Expr- | Expr :.: String- | Binop Type String [Expr]- | Fun Type String [Expr]- | Cast Type Expr- | SizeofE Expr- | SizeofT Type- deriving (Show)--data Prog- = Skip- | BComment String- | Comment String- | Expr := Expr- | Call String [Param]- | Seq [Prog]- | If Expr Prog Prog- | While Prog Expr Prog- | For String Expr Int Prog- | Block [Def] Prog- deriving (Show)--data Param- = In Expr- | Out Expr- deriving (Show)--data Block- = Bl [Def] Prog- deriving (Show)--data Def- = Init Type String Expr- | Def Type String- deriving (Show)--data Var- = Variable Type String- | Pointer Type String- deriving (Show)---- * Conversion between representation and frontend--class Interface t where- type Repr t- toInterface :: Repr t -> t- fromInterface :: t -> Repr t--instance Interface Mod where- type Repr Mod = AIR.Module ()- toInterface (Module entities ()) = Mod $ map toInterface entities- fromInterface (Mod entities) = AIR.Module (map fromInterface entities) ()--instance Interface Ent where- type Repr Ent = AIR.Entity ()- toInterface (AIR.StructDef name members () ()) =- StructD name (map (\(StructMember mname mtyp ())->(mname,toInterface mtyp)) members)- toInterface (AIR.ProcDef name inparams outparams body () ()) =- ProcDf name (map toInterface inparams) (map toInterface outparams) (toProg body)- toInterface (AIR.ProcDecl name inparams outparams () ()) =- ProcDcl name (map toInterface inparams) (map toInterface outparams)- fromInterface (StructD name members) =- AIR.StructDef name (map (\(mname,mtyp)->(StructMember mname (fromInterface mtyp) ())) members) () ()- fromInterface (ProcDf name inparams outparams body) =- AIR.ProcDef name (map fromInterface inparams) (map fromInterface outparams) (toBlock body) () ()- fromInterface (ProcDcl name inparams outparams) =- AIR.ProcDecl name (map fromInterface inparams) (map fromInterface outparams) () ()---instance Interface Type where- type Repr Type = AIR.Type- toInterface VoidType = Void- toInterface AIR.BoolType = Boolean- toInterface BitType = Bit- toInterface AIR.FloatType = Floating- toInterface (NumType Signed S8) = I8- toInterface (NumType Signed S16) = I16- toInterface (NumType Signed S32) = I32- toInterface (NumType Signed S40) = I40- toInterface (NumType Signed S64) = I64- toInterface (NumType Unsigned S8) = U8- toInterface (NumType Unsigned S16) = U16- toInterface (NumType Unsigned S32) = U32- toInterface (NumType Unsigned S40) = U40- toInterface (NumType Unsigned S64) = U64- toInterface (AIR.ComplexType t) = Complex $ toInterface t- toInterface (AIR.UserType s) = UserType s- toInterface (AIR.ArrayType (LiteralLen l) t) = SizedArray l $ toInterface t- toInterface (AIR.ArrayType _ t) = Array $ toInterface t- toInterface (AIR.StructType fields) = Struct $ map (\(name,t) -> (name,toInterface t)) fields- fromInterface Void = VoidType- fromInterface Boolean = AIR.BoolType- fromInterface Bit = BitType- fromInterface Floating = AIR.FloatType- fromInterface I8 = NumType Signed S8- fromInterface I16 = NumType Signed S16- fromInterface I32 = NumType Signed S32- fromInterface I40 = NumType Signed S40- fromInterface I64 = NumType Signed S64- fromInterface U8 = NumType Unsigned S8- fromInterface U16 = NumType Unsigned S16- fromInterface U32 = NumType Unsigned S32- fromInterface U40 = NumType Unsigned S40- fromInterface U64 = NumType Unsigned S64- fromInterface (Complex t) = AIR.ComplexType $ fromInterface t- fromInterface (UserType s) = AIR.UserType s- fromInterface (Array t) = AIR.ArrayType UndefinedLen $ fromInterface t- fromInterface (SizedArray l t) = AIR.ArrayType (LiteralLen l) $ fromInterface t- fromInterface (Struct fields) = AIR.StructType $ map (\(name,t) -> (name,fromInterface t)) fields--instance Interface Expr where- type Repr Expr = Expression ()- toInterface (VarExpr (AIR.Variable name t Value ()) ()) = Var (toInterface t) name- toInterface (VarExpr (AIR.Variable name t AIR.Pointer ()) ()) = Ptr (toInterface t) name- toInterface (ArrayElem arr idx () ()) = (toInterface arr) :!: (toInterface idx)- toInterface (StructField str field () ()) = (toInterface str) :.: field- toInterface (ConstExpr (BoolConst True () ()) ()) = Tr- toInterface (ConstExpr (BoolConst False () ()) ()) = Fl- toInterface (ConstExpr (IntConst x t () ()) ()) = LitI (toInterface t) x- toInterface (ConstExpr (FloatConst x () ()) ()) = LitF x- toInterface (ConstExpr (ComplexConst r i () ()) ()) = LitC (toInterface $ ConstExpr r ()) (toInterface $ ConstExpr i ())- toInterface (FunctionCall (Function name t Prefix) ps () ()) = Fun (toInterface t) name $ map toInterface ps- toInterface (FunctionCall (Function name t Infix) ps () ()) = Binop (toInterface t) name $ map toInterface ps- toInterface (AIR.Cast t e () ()) = Cast (toInterface t) (toInterface e)- toInterface (SizeOf (Left t) () ()) = SizeofT $ toInterface t- toInterface (SizeOf (Right e) () ()) = SizeofE $ toInterface e- fromInterface (Var t name) = VarExpr (AIR.Variable name (fromInterface t) Value ()) ()- fromInterface (Ptr t name) = VarExpr (AIR.Variable name (fromInterface t) AIR.Pointer ()) ()- fromInterface (Tr) = ConstExpr (BoolConst True () ()) ()- fromInterface (Fl) = ConstExpr (BoolConst False () ()) ()- fromInterface (LitI t x) = ConstExpr (IntConst x (fromInterface t) () ()) ()- fromInterface (LitF x) = ConstExpr (FloatConst x () ()) ()- fromInterface (LitC (fromInterface -> (ConstExpr r ())) (fromInterface -> (ConstExpr i ()))) =- ConstExpr (ComplexConst r i () ()) ()- fromInterface (LitC _ _) = error "Illegal LitC" -- TODO (?)- fromInterface (Binop t name es) = FunctionCall (Function name (fromInterface t) Infix) (map fromInterface es) () ()- fromInterface (Fun t name es) = FunctionCall (Function name (fromInterface t) Prefix) (map fromInterface es) () ()- fromInterface (Cast t e) = AIR.Cast (fromInterface t) (fromInterface e) () ()- fromInterface (SizeofE e) = SizeOf (Right $ fromInterface e) () ()- fromInterface (SizeofT t) = SizeOf (Left $ fromInterface t) () ()- fromInterface (arr :!: idx) = ArrayElem (fromInterface arr) (fromInterface idx) () ()- fromInterface (str :.: field) = StructField (fromInterface str) field () ()--instance Interface Prog where- type Repr Prog = AIR.Program ()- toInterface (Empty () ()) = Skip- toInterface (AIR.Comment True s () ()) = BComment s- toInterface (AIR.Comment False s () ()) = Comment s- toInterface (Assign lhs rhs () ()) = (toInterface lhs) := (toInterface rhs)- toInterface (ProcedureCall s ps () ()) = Call s (map toInterface ps)- toInterface (Sequence ps () ()) = Seq (map toInterface ps)- toInterface (Branch e b1 b2 () ()) = If (toInterface e) (toProg b1) (toProg b2)- toInterface (SeqLoop e pe b () ()) = While (toProg pe) (toInterface e) (toProg b)- toInterface (ParLoop v e i b () ()) = For (varName v) (toInterface e) i (toProg b)- toInterface (BlockProgram b ()) = Block (map toInterface $ locals b) (toInterface $ blockBody b)- fromInterface (Skip) = Empty () ()- fromInterface (BComment s) = AIR.Comment True s () ()- fromInterface (Comment s) = AIR.Comment False s () ()- fromInterface (lhs := rhs) = Assign (fromInterface lhs) (fromInterface rhs) () ()- fromInterface (Call s ps) = ProcedureCall s (map fromInterface ps) () ()- fromInterface (Seq ps) = Sequence (map fromInterface ps) () ()- fromInterface (If e p1 p2) = Branch (fromInterface e) (toBlock p1) (toBlock p2) () ()- fromInterface (While pe e p) = SeqLoop (fromInterface e) (toBlock pe) (toBlock p) () ()- fromInterface (For s e i p) = ParLoop- (AIR.Variable s (NumType Unsigned S32) Value ()) (fromInterface e) i (toBlock p) () ()- fromInterface (Block ds p) = BlockProgram (AIR.Block (map fromInterface ds) (fromInterface p) ()) ()--instance Interface Param where- type Repr Param = ActualParameter ()- toInterface (AIR.In e ()) = In (toInterface e)- toInterface (AIR.Out e ()) = Out (toInterface e)- fromInterface (In e) = AIR.In (fromInterface e) ()- fromInterface (Out e) = AIR.Out (fromInterface e) ()--instance Interface Def where- type Repr Def = Declaration ()- toInterface (Declaration v (Just e) ()) = Init (toInterface $ varType v) (varName v) (toInterface e)- toInterface (Declaration v Nothing ()) = Def (toInterface $ varType v) (varName v)- fromInterface (Init t s e) = Declaration (AIR.Variable s (fromInterface t) Value ()) (Just $ fromInterface e) ()- fromInterface (Def t s) = Declaration (AIR.Variable s (fromInterface t) Value ()) Nothing ()--instance Interface Block where- type Repr Block = AIR.Block ()- toInterface (AIR.Block ds p ()) = Bl (map toInterface ds) (toInterface p)- fromInterface (Bl ds p) = AIR.Block (map fromInterface ds) (fromInterface p) ()--instance Interface Var where- type Repr Var = AIR.Variable ()- toInterface (AIR.Variable name typ Value ()) = Variable (toInterface typ) name- toInterface (AIR.Variable name typ AIR.Pointer ()) = Pointer (toInterface typ) name- fromInterface (Variable typ name) = AIR.Variable name (fromInterface typ) Value ()- fromInterface (Pointer typ name) = AIR.Variable name (fromInterface typ) AIR.Pointer ()--toBlock :: Prog -> AIR.Block ()-toBlock (Block ds p) = AIR.Block (map fromInterface ds) (fromInterface p) ()-toBlock p = AIR.Block [] (fromInterface p) ()--toProg :: AIR.Block () -> Prog-toProg (AIR.Block [] p ()) = toInterface p-toProg (AIR.Block ds p ()) = Block (map toInterface ds) (toInterface p)--boolToExpr :: Bool -> Expr-boolToExpr True = Tr-boolToExpr False = Fl--setLength :: Expr -> Expr -> Prog-setLength arr len = Call "setLength" [Out arr, In len]--increaseLength :: Expr -> Expr -> Prog-increaseLength arr len = Call "increaseLength" [Out arr, In len]--copyProg :: Expr -> Expr -> Prog-copyProg outExp inExp = Call "copy" [Out outExp, In inExp]--copyProgPos :: Expr -> Expr -> Expr -> Prog-copyProgPos outExp shift inExp = Call "copyArrayPos" [Out outExp, In shift, In inExp]--copyProgLen :: Expr -> Expr -> Expr -> Prog-copyProgLen outExp inExp len = Call "copyArrayLen" [Out outExp, In inExp, In len]--instance Show Type- where- show Void = "void"- show Boolean = "bool"- show Bit = "bit"- show Floating = "float"- show I8 = "int8"- show I16 = "int16"- show I32 = "int32"- show I40 = "int40"- show I64 = "int64"- show U8 = "uint8"- show U16 = "uint16"- show U32 = "uint32"- show U40 = "uint40"- show U64 = "uint64"- show (Complex t) = "complexOf_" ++ show t- show (UserType s) = "userType_" ++ s- show (Array t) = "arrayOf_" ++ show t- show (SizedArray i t) = "arrayOfSize_" ++ show i ++ "_" ++ show t- show (Struct fields) = "struct_" ++ intercalate "_" (map (\(s,t) -> s ++ "_" ++ show t) fields)--instance HasType Expr- where- type TypeOf Expr = Type- typeof = toInterface . typeof . fromInterface--intWidth :: Type -> Maybe Integer-intWidth I8 = Just 8-intWidth I16 = Just 16-intWidth I32 = Just 32-intWidth I40 = Just 40-intWidth I64 = Just 64-intWidth U8 = Just 8-intWidth U16 = Just 16-intWidth U32 = Just 32-intWidth U40 = Just 40-intWidth U64 = Just 64-intWidth _ = Nothing--intSigned :: Type -> Maybe Bool-intSigned I8 = Just True-intSigned I16 = Just True-intSigned I32 = Just True-intSigned I40 = Just True-intSigned I64 = Just True-intSigned U8 = Just False-intSigned U16 = Just False-intSigned U32 = Just False-intSigned U40 = Just False-intSigned U64 = Just False-intSigned _ = Nothing--litB :: Bool -> Expr-litB True = Tr-litB False = Fl--isArray :: Type -> Bool-isArray (Array _) = True-isArray (SizedArray _ _) = True-isArray _ = False
− Feldspar/Compiler/Imperative/Plugin/ConstantFolding.hs
@@ -1,68 +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 #-}--module Feldspar.Compiler.Imperative.Plugin.ConstantFolding where--import Feldspar.Transformation--data ConstantFolding = ConstantFolding--instance Plugin ConstantFolding where- type ExternalInfo ConstantFolding = ()- executePlugin ConstantFolding _ procedure = result $ transform ConstantFolding () () procedure--instance Transformation ConstantFolding where- type From ConstantFolding = ()- type To ConstantFolding = ()- type Down ConstantFolding = ()- type Up ConstantFolding = ()- type State ConstantFolding = ()--instance Transformable ConstantFolding Expression where- transform t s d f@(FunctionCall _ _ _ _) = case funMode $ function f' of- Infix -> case funName $ function f' of- "+" -> tr' $ elimParamIf (isConstIntN 0) True $ result tr- "-" -> tr' $ elimParamIf (isConstIntN 0) False $ result tr- "*" -> tr' $ elimParamIf (isConstIntN 1) True $ result tr- _ -> tr- _ -> tr- where- tr = defaultTransform t s d f- tr' x = tr {result = x}- f' = result tr- isConstIntN n (ConstExpr (IntConst i _ _ _) _) = n == i- isConstIntN _ _ = False-- elimParamIf pred flippable funCall@(FunctionCall (Function _ _ Infix) (x:xs) _ _)- | pred (head xs) = x- | flippable && pred x = head xs- | otherwise = funCall- elimParamIf _ _ funCall = funCall- transform t s d e = defaultTransform t s d e
− Feldspar/Compiler/Imperative/Plugin/Naming.hs
@@ -1,161 +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 EmptyDataDecls, TypeFamilies #-}--module Feldspar.Compiler.Imperative.Plugin.Naming where--import Data.Char--import Feldspar.Transformation-import Feldspar.Core.Types--import qualified Feldspar.NameExtractor as Precompiler-import Feldspar.Compiler.Error-import Feldspar.Compiler.Backend.C.Library--import System.IO.Unsafe---- ===========================================================================--- == Precompilation plugin--- ===========================================================================--data SignatureInformation = SignatureInformation {- originalFunctionName :: String,- generatedImperativeParameterNames :: [String],- originalParameterNames :: Maybe [Maybe String]-} deriving (Show, Eq)--instance Default SignatureInformation where def = precompilationError InternalError "Default value should not be used"--precompilationError = handleError "PluginArch/Naming"--data Precompilation = Precompilation--instance Transformation Precompilation where- type From Precompilation = ()- type To Precompilation = ()- type Down Precompilation = SignatureInformation- type Up Precompilation = ()- type State Precompilation = ()---instance Transformable Precompilation Entity where- transform t s d x@(ProcDef n i _ _ _ _) | n == "PLACEHOLDER" = tr { result = (result tr){ procName = n' } } where- d' = d { generatedImperativeParameterNames = map varName i }- tr = defaultTransform t s d' x- n' = originalFunctionName d- transform t s d x = defaultTransform t s d x--instance Transformable Precompilation Variable where- transform t s d v = Result newVar s def where- newVar = v - { varName = (maybeStr2Str $ getVariableName d (varName v)) ++ varName v- , varLabel = ()- }--getVariableName :: SignatureInformation -> String -> Maybe String-getVariableName signatureInformation origname = case (originalParameterNames signatureInformation) of- Just originalParameterNameList ->- if length (generatedImperativeParameterNames signatureInformation) == length originalParameterNameList then- case searchResults of- [] -> Nothing- otherwise -> snd $ head $ searchResults- else- precompilationError InternalError $ "parameter name list length mismatch:" ++- show (generatedImperativeParameterNames signatureInformation) ++ " " ++ show originalParameterNameList- where- searchResults = filter (((==) origname).fst)- (zip (generatedImperativeParameterNames signatureInformation) originalParameterNameList)- Nothing -> Nothing--maybeStr2Str :: Maybe String -> String-maybeStr2Str (Just s) = s ++ "_"-maybeStr2Str Nothing = ""--data PrecompilationExternalInfo = PrecompilationExternalInfo {- originalFunctionSignature :: Precompiler.OriginalFunctionSignature, - inputParametersDescriptor :: [Int],- numberOfFunctionArguments :: Int,- compilationMode :: CompilationMode-}--addPostfixNumberToMaybeString :: (Maybe String, Int) -> Maybe String-addPostfixNumberToMaybeString (ms, num) = case ms of- Just s -> Just $ s ++ (show num)- Nothing -> Nothing- -inflate :: Int -> [Maybe String] -> [Maybe String]-inflate target list | length list < target = inflate target (list++[Nothing])- | length list == target = list- | otherwise = precompilationError InternalError "Unexpected situation in 'inflate'"- --- Replicates each element of the [parameter list given by the precompiler] based on the input parameter descriptor-parameterNameListConsolidator :: PrecompilationExternalInfo -> [Maybe String]-parameterNameListConsolidator externalInfo =- if (numberOfFunctionArguments externalInfo == (length $ inputParametersDescriptor externalInfo))- then- concat $ map (\(cnt,name)->replicate cnt name) - (zip (inputParametersDescriptor externalInfo)- (Precompiler.originalParameterNames $ originalFunctionSignature externalInfo))- else- precompilationError InternalError "numArgs should be equal to the length of the input parameters' descriptor"--instance Plugin Precompilation where- type ExternalInfo Precompilation = PrecompilationExternalInfo- executePlugin Precompilation externalInfo procedure = result- $ transform Precompilation ({-state-}) (SignatureInformation {- originalFunctionName = Precompiler.originalFunctionName $ originalFunctionSignature externalInfo,- generatedImperativeParameterNames = precompilationError InternalError "GIPN should have been overwritten", - originalParameterNames = case compilationMode externalInfo of- Standalone ->- if -- ultimate check, should be enough...- numberOfFunctionArguments externalInfo ==- length (Precompiler.originalParameterNames $ originalFunctionSignature externalInfo)- then- Just $ parameterNameListConsolidator externalInfo- else- (unsafePerformIO $ do- withColor Yellow $ putStrLn $ "[WARNING @ PluginArch/Naming]:"++- " not enough named parameters in function " ++ - (Precompiler.originalFunctionName $ originalFunctionSignature externalInfo)- withColor Yellow $ putStrLn $ "numArgs: " ++ show (numberOfFunctionArguments externalInfo) ++- ", parameter list: " ++ show (Precompiler.originalParameterNames $- originalFunctionSignature externalInfo) - return $ Just $ parameterNameListConsolidator (externalInfo {- originalFunctionSignature = (originalFunctionSignature externalInfo) {- Precompiler.originalParameterNames =- inflate (numberOfFunctionArguments externalInfo) $- Precompiler.originalParameterNames $- originalFunctionSignature externalInfo- }- })- )- Interactive -> Nothing -- no parameter name handling in interactive mode- }) procedure-
− Feldspar/Compiler/Imperative/Plugin/Unroll.hs
@@ -1,270 +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 FlexibleInstances, TypeFamilies #-}--module Feldspar.Compiler.Imperative.Plugin.Unroll where--import Data.List (elem)--import Feldspar.Compiler.Backend.C.Options-import Feldspar.Transformation---- ============================--- == Unroll's Semantic info ==--- ============================--data SemInfPrg = SemInfPrg- { position :: Int- , varNames :: [String]- , loopVar :: String- } deriving (Eq, Show)--data UnrollSemInf--instance Annotation UnrollSemInf Module where- type Label UnrollSemInf Module = ()--instance Annotation UnrollSemInf Entity where- type Label UnrollSemInf Entity = ()--instance Annotation UnrollSemInf Struct where- type Label UnrollSemInf Struct = ()--instance Annotation UnrollSemInf StructMember where- type Label UnrollSemInf StructMember = ()--instance Annotation UnrollSemInf ProcDef where- type Label UnrollSemInf ProcDef = ()--instance Annotation UnrollSemInf ProcDecl where- type Label UnrollSemInf ProcDecl = ()--instance Annotation UnrollSemInf Block where- type Label UnrollSemInf Block = ()--instance Annotation UnrollSemInf Program where- type Label UnrollSemInf Program = Maybe SemInfPrg--instance Annotation UnrollSemInf Empty where- type Label UnrollSemInf Empty = ()--instance Annotation UnrollSemInf Comment where- type Label UnrollSemInf Comment = ()--instance Annotation UnrollSemInf Assign where- type Label UnrollSemInf Assign = ()--instance Annotation UnrollSemInf ProcedureCall where- type Label UnrollSemInf ProcedureCall = ()--instance Annotation UnrollSemInf Sequence where- type Label UnrollSemInf Sequence = ()--instance Annotation UnrollSemInf Branch where- type Label UnrollSemInf Branch = ()--instance Annotation UnrollSemInf SeqLoop where- type Label UnrollSemInf SeqLoop = ()--instance Annotation UnrollSemInf ParLoop where- type Label UnrollSemInf ParLoop = ()--instance Annotation UnrollSemInf ActualParameter where- type Label UnrollSemInf ActualParameter = ()--instance Annotation UnrollSemInf Declaration where- type Label UnrollSemInf Declaration = ()--instance Annotation UnrollSemInf Expression where- type Label UnrollSemInf Expression = ()--instance Annotation UnrollSemInf FunctionCall where- type Label UnrollSemInf FunctionCall = ()--instance Annotation UnrollSemInf Cast where- type Label UnrollSemInf Cast = ()--instance Annotation UnrollSemInf SizeOf where- type Label UnrollSemInf SizeOf = ()--instance Annotation UnrollSemInf ArrayElem where- type Label UnrollSemInf ArrayElem = ()--instance Annotation UnrollSemInf StructField where- type Label UnrollSemInf StructField = ()--instance Annotation UnrollSemInf Constant where- type Label UnrollSemInf Constant = ()--instance Annotation UnrollSemInf IntConst where- type Label UnrollSemInf IntConst = ()--instance Annotation UnrollSemInf FloatConst where- type Label UnrollSemInf FloatConst = ()--instance Annotation UnrollSemInf BoolConst where- type Label UnrollSemInf BoolConst = ()--instance Annotation UnrollSemInf ArrayConst where- type Label UnrollSemInf ArrayConst = ()--instance Annotation UnrollSemInf ComplexConst where- type Label UnrollSemInf ComplexConst = ()--instance Annotation UnrollSemInf Variable where- type Label UnrollSemInf Variable = ()---- ==--- == Plugin--- ==--instance Default Bool where- def = False--instance Combine Bool where- combine = (||)--instance Default (Maybe SemInfPrg) where def = Nothing ---instance Plugin UnrollPlugin where- type ExternalInfo UnrollPlugin = UnrollStrategy- executePlugin UnrollPlugin ei p = case ei of- NoUnroll -> p- Unroll unrollCount -> result $ transform Unroll_2 () Nothing $ result $ transform Unroll_1 () unrollCount p- -data UnrollPlugin = UnrollPlugin-instance Transformation UnrollPlugin where- type From UnrollPlugin = ()- type To UnrollPlugin = ()- type Down UnrollPlugin = ()- type Up UnrollPlugin = ()- type State UnrollPlugin = ()--data Unroll_1 = Unroll_1-instance Transformation Unroll_1 where- type From Unroll_1 = ()- type To Unroll_1 = UnrollSemInf- type Down Unroll_1 = Int- type Up Unroll_1 = Bool- type State Unroll_1 = ()--instance Transformable Unroll_1 Program where- transform t s d p@(ParLoop _ _ _ _ _ _)- | up tr == False && unrollPossible = tr'- | otherwise = tr- where- tr = defaultTransform t s d p- tr' = tr - { result = (result tr)- { pLoopStep = d- , pLoopBlock = loopCore- { locals = unrollDecls- , blockBody = Sequence prgs () Nothing- }- }- , up = True- }- prgs = map (\(i,p) -> p{ programLabel = (Just $ SemInfPrg i varNames loopCounter) }) $ zip [0,1..] replPrg- replPrg = replicate d $ blockBody loopCore- unrollDecls = concat $ map (\(i,ds) -> renameDecls ds i) $ zip [0,1..] replDecls- renameDecls ds i = map (\d -> renameDeclaration d ((getVarNameDecl d) ++ "_u" ++ (show i))) ds- replDecls = replicate d $ locals loopCore- loopCore = pLoopBlock $ result tr - loopBound = pLoopBound $ result tr- loopCounter = varName $ pLoopCounter $ result tr- varNames = map (\d -> getVarNameDecl d) $ locals loopCore- unrollPossible = case loopBound of- (ConstExpr (IntConst i _ _ _) _) -> mod i (toInteger d) == 0- _ -> False- transform t s d p = defaultTransform t s d p---data Unroll_2 = Unroll_2 -instance Transformation Unroll_2 where- type From Unroll_2 = UnrollSemInf- type To Unroll_2 = ()- type Down Unroll_2 = Maybe SemInfPrg- type Up Unroll_2 = ()- type State Unroll_2 = ()--instance Transformable Unroll_2 Program where- transform t s d p = defaultTransform t s d' p where- d' = case programLabel p of- Nothing -> d- x -> x --instance Transformable Unroll_2 Expression where- transform t s d l = case d of- Nothing -> tr- Just x -> case l of- VarExpr n _- | varName n == loopVar x -> tr - { result = FunctionCall - { function = Function- { funName = "+"- , returnType = NumType Signed S32- , funMode = Infix- }- , funCallParams = - [ result tr- , ConstExpr (IntConst (toInteger $ position x) (NumType Signed S32) () ()) ()- ]- , funCallLabel = ()- , exprLabel = ()- }- }- | otherwise -> tr- _ -> tr- where- tr = defaultTransform t s d l---instance Transformable Unroll_2 Variable where- transform t s d v = case d of- Just x- | (varName v) `elem` (varNames x) -> tr- { result = (result tr)- { varName = (varName v) ++ "_u" ++ (show $ position x)- , varLabel = ()- }- }- | otherwise -> tr- Nothing -> tr- where- tr = defaultTransform t s d v----- helper functions : -isJust (Just x) = True-isJust _ = False-getVarNameDecl d = varName $ declVar d-renameDeclaration d n = d { declVar = renameVariable (declVar d) n }-renameVariable v n = v { varName = n }-
− Feldspar/Compiler/Imperative/Representation.hs
@@ -1,571 +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, UndecidableInstances, OverlappingInstances #-}-module Feldspar.Compiler.Imperative.Representation where--import Data.Typeable-import qualified Data.List as List (find)--import Feldspar.Compiler.Error---- ===============================================================================================--- == Class defining semantic information attached to different nodes in the imperative program ==--- ===============================================================================================--class Annotation t s where- type Label t s--instance Annotation () s where- type Label () s = ()---- =================================================--- == Data stuctures to store imperative programs ==--- =================================================--data Module t = Module- { entities :: [Entity t]- , moduleLabel :: Label t Module- }- deriving Typeable--deriving instance (ShowLabel t) => Show (Module t)-deriving instance (EqLabel t) => Eq (Module t) --data Entity t- = StructDef- { structName :: String- , structMembers :: [StructMember t]- , structLabel :: Label t Struct- , definitionLabel :: Label t Entity- }- | ProcDef- { procName :: String- , inParams :: [Variable t]- , outParams :: [Variable t]- , procBody :: Block t- , procDefLabel :: Label t ProcDef- , definitionLabel :: Label t Entity- }- | ProcDecl- { procName :: String- , inParams :: [Variable t]- , outParams :: [Variable t]- , procDeclLabel :: Label t ProcDecl- , definitionLabel :: Label t Entity- }- deriving Typeable--deriving instance (ShowLabel t) => Show (Entity t)-deriving instance (EqLabel t) => Eq (Entity t) --data StructMember t = StructMember- { structMemberName :: String- , structMemberType :: Type- , structMemberLabel :: Label t StructMember- }- deriving Typeable--deriving instance (ShowLabel t) => Show (StructMember t)-deriving instance (EqLabel t) => Eq (StructMember t)--data Block t = Block- { locals :: [Declaration t]- , blockBody :: Program t- , blockLabel :: Label t Block- }- deriving Typeable--deriving instance (ShowLabel t) => Show (Block t)-deriving instance (EqLabel t) => Eq (Block t)--data Program t- = Empty- { emptyLabel :: Label t Empty- , programLabel :: Label t Program- }- | Comment- { isBlockComment :: Bool- , commentValue :: String- , commentLabel :: Label t Comment- , programLabel :: Label t Program- }- | Assign- { lhs :: Expression t- , rhs :: Expression t- , assignLabel :: Label t Assign- , programLabel :: Label t Program- }- | ProcedureCall- { procCallName :: String- , procCallParams :: [ActualParameter t]- , procCallLabel :: Label t ProcedureCall- , programLabel :: Label t Program- }- | Sequence- { sequenceProgs :: [Program t]- , sequenceLabel :: Label t Sequence- , programLabel :: Label t Program- }- | Branch- { branchCond :: Expression t- , thenBlock :: Block t- , elseBlock :: Block t- , branchLabel :: Label t Branch- , programLabel :: Label t Program- }- | SeqLoop- { sLoopCond :: Expression t- , sLoopCondCalc :: Block t- , sLoopBlock :: Block t- , sLoopLabel :: Label t SeqLoop- , programLabel :: Label t Program- }- | ParLoop- { pLoopCounter :: Variable t- , pLoopBound :: Expression t- , pLoopStep :: Int- , pLoopBlock :: Block t- , pLoopLabel :: Label t ParLoop- , programLabel :: Label t Program- }- | BlockProgram- { blockProgram :: Block t- , programLabel :: Label t Program- }- deriving Typeable--deriving instance (ShowLabel t) => Show (Program t)-deriving instance (EqLabel t) => Eq (Program t)--data ActualParameter t- = In- { inParam :: Expression t- , actParamLabel :: Label t ActualParameter- }- | Out- { outParam :: Expression t- , actParamLabel :: Label t ActualParameter- }- deriving Typeable--deriving instance (ShowLabel t) => Show (ActualParameter t)-deriving instance (EqLabel t) => Eq (ActualParameter t)--data Declaration t = Declaration- { declVar :: Variable t- , initVal :: Maybe (Expression t)- , declLabel :: Label t Declaration- }- deriving Typeable--deriving instance (ShowLabel t) => Show (Declaration t)-deriving instance (EqLabel t) => Eq (Declaration t)--data Expression t- = VarExpr- { var :: Variable t- , exprLabel :: Label t Expression- }- | ArrayElem- { array :: Expression t- , arrayIndex :: Expression t- , arrayLabel :: Label t ArrayElem- , exprLabel :: Label t Expression- }- | StructField- { struct :: Expression t- , fieldName :: String- , structFieldLabel :: Label t StructField- , exprLabel :: Label t Expression- }- | ConstExpr- { constExpr :: Constant t- , exprLabel :: Label t Expression- }- | FunctionCall- { function :: Function- , funCallParams :: [Expression t]- , funCallLabel :: Label t FunctionCall- , exprLabel :: Label t Expression- }- | Cast- { castType :: Type- , castExpr :: Expression t- , castLabel :: Label t Cast- , exprLabel :: Label t Expression- }- | SizeOf- { sizeOf :: Either Type (Expression t)- , sizeOfLabel :: Label t SizeOf- , exprLabel :: Label t Expression- }- deriving Typeable--deriving instance (ShowLabel t) => Show (Expression t)-deriving instance (EqLabel t) => Eq (Expression t)--data Function = Function {- funName :: String- , returnType :: Type- , funMode :: FunctionMode-} deriving (Eq, Show)--data Constant t- = IntConst- { intValue :: Integer- , intType :: Type- , intConstLabel :: Label t IntConst- , constLabel :: Label t Constant- }- | FloatConst- { floatValue :: Double- , floatConstLabel :: Label t FloatConst- , constLabel :: Label t Constant- }- | BoolConst- { boolValue :: Bool- , boolConstLabel :: Label t BoolConst- , constLabel :: Label t Constant- }- -- | ArrayConst- -- { arrayValues :: [Constant t]- -- , arrayConstLabel :: Label t ArrayConst- -- , constLabel :: Label t Constant- -- }- | ComplexConst- { realPartComplexValue :: Constant t- , imagPartComplexValue :: Constant t- , complexConstLabel :: Label t ComplexConst- , constLabel :: Label t Constant- }- deriving Typeable--deriving instance (ShowLabel t) => Show (Constant t)-deriving instance (EqLabel t) => Eq (Constant t)--data Variable t = Variable- { varName :: String- , varType :: Type- , varRole :: VariableRole- , varLabel :: Label t Variable- }- deriving Typeable--deriving instance (ShowLabel t) => Show (Variable t)-deriving instance (EqLabel t) => Eq (Variable t)---- ======================--- == Basic structures ==--- ======================--data Length =- LiteralLen Int- | UndefinedLen- deriving (Eq,Show)--data Size = S8 | S16 | S32 | S40 | S64- deriving (Eq,Show)--data Signedness = Signed | Unsigned- deriving (Eq,Show)--data Type =- VoidType- | BoolType- | BitType- | FloatType- | NumType Signedness Size- | ComplexType Type- | UserType String- | ArrayType Length Type- | StructType [(String, Type)]- deriving (Eq,Show)--data FunctionMode = Prefix | Infix- deriving (Eq,Show)--data VariableRole = Value | Pointer- deriving (Eq,Show)--------------------------- Type inference ---------------------------class HasType a where- type TypeOf a- typeof :: a -> TypeOf a--instance HasType (Variable t) where- type TypeOf (Variable t) = Type- typeof (Variable r t s _) = t --instance (ShowLabel t) => HasType (Constant t) where- type TypeOf (Constant t) = Type- typeof (IntConst _ t _ _) = t- typeof (FloatConst _ _ _) = FloatType- typeof (BoolConst _ _ _) = BoolType- typeof (ComplexConst r i _ _) = ComplexType (typeof r)--instance (ShowLabel t) => HasType (Expression t) where- type TypeOf (Expression t) = Type- typeof (VarExpr v _) = typeof v- typeof (ArrayElem n i _ _) = decrArrayDepth (typeof n)- where- decrArrayDepth :: Type -> Type- decrArrayDepth (ArrayType _ t) = t- decrArrayDepth t = reprError InternalError $ "Non-array variable is indexed! " ++ show t- typeof (StructField s f _ _) = getStructFieldType f (typeof s)- where- 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 = reprError InternalError $- "Trying to get a struct field from not a struct typed expression\n" ++ "Field: " ++ f ++ "\nType: " ++ show t- structFieldNotFound f = reprError InternalError $ "Not found struct field with this name: " ++ f- typeof (ConstExpr c _) = typeof c- typeof (FunctionCall f p _ _) = returnType f- typeof (Cast t e _ _) = t- typeof (SizeOf s _ _) = NumType Signed S32--instance (ShowLabel t) => HasType (ActualParameter t) where- type TypeOf (ActualParameter t) = Type- typeof (In e _) = typeof e- typeof (Out l _) = typeof l--reprError = handleError "Feldspar.Compiler.Imperative.Representation"---- =====================--- == Technical types ==--- =====================--data Struct t-data ProcDef t-data ProcDecl t-data Empty t-data Comment t-data Assign t-data ProcedureCall t-data Sequence t-data Branch t-data SeqLoop t-data ParLoop t-data FunctionCall t-data Cast t-data SizeOf t-data ArrayElem t-data StructField t-data LeftFunCall t-data IntConst t-data FloatConst t-data BoolConst t-data ArrayConst t-data ComplexConst t---- ==========================--- == Show and Eq instance ==--- ==========================--class ( Show (Label t Module)- , Show (Label t Entity)- , Show (Label t Struct)- , Show (Label t ProcDef)- , Show (Label t ProcDecl)- , Show (Label t StructMember)- , Show (Label t Block)- , Show (Label t Program)- , Show (Label t Empty)- , Show (Label t Comment)- , Show (Label t Assign)- , Show (Label t ProcedureCall)- , Show (Label t Sequence)- , Show (Label t Branch)- , Show (Label t SeqLoop)- , Show (Label t ParLoop)- , Show (Label t ActualParameter)- , Show (Label t Declaration)- , Show (Label t Expression)- , Show (Label t FunctionCall)- , Show (Label t Cast)- , Show (Label t SizeOf)- , Show (Label t ArrayElem)- , Show (Label t StructField)- , Show (Label t Constant)- , Show (Label t IntConst)- , Show (Label t FloatConst)- , Show (Label t BoolConst)- , Show (Label t ArrayConst)- , Show (Label t ComplexConst)- , Show (Label t Variable)- ) => ShowLabel t--instance ( Show (Label t Module)- , Show (Label t Entity)- , Show (Label t Struct)- , Show (Label t ProcDef)- , Show (Label t ProcDecl)- , Show (Label t StructMember)- , Show (Label t Block)- , Show (Label t Program)- , Show (Label t Empty)- , Show (Label t Comment)- , Show (Label t Assign)- , Show (Label t ProcedureCall)- , Show (Label t Sequence)- , Show (Label t Branch)- , Show (Label t SeqLoop)- , Show (Label t ParLoop)- , Show (Label t ActualParameter)- , Show (Label t Declaration)- , Show (Label t Expression)- , Show (Label t FunctionCall)- , Show (Label t Cast)- , Show (Label t SizeOf)- , Show (Label t ArrayElem)- , Show (Label t StructField)- , Show (Label t Constant)- , Show (Label t IntConst)- , Show (Label t FloatConst)- , Show (Label t BoolConst)- , Show (Label t ArrayConst)- , Show (Label t ComplexConst)- , Show (Label t Variable)- ) => ShowLabel t--class ( Eq (Label t Module)- , Eq (Label t Entity)- , Eq (Label t Struct)- , Eq (Label t ProcDef)- , Eq (Label t ProcDecl)- , Eq (Label t StructMember)- , Eq (Label t Block)- , Eq (Label t Program)- , Eq (Label t Empty)- , Eq (Label t Comment)- , Eq (Label t Assign)- , Eq (Label t ProcedureCall)- , Eq (Label t Sequence)- , Eq (Label t Branch)- , Eq (Label t SeqLoop)- , Eq (Label t ParLoop)- , Eq (Label t ActualParameter)- , Eq (Label t Declaration)- , Eq (Label t Expression)- , Eq (Label t FunctionCall)- , Eq (Label t Cast)- , Eq (Label t SizeOf)- , Eq (Label t StructField)- , Eq (Label t ArrayElem)- , Eq (Label t Constant)- , Eq (Label t IntConst)- , Eq (Label t FloatConst)- , Eq (Label t BoolConst)- , Eq (Label t ArrayConst)- , Eq (Label t ComplexConst)- , Eq (Label t Variable)- ) => EqLabel t--instance ( Eq (Label t Module)- , Eq (Label t Entity)- , Eq (Label t Struct)- , Eq (Label t ProcDef)- , Eq (Label t ProcDecl)- , Eq (Label t StructMember)- , Eq (Label t Block)- , Eq (Label t Program)- , Eq (Label t Empty)- , Eq (Label t Comment)- , Eq (Label t Assign)- , Eq (Label t ProcedureCall)- , Eq (Label t Sequence)- , Eq (Label t Branch)- , Eq (Label t SeqLoop)- , Eq (Label t ParLoop)- , Eq (Label t ActualParameter)- , Eq (Label t Declaration)- , Eq (Label t Expression)- , Eq (Label t FunctionCall)- , Eq (Label t Cast)- , Eq (Label t SizeOf)- , Eq (Label t StructField)- , Eq (Label t ArrayElem)- , Eq (Label t Constant)- , Eq (Label t IntConst)- , Eq (Label t FloatConst)- , Eq (Label t BoolConst)- , Eq (Label t ArrayConst)- , Eq (Label t ComplexConst)- , Eq (Label t Variable)- ) => EqLabel t---- * Set and get labels--class Labeled c where- label :: c t -> Label t c- setLabel :: c t -> Label t c -> c t--instance Labeled Module where- label = moduleLabel- setLabel c lab = c{ moduleLabel = lab }--instance Labeled Entity where- label = definitionLabel- setLabel c lab = c{ definitionLabel = lab }--instance Labeled Program where- label = programLabel- setLabel c lab = c{ programLabel = lab }--instance Labeled Declaration where- label = declLabel- setLabel c lab = c{ declLabel = lab }--instance Labeled Constant where- label = constLabel- setLabel c lab = c{ constLabel = lab }--instance Labeled StructMember where- label = structMemberLabel- setLabel c lab = c{ structMemberLabel = lab }--instance Labeled Variable where- label = varLabel- setLabel c lab = c{ varLabel = lab }--instance Labeled Expression where- label = exprLabel- setLabel c lab = c{ exprLabel = lab }--instance Labeled ActualParameter where- label = actParamLabel- setLabel c lab = c{ actParamLabel = lab }--instance Labeled Block where- label = blockLabel- setLabel c lab = c{ blockLabel = lab }
− Feldspar/Compiler/Imperative/TransformationInstance.hs
@@ -1,171 +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 UndecidableInstances, OverlappingInstances #-} --module Feldspar.Compiler.Imperative.TransformationInstance where---import Feldspar.Transformation.Framework-import Feldspar.Compiler.Imperative.Representation---- =========================================--- == Classes for the plugin architecture ==--- =========================================- --- class to simplify contexts-class (Transformation t, Convert (Label (From t) s) (Label (To t) s), Default (Label (To t) s)) => Conversion t s--instance (Transformation t, Convert (Label (From t) s) (Label (To t) s), Default (Label (To t) s)) => Conversion t s---- ====================--- == Transformation ==--- ====================--instance (Transformable1 t [] Entity, Conversion t Module)- => DefaultTransformable t Module where- defaultTransform t s d (Module m inf) = Result (Module (result1 tr) $ convert inf) (state1 tr) (up1 tr) where- tr = transform1 t s d m--instance (Transformable1 t [] StructMember, Transformable1 t [] Variable, Transformable t Block, Transformable t Declaration, Conversion t Entity, Conversion t Struct, Conversion t ProcDef, Conversion t ProcDecl)- => DefaultTransformable t Entity where- defaultTransform t s d (StructDef n m inf1 inf2) =- Result (StructDef n (result1 tr) (convert inf1) $ convert inf2) (state1 tr) (up1 tr) where- tr = transform1 t s d m- defaultTransform t s d (ProcDef n i o p inf1 inf2) =- Result (ProcDef n (result1 tr1) (result1 tr2) (result tr3) (convert inf1) $ convert inf2)- (state tr3) (foldl combine (up1 tr1) [up1 tr2, up tr3]) where- tr1 = transform1 t s d i- tr2 = transform1 t (state1 tr1) d o- tr3 = transform t (state1 tr2) d p- defaultTransform t s d (ProcDecl name inp outp inf1 inf2) =- Result (ProcDecl name (result1 tr1) (result1 tr2) (convert inf1) (convert inf2))- (state1 tr2) (foldl1 combine [up1 tr1, up1 tr2]) where- tr1 = transform1 t s d inp- tr2 = transform1 t (state1 tr1) d outp--instance (Conversion t StructMember, Default (Up t))- => DefaultTransformable t StructMember where- defaultTransform t s d (StructMember n typ inf) = Result (StructMember n typ $ convert inf) s def--instance (Transformable1 t [] Declaration, Transformable t Program, Conversion t Block)- => DefaultTransformable t Block where- defaultTransform t s d (Block l b inf) = Result (Block (result1 tr1) (result tr2) $ convert inf) (state tr2) (combine (up1 tr1) (up tr2)) where- tr1 = transform1 t s d l- tr2 = transform t (state1 tr1) d b--instance (Transformable1 t [] Program, Transformable t Expression, Transformable1 t [] ActualParameter, Transformable t Block, Transformable t Variable, Conversion t Program, Conversion t Empty, Conversion t Comment, Conversion t Assign, Conversion t ProcedureCall, Conversion t Sequence, Conversion t Branch, Conversion t SeqLoop, Conversion t ParLoop, Default (Up t))- => DefaultTransformable t Program where- defaultTransform t s d (Empty inf1 inf2) = Result (Empty (convert inf1) $ convert inf2) s def- defaultTransform t s d (Comment b c inf1 inf2) = Result (Comment b c (convert inf1) $ convert inf2) s def- defaultTransform t s d (Assign l r inf1 inf2) = Result (Assign (result tr1) (result tr2) (convert inf1) $ convert inf2) (state tr2) (combine (up tr1) (up tr2)) where- tr1 = transform t s d l- tr2 = transform t (state tr1) d r- defaultTransform t s d (ProcedureCall f par inf1 inf2) = Result (ProcedureCall f (result1 tr) (convert inf1) $ convert inf2) (state1 tr) (up1 tr) where- tr = transform1 t s d par- defaultTransform t s d (Sequence p inf1 inf2) = Result (Sequence (result1 tr) (convert inf1) $ convert inf2) (state1 tr) (up1 tr) where- tr = transform1 t s d p- defaultTransform t s d (Branch e p1 p2 inf1 inf2) = Result (Branch (result tr1) (result tr2) (result tr3) (convert inf1) $ convert inf2) (state tr3) (foldl combine (up tr1) [up tr2, up tr3]) where- tr1 = transform t s d e- tr2 = transform t (state tr1) d p1- tr3 = transform t (state tr2) d p2- defaultTransform t s d (SeqLoop v c p inf1 inf2) = Result (SeqLoop (result tr1) (result tr2) (result tr3) (convert inf1) $ convert inf2) (state tr3) (foldl combine (up tr1) [up tr2, up tr3]) where- tr1 = transform t s d v- tr2 = transform t (state tr1) d c- tr3 = transform t (state tr2) d p- defaultTransform t s d (ParLoop v b i p inf1 inf2) = Result (ParLoop (result tr1) (result tr2) i (result tr3) (convert inf1) $ convert inf2) (state tr3) (foldl combine (up tr1) [up tr2, up tr3]) where- tr1 = transform t s d v- tr2 = transform t (state tr1) d b- tr3 = transform t (state tr2) d p- defaultTransform t s d (BlockProgram b inf) = Result (BlockProgram (result tr) $ convert inf) (state tr) (up tr) where- tr = transform t s d b--instance (Transformable t Expression, Conversion t ActualParameter)- => DefaultTransformable t ActualParameter where- defaultTransform t s d (In p inf) = Result (In (result tr) $ convert inf) (state tr) (up tr) where- tr = transform t s d p- defaultTransform t s d (Out p inf) = Result (Out (result tr) $ convert inf) (state tr) (up tr) where- tr = transform t s d p--instance (Transformable t Variable, Transformable1 t Maybe Expression, Conversion t Declaration)- => DefaultTransformable t Declaration where- defaultTransform 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 d v- tr2 = transform1 t (state tr1) d i--instance (Transformable t Expression, Transformable t Variable, Transformable t Constant, Transformable1 t [] Expression, Conversion t Expression, Conversion t FunctionCall, Conversion t ArrayElem, Conversion t StructField, Conversion t SizeOf, Conversion t Cast, Default (Up t))- => DefaultTransformable t Expression where- defaultTransform t s d (VarExpr v inf) = Result (VarExpr (result tr) $ convert inf) (state tr) (up tr) where- tr = transform t s d v- defaultTransform t s d (ArrayElem a i inf1 inf2) = Result (ArrayElem (result tr1) (result tr2) (convert inf1) (convert inf2)) (state tr2) (combine (up tr1) (up tr2)) where- tr1 = transform t s d a- tr2 = transform t (state tr1) d i- defaultTransform t s d (StructField l n inf1 inf2) = Result (StructField (result tr) n (convert inf1) $ convert inf2) (state tr) (up tr) where- tr = transform t s d l- defaultTransform t s d (ConstExpr c inf) = Result (ConstExpr (result tr) $ convert inf) (state tr) (up tr) where- tr = transform t s d c- defaultTransform t s d (FunctionCall f par inf1 inf2) = - Result (FunctionCall f (result1 tr) (convert inf1) $ convert inf2) (state1 tr) (up1 tr) where- tr = transform1 t s d par- defaultTransform t s d (Cast typ exp inf1 inf2) = Result (Cast typ (result tr) (convert inf1) $ convert inf2) (state tr) (up tr) where- tr = transform t s d exp- defaultTransform t s d (SizeOf par inf1 inf2) = case par of- Left typ -> Result (SizeOf (Left typ) (convert inf1) $ convert inf2) s def- Right exp -> Result (SizeOf (Right $ result tr) (convert inf1) $ convert inf2) (state tr) (up tr) where- tr = transform t s d exp--instance (Transformable t Constant, Transformable1 t [] Constant, Conversion t Constant, Conversion t IntConst, Conversion t FloatConst, Conversion t BoolConst, Conversion t ArrayConst, Conversion t ComplexConst, Default (Up t))- => DefaultTransformable t Constant where- defaultTransform t s d (IntConst c typ inf1 inf2) = Result (IntConst c typ (convert inf1) $ convert inf2) s def- defaultTransform t s d (FloatConst c inf1 inf2) = Result (FloatConst c (convert inf1) $ convert inf2) s def- defaultTransform t s d (BoolConst c inf1 inf2) = Result (BoolConst c (convert inf1) $ convert inf2) s def- -- defaultTransform t s d (ArrayConst c inf1 inf2) = Result (ArrayConst (result1 tr) (convert inf1) $ convert inf2) (state1 tr) (up1 tr) where- -- tr = transform1 t s d c- defaultTransform t s d (ComplexConst re im inf1 inf2) = Result (ComplexConst (result tr1) (result tr2) (convert inf1) $ convert inf2) (state tr2) (combine (up tr1) $ up tr2) where- tr1 = transform t s d re- tr2 = transform t (state tr1) d im--instance (Conversion t Variable, Default (Up t))- => DefaultTransformable t Variable where- defaultTransform t s d (Variable name typ role inf) = Result (Variable name typ role $ convert inf) s def---instance (Transformable t a, Default (Up t), Combine (Up t))- => DefaultTransformable1 t [] a where- defaultTransform1 t s d [] = Result1 [] s def- defaultTransform1 t s d [x] = Result1 [result tr] (state tr) (up tr) where- tr = transform t s d x- defaultTransform1 t s d (x:xs) = Result1 ((result tr1):(result1 tr2)) (state1 tr2) (combine (up tr1) (up1 tr2)) where- tr1 = transform t s d x- tr2 = transform1 t (state tr1) d xs--instance (Transformable t a, Default (Up t))- => DefaultTransformable1 t Maybe a where- defaultTransform1 t s d Nothing = Result1 Nothing s def- defaultTransform1 t s d (Just x) = Result1 (Just $ result tr) (state tr) (up tr) where- tr = transform t s d x
− Feldspar/NameExtractor.hs
@@ -1,147 +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.-----module Feldspar.NameExtractor where--import System.IO-import System.IO.Unsafe-import Language.Haskell.Exts-import Feldspar.Compiler.Error-import Feldspar.Compiler.Backend.C.Library--data OriginalFunctionSignature = OriginalFunctionSignature {- originalFunctionName :: String,- originalParameterNames :: [Maybe String]-} deriving (Show, Eq)--nameExtractorError errorClass msg = handleError "NameExtractor" errorClass msg --neutralName = "\\"++(r 4)++"/\\"++(r 7)++"\n ) ( ')"++(r 6)++"\n( / )"++(r 7)++"\n \\(__)|"- where r n = replicate n ' '--ignore = OriginalFunctionSignature neutralName []--warning msg retval = unsafePerformIO $ do- withColor Yellow $ putStrLn $ "Warning: " ++ msg- return retval---- Module SrcLoc ModuleName [OptionPragma] (Maybe WarningText) (Maybe [ExportSpec]) [ImportDecl] [Decl]-stripModule x = case x of- Module a b c d e f g -> g--stripFunBind :: Decl -> OriginalFunctionSignature-stripFunBind x = case x of- FunBind [Match a b c d e f] ->- OriginalFunctionSignature (stripName b) (map stripPattern c) -- going for name and parameter list- -- "Match SrcLoc Name [Pat] (Maybe Type) Rhs Binds"- FunBind l@((Match a b c d e f):rest) | length l > 1 -> warning- ("Ignoring function " ++ (stripName b) ++- ": multi-pattern function definitions are not compilable as Feldspar functions.") ignore- PatBind a b c d e -> case stripPattern b of- Just functionName -> OriginalFunctionSignature functionName [] -- parameterless declarations (?)- Nothing -> nameExtractorError InternalError ("Unsupported pattern binding: " ++ show b)- TypeSig a b c -> ignore --head b -- we don't need the type signature (yet)- DataDecl a b c d e f g -> ignore- InstDecl a b c d e -> ignore- -- TypeDecl SrcLoc Name [TyVarBind] Type- TypeDecl a b c d -> ignore- unknown -> nameExtractorError InternalError ("Unexpected language element [SFB/1]: " ++ show unknown- ++ "\nPlease file a feature request with an example attached.")--stripPattern :: Pat -> Maybe String-stripPattern (PVar x) = Just $ stripName x-stripPattern PWildCard = Nothing-stripPattern (PAsPat x _) = Just $ stripName x-stripPattern (PParen pattern) = stripPattern pattern-stripPattern _ = Nothing--stripName :: Name -> String-stripName (Ident a) = a-stripName (Symbol a) = a--stripModule2 (Module a b c d e f g) = b--stripModuleName (ModuleName x) = x--getModuleName :: FilePath -> String -> String -- filename, filecontents -> modulename-getModuleName fileName = stripModuleName . stripModule2 . fromParseResult . customizedParse fileName--usedExtensions = glasgowExts ++ [ExplicitForall]---- Ultimate debug function-getParseOutput fileName = parseFileWithMode (defaultParseMode { extensions = usedExtensions }) fileName--customizedParse fileName = parseFileContentsWithMode- (defaultParseMode- { extensions = usedExtensions- , parseFilename = fileName- })--getFullDeclarationListWithParameterList :: FilePath -> String -> [OriginalFunctionSignature]-getFullDeclarationListWithParameterList fileName fileContents =- map stripFunBind (stripModule $ fromParseResult $ customizedParse fileName fileContents )--functionNameNeeded :: String -> Bool-functionNameNeeded functionName = (functionName /= neutralName)--stripUnnecessary :: [String] -> [String]-stripUnnecessary = filter functionNameNeeded--printDeclarationList fileName = do- handle <- openFile fileName ReadMode- fileContents <- hGetContents handle- return $ getDeclarationList fileContents--printDeclarationListWithParameterList fileName = do- handle <- openFile fileName ReadMode- fileContents <- hGetContents handle- putStrLn $ show $ filter (functionNameNeeded . originalFunctionName) (getFullDeclarationListWithParameterList fileName fileContents)--printParameterListOfFunction :: FilePath -> String -> IO [Maybe String]-printParameterListOfFunction fileName functionName = getParameterList fileName functionName---- The interface-getDeclarationList :: FilePath -> String -> [String] -- filename, filecontents -> Stringlist-getDeclarationList fileName = stripUnnecessary . (map originalFunctionName) . getFullDeclarationListWithParameterList fileName--getExtendedDeclarationList :: FilePath -> String -> [OriginalFunctionSignature] -- filename, filecontents -> ExtDeclList-getExtendedDeclarationList fileName fileContents =- filter (functionNameNeeded . originalFunctionName)- (getFullDeclarationListWithParameterList fileName fileContents)--getParameterListOld :: FilePath -> String -> String -> [Maybe String]-getParameterListOld fileName fileContents funName = originalParameterNames $ head $- filter ((==funName) . originalFunctionName)- (getExtendedDeclarationList fileName fileContents)--getParameterList :: FilePath -> String -> IO [Maybe String]-getParameterList fileName funName = do- handle <- openFile fileName ReadMode- fileContents <- hGetContents handle- return $ originalParameterNames $ head $- filter ((==funName) . originalFunctionName) (getExtendedDeclarationList fileName fileContents)
− Feldspar/Transformation.hs
@@ -1,49 +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, FlexibleContexts, Rank2Types #-}--module Feldspar.Transformation- ( module Feldspar.Transformation- , module Feldspar.Transformation.Framework- , module Feldspar.Compiler.Imperative.TransformationInstance- , module Feldspar.Compiler.Imperative.Representation- ) where--import Feldspar.Transformation.Framework-import Feldspar.Compiler.Imperative.TransformationInstance-import Feldspar.Compiler.Imperative.Representation---- ================================================================================================--- == Plugin class--- ================================================================================================---class (Transformable t Module) => Plugin t where- type ExternalInfo t- executePlugin :: t -> ExternalInfo t -> Module (From t) -> Module (To t)
− Feldspar/Transformation/Framework.hs
@@ -1,140 +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 OverlappingInstances, UndecidableInstances, StandaloneDeriving #-}--module Feldspar.Transformation.Framework where--import Feldspar.Compiler.Error-import Feldspar.Compiler.Imperative.Representation--transformationError = handleError "PluginArch/TransformationFramework" InternalError---- ===========--- == Utils ==--- ===========--class Default t where- def :: t- def = transformationError "Default value requested."--class Combine t where- combine :: t -> t -> t- combine = transformationError "Default combination function used."--class Convert a b where- convert :: a -> b--instance Default () where- def = ()--instance Default [a] where- def = []--instance Default Int where- def = 0--instance (Default a, Default b) => Default (a,b) where- def = (def, def)--instance (Default a, Default b, Default c) => Default (a,b,c) where- def = (def, def, def)--instance Combine () where- combine _ _ = ()--instance Combine String where- combine s1 s2 = s1 ++ s2--instance Combine Int where- combine i1 i2 = i1 + i2--instance (Combine a, Combine b)- => Combine (a,b) where- combine (x,y) (v,w) = (combine x v, combine y w)--instance Default b => Convert a b where- convert _ = def---- =============================--- == TransformationFramework ==--- =============================--class (Default (Up t), Combine (Up t))- => Transformation t where- type From t- type To t-- type State t- type Down t- type Up t--data (Transformation t)- => Result t s- = Result- { result :: s (To t)- , state :: State t- , up :: Up t- }--deriving instance (Transformation t, Show (s (To t)), Show (State t), Show (Up t)) => Show (Result t s)--data (Transformation t)- => Result1 t s a- = Result1- { result1 :: s (a (To t))- , state1 :: State t- , up1 :: Up t- }--deriving instance (Transformation t, Show (s (b (To t))), Show (State t), Show (Up t)) => Show (Result1 t s b)--class (Transformation t)- => Transformable t s where- transform :: t -> State t -> Down t -> s (From t) -> Result t s--class (Transformation t)- => Transformable1 t s a where- transform1 :: t -> State t -> Down t -> s (a (From t)) -> Result1 t s a--class (Transformation t)- => DefaultTransformable t s where- defaultTransform :: t -> State t -> Down t -> s (From t) -> Result t s--class (Transformation t)- => DefaultTransformable1 t s a where- defaultTransform1 :: t -> State t -> Down t -> s (a (From t)) -> Result1 t s a--instance (DefaultTransformable t s)- => Transformable t s where- transform = defaultTransform--instance (DefaultTransformable1 t s a)- => Transformable1 t s a where- transform1 = defaultTransform1-
LICENSE view
@@ -1,3 +1,5 @@+Copyright (c) 2012, Emil Axelsson, Gergely Dévai, Anders Persson and+ Josef Svenningsson Copyright (c) 2009-2011, ERICSSON AB All rights reserved.
feldspar-compiler.cabal view
@@ -1,15 +1,18 @@ name: feldspar-compiler-version: 0.5.0.1-cabal-version: >= 1.6+version: 0.6.0.2+cabal-version: >= 1.14 build-type: Simple license: BSD3 license-file: LICENSE-copyright: Copyright (c) 2009-2011, ERICSSON AB+copyright: 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 stability: experimental-homepage: http://feldspar.inf.elte.hu/feldspar/+homepage: https://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** and **PAR**allelism) is an embedded DSL for describing digital@@ -19,9 +22,15 @@ language both according to ANSI C and also targeted to a real DSP HW. category: Compiler-tested-with: GHC==7.0+tested-with: GHC==7.6.1, GHC==7.4.2 +source-repository head+ type: git+ location: git://github.com/feldspar/feldspar-compiler.git+ library+ hs-source-dirs: lib+ exposed-modules: Feldspar.Compiler.Imperative.Representation Feldspar.Compiler.Imperative.FromCore@@ -30,11 +39,13 @@ Feldspar.Compiler.Imperative.FromCore.Condition Feldspar.Compiler.Imperative.FromCore.ConditionM Feldspar.Compiler.Imperative.FromCore.Error+ Feldspar.Compiler.Imperative.FromCore.Future Feldspar.Compiler.Imperative.FromCore.Interpretation Feldspar.Compiler.Imperative.FromCore.Literal Feldspar.Compiler.Imperative.FromCore.Loop Feldspar.Compiler.Imperative.FromCore.Mutable Feldspar.Compiler.Imperative.FromCore.MutableToPure+ Feldspar.Compiler.Imperative.FromCore.NoInline Feldspar.Compiler.Imperative.FromCore.Par Feldspar.Compiler.Imperative.FromCore.Primitive Feldspar.Compiler.Imperative.FromCore.SizeProp@@ -44,7 +55,10 @@ Feldspar.Compiler.Imperative.FromCore.Save 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@@ -54,15 +68,10 @@ Feldspar.Compiler.Backend.C.Plugin.TypeCorrector Feldspar.Compiler.Backend.C.Plugin.TypeDefinitionGenerator Feldspar.Compiler.Backend.C.Plugin.VariableRoleAssigner- Feldspar.Compiler.Backend.C.Plugin.AllocationEliminator Feldspar.Compiler.Backend.C.Plugin.Rule Feldspar.Compiler.Backend.C.Library Feldspar.Compiler.Backend.C.Options Feldspar.Compiler.Backend.C.Platforms- Feldspar.Compiler.Frontend.CommandLine.API.Library- Feldspar.Compiler.Frontend.CommandLine.API.Constants- Feldspar.Compiler.Frontend.CommandLine.API.Options- Feldspar.Compiler.Frontend.CommandLine.API Feldspar.Compiler.Frontend.Interactive.Interface Feldspar.Compiler.Compiler Feldspar.Compiler.Error@@ -71,21 +80,22 @@ Feldspar.Transformation.Framework Feldspar.NameExtractor + default-language: Haskell98+ build-depends:- feldspar-language == 0.5.*,+ feldspar-language >= 0.6 && < 0.7, ansi-terminal,- base >= 4 && < 4.4,+ base >= 4 && < 4.7, containers,- haskell-src-exts,+ haskell-src-exts >= 1.12, directory, filepath,- hint, MonadCatchIO-mtl, mtl, process,- syntactic >= 0.8+ syntactic >= 1.4 && < 1.5 - extensions:+ default-extensions: DeriveDataTypeable EmptyDataDecls FlexibleContexts@@ -104,11 +114,13 @@ ViewPatterns include-dirs:- ./Feldspar/C+ ./lib/Feldspar/C c-sources:--- ./Feldspar/C/feldspar_c99.c--- ./Feldspar/C/feldspar_array.c+-- lib/Feldspar/C/feldspar_c99.c+-- lib/Feldspar/C/feldspar_array.c+-- lib/Feldspar/C/ivar.c+-- lib/Feldspar/C/taskpool.c cc-options: -std=c99 -Wall @@ -119,29 +131,46 @@ feldspar_c99.c feldspar_tic64x.h feldspar_tic64x.c+ feldspar_future.h+ log.h+ ivar.h+ ivar.c+ taskpool.h+ taskpool.c ghc-options: -fcontext-stack=100 cpp-options: -DRELEASE executable feldspar- main-is : ./Feldspar/Compiler/Frontend/CommandLine/Main.hs+ hs-source-dirs: src + main-is : Feldspar/Compiler/Frontend/CommandLine/Main.hs++ default-language: Haskell98++ 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+ build-depends:--- feldspar-language == 0.5.*,--- syntactic >= 0.8.*,- ansi-terminal--- base >= 4 && < 4.4,--- mtl,--- hint,--- process,--- filepath,--- directory,--- containers,--- haskell-src-exts,--- MonadCatchIO-mtl+ feldspar-language >= 0.6 && < 0.7,+ feldspar-compiler,+ syntactic >= 1.4 && < 1.5,+ base >= 4 && < 4.7,+ hint,+ MonadCatchIO-mtl,+ mtl,+ directory,+ filepath,+ process,+ ansi-terminal,+ containers,+ haskell-src-exts >= 1.12 - extensions:+ default-extensions: CPP DeriveDataTypeable EmptyDataDecls@@ -163,3 +192,4 @@ ghc-options: -fcontext-stack=100 cpp-options: -DRELEASE+
+ lib/Feldspar/C/feldspar_array.c view
@@ -0,0 +1,61 @@+//+// 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);+}+
+ lib/Feldspar/C/feldspar_array.h view
@@ -0,0 +1,225 @@+//+// 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.+//++#ifndef FELDSPAR_ARRAY_H+#define FELDSPAR_ARRAY_H++#include <stdint.h>+#include <string.h>+#include <assert.h>+#include <stdlib.h>+//#define LOG+#include "log.h"++#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+{+ void* buffer; /* pointer to the buffer of elements */+ 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)+{+ int newBytes;++ log_3("initArray %p %d %d - enter\n", arr, size, len);+ assert(arr);+ arr->elemSize = size;+ arr->length = len;+ if( size < 0 )+ size = sizeof(struct array);+ newBytes = size * len;+ if( arr->buffer && (arr->inited == INITED) )+ {+ // Re-initialization+ log_1("initArray %p - reinitialize\n",arr);+ if( arr->bytes < newBytes )+ {+ 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 );+ }+ else+ {+ // Otherwise: space is enough, nothing to do+ log_3("initArray %p - large enough %d >= %d\n"+ , arr, arr->bytes, newBytes);+ }+ }+ else+ {+ // First initialization+ arr->bytes = newBytes;+ arr->buffer = (void*)malloc( newBytes ); + log_5("initArray %p - alloc %d * %d bytes %d 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);+}++// Free array+// TODO: Think about arrays escaping from their scope.+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;+ log_1("freeArray %p - leave\n", arr);+}++/* Deep array copy */+static inline void copyArray(struct array *to, struct array *from)+{+ assert(to);+ assert(from);+ log_2("copyArray %p %p - enter\n", to, from);+ if( from->elemSize < 0 )+ {+ log_2("copyArray %p %p - nested enter\n", to, from);+ unsigned i;+ for( i = 0; i < from->length; ++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 );+ copyArray( to_row, from_row );+ }+ log_2("copyArray %p %p - nested leave\n", to, from);+ }+ else+ {+ assert(to->buffer);+ assert(from->buffer);+ log_3("copyArray %p %p - memcpy %d bytes\n", to, from+ , from->length * from->elemSize);+ memcpy( to->buffer, from->buffer, from->length * from->elemSize );+ }+ log_2("copyArray %p %p - leave\n", to, from);+}++/* Deep array copy to a given position */+static inline void copyArrayPos(struct array *to, unsigned pos, struct array *from)+{+ assert(to);+ assert(from);+ log_3("copyArrayPos %p %d %p - enter\n", to, pos, from);+ if( from->elemSize < 0 )+ {+ unsigned i;+ for( i = 0; i < from->length; ++i )+ copyArray( &at(struct array, to, i + pos), &at(struct array, from, i) );+ }+ else+ {+ assert(to->buffer);+ assert(from->buffer);+ memcpy( (char*)(to->buffer) + pos * to->elemSize, from->buffer, from->length * from->elemSize );+ }+ log_3("copyArrayPos %p %d %p - leave\n", to, pos, from);+}+++/* 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)+{+ assert(arr);+ return arr->length;+}++/* Reset array length */+static inline void setLength(struct array *arr, int32_t len)+{+ assert(arr);+ log_2("setLength %p %d - enter\n", arr, len);+ int newBytes = arr->elemSize * len;+ if( arr->bytes >= newBytes )+ {+ arr->length = len;+ }+ else+ {+ 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 );+ }+ log_2("setLength %p %d - leave\n", arr, len);+}++#endif
+ lib/Feldspar/C/feldspar_c99.c view
@@ -0,0 +1,1894 @@+//+// 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_c99.h"++#include <stdint.h>+#include <stdio.h>+#include <stdlib.h>+#include <math.h>+#include <complex.h>++#if defined(WIN32)+ #include <windows.h>+#else+ #include <sys/time.h>+ #include <time.h>+#endif /* WIN32 */+++unsigned int feldspar_c99_linker_hook = 0xDECAFBAD;++/*--------------------------------------------------------------------------*+ * pow(), abs(), signum(), logBase() *+ *--------------------------------------------------------------------------*/++int8_t pow_fun_int8( int8_t a, int8_t b )+{+ int8_t r = 1;+ int i;+ if (b < 0) {+ fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);+ exit(1);+ }+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++int16_t pow_fun_int16( int16_t a, int16_t b )+{+ int16_t r = 1;+ int i;+ if (b < 0) {+ fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);+ exit(1);+ }+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++int32_t pow_fun_int32( int32_t a, int32_t b )+{+ int32_t r = 1;+ int i;+ if (b < 0) {+ fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);+ exit(1);+ }+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++int64_t pow_fun_int64( int64_t a, int64_t b )+{+ int64_t r = 1;+ int i;+ if (b < 0) {+ fprintf(stderr, "Negative exponent in function pow_fun_(): %lld `pow` %lld", a, b);+ exit(1);+ }+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++uint8_t pow_fun_uint8( uint8_t a, uint8_t b )+{+ uint8_t r = 1;+ int i;+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++uint16_t pow_fun_uint16( uint16_t a, uint16_t b )+{+ uint16_t r = 1;+ int i;+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++uint32_t pow_fun_uint32( uint32_t a, uint32_t b )+{+ uint32_t r = 1;+ int i;+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++uint64_t pow_fun_uint64( uint64_t a, uint64_t b )+{+ uint64_t r = 1;+ int i;+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++++int8_t abs_fun_int8( int8_t a )+{+ // From Bit Twiddling Hacks:+ // "Compute the integer absolute value (abs) without branching"+ int8_t mask = a >> 7;+ return (a + mask) ^ mask;+}++int16_t abs_fun_int16( int16_t a )+{+ // From Bit Twiddling Hacks:+ // "Compute the integer absolute value (abs) without branching"+ int16_t mask = a >> 15;+ return (a + mask) ^ mask;+}++int32_t abs_fun_int32( int32_t a )+{+ // From Bit Twiddling Hacks:+ // "Compute the integer absolute value (abs) without branching"+ int32_t mask = a >> 31;+ return (a + mask) ^ mask;+}++int64_t abs_fun_int64( int64_t a )+{+ // From Bit Twiddling Hacks:+ // "Compute the integer absolute value (abs) without branching"+ int64_t mask = a >> 63;+ return (a + mask) ^ mask;+}++++int8_t signum_fun_int8( 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 )+{+ // From Bit Twiddling Hacks: "Compute the sign of an integer"+ return (a != 0) | (a >> 15);+}++int32_t signum_fun_int32( 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 )+{+ // From Bit Twiddling Hacks: "Compute the sign of an integer"+ return (a != 0) | (a >> 63);+}++uint8_t signum_fun_uint8( uint8_t a )+{+ return (a > 0);+}++uint16_t signum_fun_uint16( uint16_t a )+{+ return (a > 0);+}++uint32_t signum_fun_uint32( uint32_t a )+{+ return (a > 0);+}++uint64_t signum_fun_uint64( uint64_t a )+{+ return (a > 0);+}++float signum_fun_float( float a )+{+ // From Bit Twiddling Hacks: "Compute the sign of an integer"+ return (a > 0) - (a < 0);+}++++float logBase_fun_float( float a, float b )+{+ return logf(b) / logf(a);+}++++/*--------------------------------------------------------------------------*+ * Bit operations *+ *--------------------------------------------------------------------------*/++int8_t setBit_fun_int8( int8_t x, uint32_t i )+{+ return x | 1 << i;+}++int16_t setBit_fun_int16( int16_t x, uint32_t i )+{+ return x | 1 << i;+}++int32_t setBit_fun_int32( int32_t x, uint32_t i )+{+ return x | 1 << i;+}++int64_t setBit_fun_int64( int64_t x, uint32_t i )+{+ return x | 1 << i;+}++uint8_t setBit_fun_uint8( uint8_t x, uint32_t i )+{+ return x | 1 << i;+}++uint16_t setBit_fun_uint16( uint16_t x, uint32_t i )+{+ return x | 1 << i;+}++uint32_t setBit_fun_uint32( uint32_t x, uint32_t i )+{+ return x | 1 << i;+}++uint64_t setBit_fun_uint64( uint64_t x, uint32_t i )+{+ return x | 1 << i;+}++++int8_t clearBit_fun_int8( int8_t x, uint32_t i )+{+ return x & ~(1 << i);+}++int16_t clearBit_fun_int16( int16_t x, uint32_t i )+{+ return x & ~(1 << i);+}++int32_t clearBit_fun_int32( int32_t x, uint32_t i )+{+ return x & ~(1 << i);+}++int64_t clearBit_fun_int64( int64_t x, uint32_t i )+{+ return x & ~(1 << i);+}++uint8_t clearBit_fun_uint8( uint8_t x, uint32_t i )+{+ return x & ~(1 << i);+}++uint16_t clearBit_fun_uint16( uint16_t x, uint32_t i )+{+ return x & ~(1 << i);+}++uint32_t clearBit_fun_uint32( uint32_t x, uint32_t i )+{+ return x & ~(1 << i);+}++uint64_t clearBit_fun_uint64( uint64_t x, uint32_t i )+{+ return x & ~(1 << i);+}++++int8_t complementBit_fun_int8( int8_t x, uint32_t i )+{+ return x ^ 1 << i;+}++int16_t complementBit_fun_int16( int16_t x, uint32_t i )+{+ return x ^ 1 << i;+}++int32_t complementBit_fun_int32( int32_t x, uint32_t i )+{+ return x ^ 1 << i;+}++int64_t complementBit_fun_int64( int64_t x, uint32_t i )+{+ return x ^ 1 << i;+}++uint8_t complementBit_fun_uint8( uint8_t x, uint32_t i )+{+ return x ^ 1 << i;+}++uint16_t complementBit_fun_uint16( uint16_t x, uint32_t i )+{+ return x ^ 1 << i;+}++uint32_t complementBit_fun_uint32( uint32_t x, uint32_t i )+{+ return x ^ 1 << i;+}++uint64_t complementBit_fun_uint64( uint64_t x, uint32_t i )+{+ return x ^ 1 << i;+}++++int testBit_fun_int8( int8_t x, uint32_t i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_int16( int16_t x, uint32_t i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_int32( int32_t x, uint32_t i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_int64( int64_t x, uint32_t i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_uint8( uint8_t x, uint32_t i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_uint16( uint16_t x, uint32_t i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_uint32( uint32_t x, uint32_t i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_uint64( uint64_t x, uint32_t i )+{+ return (x & 1 << i) != 0;+}++++int8_t rotateL_fun_int8( 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ if ((i %= 8) == 0) return x;+ return (x << i) | (x >> (8 - i));+}++uint16_t rotateL_fun_uint16( 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 )+{+ if ((i %= 32) == 0) return x;+ return (x << i) | (x >> (32 - i));+}++uint64_t rotateL_fun_uint64( uint64_t x, int32_t i )+{+ if ((i %= 64) == 0) return x;+ return (x << i) | (x >> (64 - i));+}++++int8_t rotateR_fun_int8( 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ if ((i %= 8) == 0) return x;+ return (x << (8 - i)) | (x >> i);+}++uint16_t rotateR_fun_uint16( 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 )+{+ if ((i %= 32) == 0) return x;+ return (x << (32 - i)) | (x >> i);+}++uint64_t rotateR_fun_uint64( uint64_t x, int32_t i )+{+ if ((i %= 64) == 0) return x;+ return (x << (64 - i)) | (x >> i);+}++++int8_t reverseBits_fun_int8( int8_t x )+{+ int8_t r = x;+ int i = 7;+ for (x = x >> 1 & 0x7f; x; x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++int16_t reverseBits_fun_int16( int16_t x )+{+ int16_t r = x;+ int i = 15;+ for (x = x >> 1 & 0x7fff; x; x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++int32_t reverseBits_fun_int32( int32_t x )+{+ int32_t r = x;+ int i = 31;+ for (x = x >> 1 & 0x7fffffff; x; x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++int64_t reverseBits_fun_int64( int64_t x )+{+ int64_t r = x;+ int i = 63;+ for (x = x >> 1 & 0x7fffffffffffffffll; x; x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++uint8_t reverseBits_fun_uint8( uint8_t x )+{+ uint8_t r = x;+ int i = 7;+ while (x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++uint16_t reverseBits_fun_uint16( uint16_t x )+{+ uint16_t r = x;+ int i = 15;+ while (x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++uint32_t reverseBits_fun_uint32( uint32_t x )+{+ uint32_t r = x;+ int i = 31;+ while (x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++uint64_t reverseBits_fun_uint64( uint64_t x )+{+ uint64_t r = x;+ int i = 63;+ while (x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++++uint32_t bitScan_fun_int8( int8_t x )+{+ uint32_t r = 0;+ int8_t s = (x & 0x80);+ if (x == 0) return 7;+ while ((int8_t)((x <<= 1) & 0x80) == s)+ ++r;+ return r;+}++uint32_t bitScan_fun_int16( int16_t x )+{+ uint32_t r = 0;+ int16_t s = (x & 0x8000);+ if (x == 0) return 15;+ while ((int16_t)((x <<= 1) & 0x8000) == s)+ ++r;+ return r;+}++uint32_t bitScan_fun_int32( int32_t x )+{+ uint32_t r = 0;+ int32_t s = (x & 0x80000000);+ if (x == 0) return 31;+ while ((int32_t)((x <<= 1) & 0x80000000) == s)+ ++r;+ return r;+}++uint32_t bitScan_fun_int64( int64_t x )+{+ uint32_t r = 0;+ int64_t s = (x & 0x8000000000000000ll);+ if (x == 0) return 63;+ while ((int64_t)((x <<= 1) & 0x8000000000000000ll) == s)+ ++r;+ return r;+}++uint32_t bitScan_fun_uint8( uint8_t x )+{+ uint32_t r = 8;+ while (x)+ {+ --r;+ x >>= 1;+ }+ return r;+}++uint32_t bitScan_fun_uint16( uint16_t x )+{+ uint32_t r = 16;+ while (x)+ {+ --r;+ x >>= 1;+ }+ return r;+}++uint32_t bitScan_fun_uint32( uint32_t x )+{+ uint32_t r = 32;+ while (x)+ {+ --r;+ x >>= 1;+ }+ return r;+}++uint32_t bitScan_fun_uint64( uint64_t x )+{+ uint32_t r = 64;+ while (x)+ {+ --r;+ x >>= 1;+ }+ return r;+}++++uint32_t bitCount_fun_int8( int8_t x )+{+ uint32_t r = x & 1;+ for (x = x >> 1 & 0x7f; x; x >>= 1)+ r += x & 1;+ return r;+}++uint32_t bitCount_fun_int16( int16_t x )+{+ uint32_t r = x & 1;+ for (x = x >> 1 & 0x7fff; x; x >>= 1)+ r += x & 1;+ return r;+}++uint32_t bitCount_fun_int32( int32_t x )+{+ uint32_t r = x & 1;+ for (x = x >> 1 & 0x7fffffff; x; x >>= 1)+ r += x & 1;+ return r;+}++uint32_t bitCount_fun_int64( int64_t x )+{+ uint32_t r = x & 1;+ for (x = x >> 1 & 0x7fffffffffffffffll; x; x >>= 1)+ r += x & 1;+ return r;+}++uint32_t bitCount_fun_uint8( uint8_t x )+{+ uint32_t r = x & 1;+ while (x >>= 1)+ r += x & 1;+ return r;+}++uint32_t bitCount_fun_uint16( uint16_t x )+{+ uint32_t r = x & 1;+ while (x >>= 1)+ r += x & 1;+ return r;+}++uint32_t bitCount_fun_uint32( uint32_t x )+{+ uint32_t r = x & 1;+ while (x >>= 1)+ r += x & 1;+ return r;+}++uint32_t bitCount_fun_uint64( uint64_t x )+{+ uint32_t r = x & 1;+ while (x >>= 1)+ r += x & 1;+ return r;+}++++/*--------------------------------------------------------------------------*+ * Complex numbers *+ *--------------------------------------------------------------------------*/++int equal_fun_complexOf_int8( complexOf_int8 a, complexOf_int8 b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_int16( complexOf_int16 a, complexOf_int16 b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_int32( complexOf_int32 a, complexOf_int32 b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_int64( complexOf_int64 a, complexOf_int64 b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_uint8( complexOf_uint8 a, complexOf_uint8 b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_uint16( complexOf_uint16 a, complexOf_uint16 b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_uint32( complexOf_uint32 a, complexOf_uint32 b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_uint64( complexOf_uint64 a, complexOf_uint64 b )+{+ return a.re == b.re && a.im == b.im;+}++++complexOf_int8 negate_fun_complexOf_int8( complexOf_int8 a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_int16 negate_fun_complexOf_int16( complexOf_int16 a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_int32 negate_fun_complexOf_int32( complexOf_int32 a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_int64 negate_fun_complexOf_int64( complexOf_int64 a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_uint8 negate_fun_complexOf_uint8( complexOf_uint8 a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_uint16 negate_fun_complexOf_uint16( complexOf_uint16 a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_uint32 negate_fun_complexOf_uint32( complexOf_uint32 a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_uint64 negate_fun_complexOf_uint64( complexOf_uint64 a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++++complexOf_int8 abs_fun_complexOf_int8( complexOf_int8 a )+{+ a.re = magnitude_fun_complexOf_int8(a);+ a.im = 0;+ return a;+}++complexOf_int16 abs_fun_complexOf_int16( complexOf_int16 a )+{+ a.re = magnitude_fun_complexOf_int16(a);+ a.im = 0;+ return a;+}++complexOf_int32 abs_fun_complexOf_int32( complexOf_int32 a )+{+ a.re = magnitude_fun_complexOf_int32(a);+ a.im = 0;+ return a;+}++complexOf_int64 abs_fun_complexOf_int64( complexOf_int64 a )+{+ a.re = magnitude_fun_complexOf_int64(a);+ a.im = 0;+ return a;+}++complexOf_uint8 abs_fun_complexOf_uint8( complexOf_uint8 a )+{+ a.re = magnitude_fun_complexOf_uint8(a);+ a.im = 0;+ return a;+}++complexOf_uint16 abs_fun_complexOf_uint16( complexOf_uint16 a )+{+ a.re = magnitude_fun_complexOf_uint16(a);+ a.im = 0;+ return a;+}++complexOf_uint32 abs_fun_complexOf_uint32( complexOf_uint32 a )+{+ a.re = magnitude_fun_complexOf_uint32(a);+ a.im = 0;+ return a;+}++complexOf_uint64 abs_fun_complexOf_uint64( complexOf_uint64 a )+{+ a.re = magnitude_fun_complexOf_uint64(a);+ a.im = 0;+ return a;+}++++complexOf_int8 signum_fun_complexOf_int8( complexOf_int8 a )+{+ int8_t m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_int8(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_int16 signum_fun_complexOf_int16( complexOf_int16 a )+{+ int16_t m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_int16(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_int32 signum_fun_complexOf_int32( complexOf_int32 a )+{+ int32_t m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_int32(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_int64 signum_fun_complexOf_int64( complexOf_int64 a )+{+ int64_t m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_int64(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_uint8 signum_fun_complexOf_uint8( complexOf_uint8 a )+{+ uint8_t m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_uint8(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_uint16 signum_fun_complexOf_uint16( complexOf_uint16 a )+{+ uint16_t m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_uint16(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_uint32 signum_fun_complexOf_uint32( complexOf_uint32 a )+{+ uint32_t m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_uint32(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_uint64 signum_fun_complexOf_uint64( complexOf_uint64 a )+{+ uint64_t m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_uint64(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++float complex signum_fun_complexOf_float( float complex a )+{+ float 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ a.re = a.re + b.re;+ a.im = a.im + b.im;+ return a;+}++++complexOf_int8 sub_fun_complexOf_int8( complexOf_int8 a, complexOf_int8 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ a.re = a.re - b.re;+ a.im = a.im - b.im;+ return a;+}++++complexOf_int8 mult_fun_complexOf_int8( complexOf_int8 a, complexOf_int8 b )+{+ complexOf_int8 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 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 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 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 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 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 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 r;+ r.re = a.re * b.re - a.im * b.im;+ r.im = a.im * b.re + a.re * b.im;+ return r;+}++#ifdef __FreeBSD__+float complex clogf( float complex x )+{+ return (I * atan2f(cimagf(x), crealf(x))) + logf(cabsf(x));+}+#endif+++float complex logBase_fun_complexOf_float( float complex a, float complex b )+{+ return clogf(b) / clogf(a);+}++++complexOf_int8 complex_fun_int8( int8_t re, int8_t im )+{+ complexOf_int8 r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_int16 complex_fun_int16( int16_t re, int16_t im )+{+ complexOf_int16 r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_int32 complex_fun_int32( int32_t re, int32_t im )+{+ complexOf_int32 r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_int64 complex_fun_int64( int64_t re, int64_t im )+{+ complexOf_int64 r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_uint8 complex_fun_uint8( uint8_t re, uint8_t im )+{+ complexOf_uint8 r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_uint16 complex_fun_uint16( uint16_t re, uint16_t im )+{+ complexOf_uint16 r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_uint32 complex_fun_uint32( uint32_t re, uint32_t im )+{+ complexOf_uint32 r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_uint64 complex_fun_uint64( uint64_t re, uint64_t im )+{+ complexOf_uint64 r;+ r.re = re;+ r.im = im;+ return r;+}++float complex complex_fun_float( float re, float im )+{+ return ( re + im * I );+}++++int8_t creal_fun_complexOf_int8( complexOf_int8 a )+{+ return a.re;+}++int16_t creal_fun_complexOf_int16( complexOf_int16 a )+{+ return a.re;+}++int32_t creal_fun_complexOf_int32( complexOf_int32 a )+{+ return a.re;+}++int64_t creal_fun_complexOf_int64( complexOf_int64 a )+{+ return a.re;+}++uint8_t creal_fun_complexOf_uint8( complexOf_uint8 a )+{+ return a.re;+}++uint16_t creal_fun_complexOf_uint16( complexOf_uint16 a )+{+ return a.re;+}++uint32_t creal_fun_complexOf_uint32( complexOf_uint32 a )+{+ return a.re;+}++uint64_t creal_fun_complexOf_uint64( complexOf_uint64 a )+{+ return a.re;+}++++int8_t cimag_fun_complexOf_int8( complexOf_int8 a )+{+ return a.im;+}++int16_t cimag_fun_complexOf_int16( complexOf_int16 a )+{+ return a.im;+}++int32_t cimag_fun_complexOf_int32( complexOf_int32 a )+{+ return a.im;+}++int64_t cimag_fun_complexOf_int64( complexOf_int64 a )+{+ return a.im;+}++uint8_t cimag_fun_complexOf_uint8( complexOf_uint8 a )+{+ return a.im;+}++uint16_t cimag_fun_complexOf_uint16( complexOf_uint16 a )+{+ return a.im;+}++uint32_t cimag_fun_complexOf_uint32( complexOf_uint32 a )+{+ return a.im;+}++uint64_t cimag_fun_complexOf_uint64( complexOf_uint64 a )+{+ return a.im;+}++++complexOf_int8 conj_fun_complexOf_int8( complexOf_int8 a )+{+ a.im = -a.im;+ return a;+}++complexOf_int16 conj_fun_complexOf_int16( complexOf_int16 a )+{+ a.im = -a.im;+ return a;+}++complexOf_int32 conj_fun_complexOf_int32( complexOf_int32 a )+{+ a.im = -a.im;+ return a;+}++complexOf_int64 conj_fun_complexOf_int64( complexOf_int64 a )+{+ a.im = -a.im;+ return a;+}++complexOf_uint8 conj_fun_complexOf_uint8( complexOf_uint8 a )+{+ a.im = -a.im;+ return a;+}++complexOf_uint16 conj_fun_complexOf_uint16( complexOf_uint16 a )+{+ a.im = -a.im;+ return a;+}++complexOf_uint32 conj_fun_complexOf_uint32( complexOf_uint32 a )+{+ a.im = -a.im;+ return a;+}++complexOf_uint64 conj_fun_complexOf_uint64( complexOf_uint64 a )+{+ a.im = -a.im;+ return a;+}++++int8_t magnitude_fun_complexOf_int8( complexOf_int8 a )+{+ return lroundf(hypotf(a.re, a.im));+}++int16_t magnitude_fun_complexOf_int16( complexOf_int16 a )+{+ return lroundf(hypotf(a.re, a.im));+}++int32_t magnitude_fun_complexOf_int32( complexOf_int32 a )+{+ return lroundf(hypotf(a.re, a.im));+}++int64_t magnitude_fun_complexOf_int64( complexOf_int64 a )+{+ return llroundf(hypotf(a.re, a.im));+}++uint8_t magnitude_fun_complexOf_uint8( complexOf_uint8 a )+{+ return lroundf(hypotf(a.re, a.im));+}++uint16_t magnitude_fun_complexOf_uint16( complexOf_uint16 a )+{+ return lroundf(hypotf(a.re, a.im));+}++uint32_t magnitude_fun_complexOf_uint32( complexOf_uint32 a )+{+ return lroundf(hypotf(a.re, a.im));+}++uint64_t magnitude_fun_complexOf_uint64( complexOf_uint64 a )+{+ return llroundf(hypotf(a.re, a.im));+}++++int8_t phase_fun_complexOf_int8( complexOf_int8 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ 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 )+{+ if (a.re == 0 && a.im == 0) return 0;+ else return llroundf(atan2f(a.im, a.re));+}++++complexOf_int8 mkPolar_fun_int8( int8_t r, int8_t t )+{+ complexOf_int8 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 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 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 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 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 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 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 a;+ a.re = llroundf(r * cosf(t));+ a.im = llroundf(r * sinf(t));+ return a;+}++float complex mkPolar_fun_float( float r, float t )+{+ return r * cosf(t) + r * sinf(t) * I;+}++++complexOf_int8 cis_fun_int8( int8_t t )+{+ complexOf_int8 r;+ r.re = lroundf(cosf(t));+ r.im = lroundf(sinf(t));+ return r;+}++complexOf_int16 cis_fun_int16( int16_t t )+{+ complexOf_int16 r;+ r.re = lroundf(cosf(t));+ r.im = lroundf(sinf(t));+ return r;+}++complexOf_int32 cis_fun_int32( int32_t t )+{+ complexOf_int32 r;+ r.re = lroundf(cosf(t));+ r.im = lroundf(sinf(t));+ return r;+}++complexOf_int64 cis_fun_int64( int64_t t )+{+ complexOf_int64 r;+ r.re = llroundf(cosf(t));+ r.im = llroundf(sinf(t));+ return r;+}++complexOf_uint8 cis_fun_uint8( uint8_t t )+{+ complexOf_uint8 r;+ r.re = lroundf(cosf(t));+ r.im = lroundf(sinf(t));+ return r;+}++complexOf_uint16 cis_fun_uint16( uint16_t t )+{+ complexOf_uint16 r;+ r.re = lroundf(cosf(t));+ r.im = lroundf(sinf(t));+ return r;+}++complexOf_uint32 cis_fun_uint32( uint32_t t )+{+ complexOf_uint32 r;+ r.re = lroundf(cosf(t));+ r.im = lroundf(sinf(t));+ return r;+}++complexOf_uint64 cis_fun_uint64( uint64_t t )+{+ complexOf_uint64 r;+ r.re = llroundf(cosf(t));+ r.im = llroundf(sinf(t));+ return r;+}++float complex cis_fun_float( float t )+{+ return cosf(t) + sinf(t) * I;+}++++/*--------------------------------------------------------------------------*+ * Trace functions *+ *--------------------------------------------------------------------------*/++static FILE *trace_log_file;++#if defined(WIN32)++static DWORD trace_start_time;++void traceStart()+{+ SYSTEMTIME lt;+ GetLocalTime(<);+ char str [256];+ sprintf(str, "trace-%04d%02d%02d-%02d%02d%02d.log",+ lt.wYear, lt.wMonth, lt.wDay, lt.wHour, lt.wMinute, lt.wSecond);+ trace_log_file = fopen(str, "a");+ if (trace_log_file == NULL) {+ fprintf(stderr,"Can not open trace file.\n");+ exit (8);+ }+ fprintf(trace_log_file,+ "Logging started at %02d-%02d-%04d %02d:%02d:%02d.\n",+ lt.wDay, lt.wMonth, lt.wYear, lt.wHour, lt.wMinute, lt.wSecond);+ fflush(trace_log_file);+ trace_start_time = GetTickCount();+}++void elapsedTimeString( char* str )+{+ DWORD diff_ms = GetTickCount() - trace_start_time;+ DWORD diff = diff_ms / 1000;+ diff_ms = diff_ms % 1000;+ sprintf(str, "%d.%.3d", diff, diff_ms);+}++#else++static struct timeval trace_start_time;++void traceStart()+{+ gettimeofday(&trace_start_time, NULL);+ struct tm * timeinfo = localtime(&(trace_start_time.tv_sec));+ char timestr [80];+ char str [256];+ strftime(timestr, 80, "%Y%m%d-%H%M%S", timeinfo);+ sprintf(str, "trace-%s.log", timestr);+ trace_log_file = fopen(str, "a");+ if (trace_log_file == NULL) {+ fprintf(stderr,"Can not open trace file.\n");+ exit (8);+ }+ strftime(timestr, 80, "%d-%b-%Y %H:%M:%S", timeinfo);+ fprintf(trace_log_file, "Logging started at %s.\n", timestr);+ fflush(trace_log_file);+ gettimeofday(&trace_start_time, NULL);+}++void elapsedTimeString( char* str )+{+ struct timeval tv;+ gettimeofday (&tv, NULL);+ if (trace_start_time.tv_usec <= tv.tv_usec) {+ tv.tv_sec = tv.tv_sec - trace_start_time.tv_sec;+ tv.tv_usec = tv.tv_usec - trace_start_time.tv_usec;+ } else {+ tv.tv_sec = tv.tv_sec - trace_start_time.tv_sec - 1;+ tv.tv_usec = 1000000 + tv.tv_usec - trace_start_time.tv_usec;+ }+ sprintf(str, "%ld.%06d", tv.tv_sec, (int)tv.tv_usec);+}++#endif /* WIN32 */++void traceEnd()+{+ fprintf(trace_log_file, "Logging finished.\n");+ fclose(trace_log_file);+}++void trace_int8( int8_t val, int32_t id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%d\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_int16( int16_t val, int32_t id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%d\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_int32( int32_t val, int32_t id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%d\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_int64( int64_t val, int32_t id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%lld\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_uint8( uint8_t val, int32_t id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%u\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_uint16( uint16_t val, int32_t id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%u\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_uint32( uint32_t val, int32_t id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%u\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_uint64( uint64_t val, int32_t id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%llu\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_float( float 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( complexOf_int8 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 )+{+ 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_int32( complexOf_int32 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_int64( complexOf_int64 val, int32_t id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%lld+%lld*I\n", id, timestr, val.re, val.im);+ fflush(trace_log_file);+}++void trace_complexOf_uint8( complexOf_uint8 val, int32_t id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%u+%u*I\n", id, timestr, val.re, val.im);+ fflush(trace_log_file);+}++void trace_complexOf_uint16( complexOf_uint16 val, int32_t id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%u+%u*I\n", id, timestr, val.re, val.im);+ fflush(trace_log_file);+}++void trace_complexOf_uint32( complexOf_uint32 val, int32_t id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%u+%u*I\n", id, timestr, val.re, val.im);+ fflush(trace_log_file);+}++void trace_complexOf_uint64( complexOf_uint64 val, int32_t id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%llu+%llu*I\n", id, timestr, val.re, val.im);+ fflush(trace_log_file);+}++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);+}+
+ lib/Feldspar/C/feldspar_c99.h view
@@ -0,0 +1,356 @@+//+// 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.+//++#ifndef FELDSPAR_C99_H+#define FELDSPAR_C99_H++#include <stdint.h>+#include <complex.h>++++#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 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 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 );+float signum_fun_float( float );++float logBase_fun_float( float, float );++++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 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 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 );++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 );++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 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 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 );++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 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 );++++typedef struct {+ int8_t re;+ int8_t im;+} complexOf_int8;++typedef struct {+ int16_t re;+ int16_t im;+} complexOf_int16;++typedef struct {+ int32_t re;+ int32_t im;+} complexOf_int32;++typedef struct {+ int64_t re;+ int64_t im;+} complexOf_int64;++typedef struct {+ uint8_t re;+ uint8_t im;+} complexOf_uint8;++typedef struct {+ uint16_t re;+ uint16_t im;+} complexOf_uint16;++typedef struct {+ uint32_t re;+ uint32_t im;+} complexOf_uint32;++typedef struct {+ uint64_t re;+ uint64_t im;+} complexOf_uint64;++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 );++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 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 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 );+float complex signum_fun_complexOf_float( float 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 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 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 );++float complex logBase_fun_complexOf_float( float complex, float 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 );+float complex complex_fun_float( float, float );++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 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 );++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 );++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 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 );++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 );+float complex mkPolar_fun_float( float, float );++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 );+float complex cis_fun_float( float );++++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_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_complexOf_float( float complex, int32_t );++#endif /* FELDSPAR_C99_H */
+ lib/Feldspar/C/feldspar_future.h view
@@ -0,0 +1,30 @@+//+// 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 <pthread.h>+
+ lib/Feldspar/C/feldspar_tic64x.c view
@@ -0,0 +1,2364 @@+//+// 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_tic64x.h"++#include <stdio.h>+#include <stdlib.h>+#include <math.h>+#include <time.h>++float hypotf(float x, float y) {+ return sqrtf(x * x + y * y);+}++++/*--------------------------------------------------------------------------*+ * pow(), abs(), signum(), logBase() *+ *--------------------------------------------------------------------------*/++char pow_fun_char( char a, char b )+{+ char r = 1;+ int i;+ if (b < 0) {+ fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);+ exit(1);+ }+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++short pow_fun_short( short a, short b )+{+ short r = 1;+ int i;+ if (b < 0) {+ fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);+ exit(1);+ }+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++int pow_fun_int( int a, int b )+{+ int r = 1;+ int i;+ if (b < 0) {+ fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);+ exit(1);+ }+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++long pow_fun_long( long a, long b )+{+ long r = 1;+ int i;+ if (b < 0) {+ fprintf(stderr, "Negative exponent in function pow_fun_(): %ld `pow` %ld", a, b);+ exit(1);+ }+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++long long pow_fun_llong( long long a, long long b )+{+ long long r = 1;+ int i;+ if (b < 0) {+ fprintf(stderr, "Negative exponent in function pow_fun_(): %lld `pow` %lld", a, b);+ exit(1);+ }+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++unsigned char pow_fun_uchar( unsigned char a, unsigned char b )+{+ unsigned char r = 1;+ int i;+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++unsigned short pow_fun_ushort( unsigned short a, unsigned short b )+{+ unsigned short r = 1;+ int i;+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++unsigned pow_fun_uint( unsigned a, unsigned b )+{+ unsigned r = 1;+ int i;+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++unsigned long pow_fun_ulong( unsigned long a, unsigned long b )+{+ unsigned long r = 1;+ int i;+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++unsigned long long pow_fun_ullong( unsigned long long a, unsigned long long b )+{+ unsigned long long r = 1;+ int i;+ for(i = 0; i < b; ++i)+ r *= a;+ return r;+}++++char abs_fun_char( char a )+{+ // From Bit Twiddling Hacks:+ // "Compute the integer absolute value (abs) without branching"+ char mask = a >> 7;+ return (a + mask) ^ mask;+}++short abs_fun_short( short a )+{+ // From Bit Twiddling Hacks:+ // "Compute the integer absolute value (abs) without branching"+ short mask = a >> 15;+ return (a + mask) ^ mask;+}++long abs_fun_long( long a )+{+ // From Bit Twiddling Hacks:+ // "Compute the integer absolute value (abs) without branching"+ long mask = a >> 39;+ return (a + mask) ^ mask;+}++long long abs_fun_llong( long long a )+{+ // From Bit Twiddling Hacks:+ // "Compute the integer absolute value (abs) without branching"+ long long mask = a >> 63;+ return (a + mask) ^ mask;+}++++char signum_fun_char( char a )+{+ // From Bit Twiddling Hacks: "Compute the sign of an integer"+ return (a != 0) | (a >> 7);+}++short signum_fun_short( short a )+{+ // From Bit Twiddling Hacks: "Compute the sign of an integer"+ return (a != 0) | (a >> 15);+}++int signum_fun_int( int a )+{+ // From Bit Twiddling Hacks: "Compute the sign of an integer"+ return (a != 0) | (a >> 31);+}++long signum_fun_long( long a )+{+ // From Bit Twiddling Hacks: "Compute the sign of an integer"+ return (a != 0) | (a >> 39);+}++long long signum_fun_llong( long long a )+{+ // From Bit Twiddling Hacks: "Compute the sign of an integer"+ return (a != 0) | (a >> 63);+}++unsigned char signum_fun_uchar( unsigned char a )+{+ return (a > 0);+}++unsigned short signum_fun_ushort( unsigned short a )+{+ return (a > 0);+}++unsigned signum_fun_uint( unsigned a )+{+ return (a > 0);+}++unsigned long signum_fun_ulong( unsigned long a )+{+ return (a > 0);+}++unsigned long long signum_fun_ullong( unsigned long long a )+{+ return (a > 0);+}++float signum_fun_float( float a )+{+ // From Bit Twiddling Hacks: "Compute the sign of an integer"+ return (a > 0) - (a < 0);+}++++float logBase_fun_float( float a, float b )+{+ return logf(b) / logf(a);+}++++/*--------------------------------------------------------------------------*+ * Bit operations *+ *--------------------------------------------------------------------------*/++char setBit_fun_char( char x, unsigned i )+{+ return x | 1 << i;+}++short setBit_fun_short( short x, unsigned i )+{+ return x | 1 << i;+}++int setBit_fun_int( int x, unsigned i )+{+ return x | 1 << i;+}++long setBit_fun_long( long x, unsigned i )+{+ return x | 1 << i;+}++long long setBit_fun_llong( long long x, unsigned i )+{+ return x | 1 << i;+}++unsigned char setBit_fun_uchar( unsigned char x, unsigned i )+{+ return x | 1 << i;+}++unsigned short setBit_fun_ushort( unsigned short x, unsigned i )+{+ return x | 1 << i;+}++unsigned setBit_fun_uint( unsigned x, unsigned i )+{+ return x | 1 << i;+}++unsigned long setBit_fun_ulong( unsigned long x, unsigned i )+{+ return x | 1 << i;+}++unsigned long long setBit_fun_ullong( unsigned long long x, unsigned i )+{+ return x | 1 << i;+}++++char clearBit_fun_char( char x, unsigned i )+{+ return x & ~(1 << i);+}++short clearBit_fun_short( short x, unsigned i )+{+ return x & ~(1 << i);+}++int clearBit_fun_int( int x, unsigned i )+{+ return x & ~(1 << i);+}++long clearBit_fun_long( long x, unsigned i )+{+ return x & ~(1 << i);+}++long long clearBit_fun_llong( long long x, unsigned i )+{+ return x & ~(1 << i);+}++unsigned char clearBit_fun_uchar( unsigned char x, unsigned i )+{+ return x & ~(1 << i);+}++unsigned short clearBit_fun_ushort( unsigned short x, unsigned i )+{+ return x & ~(1 << i);+}++unsigned clearBit_fun_uint( unsigned x, unsigned i )+{+ return x & ~(1 << i);+}++unsigned long clearBit_fun_ulong( unsigned long x, unsigned i )+{+ return x & ~(1 << i);+}++unsigned long long clearBit_fun_ullong( unsigned long long x, unsigned i )+{+ return x & ~(1 << i);+}++++char complementBit_fun_char( char x, unsigned i )+{+ return x ^ 1 << i;+}++short complementBit_fun_short( short x, unsigned i )+{+ return x ^ 1 << i;+}++int complementBit_fun_int( int x, unsigned i )+{+ return x ^ 1 << i;+}++long complementBit_fun_long( long x, unsigned i )+{+ return x ^ 1 << i;+}++long long complementBit_fun_llong( long long x, unsigned i )+{+ return x ^ 1 << i;+}++unsigned char complementBit_fun_uchar( unsigned char x, unsigned i )+{+ return x ^ 1 << i;+}++unsigned short complementBit_fun_ushort( unsigned short x, unsigned i )+{+ return x ^ 1 << i;+}++unsigned complementBit_fun_uint( unsigned x, unsigned i )+{+ return x ^ 1 << i;+}++unsigned long complementBit_fun_ulong( unsigned long x, unsigned i )+{+ return x ^ 1 << i;+}++unsigned long long complementBit_fun_ullong( unsigned long long x, unsigned i )+{+ return x ^ 1 << i;+}++++int testBit_fun_char( char x, unsigned i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_short( short x, unsigned i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_int( int x, unsigned i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_long( long x, unsigned i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_llong( long long x, unsigned i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_uchar( unsigned char x, unsigned i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_ushort( unsigned short x, unsigned i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_uint( unsigned x, unsigned i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_ulong( unsigned long x, unsigned i )+{+ return (x & 1 << i) != 0;+}++int testBit_fun_ullong( unsigned long long x, unsigned i )+{+ return (x & 1 << i) != 0;+}++++char rotateL_fun_char( char x, int i )+{+ if ((i %= 8) == 0) return x;+ return (x << i) | ((0x7f >> (7 - i)) & (x >> (8 - i)));+}++short rotateL_fun_short( short x, int i )+{+ if ((i %= 16) == 0) return x;+ return (x << i) | ((0x7fff >> (15 - i)) & (x >> (16 - i)));+}++long rotateL_fun_long( long x, int i )+{+ if ((i %= 40) == 0) return x;+ return (x << i) | ((0x7fffffffffl >> (39 - i)) & (x >> (40 - i)));+}++long long rotateL_fun_llong( long long x, int i )+{+ if ((i %= 64) == 0) return x;+ return (x << i) | ((0x7fffffffffffffffll >> (63 - i)) & (x >> (64 - i)));+}++int rotateL_fun_int( int x, int i )+{+ return (int)_rotl((unsigned)x, (unsigned)i);+}++unsigned char rotateL_fun_uchar( unsigned char x, int i )+{+ if ((i %= 8) == 0) return x;+ return (x << i) | (x >> (8 - i));+}++unsigned short rotateL_fun_ushort( unsigned short x, int i )+{+ if ((i %= 16) == 0) return x;+ return (x << i) | (x >> (16 - i));+}++unsigned long rotateL_fun_ulong( unsigned long x, int i )+{+ if ((i %= 40) == 0) return x;+ return (x << i) | (x >> (40 - i));+}++unsigned long long rotateL_fun_ullong( unsigned long long x, int i )+{+ if ((i %= 64) == 0) return x;+ return (x << i) | (x >> (64 - i));+}++++char rotateR_fun_char( char x, int i )+{+ if ((i %= 8) == 0) return x;+ return (x << (8 - i)) | ((0x7f >> (i - 1)) & (x >> i));+}++short rotateR_fun_short( short x, int i )+{+ if ((i %= 16) == 0) return x;+ return (x << (16 - i)) | ((0x7fff >> (i - 1)) & (x >> i));+}++int rotateR_fun_int( int x, int i )+{+ if ((i %= 32) == 0) return x;+ return (x << (32 - i)) | ((0x7fffffff >> (i - 1)) & (x >> i));+}++long rotateR_fun_long( long x, int i )+{+ if ((i %= 40) == 0) return x;+ return (x << (40 - i)) | ((0x7fffffffffl >> (i - 1)) & (x >> i));+}++long long rotateR_fun_llong( long long x, int i )+{+ if ((i %= 64) == 0) return x;+ return (x << (64 - i)) | ((0x7fffffffffffffffll >> (i - 1)) & (x >> i));+}++unsigned char rotateR_fun_uchar( unsigned char x, int i )+{+ if ((i %= 8) == 0) return x;+ return (x << (8 - i)) | (x >> i);+}++unsigned short rotateR_fun_ushort( unsigned short x, int i )+{+ if ((i %= 16) == 0) return x;+ return (x << (16 - i)) | (x >> i);+}++unsigned rotateR_fun_uint( unsigned x, int i )+{+ if ((i %= 32) == 0) return x;+ return (x << (32 - i)) | (x >> i);+}++unsigned long rotateR_fun_ulong( unsigned long x, int i )+{+ if ((i %= 40) == 0) return x;+ return (x << (40 - i)) | (x >> i);+}++unsigned long long rotateR_fun_ullong( unsigned long long x, int i )+{+ if ((i %= 64) == 0) return x;+ return (x << (64 - i)) | (x >> i);+}++++char reverseBits_fun_char( char x )+{+ char r = x;+ int i = 7;+ for (x = x >> 1 & 0x7f; x; x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++short reverseBits_fun_short( short x )+{+ short r = x;+ int i = 15;+ for (x = x >> 1 & 0x7fff; x; x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++int reverseBits_fun_int( int x )+{+ int r = x;+ int i = 31;+ for (x = x >> 1 & 0x7fffffff; x; x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++long reverseBits_fun_long( long x )+{+ long r = x;+ int i = 39;+ for (x = x >> 1 & 0x7fffffffffl; x; x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++long long reverseBits_fun_llong( long long x )+{+ long long r = x;+ int i = 63;+ for (x = x >> 1 & 0x7fffffffffffffffll; x; x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++unsigned char reverseBits_fun_uchar( unsigned char x )+{+ unsigned char r = x;+ int i = 7;+ while (x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++unsigned short reverseBits_fun_ushort( unsigned short x )+{+ unsigned short r = x;+ int i = 15;+ while (x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++unsigned long reverseBits_fun_ulong( unsigned long x )+{+ unsigned long r = x;+ int i = 39;+ while (x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++unsigned long long reverseBits_fun_ullong( unsigned long long x )+{+ unsigned long long r = x;+ int i = 63;+ while (x >>= 1)+ {+ r = (r << 1) | (x & 1);+ --i;+ }+ return r << i;+}++++unsigned bitScan_fun_char( char x )+{+ unsigned r = 0;+ char s = (x & 0x80);+ if (x == 0) return 7;+ while (((x <<= 1) & 0x80) == s)+ ++r;+ return r;+}++unsigned bitScan_fun_short( short x )+{+ unsigned r = 0;+ short s = (x & 0x8000);+ if (x == 0) return 15;+ while (((x <<= 1) & 0x8000) == s)+ ++r;+ return r;+}++unsigned bitScan_fun_int( int x )+{+ unsigned r = 0;+ int s = (x & 0x80000000);+ if (x == 0) return 31;+ while (((x <<= 1) & 0x80000000) == s)+ ++r;+ return r;+}++unsigned bitScan_fun_long( long x )+{+ unsigned r = 0;+ long s = (x & 0x8000000000l);+ if (x == 0) return 39;+ while (((x <<= 1) & 0x8000000000l) == s)+ ++r;+ return r;+}++unsigned bitScan_fun_llong( long long x )+{+ unsigned r = 0;+ long long s = (x & 0x8000000000000000ll);+ if (x == 0) return 63;+ while (((x <<= 1) & 0x8000000000000000ll) == s)+ ++r;+ return r;+}++unsigned bitScan_fun_uchar( unsigned char x )+{+ unsigned r = 8;+ while (x)+ {+ --r;+ x >>= 1;+ }+ return r;+}++unsigned bitScan_fun_ushort( unsigned short x )+{+ unsigned r = 16;+ while (x)+ {+ --r;+ x >>= 1;+ }+ return r;+}++unsigned bitScan_fun_uint( unsigned x )+{+ unsigned r = 32;+ while (x)+ {+ --r;+ x >>= 1;+ }+ return r;+}++unsigned bitScan_fun_ulong( unsigned long x )+{+ unsigned r = 40;+ while (x)+ {+ --r;+ x >>= 1;+ }+ return r;+}++unsigned bitScan_fun_ullong( unsigned long long x )+{+ unsigned r = 64;+ while (x)+ {+ --r;+ x >>= 1;+ }+ return r;+}++++unsigned bitCount_fun_char( char x )+{+ unsigned r = x & 1;+ for (x = x >> 1 & 0x7f; x; x >>= 1)+ r += x & 1;+ return r;+}++unsigned bitCount_fun_short( short x )+{+ unsigned r = x & 1;+ for (x = x >> 1 & 0x7fff; x; x >>= 1)+ r += x & 1;+ return r;+}++unsigned bitCount_fun_int( int x )+{+ unsigned r = x & 1;+ for (x = x >> 1 & 0x7fffffff; x; x >>= 1)+ r += x & 1;+ return r;+}++unsigned bitCount_fun_long( long x )+{+ unsigned r = x & 1;+ for (x = x >> 1 & 0x7fffffffffl; x; x >>= 1)+ r += x & 1;+ return r;+}++unsigned bitCount_fun_llong( long long x )+{+ unsigned r = x & 1;+ for (x = x >> 1 & 0x7fffffffffffffffll; x; x >>= 1)+ r += x & 1;+ return r;+}++unsigned bitCount_fun_uchar( unsigned char x )+{+ unsigned r = x & 1;+ while (x >>= 1)+ r += x & 1;+ return r;+}++unsigned bitCount_fun_ushort( unsigned short x )+{+ unsigned r = x & 1;+ while (x >>= 1)+ r += x & 1;+ return r;+}++unsigned bitCount_fun_ulong( unsigned long x )+{+ unsigned r = x & 1;+ while (x >>= 1)+ r += x & 1;+ return r;+}++unsigned bitCount_fun_ullong( unsigned long long x )+{+ unsigned r = x & 1;+ while (x >>= 1)+ r += x & 1;+ return r;+}++++/*--------------------------------------------------------------------------*+ * Complex numbers *+ *--------------------------------------------------------------------------*/++int equal_fun_complexOf_char( complexOf_char a, complexOf_char b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_int( complexOf_int a, complexOf_int b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_long( complexOf_long a, complexOf_long b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_llong( complexOf_llong a, complexOf_llong b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_uchar( complexOf_uchar a, complexOf_uchar b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_uint( complexOf_uint a, complexOf_uint b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_ulong( complexOf_ulong a, complexOf_ulong b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_ullong( complexOf_ullong a, complexOf_ullong b )+{+ return a.re == b.re && a.im == b.im;+}++int equal_fun_complexOf_float( complexOf_float a, complexOf_float b )+{+ return a.re == b.re && a.im == b.im;+}++++complexOf_char negate_fun_complexOf_char( complexOf_char a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_int negate_fun_complexOf_int( complexOf_int a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_long negate_fun_complexOf_long( complexOf_long a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_llong negate_fun_complexOf_llong( complexOf_llong a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_uchar negate_fun_complexOf_uchar( complexOf_uchar a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_uint negate_fun_complexOf_uint( complexOf_uint a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_ulong negate_fun_complexOf_ulong( complexOf_ulong a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_ullong negate_fun_complexOf_ullong( complexOf_ullong a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++complexOf_float negate_fun_complexOf_float( complexOf_float a )+{+ a.re = -a.re;+ a.im = -a.im;+ return a;+}++++complexOf_char abs_fun_complexOf_char( complexOf_char a )+{+ a.re = magnitude_fun_complexOf_char(a);+ a.im = 0;+ return a;+}++complexOf_int abs_fun_complexOf_int( complexOf_int a )+{+ a.re = magnitude_fun_complexOf_int(a);+ a.im = 0;+ return a;+}++complexOf_long abs_fun_complexOf_long( complexOf_long a )+{+ a.re = magnitude_fun_complexOf_long(a);+ a.im = 0;+ return a;+}++complexOf_llong abs_fun_complexOf_llong( complexOf_llong a )+{+ a.re = magnitude_fun_complexOf_llong(a);+ a.im = 0;+ return a;+}++complexOf_uchar abs_fun_complexOf_uchar( complexOf_uchar a )+{+ a.re = magnitude_fun_complexOf_uchar(a);+ a.im = 0;+ return a;+}++complexOf_uint abs_fun_complexOf_uint( complexOf_uint a )+{+ a.re = magnitude_fun_complexOf_uint(a);+ a.im = 0;+ return a;+}++complexOf_ulong abs_fun_complexOf_ulong( complexOf_ulong a )+{+ a.re = magnitude_fun_complexOf_ulong(a);+ a.im = 0;+ return a;+}++complexOf_ullong abs_fun_complexOf_ullong( complexOf_ullong a )+{+ a.re = magnitude_fun_complexOf_ullong(a);+ a.im = 0;+ return a;+}++complexOf_float abs_fun_complexOf_float( complexOf_float a )+{+ a.re = magnitude_fun_complexOf_float(a);+ a.im = 0;+ return a;+}++unsigned abs_fun_complexOf_short( unsigned a )+{+ return _pack2(magnitude_fun_complexOf_short(a), 0);+}++unsigned abs_fun_complexOf_ushort( unsigned a )+{+ return _pack2(magnitude_fun_complexOf_ushort(a), 0);+}++++complexOf_char signum_fun_complexOf_char( complexOf_char a )+{+ char m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_char(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_int signum_fun_complexOf_int( complexOf_int a )+{+ int m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_int(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_long signum_fun_complexOf_long( complexOf_long a )+{+ long m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_long(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_llong signum_fun_complexOf_llong( complexOf_llong a )+{+ long long m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_llong(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_uchar signum_fun_complexOf_uchar( complexOf_uchar a )+{+ unsigned char m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_uchar(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_uint signum_fun_complexOf_uint( complexOf_uint a )+{+ unsigned m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_uint(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_ulong signum_fun_complexOf_ulong( complexOf_ulong a )+{+ unsigned long m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_ulong(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_ullong signum_fun_complexOf_ullong( complexOf_ullong a )+{+ unsigned long long m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_ullong(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++complexOf_float signum_fun_complexOf_float( complexOf_float a )+{+ float m;+ if (a.re == 0 && a.im == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_float(a);+ a.re = a.re / m;+ a.im = a.im / m;+ return a;+ }+}++unsigned signum_fun_complexOf_short( unsigned a )+{+ short m;+ if (a == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_short(a);+ return _pack2((a >> 16) / m, (a & 0x0000ffff) / m);+ }+}++unsigned signum_fun_complexOf_ushort( unsigned a )+{+ unsigned short m;+ if (a == 0) {+ return a;+ } else {+ m = magnitude_fun_complexOf_ushort(a);+ return _pack2((a >> 16) / m, (a & 0x0000ffff) / m);+ }+}++++complexOf_char add_fun_complexOf_char( complexOf_char a, complexOf_char b )+{+ a.re = a.re + b.re;+ a.im = a.im + b.im;+ return a;+}++complexOf_int add_fun_complexOf_int( complexOf_int a, complexOf_int b )+{+ a.re = a.re + b.re;+ a.im = a.im + b.im;+ return a;+}++complexOf_long add_fun_complexOf_long( complexOf_long a, complexOf_long b )+{+ a.re = a.re + b.re;+ a.im = a.im + b.im;+ return a;+}++complexOf_llong add_fun_complexOf_llong( complexOf_llong a, complexOf_llong b )+{+ a.re = a.re + b.re;+ a.im = a.im + b.im;+ return a;+}++complexOf_uchar add_fun_complexOf_uchar( complexOf_uchar a, complexOf_uchar b )+{+ a.re = a.re + b.re;+ a.im = a.im + b.im;+ return a;+}++complexOf_uint add_fun_complexOf_uint( complexOf_uint a, complexOf_uint b )+{+ a.re = a.re + b.re;+ a.im = a.im + b.im;+ return a;+}++complexOf_ulong add_fun_complexOf_ulong( complexOf_ulong a, complexOf_ulong b )+{+ a.re = a.re + b.re;+ a.im = a.im + b.im;+ return a;+}++complexOf_ullong add_fun_complexOf_ullong( complexOf_ullong a, complexOf_ullong b )+{+ a.re = a.re + b.re;+ a.im = a.im + b.im;+ return a;+}++complexOf_float add_fun_complexOf_float( complexOf_float a, complexOf_float b )+{+ a.re = a.re + b.re;+ a.im = a.im + b.im;+ return a;+}++++complexOf_char sub_fun_complexOf_char( complexOf_char a, complexOf_char b )+{+ a.re = a.re - b.re;+ a.im = a.im - b.im;+ return a;+}++complexOf_int sub_fun_complexOf_int( complexOf_int a, complexOf_int b )+{+ a.re = a.re - b.re;+ a.im = a.im - b.im;+ return a;+}++complexOf_long sub_fun_complexOf_long( complexOf_long a, complexOf_long b )+{+ a.re = a.re - b.re;+ a.im = a.im - b.im;+ return a;+}++complexOf_llong sub_fun_complexOf_llong( complexOf_llong a, complexOf_llong b )+{+ a.re = a.re - b.re;+ a.im = a.im - b.im;+ return a;+}++complexOf_uchar sub_fun_complexOf_uchar( complexOf_uchar a, complexOf_uchar b )+{+ a.re = a.re - b.re;+ a.im = a.im - b.im;+ return a;+}++complexOf_uint sub_fun_complexOf_uint( complexOf_uint a, complexOf_uint b )+{+ a.re = a.re - b.re;+ a.im = a.im - b.im;+ return a;+}++complexOf_ulong sub_fun_complexOf_ulong( complexOf_ulong a, complexOf_ulong b )+{+ a.re = a.re - b.re;+ a.im = a.im - b.im;+ return a;+}++complexOf_ullong sub_fun_complexOf_ullong( complexOf_ullong a, complexOf_ullong b )+{+ a.re = a.re - b.re;+ a.im = a.im - b.im;+ return a;+}++complexOf_float sub_fun_complexOf_float( complexOf_float a, complexOf_float b )+{+ a.re = a.re - b.re;+ a.im = a.im - b.im;+ return a;+}++++complexOf_char mult_fun_complexOf_char( complexOf_char a, complexOf_char b )+{+ complexOf_char r;+ r.re = a.re * b.re - a.im * b.im;+ r.im = a.im * b.re + a.re * b.im;+ return r;+}++complexOf_int mult_fun_complexOf_int( complexOf_int a, complexOf_int b )+{+ complexOf_int r;+ r.re = a.re * b.re - a.im * b.im;+ r.im = a.im * b.re + a.re * b.im;+ return r;+}++complexOf_long mult_fun_complexOf_long( complexOf_long a, complexOf_long b )+{+ complexOf_long r;+ r.re = a.re * b.re - a.im * b.im;+ r.im = a.im * b.re + a.re * b.im;+ return r;+}++complexOf_llong mult_fun_complexOf_llong( complexOf_llong a, complexOf_llong b )+{+ complexOf_llong r;+ r.re = a.re * b.re - a.im * b.im;+ r.im = a.im * b.re + a.re * b.im;+ return r;+}++complexOf_uchar mult_fun_complexOf_uchar( complexOf_uchar a, complexOf_uchar b )+{+ complexOf_uchar r;+ r.re = a.re * b.re - a.im * b.im;+ r.im = a.im * b.re + a.re * b.im;+ return r;+}++complexOf_uint mult_fun_complexOf_uint( complexOf_uint a, complexOf_uint b )+{+ complexOf_uint r;+ r.re = a.re * b.re - a.im * b.im;+ r.im = a.im * b.re + a.re * b.im;+ return r;+}++complexOf_ulong mult_fun_complexOf_ulong( complexOf_ulong a, complexOf_ulong b )+{+ complexOf_ulong r;+ r.re = a.re * b.re - a.im * b.im;+ r.im = a.im * b.re + a.re * b.im;+ return r;+}++complexOf_ullong mult_fun_complexOf_ullong( complexOf_ullong a, complexOf_ullong b )+{+ complexOf_ullong r;+ r.re = a.re * b.re - a.im * b.im;+ r.im = a.im * b.re + a.re * b.im;+ return r;+}++complexOf_float mult_fun_complexOf_float( complexOf_float a, complexOf_float b )+{+ complexOf_float r;+ r.re = a.re * b.re - a.im * b.im;+ r.im = a.im * b.re + a.re * b.im;+ return r;+}++unsigned mult_fun_complexOf_short( unsigned a, unsigned b )+{+ short are = (short)(a >> 16);+ short aim = (short)(a & 0x0000ffff);+ short bre = (short)(b >> 16);+ short bim = (short)(b & 0x0000ffff);+ return _pack2(are * bre - aim * bim, aim * bre + are * bim);+}++unsigned mult_fun_complexOf_ushort( unsigned a, unsigned b )+{+ unsigned short are = (unsigned short)(a >> 16);+ unsigned short aim = (unsigned short)(a & 0x0000ffff);+ unsigned short bre = (unsigned short)(b >> 16);+ unsigned short bim = (unsigned short)(b & 0x0000ffff);+ return _pack2(are * bre - aim * bim, aim * bre + are * bim);+}++++complexOf_float div_fun_complexOf_float( complexOf_float a, complexOf_float b )+{+ float x = b.re * b.re + b.im * b.im;+ complexOf_float r;+ r.re = (a.re * b.re + a.im * b.im) / x;+ r.im = (a.im * b.re - a.re * b.im) / x;+ return r;+}++++complexOf_float exp_fun_complexOf_float( complexOf_float a )+{+ float expre = expf(a.re);+ a.re = expre * cosf(a.im);+ a.im = expre * sinf(a.im);+ return a;+}++++complexOf_float sqrt_fun_complexOf_float( complexOf_float a )+{+ float magare = magnitude_fun_complexOf_float(a) + a.re;+ a.re = sqrtf(magare / 2);+ a.im = a.im / sqrtf(2 * magare);+ return a;+}++++complexOf_float log_fun_complexOf_float( complexOf_float a )+{+ complexOf_float r;+ r.re = logf(magnitude_fun_complexOf_float(a));+ r.im = phase_fun_complexOf_float(a);+ return r;+}++++complexOf_float pow_fun_complexOf_float( complexOf_float a, complexOf_float b )+{+ return exp_fun_complexOf_float(mult_fun_complexOf_float(log_fun_complexOf_float(a), b));+}++++complexOf_float logBase_fun_complexOf_float( complexOf_float a, complexOf_float b )+{+ return div_fun_complexOf_float(log_fun_complexOf_float(b), log_fun_complexOf_float(a));+}++++complexOf_float sin_fun_complexOf_float( complexOf_float a )+{+ complexOf_float r;+ r.re = sinf(a.re) * coshf(a.im);+ r.im = cosf(a.re) * sinhf(a.im);+ return r;+}++++complexOf_float cos_fun_complexOf_float( complexOf_float a )+{+ complexOf_float r;+ r.re = cosf(a.re) * coshf(a.im);+ r.im = - sinf(a.re) * sinhf(a.im);+ return r;+}++++complexOf_float tan_fun_complexOf_float( complexOf_float a )+{+ return div_fun_complexOf_float(sin_fun_complexOf_float(a), cos_fun_complexOf_float(a));+}++++complexOf_float sinh_fun_complexOf_float( complexOf_float a )+{+ complexOf_float r;+ r.re = sinhf(a.re) * cosf(a.im);+ r.im = coshf(a.re) * sinf(a.im);+ return r;+}++++complexOf_float cosh_fun_complexOf_float( complexOf_float a )+{+ complexOf_float r;+ r.re = cosf(a.re) * coshf(a.im);+ r.im = sinhf(a.re) * sinf(a.im);+ return r;+}++++complexOf_float tanh_fun_complexOf_float( complexOf_float a )+{+ return div_fun_complexOf_float(sinh_fun_complexOf_float(a), cosh_fun_complexOf_float(a));+}++++complexOf_float asin_fun_complexOf_float( complexOf_float a )+{+ complexOf_float b = add_fun_complexOf_float(log_fun_complexOf_float(complex_fun_float(-a.im, a.re)), sqrt_fun_complexOf_float(sub_fun_complexOf_float(complex_fun_float(1, 0), mult_fun_complexOf_float(a, a))));+ a.re = b.im;+ a.im = -b.re;+ return a;+}++++complexOf_float acos_fun_complexOf_float( complexOf_float a )+{+ complexOf_float b = sqrt_fun_complexOf_float(sub_fun_complexOf_float(complex_fun_float(1, 0), mult_fun_complexOf_float(a, a)));+ complexOf_float c = log_fun_complexOf_float(add_fun_complexOf_float(a, complex_fun_float(-b.im, b.re)));+ a.re = c.im;+ a.im = -c.re;+ return a;+}++++complexOf_float atan_fun_complexOf_float( complexOf_float a )+{+ complexOf_float b = log_fun_complexOf_float(div_fun_complexOf_float(complex_fun_float(1 - a.im, a.re), sqrt_fun_complexOf_float(add_fun_complexOf_float(complex_fun_float(1, 0), mult_fun_complexOf_float(a, a)))));+ a.re = b.im;+ a.im = -b.re;+ return a;+}++++complexOf_float asinh_fun_complexOf_float( complexOf_float a )+{+ return log_fun_complexOf_float(add_fun_complexOf_float(a, sqrt_fun_complexOf_float(add_fun_complexOf_float(complex_fun_float(1, 0), mult_fun_complexOf_float(a, a)))));+}++++complexOf_float acosh_fun_complexOf_float( complexOf_float a )+{+ complexOf_float b = {1, 0};+ complexOf_float c = add_fun_complexOf_float(a, b);+ return log_fun_complexOf_float(add_fun_complexOf_float(a, mult_fun_complexOf_float(c, sqrt_fun_complexOf_float(div_fun_complexOf_float(sub_fun_complexOf_float(a, b), c)))));+}++++complexOf_float atanh_fun_complexOf_float( complexOf_float a )+{+ complexOf_float b = {1, 0};+ return log_fun_complexOf_float(div_fun_complexOf_float(add_fun_complexOf_float(b, a), sqrt_fun_complexOf_float(sub_fun_complexOf_float(b, mult_fun_complexOf_float(a, a)))));+}++++complexOf_char complex_fun_char( char re, char im )+{+ complexOf_char r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_int complex_fun_int( int re, int im )+{+ complexOf_int r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_long complex_fun_long( long re, long im )+{+ complexOf_long r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_llong complex_fun_llong( long long re, long long im )+{+ complexOf_llong r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_uchar complex_fun_uchar( unsigned char re, unsigned char im )+{+ complexOf_uchar r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_uint complex_fun_uint( unsigned re, unsigned im )+{+ complexOf_uint r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_ulong complex_fun_ulong( unsigned long re, unsigned long im )+{+ complexOf_ulong r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_ullong complex_fun_ullong( unsigned long long re, unsigned long long im )+{+ complexOf_ullong r;+ r.re = re;+ r.im = im;+ return r;+}++complexOf_float complex_fun_float( float re, float im )+{+ complexOf_float r;+ r.re = re;+ r.im = im;+ return r;+}++++char creal_fun_complexOf_char( complexOf_char a )+{+ return a.re;+}++int creal_fun_complexOf_int( complexOf_int a )+{+ return a.re;+}++long creal_fun_complexOf_long( complexOf_long a )+{+ return a.re;+}++long long creal_fun_complexOf_llong( complexOf_llong a )+{+ return a.re;+}++unsigned char creal_fun_complexOf_uchar( complexOf_uchar a )+{+ return a.re;+}++unsigned creal_fun_complexOf_uint( complexOf_uint a )+{+ return a.re;+}++unsigned long creal_fun_complexOf_ulong( complexOf_ulong a )+{+ return a.re;+}++unsigned long long creal_fun_complexOf_ullong( complexOf_ullong a )+{+ return a.re;+}++float creal_fun_complexOf_float( complexOf_float a )+{+ return a.re;+}++short creal_fun_complexOf_short( unsigned a )+{+ return a >> 16;+}++unsigned short creal_fun_complexOf_ushort( unsigned a )+{+ return a >> 16;+}++++char cimag_fun_complexOf_char( complexOf_char a )+{+ return a.im;+}++int cimag_fun_complexOf_int( complexOf_int a )+{+ return a.im;+}++long cimag_fun_complexOf_long( complexOf_long a )+{+ return a.im;+}++long long cimag_fun_complexOf_llong( complexOf_llong a )+{+ return a.im;+}++unsigned char cimag_fun_complexOf_uchar( complexOf_uchar a )+{+ return a.im;+}++unsigned cimag_fun_complexOf_uint( complexOf_uint a )+{+ return a.im;+}++unsigned long cimag_fun_complexOf_ulong( complexOf_ulong a )+{+ return a.im;+}++unsigned long long cimag_fun_complexOf_ullong( complexOf_ullong a )+{+ return a.im;+}++float cimag_fun_complexOf_float( complexOf_float a )+{+ return a.im;+}++short cimag_fun_complexOf_short( unsigned a )+{+ return a & 0x0000ffff;+}++unsigned short cimag_fun_complexOf_ushort( unsigned a )+{+ return a & 0x0000ffff;+}++++complexOf_char conj_fun_complexOf_char( complexOf_char a )+{+ a.im = -a.im;+ return a;+}++complexOf_int conj_fun_complexOf_int( complexOf_int a )+{+ a.im = -a.im;+ return a;+}++complexOf_long conj_fun_complexOf_long( complexOf_long a )+{+ a.im = -a.im;+ return a;+}++complexOf_llong conj_fun_complexOf_llong( complexOf_llong a )+{+ a.im = -a.im;+ return a;+}++complexOf_uchar conj_fun_complexOf_uchar( complexOf_uchar a )+{+ a.im = -a.im;+ return a;+}++complexOf_uint conj_fun_complexOf_uint( complexOf_uint a )+{+ a.im = -a.im;+ return a;+}++complexOf_ulong conj_fun_complexOf_ulong( complexOf_ulong a )+{+ a.im = -a.im;+ return a;+}++complexOf_ullong conj_fun_complexOf_ullong( complexOf_ullong a )+{+ a.im = -a.im;+ return a;+}++complexOf_float conj_fun_complexOf_float( complexOf_float a )+{+ a.im = -a.im;+ return a;+}++unsigned conj_fun_complexOf_short( unsigned a )+{+ return _pack2(a >> 16, -(a & 0x0000ffff));+}++unsigned conj_fun_complexOf_ushort( unsigned a )+{+ return _pack2(a >> 16, -(a & 0x0000ffff));+}++++char magnitude_fun_complexOf_char( complexOf_char a )+{+ return roundf(hypotf(a.re, a.im));+}++int magnitude_fun_complexOf_int( complexOf_int a )+{+ return roundf(hypotf(a.re, a.im));+}++long magnitude_fun_complexOf_long( complexOf_long a )+{+ return roundf(hypotf(a.re, a.im));+}++long long magnitude_fun_complexOf_llong( complexOf_llong a )+{+ return roundf(hypotf(a.re, a.im));+}++unsigned char magnitude_fun_complexOf_uchar( complexOf_uchar a )+{+ return roundf(hypotf(a.re, a.im));+}++unsigned magnitude_fun_complexOf_uint( complexOf_uint a )+{+ return roundf(hypotf(a.re, a.im));+}++unsigned long magnitude_fun_complexOf_ulong( complexOf_ulong a )+{+ return roundf(hypotf(a.re, a.im));+}++unsigned long long magnitude_fun_complexOf_ullong( complexOf_ullong a )+{+ return roundf(hypotf(a.re, a.im));+}++float magnitude_fun_complexOf_float( complexOf_float a )+{+ return (hypotf(a.re, a.im));+}++short magnitude_fun_complexOf_short( unsigned a )+{+ return roundf(hypotf((a >> 16), (a & 0x0000ffff)));+}++unsigned short magnitude_fun_complexOf_ushort( unsigned a )+{+ return roundf(hypotf((a >> 16), (a & 0x0000ffff)));+}++++char phase_fun_complexOf_char( complexOf_char a )+{+ if (a.re == 0 && a.im == 0) return 0;+ else return roundf(atan2f(a.im, a.re));+}++int phase_fun_complexOf_int( complexOf_int a )+{+ if (a.re == 0 && a.im == 0) return 0;+ else return roundf(atan2f(a.im, a.re));+}++long phase_fun_complexOf_long( complexOf_long a )+{+ if (a.re == 0 && a.im == 0) return 0;+ else return roundf(atan2f(a.im, a.re));+}++long long phase_fun_complexOf_llong( complexOf_llong a )+{+ if (a.re == 0 && a.im == 0) return 0;+ else return roundf(atan2f(a.im, a.re));+}++unsigned char phase_fun_complexOf_uchar( complexOf_uchar a )+{+ if (a.re == 0 && a.im == 0) return 0;+ else return roundf(atan2f(a.im, a.re));+}++unsigned phase_fun_complexOf_uint( complexOf_uint a )+{+ if (a.re == 0 && a.im == 0) return 0;+ else return roundf(atan2f(a.im, a.re));+}++unsigned long phase_fun_complexOf_ulong( complexOf_ulong a )+{+ if (a.re == 0 && a.im == 0) return 0;+ else return roundf(atan2f(a.im, a.re));+}++unsigned long long phase_fun_complexOf_ullong( complexOf_ullong a )+{+ if (a.re == 0 && a.im == 0) return 0;+ else return roundf(atan2f(a.im, a.re));+}++float phase_fun_complexOf_float( complexOf_float a )+{+ if (a.re == 0 && a.im == 0) return 0;+ else return (atan2f(a.im, a.re));+}++short phase_fun_complexOf_short( unsigned a )+{+ short re = (a >> 16);+ short im = (a & 0x0000ffff);+ if (re == 0 && im == 0) return 0;+ else return roundf(atan2f(im, re));+}++unsigned short phase_fun_complexOf_ushort( unsigned a )+{+ unsigned short re = (a >> 16);+ unsigned short im = (a & 0x0000ffff);+ if (re == 0 && im == 0) return 0;+ else return roundf(atan2f(im, re));+}++++complexOf_char mkPolar_fun_char( char r, char t )+{+ complexOf_char a;+ a.re = roundf(r * cosf(t));+ a.im = roundf(r * sinf(t));+ return a;+}++complexOf_int mkPolar_fun_int( int r, int t )+{+ complexOf_int a;+ a.re = roundf(r * cosf(t));+ a.im = roundf(r * sinf(t));+ return a;+}++complexOf_long mkPolar_fun_long( long r, long t )+{+ complexOf_long a;+ a.re = roundf(r * cosf(t));+ a.im = roundf(r * sinf(t));+ return a;+}++complexOf_llong mkPolar_fun_llong( long long r, long long t )+{+ complexOf_llong a;+ a.re = roundf(r * cosf(t));+ a.im = roundf(r * sinf(t));+ return a;+}++complexOf_uchar mkPolar_fun_uchar( unsigned char r, unsigned char t )+{+ complexOf_uchar a;+ a.re = roundf(r * cosf(t));+ a.im = roundf(r * sinf(t));+ return a;+}++complexOf_uint mkPolar_fun_uint( unsigned r, unsigned t )+{+ complexOf_uint a;+ a.re = roundf(r * cosf(t));+ a.im = roundf(r * sinf(t));+ return a;+}++complexOf_ulong mkPolar_fun_ulong( unsigned long r, unsigned long t )+{+ complexOf_ulong a;+ a.re = roundf(r * cosf(t));+ a.im = roundf(r * sinf(t));+ return a;+}++complexOf_ullong mkPolar_fun_ullong( unsigned long long r, unsigned long long t )+{+ complexOf_ullong a;+ a.re = roundf(r * cosf(t));+ a.im = roundf(r * sinf(t));+ return a;+}++complexOf_float mkPolar_fun_float( float r, float t )+{+ complexOf_float a;+ a.re = (r * cosf(t));+ a.im = (r * sinf(t));+ return a;+}++unsigned mkPolar_fun_short( short r, short t )+{+ return _pack2(roundf(r * cosf(t)), roundf(r * sinf(t)));+}++unsigned mkPolar_fun_ushort( unsigned short r, unsigned short t )+{+ return _pack2(roundf(r * cosf(t)), roundf(r * sinf(t)));+}++++complexOf_char cis_fun_char( char t )+{+ complexOf_char r;+ r.re = roundf(cosf(t));+ r.im = roundf(sinf(t));+ return r;+}++complexOf_int cis_fun_int( int t )+{+ complexOf_int r;+ r.re = roundf(cosf(t));+ r.im = roundf(sinf(t));+ return r;+}++complexOf_long cis_fun_long( long t )+{+ complexOf_long r;+ r.re = roundf(cosf(t));+ r.im = roundf(sinf(t));+ return r;+}++complexOf_llong cis_fun_llong( long long t )+{+ complexOf_llong r;+ r.re = roundf(cosf(t));+ r.im = roundf(sinf(t));+ return r;+}++complexOf_uchar cis_fun_uchar( unsigned char t )+{+ complexOf_uchar r;+ r.re = roundf(cosf(t));+ r.im = roundf(sinf(t));+ return r;+}++complexOf_uint cis_fun_uint( unsigned t )+{+ complexOf_uint r;+ r.re = roundf(cosf(t));+ r.im = roundf(sinf(t));+ return r;+}++complexOf_ulong cis_fun_ulong( unsigned long t )+{+ complexOf_ulong r;+ r.re = roundf(cosf(t));+ r.im = roundf(sinf(t));+ return r;+}++complexOf_ullong cis_fun_ullong( unsigned long long t )+{+ complexOf_ullong r;+ r.re = roundf(cosf(t));+ r.im = roundf(sinf(t));+ return r;+}++complexOf_float cis_fun_float( float t )+{+ complexOf_float r;+ r.re = (cosf(t));+ r.im = (sinf(t));+ return r;+}++unsigned cis_fun_short( short t )+{+ return _pack2(roundf(cosf(t)), roundf(sinf(t)));+}++unsigned cis_fun_ushort( unsigned short t )+{+ return _pack2(roundf(cosf(t)), roundf(sinf(t)));+}++++/*--------------------------------------------------------------------------*+ * Trace functions *+ *--------------------------------------------------------------------------*/++static FILE *trace_log_file;+static time_t trace_start_time;++void traceStart()+{+ char timestr [80];+ char str [256];+ struct tm * timeinfo;+ trace_start_time = time(NULL);+ timeinfo = localtime(&(trace_start_time));+ strftime(timestr, 80, "%Y%m%d-%H%M%S", timeinfo);+ sprintf(str, "trace-%s.log", timestr);+ trace_log_file = fopen(str, "a");+ if (trace_log_file == NULL) {+ fprintf(stderr,"Can not open trace file.\n");+ exit (8);+ }+ strftime(timestr, 80, "%d-%b-%Y %H:%M:%S", timeinfo);+ fprintf(trace_log_file, "Logging started at %s.\n", timestr);+ fflush(trace_log_file);+ trace_start_time = time(NULL);+}++void elapsedTimeString( char* str )+{+ sprintf(str, "%ld.000", time(NULL) - trace_start_time);+}++void traceEnd()+{+ fprintf(trace_log_file, "Logging finished.\n");+ fclose(trace_log_file);+}++void trace_char( char val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%d\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_short( short val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%d\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_int( int val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%d\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_long( long val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%ld\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_llong( long long val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%lld\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_uchar( unsigned char val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%u\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_ushort( unsigned short val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%u\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_uint( unsigned val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%u\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_ulong( unsigned long val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%lu\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_ullong( unsigned long long val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%llu\n", id, timestr, val);+ fflush(trace_log_file);+}++void trace_float( float val, int 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_char( complexOf_char val, int 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_short( unsigned val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%d+%d*I\n", id, timestr, (short)(val >> 16), (short)(val & 0x0000ffff));+ fflush(trace_log_file);+}++void trace_complexOf_int( complexOf_int val, int 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_long( complexOf_long val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%ld+%ld*I\n", id, timestr, val.re, val.im);+ fflush(trace_log_file);+}++void trace_complexOf_llong( complexOf_llong val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%lld+%lld*I\n", id, timestr, val.re, val.im);+ fflush(trace_log_file);+}++void trace_complexOf_uchar( complexOf_uchar val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%u+%u*I\n", id, timestr, val.re, val.im);+ fflush(trace_log_file);+}++void trace_complexOf_ushort( unsigned val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%u+%u*I\n", id, timestr, (val >> 16), (val & 0x0000ffff));+ fflush(trace_log_file);+}++void trace_complexOf_uint( complexOf_uint val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%u+%u*I\n", id, timestr, val.re, val.im);+ fflush(trace_log_file);+}++void trace_complexOf_ulong( complexOf_ulong val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%lu+%lu*I\n", id, timestr, val.re, val.im);+ fflush(trace_log_file);+}++void trace_complexOf_ullong( complexOf_ullong val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%llu+%llu*I\n", id, timestr, val.re, val.im);+ fflush(trace_log_file);+}++void trace_complexOf_float( complexOf_float val, int id )+{+ char timestr [80];+ elapsedTimeString(timestr);+ fprintf(trace_log_file, "id=%d, time=%s, value=%f+%f*I\n", id, timestr, val.re, val.im);+ fflush(trace_log_file);+}+
+ lib/Feldspar/C/feldspar_tic64x.h view
@@ -0,0 +1,443 @@+//+// 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.+//++#ifndef FELDSPAR_TI_C64X_H+#define FELDSPAR_TI_C64X_H++++char pow_fun_char( char, char );+short pow_fun_short( short, short );+int pow_fun_int( int, int );+long pow_fun_long( long, long );+long long pow_fun_llong( long long, long long );+unsigned char pow_fun_uchar( unsigned char, unsigned char );+unsigned short pow_fun_ushort( unsigned short, unsigned short );+unsigned pow_fun_uint( unsigned, unsigned );+unsigned long pow_fun_ulong( unsigned long, unsigned long );+unsigned long long pow_fun_ullong( unsigned long long, unsigned long long );++char abs_fun_char( char );+short abs_fun_short( short );+long abs_fun_long( long );+long long abs_fun_llong( long long );++char signum_fun_char( char );+short signum_fun_short( short );+int signum_fun_int( int );+long signum_fun_long( long );+long long signum_fun_llong( long long );+unsigned char signum_fun_uchar( unsigned char );+unsigned short signum_fun_ushort( unsigned short );+unsigned signum_fun_uint( unsigned );+unsigned long signum_fun_ulong( unsigned long );+unsigned long long signum_fun_ullong( unsigned long long );+float signum_fun_float( float );++float logBase_fun_float( float, float );++++char setBit_fun_char( char, unsigned );+short setBit_fun_short( short, unsigned );+int setBit_fun_int( int, unsigned );+long setBit_fun_long( long, unsigned );+long long setBit_fun_llong( long long, unsigned );+unsigned char setBit_fun_uchar( unsigned char, unsigned );+unsigned short setBit_fun_ushort( unsigned short, unsigned );+unsigned setBit_fun_uint( unsigned, unsigned );+unsigned long setBit_fun_ulong( unsigned long, unsigned );+unsigned long long setBit_fun_ullong( unsigned long long, unsigned );++char clearBit_fun_char( char, unsigned );+short clearBit_fun_short( short, unsigned );+int clearBit_fun_int( int, unsigned );+long clearBit_fun_long( long, unsigned );+long long clearBit_fun_llong( long long, unsigned );+unsigned char clearBit_fun_uchar( unsigned char, unsigned );+unsigned short clearBit_fun_ushort( unsigned short, unsigned );+unsigned clearBit_fun_uint( unsigned, unsigned );+unsigned long clearBit_fun_ulong( unsigned long, unsigned );+unsigned long long clearBit_fun_ullong( unsigned long long, unsigned );++char complementBit_fun_char( char, unsigned );+short complementBit_fun_short( short, unsigned );+int complementBit_fun_int( int, unsigned );+long complementBit_fun_long( long, unsigned );+long long complementBit_fun_llong( long long, unsigned );+unsigned char complementBit_fun_uchar( unsigned char, unsigned );+unsigned short complementBit_fun_ushort( unsigned short, unsigned );+unsigned complementBit_fun_uint( unsigned, unsigned );+unsigned long complementBit_fun_ulong( unsigned long, unsigned );+unsigned long long complementBit_fun_ullong( unsigned long long, unsigned );++int testBit_fun_char( char, unsigned );+int testBit_fun_short( short, unsigned );+int testBit_fun_int( int, unsigned );+int testBit_fun_long( long, unsigned );+int testBit_fun_llong( long long, unsigned );+int testBit_fun_uchar( unsigned char, unsigned );+int testBit_fun_ushort( unsigned short, unsigned );+int testBit_fun_uint( unsigned, unsigned );+int testBit_fun_ulong( unsigned long, unsigned );+int testBit_fun_ullong( unsigned long long, unsigned );++char rotateL_fun_char( char, int );+short rotateL_fun_short( short, int );+long rotateL_fun_long( long, int );+long long rotateL_fun_llong( long long, int );+int rotateL_fun_int( int, int );+unsigned char rotateL_fun_uchar( unsigned char, int );+unsigned short rotateL_fun_ushort( unsigned short, int );+unsigned long rotateL_fun_ulong( unsigned long, int );+unsigned long long rotateL_fun_ullong( unsigned long long, int );++char rotateR_fun_char( char, int );+short rotateR_fun_short( short, int );+int rotateR_fun_int( int, int );+long rotateR_fun_long( long, int );+long long rotateR_fun_llong( long long, int );+unsigned char rotateR_fun_uchar( unsigned char, int );+unsigned short rotateR_fun_ushort( unsigned short, int );+unsigned rotateR_fun_uint( unsigned, int );+unsigned long rotateR_fun_ulong( unsigned long, int );+unsigned long long rotateR_fun_ullong( unsigned long long, int );++char reverseBits_fun_char( char );+short reverseBits_fun_short( short );+int reverseBits_fun_int( int );+long reverseBits_fun_long( long );+long long reverseBits_fun_llong( long long );+unsigned char reverseBits_fun_uchar( unsigned char );+unsigned short reverseBits_fun_ushort( unsigned short );+unsigned long reverseBits_fun_ulong( unsigned long );+unsigned long long reverseBits_fun_ullong( unsigned long long );++unsigned bitScan_fun_char( char );+unsigned bitScan_fun_short( short );+unsigned bitScan_fun_int( int );+unsigned bitScan_fun_long( long );+unsigned bitScan_fun_llong( long long );+unsigned bitScan_fun_uchar( unsigned char );+unsigned bitScan_fun_ushort( unsigned short );+unsigned bitScan_fun_uint( unsigned );+unsigned bitScan_fun_ulong( unsigned long );+unsigned bitScan_fun_ullong( unsigned long long );++unsigned bitCount_fun_char( char );+unsigned bitCount_fun_short( short );+unsigned bitCount_fun_int( int );+unsigned bitCount_fun_long( long );+unsigned bitCount_fun_llong( long long );+unsigned bitCount_fun_uchar( unsigned char );+unsigned bitCount_fun_ushort( unsigned short );+unsigned bitCount_fun_ulong( unsigned long );+unsigned bitCount_fun_ullong( unsigned long long );++++typedef struct {+ char re;+ char im;+} complexOf_char;++typedef struct {+ int re;+ int im;+} complexOf_int;++typedef struct {+ long re;+ long im;+} complexOf_long;++typedef struct {+ long long re;+ long long im;+} complexOf_llong;++typedef struct {+ unsigned char re;+ unsigned char im;+} complexOf_uchar;++typedef struct {+ unsigned re;+ unsigned im;+} complexOf_uint;++typedef struct {+ unsigned long re;+ unsigned long im;+} complexOf_ulong;++typedef struct {+ unsigned long long re;+ unsigned long long im;+} complexOf_ullong;++typedef struct {+ float re;+ float im;+} complexOf_float;++int equal_fun_complexOf_char( complexOf_char, complexOf_char );+int equal_fun_complexOf_int( complexOf_int, complexOf_int );+int equal_fun_complexOf_long( complexOf_long, complexOf_long );+int equal_fun_complexOf_llong( complexOf_llong, complexOf_llong );+int equal_fun_complexOf_uchar( complexOf_uchar, complexOf_uchar );+int equal_fun_complexOf_uint( complexOf_uint, complexOf_uint );+int equal_fun_complexOf_ulong( complexOf_ulong, complexOf_ulong );+int equal_fun_complexOf_ullong( complexOf_ullong, complexOf_ullong );+int equal_fun_complexOf_float( complexOf_float, complexOf_float );++complexOf_char negate_fun_complexOf_char( complexOf_char );+complexOf_int negate_fun_complexOf_int( complexOf_int );+complexOf_long negate_fun_complexOf_long( complexOf_long );+complexOf_llong negate_fun_complexOf_llong( complexOf_llong );+complexOf_uchar negate_fun_complexOf_uchar( complexOf_uchar );+complexOf_uint negate_fun_complexOf_uint( complexOf_uint );+complexOf_ulong negate_fun_complexOf_ulong( complexOf_ulong );+complexOf_ullong negate_fun_complexOf_ullong( complexOf_ullong );+complexOf_float negate_fun_complexOf_float( complexOf_float );++complexOf_char abs_fun_complexOf_char( complexOf_char );+complexOf_int abs_fun_complexOf_int( complexOf_int );+complexOf_long abs_fun_complexOf_long( complexOf_long );+complexOf_llong abs_fun_complexOf_llong( complexOf_llong );+complexOf_uchar abs_fun_complexOf_uchar( complexOf_uchar );+complexOf_uint abs_fun_complexOf_uint( complexOf_uint );+complexOf_ulong abs_fun_complexOf_ulong( complexOf_ulong );+complexOf_ullong abs_fun_complexOf_ullong( complexOf_ullong );+complexOf_float abs_fun_complexOf_float( complexOf_float );+unsigned abs_fun_complexOf_short( unsigned );+unsigned abs_fun_complexOf_ushort( unsigned );++complexOf_char signum_fun_complexOf_char( complexOf_char );+complexOf_int signum_fun_complexOf_int( complexOf_int );+complexOf_long signum_fun_complexOf_long( complexOf_long );+complexOf_llong signum_fun_complexOf_llong( complexOf_llong );+complexOf_uchar signum_fun_complexOf_uchar( complexOf_uchar );+complexOf_uint signum_fun_complexOf_uint( complexOf_uint );+complexOf_ulong signum_fun_complexOf_ulong( complexOf_ulong );+complexOf_ullong signum_fun_complexOf_ullong( complexOf_ullong );+complexOf_float signum_fun_complexOf_float( complexOf_float );+unsigned signum_fun_complexOf_short( unsigned );+unsigned signum_fun_complexOf_ushort( unsigned );++complexOf_char add_fun_complexOf_char( complexOf_char, complexOf_char );+complexOf_int add_fun_complexOf_int( complexOf_int, complexOf_int );+complexOf_long add_fun_complexOf_long( complexOf_long, complexOf_long );+complexOf_llong add_fun_complexOf_llong( complexOf_llong, complexOf_llong );+complexOf_uchar add_fun_complexOf_uchar( complexOf_uchar, complexOf_uchar );+complexOf_uint add_fun_complexOf_uint( complexOf_uint, complexOf_uint );+complexOf_ulong add_fun_complexOf_ulong( complexOf_ulong, complexOf_ulong );+complexOf_ullong add_fun_complexOf_ullong( complexOf_ullong, complexOf_ullong );+complexOf_float add_fun_complexOf_float( complexOf_float, complexOf_float );++complexOf_char sub_fun_complexOf_char( complexOf_char, complexOf_char );+complexOf_int sub_fun_complexOf_int( complexOf_int, complexOf_int );+complexOf_long sub_fun_complexOf_long( complexOf_long, complexOf_long );+complexOf_llong sub_fun_complexOf_llong( complexOf_llong, complexOf_llong );+complexOf_uchar sub_fun_complexOf_uchar( complexOf_uchar, complexOf_uchar );+complexOf_uint sub_fun_complexOf_uint( complexOf_uint, complexOf_uint );+complexOf_ulong sub_fun_complexOf_ulong( complexOf_ulong, complexOf_ulong );+complexOf_ullong sub_fun_complexOf_ullong( complexOf_ullong, complexOf_ullong );+complexOf_float sub_fun_complexOf_float( complexOf_float, complexOf_float );++complexOf_char mult_fun_complexOf_char( complexOf_char, complexOf_char );+complexOf_int mult_fun_complexOf_int( complexOf_int, complexOf_int );+complexOf_long mult_fun_complexOf_long( complexOf_long, complexOf_long );+complexOf_llong mult_fun_complexOf_llong( complexOf_llong, complexOf_llong );+complexOf_uchar mult_fun_complexOf_uchar( complexOf_uchar, complexOf_uchar );+complexOf_uint mult_fun_complexOf_uint( complexOf_uint, complexOf_uint );+complexOf_ulong mult_fun_complexOf_ulong( complexOf_ulong, complexOf_ulong );+complexOf_ullong mult_fun_complexOf_ullong( complexOf_ullong, complexOf_ullong );+complexOf_float mult_fun_complexOf_float( complexOf_float, complexOf_float );+unsigned mult_fun_complexOf_short( unsigned, unsigned );+unsigned mult_fun_complexOf_ushort( unsigned, unsigned );++complexOf_float div_fun_complexOf_float( complexOf_float, complexOf_float );++complexOf_float exp_fun_complexOf_float( complexOf_float );++complexOf_float sqrt_fun_complexOf_float( complexOf_float );++complexOf_float log_fun_complexOf_float( complexOf_float );++complexOf_float pow_fun_complexOf_float( complexOf_float, complexOf_float );++complexOf_float logBase_fun_complexOf_float( complexOf_float, complexOf_float );++complexOf_float sin_fun_complexOf_float( complexOf_float );++complexOf_float cos_fun_complexOf_float( complexOf_float );++complexOf_float tan_fun_complexOf_float( complexOf_float );++complexOf_float sinh_fun_complexOf_float( complexOf_float );++complexOf_float cosh_fun_complexOf_float( complexOf_float );++complexOf_float tanh_fun_complexOf_float( complexOf_float );++complexOf_float asin_fun_complexOf_float( complexOf_float );++complexOf_float acos_fun_complexOf_float( complexOf_float );++complexOf_float atan_fun_complexOf_float( complexOf_float );++complexOf_float asinh_fun_complexOf_float( complexOf_float );++complexOf_float acosh_fun_complexOf_float( complexOf_float );++complexOf_float atanh_fun_complexOf_float( complexOf_float );++complexOf_char complex_fun_char( char, char );+complexOf_int complex_fun_int( int, int );+complexOf_long complex_fun_long( long, long );+complexOf_llong complex_fun_llong( long long, long long );+complexOf_uchar complex_fun_uchar( unsigned char, unsigned char );+complexOf_uint complex_fun_uint( unsigned, unsigned );+complexOf_ulong complex_fun_ulong( unsigned long, unsigned long );+complexOf_ullong complex_fun_ullong( unsigned long long, unsigned long long );+complexOf_float complex_fun_float( float, float );++char creal_fun_complexOf_char( complexOf_char );+int creal_fun_complexOf_int( complexOf_int );+long creal_fun_complexOf_long( complexOf_long );+long long creal_fun_complexOf_llong( complexOf_llong );+unsigned char creal_fun_complexOf_uchar( complexOf_uchar );+unsigned creal_fun_complexOf_uint( complexOf_uint );+unsigned long creal_fun_complexOf_ulong( complexOf_ulong );+unsigned long long creal_fun_complexOf_ullong( complexOf_ullong );+float creal_fun_complexOf_float( complexOf_float );+short creal_fun_complexOf_short( unsigned );+unsigned short creal_fun_complexOf_ushort( unsigned );++char cimag_fun_complexOf_char( complexOf_char );+int cimag_fun_complexOf_int( complexOf_int );+long cimag_fun_complexOf_long( complexOf_long );+long long cimag_fun_complexOf_llong( complexOf_llong );+unsigned char cimag_fun_complexOf_uchar( complexOf_uchar );+unsigned cimag_fun_complexOf_uint( complexOf_uint );+unsigned long cimag_fun_complexOf_ulong( complexOf_ulong );+unsigned long long cimag_fun_complexOf_ullong( complexOf_ullong );+float cimag_fun_complexOf_float( complexOf_float );+short cimag_fun_complexOf_short( unsigned );+unsigned short cimag_fun_complexOf_ushort( unsigned );++complexOf_char conj_fun_complexOf_char( complexOf_char );+complexOf_int conj_fun_complexOf_int( complexOf_int );+complexOf_long conj_fun_complexOf_long( complexOf_long );+complexOf_llong conj_fun_complexOf_llong( complexOf_llong );+complexOf_uchar conj_fun_complexOf_uchar( complexOf_uchar );+complexOf_uint conj_fun_complexOf_uint( complexOf_uint );+complexOf_ulong conj_fun_complexOf_ulong( complexOf_ulong );+complexOf_ullong conj_fun_complexOf_ullong( complexOf_ullong );+complexOf_float conj_fun_complexOf_float( complexOf_float );+unsigned conj_fun_complexOf_short( unsigned );+unsigned conj_fun_complexOf_ushort( unsigned );++char magnitude_fun_complexOf_char( complexOf_char );+int magnitude_fun_complexOf_int( complexOf_int );+long magnitude_fun_complexOf_long( complexOf_long );+long long magnitude_fun_complexOf_llong( complexOf_llong );+unsigned char magnitude_fun_complexOf_uchar( complexOf_uchar );+unsigned magnitude_fun_complexOf_uint( complexOf_uint );+unsigned long magnitude_fun_complexOf_ulong( complexOf_ulong );+unsigned long long magnitude_fun_complexOf_ullong( complexOf_ullong );+float magnitude_fun_complexOf_float( complexOf_float );+short magnitude_fun_complexOf_short( unsigned );+unsigned short magnitude_fun_complexOf_ushort( unsigned );++char phase_fun_complexOf_char( complexOf_char );+int phase_fun_complexOf_int( complexOf_int );+long phase_fun_complexOf_long( complexOf_long );+long long phase_fun_complexOf_llong( complexOf_llong );+unsigned char phase_fun_complexOf_uchar( complexOf_uchar );+unsigned phase_fun_complexOf_uint( complexOf_uint );+unsigned long phase_fun_complexOf_ulong( complexOf_ulong );+unsigned long long phase_fun_complexOf_ullong( complexOf_ullong );+float phase_fun_complexOf_float( complexOf_float );+short phase_fun_complexOf_short( unsigned );+unsigned short phase_fun_complexOf_ushort( unsigned );++complexOf_char mkPolar_fun_char( char, char );+complexOf_int mkPolar_fun_int( int, int );+complexOf_long mkPolar_fun_long( long, long );+complexOf_llong mkPolar_fun_llong( long long, long long );+complexOf_uchar mkPolar_fun_uchar( unsigned char, unsigned char );+complexOf_uint mkPolar_fun_uint( unsigned, unsigned );+complexOf_ulong mkPolar_fun_ulong( unsigned long, unsigned long );+complexOf_ullong mkPolar_fun_ullong( unsigned long long, unsigned long long );+complexOf_float mkPolar_fun_float( float, float );+unsigned mkPolar_fun_short( short, short );+unsigned mkPolar_fun_ushort( unsigned short, unsigned short );++complexOf_char cis_fun_char( char );+complexOf_int cis_fun_int( int );+complexOf_long cis_fun_long( long );+complexOf_llong cis_fun_llong( long long );+complexOf_uchar cis_fun_uchar( unsigned char );+complexOf_uint cis_fun_uint( unsigned );+complexOf_ulong cis_fun_ulong( unsigned long );+complexOf_ullong cis_fun_ullong( unsigned long long );+complexOf_float cis_fun_float( float );+unsigned cis_fun_short( short );+unsigned cis_fun_ushort( unsigned short );++++void traceStart();+void traceEnd();++void trace_char( char, int );+void trace_short( short, int );+void trace_int( int, int );+void trace_long( long, int );+void trace_llong( long long, int );+void trace_uchar( unsigned char, int );+void trace_ushort( unsigned short, int );+void trace_uint( unsigned, int );+void trace_ulong( unsigned long, int );+void trace_ullong( unsigned long long, int );+void trace_float( float, int );+void trace_complexOf_char( complexOf_char, int );+void trace_complexOf_short( unsigned, int );+void trace_complexOf_int( complexOf_int, int );+void trace_complexOf_long( complexOf_long, int );+void trace_complexOf_llong( complexOf_llong, int );+void trace_complexOf_uchar( complexOf_uchar, int );+void trace_complexOf_ushort( unsigned, int );+void trace_complexOf_uint( complexOf_uint, int );+void trace_complexOf_ulong( complexOf_ulong, int );+void trace_complexOf_ullong( complexOf_ullong, int );+void trace_complexOf_float( complexOf_float, int );++#endif /* FELDSPAR_TI_C64X_H */
+ lib/Feldspar/C/ivar.c view
@@ -0,0 +1,204 @@+//+// 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 "ivar.h"+#include <stdlib.h>+#include <string.h>+//#define LOG+#include "log.h"++unsigned int ivar_linker_hook = 0xDECAFBAD;++void *worker( void *p );++void ivar_init( struct ivar *iv )+{+ struct ivar_internals *ivi;+ int err;+ log_1("ivar_init %p - enter\n", iv);+ ivi = iv->internals = (struct ivar_internals*)malloc( sizeof(struct ivar_internals) );+ err = pthread_mutex_init( &(ivi->mutex), NULL );+ if (err) exit(err);+ err = pthread_cond_init( &(ivi->cond), NULL );+ if (err) exit(err);+ ivi->full = 0;+ iv->self = iv;+ log_1("ivar_init %p - leave\n", iv);+}++void ivar_destroy( struct ivar *iv ) // TODO: Think about ivars escaping from their scope...+{+ log_1("ivar_destroy %p - enter\n", iv);+ // if( iv->self == iv ) // This is true iff this iVar is not a copy.+ // {+ // struct ivar_internals *ivi = iv->internals;+ // pthread_mutex_destroy( &(ivi->mutex) );+ // pthread_cond_destroy( &(ivi->cond) );+ // if( ivi->full )+ // free( ivi->data );+ // free( ivi );+ // }+ log_1("ivar_destroy %p - leave\n", iv);+}++void ivar_put_with_size( struct ivar iv, void *d, int size )+{+ struct ivar_internals *ivi = iv.internals;+ log_3("ivar_put_with_size %p %p %d - enter\n", &iv, d, size);+ pthread_mutex_lock( &(ivi->mutex) );+ ivi->data = (void*)malloc( size );+ memcpy( ivi->data, d, size );+ ivi->full = 1;+ pthread_cond_broadcast( &(ivi->cond) );+ pthread_mutex_unlock( &(ivi->mutex) );+ log_3("ivar_put_with_size %p %p %d - leave\n", &iv, d, size);+}++void ivar_put_array( struct ivar iv, struct array *d )+{+ struct ivar_internals *ivi = iv.internals;+ log_2("ivar_put_array %p %p - enter\n", &iv, d);+ pthread_mutex_lock( &(ivi->mutex) );+ ivi->data = (void*)malloc( sizeof(struct array) );+ initArray( ivi->data, d->elemSize, d->length );+ copyArray( ivi->data, d );+ ivi->full = 1;+ pthread_cond_broadcast( &(ivi->cond) );+ pthread_mutex_unlock( &(ivi->mutex) );+ log_2("ivar_put_array %p %p - leave\n", &iv, d);+}++void ivar_get_helper( struct ivar_internals *iv )+{+ log_1("ivar_get_helper %p - enter\n", iv);+ pthread_mutex_lock( &(iv->mutex) );+ if( !iv->full )+ {+ log_1("ivar_get_helper %p - ivar is empty\n", iv);+ int create = 0;+ pthread_mutex_lock( &(feldspar_taskpool.mutex) );+ if( !feldspar_taskpool.shutdown && (feldspar_taskpool.num_threads <= feldspar_taskpool.min_threads) )+ {+ create = 1;+ ++feldspar_taskpool.num_threads;+ log_3("ivar_get_helper %p - will create a new thread; "+ "active: %d, all: %d\n"+ , iv, feldspar_taskpool.act_threads, feldspar_taskpool.num_threads);+ }+ else+ {+ --feldspar_taskpool.act_threads;+ log_3("ivar_get_helper %p - will NOT create a new thread; "+ "active: %d, all: %d\n"+ , iv, feldspar_taskpool.act_threads, feldspar_taskpool.num_threads);+ }+ pthread_mutex_unlock( &(feldspar_taskpool.mutex) );+ if( create )+ {+ pthread_t th;+ pthread_create( &th, NULL, &worker, (void*)&feldspar_taskpool );+ }+ log_1("ivar_get_helper %p - blocking while waiting for data\n", iv);+ pthread_cond_wait( &(iv->cond), &(iv->mutex) );+ pthread_mutex_lock( &(feldspar_taskpool.mutex) );+ ++feldspar_taskpool.act_threads;+ log_3("ivar_get_helper %p - data arrived; active: %d, all: %d\n"+ , iv, feldspar_taskpool.act_threads, feldspar_taskpool.num_threads);+ pthread_mutex_unlock( &(feldspar_taskpool.mutex) ); + }+ pthread_mutex_unlock( &(iv->mutex) );+ log_1("ivar_get_helper %p - leave\n", iv);+}++void ivar_get_with_size( void *var, struct ivar iv, int size )+{+ log_3("ivar_get_with_size %p %p %d - enter\n", var, &iv, size);+ ivar_get_helper(iv.internals);+ memcpy( var, iv.internals->data, size );+ log_3("ivar_get_with_size %p %p %d - leave\n", var, &iv, size);+}++void ivar_get_array( struct array *var, struct ivar iv )+{+ struct array *ptr;+ log_2("ivar_get_array %p %p - enter\n", var, &iv);+ ivar_get_helper(iv.internals);+ ptr = (struct array*)iv.internals->data;+ assert(ptr);+ initArray( var, ptr->elemSize, ptr->length );+ copyArray( var, ptr );+ log_2("ivar_get_array %p %p - leave\n", var, &iv);+}++void ivar_get_nontask_with_size( void *var, struct ivar iv, int size )+{+ struct ivar_internals *ivi = iv.internals;+ log_3("ivar_get_nontask_with_size %p %p %d - enter\n", var, &iv, size);+ pthread_mutex_lock( &(ivi->mutex) );+ if ( !ivi->full )+ log_3("ivar_get_nontask_with_size %p %p %d -> waiting for data\n"+ , var, &iv, size);+ while( !ivi->full )+ {+ int err = pthread_cond_wait( &(ivi->cond), &(ivi->mutex) );+ if (err) { exit(err); }+ }+ pthread_mutex_unlock( &(ivi->mutex) );+ assert(ivi->data);+ memcpy( var, ivi->data, size );+ log_3("ivar_get_nontask_with_size %p %p %d - leave\n", var, &iv, size);+}++void ivar_get_array_nontask( struct array *var, struct ivar iv )+{+ struct ivar_internals *ivi = iv.internals;+ struct array *ptr;+ log_2("ivar_get_array_nontask %p %p - enter\n", var, &iv);+ pthread_mutex_lock( &(ivi->mutex) );+ if ( !ivi->full )+ log_2("ivar_get_array_nontask %p %p - waiting for data\n", var, &iv);+ while(!ivi->full)+ {+ int err = pthread_cond_wait( &(ivi->cond), &(ivi->mutex) );+ if (err) { exit(err); }+ }+ assert(ivi->full);+ pthread_mutex_unlock( &(ivi->mutex) );+ if (NULL == ivi->data)+ {+ log_2("ivar_get_array_nontask %p %p - data uninitialized\n", var, &iv);+ }+ else+ {+ ptr = (struct array*)ivi->data;+ initArray( var, ptr->elemSize, ptr->length );+ copyArray( var, ptr );+ }+ log_2("ivar_get_array_nontask %p %p - leave\n", var, &iv);+}+
+ lib/Feldspar/C/ivar.h view
@@ -0,0 +1,93 @@+//+// 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.+//++#ifndef IVAR_H+#define IVAR_H++#include <pthread.h>+#include "taskpool.h"+#include "feldspar_array.h"++/* Declaration of the Feldspar application's global taskpool. */+extern struct taskpool feldspar_taskpool;++struct ivar_internals+{+ pthread_mutex_t mutex;+ pthread_cond_t cond;+ int full;+ void *data;+};++struct ivar+{+ struct ivar_internals *internals;+ struct ivar *self;+};++/* Initializes 'iv'. */+void ivar_init( struct ivar *iv );++/* Deinitializes ivar 'iv'. */+void ivar_destroy( struct ivar *iv );++/* Copies the data at 'd' of size 'size' into the ivar 'iv'. Ivars are + * allowed to be written only once! */+void ivar_put_with_size( struct ivar iv, void *d, int size );++/* Wrapper to 'ivar_put_with_size'. */+#define ivar_put(typ,iv,d) ivar_put_with_size(iv,d,sizeof(typ))++/* Specialized version for arrays. */+void ivar_put_array( struct ivar iv, struct array *d );++/* Copies the data of size 'size' of the ivar 'iv' to 'var'. Ivars are+ * allowed to be read any number of times. Reading an empty ivar blocks+ * the thread, but a new worker thread is started instead.+ * Use this function only inside tasks! */+void ivar_get_with_size( void *var, struct ivar iv, int size );++/* Wrapper to 'ivar_get_with_size'. */+#define ivar_get(typ,var,iv) ivar_get_with_size(var,iv,sizeof(typ))++/* Specialized version for arrays. */+void ivar_get_array( struct array *var, struct ivar iv );++/* Copies the data of size 'size' of the ivar 'iv' to 'var'. Ivars are+ * allowed to be read any number of times. Reading an empty ivar blocks+ * the thread.+ * Use this function only outside tasks, eg. the main thread or similar! */+void ivar_get_nontask_with_size( void *var, struct ivar iv, int size );++/* Wrapper to 'ivar_get_nontask_with_size'. */+#define ivar_get_nontask(typ,var,iv) ivar_get_nontask_with_size(var,iv,sizeof(typ))++/* Specialized version for arrays. */+void ivar_get_array_nontask( struct array *var, struct ivar iv );++#endif /* IVAR_H */
+ lib/Feldspar/C/log.h view
@@ -0,0 +1,50 @@+//+// 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.+//++#ifndef LOG_H+#define LOG_H++#include <stdio.h>++#ifdef LOG+ #define log_0(text) printf(text)+ #define log_1(text,x1) printf(text,x1)+ #define log_2(text,x1,x2) printf(text,x1,x2)+ #define log_3(text,x1,x2,x3) printf(text,x1,x2,x3)+ #define log_4(text,x1,x2,x3,x4) printf(text,x1,x2,x3,x4)+ #define log_5(text,x1,x2,x3,x4,x5) printf(text,x1,x2,x3,x4,x5)+#else+ #define log_0(text) + #define log_1(text,x1) + #define log_2(text,x1,x2) + #define log_3(text,x1,x2,x3)+ #define log_4(text,x1,x2,x3,x4)+ #define log_5(text,x1,x2,x3,x4,x5)+#endif++#endif /* LOG_H */
+ lib/Feldspar/C/taskpool.c view
@@ -0,0 +1,164 @@+//+// 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 <stdlib.h>+#include <stdio.h>+#include "taskpool.h"+//#define LOG+#include "log.h"++unsigned int taskpool_linker_hook = 0xDECAFBAD;++/* Definition of the Feldspar application's global taskpool. */+struct taskpool *feldspar_taskpool = 0;++void *worker();++void taskpool_init( int c, int n, int m )+{+ log_3("taskpool_init %d %d %d - enter\n",c,n,m);+ log_0("taskpool_init - allocating taskpool\n");+ feldspar_taskpool = malloc(sizeof(struct taskpool));+ log_1("taskpool_init - allocating %d closures\n",c);+ feldspar_taskpool->closures = malloc( c * sizeof(void*) );+ feldspar_taskpool->capacity = c;+ feldspar_taskpool->head = 0;+ feldspar_taskpool->tail = 0;+ feldspar_taskpool->shutdown = 0;+ feldspar_taskpool->num_threads = n;+ feldspar_taskpool->act_threads = n;+ feldspar_taskpool->min_threads = m;+ feldspar_taskpool->max_threads = n;+ if( n > 0 )+ pthread_mutex_init( &(feldspar_taskpool->mutex), NULL );+ log_1("taskpool_init - starting %d threads\n",n);+ for( ; n > 0; --n )+ {+ pthread_t th;+ pthread_create( &th, NULL, &worker, NULL );+ log_1("taskpool_init - thread %p created\n", &th);+ }+ log_0("taskpool_init - leave\n");+}++void taskpool_shutdown()+{+ log_0("taskpool_shutdown - enter\n");+ feldspar_taskpool->shutdown = 1;+ log_0("taskpool_shutdown - leave\n");+}++void spawn( void *closure )+{+ log_1("spawn %p - enter\n", closure);+ pthread_mutex_lock( &(feldspar_taskpool->mutex) );+ feldspar_taskpool->closures[feldspar_taskpool->tail] = closure;+ log_3("spawn %p - saved as task %d at %p\n"+ , closure, feldspar_taskpool->tail+ , &feldspar_taskpool->closures[feldspar_taskpool->tail]);+ ++feldspar_taskpool->tail;+ if( feldspar_taskpool->tail == feldspar_taskpool->capacity )+ feldspar_taskpool->tail = 0;+ pthread_mutex_unlock( &(feldspar_taskpool->mutex) );+ log_1("spawn %p - leave\n", closure);+}++void *worker()+{+ unsigned int self;+ self = (unsigned long)pthread_self();+ log_1("worker %d - enter\n", self);+ struct taskpool *pool = feldspar_taskpool;+ void (*fun)();+ char *closure;+ int awake = 1;+ log_1("worker %d - entering the loop\n", self);+ while(1)+ {+ if( pool->shutdown && pool->head == pool->tail )+ {+ log_1("worker %d - shutdown detected, going to terminate\n", self);+ break;+ }+ if( pool->act_threads > pool->max_threads )+ {+ log_1("worker %d - too many active threads, going to terminate\n", self);+ break;+ }+ fun = NULL;+ closure = NULL;+ pthread_mutex_lock( &(pool->mutex) );+ if( pool->head != pool->tail )+ {+ log_2("worker %d - pop task %d\n", self, pool->head);+ closure = pool->closures[pool->head];+ ++pool->head;+ if( pool->head == pool->capacity )+ pool->head = 0;+ }+ else {+ }+ pthread_mutex_unlock( &(pool->mutex) );+ if( closure == NULL )+ {+ if (1 == awake)+ {+ log_1("worker %d - sleep\n", self);+ awake = 0;+ }+ }+ else+ {+ awake = 1;+ fun = *((void(**)())closure);+ log_2("worker %d - closure %p enter\n", self, fun);+ fun( closure + sizeof(void(*)()) ); /* TODO: sizeof(void*) == sizeof(void(**)()) is assumed here */+ log_2("worker %d - closure %p leave\n", self, fun);+ }+ }+ /* Cleanup before exit: */+ {+ int last = 0;+ log_1("worker %d - cleanup\n", self);+ pthread_mutex_lock( &(pool->mutex) );+ --pool->num_threads;+ --pool->act_threads;+ log_3("worker %d - cleanup done; active: %d, all: %d\n"+ , self, pool->act_threads, pool->num_threads);+ last = (pool->num_threads == 0);+ pthread_mutex_unlock( &(pool->mutex) );+ if( last )+ {+ log_1("worker %d - last one does extra cleanup\n", self);+ pthread_mutex_destroy( &(pool->mutex) );+ }+ }+ log_1("worker %d - leave\n", self);+ pthread_exit(NULL);+}+
+ lib/Feldspar/C/taskpool.h view
@@ -0,0 +1,372 @@+//+// 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.+//++#ifndef TASKPOOL_H+#define TASKPOOL_H++#include <pthread.h>++struct taskpool+{+ int capacity;+ int num_threads, act_threads, min_threads, max_threads;+ int head, tail;+ void **closures;+ int shutdown;+ pthread_mutex_t mutex;+};++void taskpool_init( int c, int num, int min );++void taskpool_shutdown();++void spawn( void *closure );++/* Helper macro: */+/* TODO: Replace runtime check with a compile time one! */+#define check_array( t, temp ) \+ if( !strcmp(#t,"struct array *") ) \+ { \+ void *m = malloc( sizeof(struct array) ); \+ memcpy( m, *(void**)(&(temp)), sizeof(struct array) ); \+ memcpy( (void*)&(temp), (void*)&m, sizeof(void*) ); \+ } \++/* Wrappers for spawn with different number of arguments: */++#define spawn0( task ) \+ { \+ void *buffer = malloc( sizeof(void(*)()) ); \+ char *p = buffer; \+ void *t0 = (task); \+ memcpy( p, &t0, sizeof(void(*)()) ); \+ spawn( buffer ); \+ } \++#define spawn1( task, t1, p1 ) \+ { \+ void *buffer = malloc( sizeof(void(*)()) + sizeof(t1) ); \+ char *p = buffer; \+ void *t0 = task; \+ t1 temp1 = (p1); \+ memcpy( p, &t0, sizeof(void(*)()) ); \+ p += sizeof(void(*)()); \+ check_array( t1, temp1 ); \+ memcpy( p, &temp1, sizeof(t1) ); \+ spawn( buffer ); \+ } \++#define spawn2( task, t1, p1, t2, p2 ) \+ { \+ void *buffer = malloc( sizeof(void(*)()) + sizeof(t1) + sizeof(t2) ); \+ char *p = buffer; \+ void *t0 = task; \+ t1 temp1 = (p1); \+ t2 temp2 = (p2); \+ memcpy( p, &t0, sizeof(void(*)()) ); \+ p += sizeof(void(*)()); \+ check_array( t1, temp1 ); \+ memcpy( p, &temp1, sizeof(t1) ); \+ p += sizeof(t1); \+ check_array( t2, temp2 ); \+ memcpy( p, &temp2, sizeof(t2) ); \+ spawn( buffer ); \+ } \++#define spawn3( task, t1, p1, t2, p2, t3, p3 ) \+ { \+ void *buffer = malloc( sizeof(void(*)()) + sizeof(t1) + sizeof(t2) + sizeof(t3) ); \+ char *p = buffer; \+ void *t0 = task; \+ t1 temp1 = (p1); \+ t2 temp2 = (p2); \+ t3 temp3 = (p3); \+ memcpy( p, &t0, sizeof(void(*)()) ); \+ p += sizeof(void(*)()); \+ check_array( t1, temp1 ); \+ memcpy( p, &temp1, sizeof(t1) ); \+ p += sizeof(t1); \+ check_array( t2, temp2 ); \+ memcpy( p, &temp2, sizeof(t2) ); \+ p += sizeof(t2); \+ check_array( t3, temp3 ); \+ memcpy( p, &temp3, sizeof(t3) ); \+ spawn( buffer ); \+ } \++#define spawn4( task, t1, p1, t2, p2, t3, p3, t4, p4 ) \+ { \+ void *buffer = malloc( sizeof(void(*)()) + sizeof(t1) + sizeof(t2) + sizeof(t3) + sizeof(t4) ); \+ char *p = buffer; \+ void *t0 = task; \+ t1 temp1 = (p1); \+ t2 temp2 = (p2); \+ t3 temp3 = (p3); \+ t4 temp4 = (p4); \+ memcpy( p, &t0, sizeof(void(*)()) ); \+ p += sizeof(void(*)()); \+ check_array( t1, temp1 ); \+ memcpy( p, &temp1, sizeof(t1) ); \+ p += sizeof(t1); \+ check_array( t2, temp2 ); \+ memcpy( p, &temp2, sizeof(t2) ); \+ p += sizeof(t2); \+ check_array( t3, temp3 ); \+ memcpy( p, &temp3, sizeof(t3) ); \+ p += sizeof(t3); \+ check_array( t4, temp4 ); \+ memcpy( p, &temp4, sizeof(t4) ); \+ spawn( buffer ); \+ } \++#define spawn5( task, t1, p1, t2, p2, t3, p3, t4, p4, t5, p5 ) \+ { \+ void *buffer = malloc( sizeof(void(*)()) + sizeof(t1) + sizeof(t2) + sizeof(t3) + sizeof(t4) + sizeof(t5) ); \+ char *p = buffer; \+ void *t0 = task; \+ t1 temp1 = (p1); \+ t2 temp2 = (p2); \+ t3 temp3 = (p3); \+ t4 temp4 = (p4); \+ t5 temp5 = (p5); \+ memcpy( p, &t0, sizeof(void(*)()) ); \+ p += sizeof(void(*)()); \+ check_array( t1, temp1 ); \+ memcpy( p, &temp1, sizeof(t1) ); \+ p += sizeof(t1); \+ check_array( t2, temp2 ); \+ memcpy( p, &temp2, sizeof(t2) ); \+ p += sizeof(t2); \+ check_array( t3, temp3 ); \+ memcpy( p, &temp3, sizeof(t3) ); \+ p += sizeof(t3); \+ check_array( t4, temp4 ); \+ memcpy( p, &temp4, sizeof(t4) ); \+ p += sizeof(t4); \+ check_array( t5, temp5 ); \+ memcpy( p, &temp5, sizeof(t5) ); \+ spawn( buffer ); \+ } \++#define spawn6( task, t1, p1, t2, p2, t3, p3, t4, p4, t5, p5, t6, p6 ) \+ { \+ void *buffer = malloc( sizeof(void(*)()) + sizeof(t1) + sizeof(t2) + sizeof(t3) + sizeof(t4) + sizeof(t5) + sizeof(t6) ); \+ char *p = buffer; \+ void *t0 = task; \+ t1 temp1 = (p1); \+ t2 temp2 = (p2); \+ t3 temp3 = (p3); \+ t4 temp4 = (p4); \+ t5 temp5 = (p5); \+ t6 temp6 = (p6); \+ memcpy( p, &t0, sizeof(void(*)()) ); \+ p += sizeof(void(*)()); \+ check_array( t1, temp1 ); \+ memcpy( p, &temp1, sizeof(t1) ); \+ p += sizeof(t1); \+ check_array( t2, temp2 ); \+ memcpy( p, &temp2, sizeof(t2) ); \+ p += sizeof(t2); \+ check_array( t3, temp3 ); \+ memcpy( p, &temp3, sizeof(t3) ); \+ p += sizeof(t3); \+ check_array( t4, temp4 ); \+ memcpy( p, &temp4, sizeof(t4) ); \+ p += sizeof(t4); \+ check_array( t5, temp5 ); \+ memcpy( p, &temp5, sizeof(t5) ); \+ p += sizeof(t5); \+ check_array( t6, temp6 ); \+ memcpy( p, &temp6, sizeof(t6) ); \+ spawn( buffer ); \+ } \++#define spawn7( task, t1, p1, t2, p2, t3, p3, t4, p4, t5, p5, t6, p6 , t7, p7 ) \+ { \+ 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; \+ t1 temp1 = (p1); \+ t2 temp2 = (p2); \+ t3 temp3 = (p3); \+ t4 temp4 = (p4); \+ t5 temp5 = (p5); \+ t6 temp6 = (p6); \+ t7 temp7 = (p7); \+ memcpy( p, &t0, sizeof(void(*)()) ); \+ p += sizeof(void(*)()); \+ check_array( t1, temp1 ); \+ memcpy( p, &temp1, sizeof(t1) ); \+ p += sizeof(t1); \+ check_array( t2, temp2 ); \+ memcpy( p, &temp2, sizeof(t2) ); \+ p += sizeof(t2); \+ check_array( t3, temp3 ); \+ memcpy( p, &temp3, sizeof(t3) ); \+ p += sizeof(t3); \+ check_array( t4, temp4 ); \+ memcpy( p, &temp4, sizeof(t4) ); \+ p += sizeof(t4); \+ check_array( t5, temp5 ); \+ memcpy( p, &temp5, sizeof(t5) ); \+ p += sizeof(t5); \+ check_array( t6, temp6 ); \+ memcpy( p, &temp6, sizeof(t6) ); \+ p += sizeof(t6); \+ check_array( t7, temp7 ); \+ memcpy( p, &temp7, sizeof(t7) ); \+ spawn( buffer ); \+ } \++/* Wrappers for task cores with different number of arguments: */++#define run0( task_core ) \+ { \+ (task_core)(); \+ } \++#define run1( task_core, t1 ) \+ { \+ t1 p1; \+ char *p = params; \+ memcpy( &p1, p, sizeof(t1) ); \+ (task_core)(p1); \+ } \++#define run2( task_core, t1, t2 ) \+ { \+ t1 p1; \+ t2 p2; \+ char *p = params; \+ memcpy( &p1, p, sizeof(t1) ); \+ p += sizeof(t1); \+ memcpy( &p2, p, sizeof(t2) ); \+ (task_core)(p1,p2); \+ } \++#define run3( task_core, t1, t2, t3 ) \+ { \+ t1 p1; \+ t2 p2; \+ t3 p3; \+ char *p = params; \+ memcpy( &p1, p, sizeof(t1) ); \+ p += sizeof(t1); \+ memcpy( &p2, p, sizeof(t2) ); \+ p += sizeof(t2); \+ memcpy( &p3, p, sizeof(t3) ); \+ (task_core)(p1,p2,p3); \+ } \++#define run4( task_core, t1, t2, t3, t4 ) \+ { \+ t1 p1; \+ t2 p2; \+ t3 p3; \+ t4 p4; \+ char *p = params; \+ memcpy( &p1, p, sizeof(t1) ); \+ p += sizeof(t1); \+ memcpy( &p2, p, sizeof(t2) ); \+ p += sizeof(t2); \+ memcpy( &p3, p, sizeof(t3) ); \+ p += sizeof(t3); \+ memcpy( &p4, p, sizeof(t4) ); \+ (task_core)(p1,p2,p3,p4); \+ } \++#define run5( task_core, t1, t2, t3, t4, t5 ) \+ { \+ t1 p1; \+ t2 p2; \+ t3 p3; \+ t4 p4; \+ t5 p5; \+ char *p = params; \+ memcpy( &p1, p, sizeof(t1) ); \+ p += sizeof(t1); \+ memcpy( &p2, p, sizeof(t2) ); \+ p += sizeof(t2); \+ memcpy( &p3, p, sizeof(t3) ); \+ p += sizeof(t3); \+ memcpy( &p4, p, sizeof(t4) ); \+ p += sizeof(t4); \+ memcpy( &p5, p, sizeof(t5) ); \+ (task_core)(p1,p2,p3,p4,p5); \+ } \++#define run6( task_core, t1, t2, t3, t4, t5, t6 ) \+ { \+ t1 p1; \+ t2 p2; \+ t3 p3; \+ t4 p4; \+ t5 p5; \+ t6 p6; \+ char *p = params; \+ memcpy( &p1, p, sizeof(t1) ); \+ p += sizeof(t1); \+ memcpy( &p2, p, sizeof(t2) ); \+ p += sizeof(t2); \+ memcpy( &p3, p, sizeof(t3) ); \+ p += sizeof(t3); \+ memcpy( &p4, p, sizeof(t4) ); \+ p += sizeof(t4); \+ memcpy( &p5, p, sizeof(t5) ); \+ p += sizeof(t5); \+ memcpy( &p6, p, sizeof(t6) ); \+ (task_core)(p1,p2,p3,p4,p5,p6); \+ } \++#define run7( task_core, t1, t2, t3, t4, t5, t6, t7 ) \+ { \+ t1 p1; \+ t2 p2; \+ t3 p3; \+ t4 p4; \+ t5 p5; \+ t6 p6; \+ t7 p7; \+ char *p = params; \+ memcpy( &p1, p, sizeof(t1) ); \+ p += sizeof(t1); \+ memcpy( &p2, p, sizeof(t2) ); \+ p += sizeof(t2); \+ memcpy( &p3, p, sizeof(t3) ); \+ p += sizeof(t3); \+ memcpy( &p4, p, sizeof(t4) ); \+ p += sizeof(t4); \+ memcpy( &p5, p, sizeof(t5) ); \+ p += sizeof(t5); \+ memcpy( &p6, p, sizeof(t6) ); \+ p += sizeof(t6); \+ memcpy( &p7, p, sizeof(t7) ); \+ (task_core)(p1,p2,p3,p4,p5,p6,p7); \+ } \++#endif /* TASKPOOL_H */
+ lib/Feldspar/Compiler.hs view
@@ -0,0 +1,43 @@+--+-- 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+ , c99PlatformOptions+ , tic64xPlatformOptions+ , 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)+
+ lib/Feldspar/Compiler/Backend/C/CodeGeneration.hs view
@@ -0,0 +1,144 @@+--+-- 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 FlexibleInstances #-}++module Feldspar.Compiler.Backend.C.CodeGeneration where++import Feldspar.Compiler.Imperative.Representation+import Feldspar.Compiler.Error+import Feldspar.Compiler.Backend.C.Options+import Feldspar.Compiler.Backend.C.Library++import qualified Data.List as List (find)++-- =======================+-- == C code generation ==+-- =======================++codeGenerationError :: ErrorClass -> String -> a+codeGenerationError = handleError "CodeGeneration"++defaultMemberName :: String+defaultMemberName = "member"++class ToC a where+ toC :: Options -> Place -> a -> String++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++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 ToC (Variable ()) where+ toC options place (Variable vname typ role _) = showVariable options place role typ vname++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++showType :: Options -> VariableRole -> Place -> Type -> IsRestrict -> String+showType options role MainParameter_pl t _+ | passByReference t || role == Pointer = tname ++ " *"+ | otherwise = tname+ where+ tname = toC options MainParameter_pl t+showType options _ Declaration_pl t _ = toC options Declaration_pl t+showType _ _ _ _ _ = ""++arrayTypeName :: String+arrayTypeName = "struct array"++ivarTypeName :: String+ivarTypeName = "struct ivar"++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 ++ ")"++passByReference :: Type -> Bool+passByReference ArrayType{} = True+passByReference StructType{} = True+passByReference _ = False++----------------------+-- Helper functions --+----------------------++ind :: (a-> String) -> a -> String+ind f x = unlines $ map (\a -> " " ++ a) $ lines $ f x++listprint :: (a->String) -> String -> [a] -> String+listprint f s = listprint' . filter (/= "") . map f+ where+ listprint' [] = ""+ listprint' [x] = x+ listprint' (x:xs) = x ++ s ++ listprint' xs++decrArrayDepth :: Type -> Type+decrArrayDepth (ArrayType _ t) = t+decrArrayDepth t = codeGenerationError InternalError $ "Non-array variable of type " ++ show t ++ " is indexed!"++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++structFieldNotFound :: String -> a+structFieldNotFound f = codeGenerationError InternalError $ "Not found struct field with this name: " ++ f
+ lib/Feldspar/Compiler/Backend/C/Library.hs view
@@ -0,0 +1,85 @@+--+-- 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.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++data CompilationMode = Interactive | Standalone+ deriving (Show, Eq)++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+ | otherwise = head s : replace (tail s) find repl++fixFunctionName :: String -> String+fixFunctionName functionName = replace (replace functionName "_" "__") "'" "_prime"++makeDebugHFileName :: String -> String+makeDebugHFileName = (<.> "h.dbg.txt")++makeDebugCFileName :: String -> String+makeDebugCFileName = (<.> "c.dbg.txt")++makeHFileName :: String -> String+makeHFileName = (<.> "h")++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]
+ lib/Feldspar/Compiler/Backend/C/Options.hs view
@@ -0,0 +1,101 @@+--+-- 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 GADTs #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++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)++data Options =+ Options+ { platform :: Platform+ , unroll :: UnrollStrategy+ , debug :: DebugOption+ , memoryInfoVisible :: Bool+ , rules :: [Rule]+ } deriving (Eq, Show)++data UnrollStrategy = NoUnroll | Unroll Int+ deriving (Eq, Show)++data DebugOption = NoDebug | NoPrimitiveInstructionHandling+ deriving (Eq, Show)++data Platform = Platform {+ name :: String,+ types :: [(Type, String, String)],+ values :: [(Type, ShowValue)],+ includes :: [String],+ platformRules :: [Rule],+ isRestrict :: IsRestrict+} deriving (Eq, Show)++type ShowValue = Constant () -> String++instance Eq ShowValue where+ (==) _ _ = True++data IsRestrict = Restrict | NoRestrict+ deriving (Show,Eq)++-- * Actions and rules++data Action t+ = Replace t+ | Propagate Rule+ | WithId (Int -> [Action t])+ | WithOptions (Options -> [Action t])+ deriving Typeable++data Rule where+ Rule :: (Typeable t) => (t -> [Action t]) -> Rule++instance Show Rule where+ show _ = "Transformation rule."++instance Eq Rule where+ _ == _ = False++rule :: (Interface t, Typeable (Repr t)) => (t -> [Action (Repr t)]) -> Rule+rule f = Rule $ \x -> f $ toInterface x++replaceWith :: (Interface t) => t -> Action (Repr t)+replaceWith = Replace . fromInterface++propagate :: (Interface t, Typeable (Repr t)) => (t -> [Action (Repr t)]) -> Action t'+propagate = Propagate . rule
+ lib/Feldspar/Compiler/Backend/C/Platforms.hs view
@@ -0,0 +1,280 @@+--+-- 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 ViewPatterns #-}++module Feldspar.Compiler.Backend.C.Platforms+ ( availablePlatforms+ , c99+ , tic64x+ , c99Rules+ , tic64xRules+ , traceRules+ ) where+++import Feldspar.Compiler.Backend.C.Options+import Feldspar.Compiler.Imperative.Representation hiding (Type, Cast, In, Out, Block)+import Feldspar.Compiler.Imperative.Frontend++availablePlatforms :: [Platform]+availablePlatforms = [ c99, 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")+ ] ,+ values =+ [ (ComplexType FloatType, \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\""+ , "<stdint.h>"+ , "<string.h>"+ , "<math.h>"+ , "<stdbool.h>"+ , "<complex.h>"],+ platformRules = c99Rules ++ traceRules,+ isRestrict = NoRestrict+}++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")+ ] ,+ values = + [ (ComplexType FloatType, \cx -> "complex_fun_float(" ++ 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>"],+ platformRules = tic64xRules ++ c99Rules ++ traceRules,+ isRestrict = Restrict+}++showRe, showIm :: Constant t -> String+showRe = showConstant . realPartComplexValue+showIm = showConstant . imagPartComplexValue++showConstant :: Constant t -> String+showConstant (IntConst c _ _ _) = show c+showConstant (FloatConst c _ _) = show c ++ "f"++c99Rules :: [Rule]+c99Rules = [rule copy, rule c99]+ where+ copy (Call "copy" [Out arg1, In arg2])+ | isArray (typeof arg1) = [replaceWith $ Call "copyArray" [Out arg1,In arg2]]+ | otherwise = [replaceWith $ arg1 := arg2]+ 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 _ = []++tic64xRules :: [Rule]+tic64xRules = [rule tic64x]+ 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 _ = []++traceRules :: [Rule]+traceRules = [rule trace]+ where+ trace (Fun t "trace" [lab, val]) = [WithId acts]+ where+ acts i = [replaceWith trcVar, propagate decl, propagate trc, propagate frame]+ where+ trcVar = Var t trcVarName+ 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']+ where+ prg' = case prg of+ Seq (Call "traceStart" [] : _) -> prg+ Block _ (Seq (Call "traceStart" [] : _)) -> prg+ _ -> Seq [Call "traceStart" [], prg, Call "traceEnd" []]+ trace _ = []++extend :: String -> Type -> String+extend s t = s ++ "_fun_" ++ show t++extend' :: String -> Type -> String+extend' s t = s ++ "_" ++ show t++log2 :: Integer -> Maybe Integer+log2 n+ | n == 2 Prelude.^ l = Just l+ | otherwise = Nothing+ where+ l = toInteger $ length $ takeWhile (<=n) $ map (2 Prelude.^) [1..]++first, second :: String+first = "member1"+second = "member2"
+ lib/Feldspar/Compiler/Backend/C/Plugin/BlockProgramHandler.hs view
@@ -0,0 +1,78 @@+--+-- 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
+ lib/Feldspar/Compiler/Backend/C/Plugin/Locator.hs view
@@ -0,0 +1,232 @@+--+-- 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+
+ lib/Feldspar/Compiler/Backend/C/Plugin/PrettyPrint.hs view
@@ -0,0 +1,714 @@+--+-- 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)
+ lib/Feldspar/Compiler/Backend/C/Plugin/Rule.hs view
@@ -0,0 +1,85 @@+--+-- 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 ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Backend.C.Plugin.Rule+ ( RulePlugin(..)+ ) where++import Data.Typeable++import Feldspar.Transformation+import Feldspar.Compiler.Backend.C.Options++data RulePlugin = RulePlugin++instance Transformation RulePlugin+ where+ type From RulePlugin = ()+ type To RulePlugin = ()+ type Down RulePlugin = Options+ type Up RulePlugin = [Rule]+ type State RulePlugin = Int++instance Plugin RulePlugin+ where+ type ExternalInfo RulePlugin = Options+ executePlugin _ externalInfo = result . transform RulePlugin 0 externalInfo++instance (DefaultTransformable RulePlugin t, Typeable1 t) => 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+ applyRule :: t () -> Int -> [Rule] -> (t (), [Rule], [Rule], Int)+ applyRule c x = foldl applyRuleFun (c,[],[],x)+ where+ applyRuleFun :: (t (), [Rule], [Rule], Int) -> Rule -> (t (), [Rule], [Rule], Int)+ applyRuleFun (cc,incomp,prop,currentID) (Rule r) = case cast r of+ Nothing -> (cc,incomp ++ [Rule r],prop, currentID)+ Just r' -> (cc',incomp,prop ++ prop', newID)+ where+ (cc',prop', newID) = applyAction cc currentID (r' cc)+ applyAction :: t () -> Int -> [Action (t ())] -> (t (), [Rule], Int)+ applyAction ccc cid = foldl applyActionFun (ccc,[],cid)+ where+ applyActionFun :: (t (), [Rule], Int) -> Action (t ()) -> (t (), [Rule], Int)+ applyActionFun (_ , prop'', i) (Replace newConstr) = (newConstr, prop'' , i)+ applyActionFun (ccc' , prop'', i) (Propagate pr) = (ccc' , prop'' ++ [pr], i)+ applyActionFun (constr, _ , i) (WithId f) = applyAction constr (i + 1) (f i)+ applyActionFun (constr, _ , i) (WithOptions f) = applyAction constr i (f d)+ (x',_,pr1,newID1) = applyRule (result recurse) (state recurse) (rules d)+ (x'',pr3,pr2,newID2) = applyRule x' newID1 (up recurse)+++instance Combine [Rule] where+ combine = (++)
+ lib/Feldspar/Compiler/Backend/C/Plugin/TypeCorrector.hs view
@@ -0,0 +1,199 @@+--+-- 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
+ lib/Feldspar/Compiler/Backend/C/Plugin/TypeDefinitionGenerator.hs view
@@ -0,0 +1,87 @@+--+-- 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
+ lib/Feldspar/Compiler/Backend/C/Plugin/VariableRoleAssigner.hs view
@@ -0,0 +1,76 @@+--+-- 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+
+ lib/Feldspar/Compiler/Compiler.hs view
@@ -0,0 +1,248 @@+--+-- 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 DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}++module Feldspar.Compiler.Compiler where++import System.FilePath+import Data.Typeable as DT+import Control.Arrow+import Control.Applicative++import Feldspar.Transformation+import qualified Feldspar.NameExtractor as NameExtractor+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.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 CompToCCoreResult = CompToCCoreResult {+ sourceCode :: String,+ endPosition :: Position,+ debugModule :: Module DebugToCSemanticInfo+}++data SplitCompToCCoreResult = SplitCompToCCoreResult {+ sctccrSource :: CompToCCoreResult,+ sctccrHeader :: CompToCCoreResult+}++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)+} where+ belongsToHeader :: Entity () -> Bool+ belongsToHeader StructDef{} = True+ belongsToHeader ProcDecl{} = True+ belongsToHeader _ = False+ 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++moduleToCCore+ :: IncludesNeeded -> Options -> Module ()+ -> CompToCCoreResult+moduleToCCore needed opts mdl =+ CompToCCoreResult {+ sourceCode = incls ++ moduleSrc+ , endPosition = endPos+ , debugModule = dbgModule+ }+ where+ (incls, lineNum) = genInclude needed++ (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++ createSplit [header, source] = SplitCompToCCoreResult header source++genIncludeLinesCore :: [String] -> (String, Int)+genIncludeLinesCore [] = ("", 1)+genIncludeLinesCore (x:xs) = ("#include " ++ x ++ "\n" ++ str, linenum + 1) where+ (str, linenum) = genIncludeLinesCore xs++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\""]++-- | Predefined options++defaultOptions :: Options+defaultOptions+ = Options+ { platform = c99+ , unroll = NoUnroll+ , debug = NoDebug+ , memoryInfoVisible = True+ , rules = []+ }++c99PlatformOptions :: Options+c99PlatformOptions = defaultOptions++tic64xPlatformOptions :: Options+tic64xPlatformOptions = defaultOptions { platform = tic64x }++unrollOptions :: Options+unrollOptions = defaultOptions { unroll = Unroll 8 }++noPrimitiveInstructionHandling :: Options+noPrimitiveInstructionHandling = defaultOptions { debug = NoPrimitiveInstructionHandling }++noMemoryInformation :: Options+noMemoryInformation = defaultOptions { memoryInfoVisible = False }++-- | Plugin system++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+ }++executePluginChain :: (Compilable c internal)+ => CompilationMode+ -> c+ -> NameExtractor.OriginalFunctionSignature+ -> Options+ -> SplitModuleDescriptor+executePluginChain cm f sig opts =+ moduleSplitter $ executePluginChain' cm f sig opts+
+ lib/Feldspar/Compiler/Error.hs view
@@ -0,0 +1,35 @@+--+-- 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.Error where++data ErrorClass = InvariantViolation | InternalError | Warning+ deriving (Show, Eq)++handleError :: String -> ErrorClass -> String -> a+handleError place errorClass message = error $ "[" ++ show errorClass ++ " @ " ++ place ++ "]: " ++ message
+ lib/Feldspar/Compiler/Frontend/Interactive/Interface.hs view
@@ -0,0 +1,102 @@+--+-- 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.Frontend.Interactive.Interface where++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 Data.Char++-- ================================================================================================+-- == 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 prg fileName functionName opts = do+ writeFile cfile $ unlines [ "#include \"" ++ 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++ withIncludeGuard code = unlines [ "#ifndef " ++ guardName+ , "#define " ++ guardName+ , ""+ , code+ , ""+ , "#endif // " ++ guardName+ ]++ guardName = map ((\c -> if c `elem` toBeChanged then '_' else c) . toUpper) hfile+ where+ toBeChanged = "./\\"+++icompile :: (Compilable t internal) => t -> IO ()+icompile prg = icompile' prg "test" 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++icompileWithInfos :: (Compilable t internal) => t -> String -> Options -> SplitCompToCCoreResult+icompileWithInfos prg functionName = compileToCCore Interactive prg Nothing IncludesNeeded+ (NameExtractor.OriginalFunctionSignature functionName [])
+ lib/Feldspar/Compiler/Imperative/FromCore.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE ConstraintKinds #-}++--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}++module Feldspar.Compiler.Imperative.FromCore where+++import Control.Monad.RWS++import Language.Syntactic+import Language.Syntactic.Constructs.Binding+import Language.Syntactic.Constructs.Binding.HigherOrder++import Feldspar.Core.Types+import Feldspar.Core.Interpretation+import Feldspar.Core.Constructs+import Feldspar.Core.Constructs.Binding+import Feldspar.Core.Frontend++import Feldspar.Compiler.Imperative.Representation (Module)+import Feldspar.Compiler.Imperative.Frontend hiding (Type)+import Feldspar.Compiler.Imperative.FromCore.Interpretation+import Feldspar.Compiler.Imperative.FromCore.Array ()+import Feldspar.Compiler.Imperative.FromCore.Binding ()+import Feldspar.Compiler.Imperative.FromCore.Condition ()+import Feldspar.Compiler.Imperative.FromCore.ConditionM ()+import Feldspar.Compiler.Imperative.FromCore.Error ()+import Feldspar.Compiler.Imperative.FromCore.FFI ()+import Feldspar.Compiler.Imperative.FromCore.Future ()+import Feldspar.Compiler.Imperative.FromCore.Literal ()+import Feldspar.Compiler.Imperative.FromCore.Loop ()+import Feldspar.Compiler.Imperative.FromCore.Mutable ()+import Feldspar.Compiler.Imperative.FromCore.MutableToPure ()+import Feldspar.Compiler.Imperative.FromCore.NoInline ()+import Feldspar.Compiler.Imperative.FromCore.Par ()+import Feldspar.Compiler.Imperative.FromCore.Primitive ()+import Feldspar.Compiler.Imperative.FromCore.Save ()+import Feldspar.Compiler.Imperative.FromCore.SizeProp ()+import Feldspar.Compiler.Imperative.FromCore.SourceInfo ()+import Feldspar.Compiler.Imperative.FromCore.Tuple ()++instance Compile FeldDomain FeldDomain+ where+ compileProgSym (C' a) = compileProgSym a+ compileExprSym (C' a) = compileExprSym a++instance Compile Empty FeldDomain+ 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)+ | 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+ 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++-- | Create a list where each element represents the number of variables needed+-- to as arguments+buildInParamDescriptor :: SyntacticFeld a => a -> [Int]+buildInParamDescriptor = go . reifyFeld N32+ 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+
+ lib/Feldspar/Compiler/Imperative/FromCore/Array.hs view
@@ -0,0 +1,133 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.Array where++++import Language.Syntactic+import Language.Syntactic.Constructs.Binding+import Language.Syntactic.Constructs.Binding.HigherOrder++import Feldspar.Core.Types as Core+import Feldspar.Core.Interpretation+import Feldspar.Core.Constructs.Array+import Feldspar.Core.Constructs.Binding+import Feldspar.Core.Constructs.Literal++import Feldspar.Compiler.Imperative.Frontend hiding (Type)+import Feldspar.Compiler.Imperative.FromCore.Interpretation++++instance ( Compile dom dom+ , Project (CLambda Type) dom+ , Project (Literal :|| Type) dom+ , Project (Variable :|| Type) dom+ )+ => Compile (Array :|| Type) dom+ where+ compileProgSym (C' Parallel) _ loc (len :* (lam :$ ixf) :* Nil)+ | 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+ tellProg [initArray loc len']+ tellProg [For name len' 1 (Block ds body)]+++ compileProgSym (C' Sequential) _ loc (len :* st :* (lam1 :$ (lam2 :$ step)) :* Nil)+ | Just (SubConstr2 (Lambda v)) <- prjLambda lam1+ , Just (SubConstr2 (Lambda s)) <- prjLambda lam2+ = do+ let t = argType $ infoType $ getInfo lam1+ let sz = defaultSize t+ let ta' = argType $ infoType $ getInfo lam2+ let sa' = defaultSize ta'+ 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+ 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")+ ])]+ where toIni (Var ty str) = Init ty str++ 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']+ -- 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...++ compileProgSym (C' SetIx) _ loc (arr :* i :* a :* Nil) = do+ compileProg loc arr+ i' <- compileExpr i+ compileProg (loc :!: i') a++ compileProgSym (C' SetLength) _ loc (len :* arr :* Nil) = do+ len' <- compileExpr len+ tellProg [setLength loc len']+ compileProg loc arr+ -- 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+ aExpr <- compileExpr a+ return $ Fun (compileTypeRep (infoType info) (infoSize info)) "getLength" [aExpr]++ compileExprSym (C' GetIx) _ (arr :* i :* Nil) = do+ a' <- compileExpr arr+ i' <- compileExpr i+ return $ a' :!: i'++ compileExprSym a info args = compileProgFresh a info args+
+ lib/Feldspar/Compiler/Imperative/FromCore/Binding.hs view
@@ -0,0 +1,83 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.Binding where++import Control.Monad.RWS++import Language.Syntactic+import Language.Syntactic.Constructs.Binding.HigherOrder++import Feldspar.Core.Types as Core+import Feldspar.Core.Interpretation+import Feldspar.Core.Constructs.Binding+import qualified Feldspar.Core.Constructs.Binding as Core++import Feldspar.Compiler.Imperative.FromCore.Interpretation++++instance Compile (Core.Variable :|| Type) dom+ where+ compileExprSym (C' (Core.Variable v)) info Nil = do+ env <- ask+ case lookup v (alias env) of+ Nothing -> return $ mkVar (compileTypeRep (infoType info) (infoSize info)) v+ Just e -> return e++instance Compile (CLambda Type) dom+ where+ compileProgSym = error "Can only compile top-level Lambda"++instance (Compile dom dom, Project (CLambda Type) dom) => Compile (Let :|| Type) dom+ where+ compileProgSym (C' Let) _ loc (a :* (lam :$ body) :* Nil)+ | Just (SubConstr2 (Lambda v)) <- prjLambda lam+ = compileLet a (getInfo lam) v >> compileProg loc body++ compileExprSym (C' Let) _ (a :* (lam :$ body) :* Nil)+ | Just (SubConstr2 (Lambda v)) <- prjLambda lam+ = compileLet a (getInfo lam) v >> compileExpr body++compileLet :: Compile dom dom+ => ASTF (Decor Info dom) a -> Info (a -> b) -> VarId -> CodeWriter ()+compileLet a info v+ = do+ let ta = argType $ infoType info+ sa = defaultSize ta+ var = mkVar (compileTypeRep ta sa) v+ declare var+ compileProg var a+
+ lib/Feldspar/Compiler/Imperative/FromCore/Condition.hs view
@@ -0,0 +1,55 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.Condition where+++import Language.Syntactic++import Feldspar.Core.Types as Core+import Feldspar.Core.Constructs.Condition++import Feldspar.Compiler.Imperative.Frontend+import Feldspar.Compiler.Imperative.FromCore.Interpretation++++instance Compile dom dom => Compile (Condition :|| Core.Type) dom+ where+ compileProgSym (C' Condition) _ loc (cond :* tHEN :* eLSE :* Nil) = do+ condExpr <- compileExpr cond+ (_, Bl tds thenProg) <- confiscateBlock $ compileProg loc tHEN+ (_, Bl eds elseProg) <- confiscateBlock $ compileProg loc eLSE+ tellProg [If condExpr (Block tds thenProg) (Block eds elseProg)]+
+ lib/Feldspar/Compiler/Imperative/FromCore/ConditionM.hs view
@@ -0,0 +1,54 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.ConditionM where+++import Language.Syntactic++import Feldspar.Core.Constructs.ConditionM++import Feldspar.Compiler.Imperative.Frontend+import Feldspar.Compiler.Imperative.FromCore.Interpretation++++instance Compile dom dom => Compile (ConditionM m) dom+ where+ compileProgSym ConditionM _ loc (cond :* tHEN :* eLSE :* Nil) = do+ condExpr <- compileExpr cond+ (_, Bl tds thenProg) <- confiscateBlock $ compileProg loc tHEN+ (_, Bl eds elseProg) <- confiscateBlock $ compileProg loc eLSE+ tellProg [If condExpr (Block tds thenProg) (Block eds elseProg)]+
+ lib/Feldspar/Compiler/Imperative/FromCore/Error.hs view
@@ -0,0 +1,70 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.Error where++++import Control.Monad.RWS++import Language.Syntactic++import Feldspar.Core.Types (Type)+import Feldspar.Core.Interpretation+import Feldspar.Core.Constructs.Error++import Feldspar.Compiler.Imperative.Frontend hiding (Type)+import Feldspar.Compiler.Imperative.FromCore.Interpretation++++instance (Compile dom dom) => Compile (Error :|| Type) dom+ where+ compileProgSym (C' Undefined) _ _ Nil = return ()+ compileProgSym (C' (Assert msg)) _ loc (cond :* a :* Nil) = do+ compileAssert cond msg+ compileProg loc a++ compileExprSym (C' (Assert msg)) _ (cond :* a :* Nil) = do+ compileAssert cond msg+ compileExpr a+ compileExprSym a info args = compileProgFresh a info args++compileAssert :: (Compile dom dom)+ => ASTF (Decor Info dom) a -> String -> CodeWriter ()+compileAssert cond msg = do+ condExpr <- compileExpr cond+ tellProg [Call "assert" [In condExpr]]+ when (length msg > 0) $ tellProg [Comment $ "{" ++ msg ++ "}"]+
+ lib/Feldspar/Compiler/Imperative/FromCore/FFI.hs view
@@ -0,0 +1,51 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.FFI where++import Language.Syntactic++import Feldspar.Core.Types (Type)+import Feldspar.Core.Interpretation+import Feldspar.Core.Constructs.FFI++import Feldspar.Compiler.Imperative.Frontend hiding (Type)+import Feldspar.Compiler.Imperative.FromCore.Interpretation++instance (Compile dom dom) => Compile (FFI :|| Type) dom+ where+ compileExprSym (C' (ForeignImport name _)) info args = do+ argExprs <- sequence $ listArgs compileExpr args+ return $ Fun (compileTypeRep (infoType info) (infoSize info)) name argExprs+
+ lib/Feldspar/Compiler/Imperative/FromCore/Future.hs view
@@ -0,0 +1,75 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.Future where++import Language.Syntactic++import Feldspar.Core.Types (Type)+import Feldspar.Core.Constructs.Future++import Feldspar.Compiler.Imperative.Frontend hiding (Type)+import qualified Feldspar.Compiler.Imperative.Frontend as Front+import Feldspar.Compiler.Imperative.FromCore.Interpretation+import Feldspar.Compiler.Imperative.Plugin.CollectFreeVars+import Feldspar.Transformation (transform, Result(..))++import Data.Map (elems)++instance Compile dom dom => Compile (FUTURE :|| Type) dom+ where+ compileExprSym = compileProgFresh++ compileProgSym (C' MkFuture) _ loc (p :* Nil) = do+ -- Task core:+ (_, Bl ds t) <- confiscateBlock $ do+ p' <- compileExprVar p+ tellProg [iVarPut loc p']+ let b = Block ds t+ let vs = elems $ up $ transform Collect () () $ Front.fromInterface b+ funId <- freshId+ let coreName = "task_core" ++ show funId+ tellDef [ProcDf coreName vs [] b]+ -- Task:+ let taskName = "task" ++ show funId+ let runTask = run coreName vs+ tellDef [ProcDf taskName [] [Front.Variable Void "params"] runTask]+ -- Spawn:+ tellProg [iVarInit loc]+ tellProg [spawn taskName vs]++ compileProgSym (C' Await) _ loc (a :* Nil) = do+ fut <- compileExprVar a -- compileExpr a+ tellProg [iVarGet loc fut]+
+ lib/Feldspar/Compiler/Imperative/FromCore/Interpretation.hs view
@@ -0,0 +1,342 @@+--+-- 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 GADTs #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.Interpretation where+++import Control.Arrow+import Control.Monad.RWS++import Language.Syntactic.Syntax hiding (result)+import Language.Syntactic.Traversal+import Language.Syntactic.Constraint+import Language.Syntactic.Constructs.Binding (VarId)++import Feldspar.Range+import Feldspar.Core.Types hiding (Type)+import Feldspar.Core.Interpretation+import qualified Feldspar.Core.Types as Core+import qualified Feldspar.Core.Constructs.Binding as Core+import qualified Feldspar.Core.Constructs.Literal as Core++import Feldspar.Compiler.Imperative.Frontend+import Feldspar.Compiler.Imperative.Representation (typeof)++-- | Code generation monad+type CodeWriter = RWS Readers Writers States++data Readers = Readers { alias :: [(VarId, Expr)] -- ^ variable aliasing+ , sourceInfo :: SourceInfo -- ^ Surrounding source info+ }++initReader :: Readers+initReader = Readers [] ""++data Writers = Writers { block :: Block -- ^ collects code within one block+ , def :: [Ent] -- ^ collects top level definitions+ }++instance Monoid Writers+ where+ mempty = Writers { block = mempty+ , def = mempty+ }+ mappend a b = Writers { block = mappend (block a) (block b)+ , def = mappend (def a) (def b)+ }++type Task = [Prog]++data States = States { fresh :: Integer -- ^ The first fresh variable id+ }++initState :: States+initState = States 0++-- | Where to place the program result+type Location = Expr++-- | A minimal complete instance has to define either 'compileProgSym' or+-- 'compileExprSym'.+class Compile sub dom+ where+ compileProgSym+ :: sub a+ -> Info (DenResult a)+ -> Location+ -> Args (AST (Decor Info dom)) a+ -> CodeWriter ()+ compileProgSym = compileExprLoc++ compileExprSym+ :: sub a+ -> Info (DenResult a)+ -> Args (AST (Decor Info dom)) a+ -> CodeWriter Expr+ compileExprSym = compileProgFresh++instance (Compile sub1 dom, Compile sub2 dom) =>+ Compile (sub1 :+: sub2) dom+ where+ compileProgSym (InjL a) = compileProgSym a+ compileProgSym (InjR a) = compileProgSym a++ compileExprSym (InjL a) = compileExprSym a+ compileExprSym (InjR a) = compileExprSym a++++-- | Implementation of 'compileExprSym' that assigns an expression to the given+-- location.+compileExprLoc :: Compile sub dom+ => sub a+ -> Info (DenResult a)+ -> Location+ -> Args (AST (Decor Info dom)) a+ -> CodeWriter ()+compileExprLoc a info loc args = do+ expr <- compileExprSym a info args+ assign loc expr++-- | Implementation of 'compileProgSym' that generates code into a fresh+-- variable.+compileProgFresh :: Compile sub dom+ => sub a+ -> Info (DenResult a)+ -> Args (AST (Decor Info dom)) a+ -> CodeWriter Expr+compileProgFresh a info args = do+ loc <- freshVar "e" (infoType info) (infoSize info)+ compileProgSym a info loc args+ return loc++compileProgDecor :: Compile dom dom+ => Location+ -> Decor Info dom a+ -> Args (AST (Decor Info dom)) a+ -> CodeWriter ()+compileProgDecor result (Decor info a) args = do+ let src = infoSource info+ aboveSrc <- asks sourceInfo+ unless (null src || src==aboveSrc) $ tellProg [BComment src]+ local (\env -> env {sourceInfo = src}) $ compileProgSym a info result args++compileExprDecor :: Compile dom dom+ => Decor Info dom a+ -> Args (AST (Decor Info dom)) a+ -> CodeWriter Expr+compileExprDecor (Decor info a) args = do+ let src = infoSource info+ aboveSrc <- asks sourceInfo+ unless (null src || src==aboveSrc) $ tellProg [BComment src]+ local (\env -> env {sourceInfo = src}) $ compileExprSym a info args++compileProg :: Compile dom dom =>+ Location -> ASTF (Decor Info dom) a -> CodeWriter ()+compileProg result = simpleMatch (compileProgDecor result)++compileExpr :: Compile dom dom => ASTF (Decor Info dom) a -> CodeWriter Expr+compileExpr = simpleMatch compileExprDecor++-- Compile an expression and make sure that the result is stored in a variable+compileExprVar :: Compile dom dom => ASTF (Decor Info dom) a -> CodeWriter Expr+compileExprVar e = do+ e' <- compileExpr e+ case e' of+ Var _ _ -> return e'+ Ptr _ _ -> return e'+ _ -> do+ varId <- freshId+ let loc = Var (typeof e') ('e' : show varId)+ declare loc+ assign loc e'+ return loc++--------------------------------------------------------------------------------+-- * Utility functions+--------------------------------------------------------------------------------++compileNumType :: Signedness a -> BitWidth n -> Type+compileNumType U N8 = U8+compileNumType S N8 = I8+compileNumType U N16 = U16+compileNumType S N16 = I16+compileNumType U N32 = U32+compileNumType S N32 = I32+compileNumType U N64 = U64+compileNumType S N64 = I64+compileNumType U NNative = U32 -- TODO+compileNumType S NNative = I32 -- TODO++compileTypeRep :: TypeRep a -> Size a -> Type+compileTypeRep UnitType _ = Void+compileTypeRep BoolType _ = Boolean+compileTypeRep (IntType s n) _ = compileNumType s n+compileTypeRep FloatType _ = Floating+compileTypeRep (ComplexType t) _ = Complex (compileTypeRep t (defaultSize t))+compileTypeRep (Tup2Type a b) (sa,sb) = Struct+ [ ("member1", compileTypeRep a sa)+ , ("member2", compileTypeRep b sb)+ ]+compileTypeRep (Tup3Type a b c) (sa,sb,sc) = Struct+ [ ("member1", compileTypeRep a sa)+ , ("member2", compileTypeRep b sb)+ , ("member3", compileTypeRep c sc)+ ]+compileTypeRep (Tup4Type a b c d) (sa,sb,sc,sd) = Struct+ [ ("member1", compileTypeRep a sa)+ , ("member2", compileTypeRep b sb)+ , ("member3", compileTypeRep c sc)+ , ("member4", compileTypeRep d sd)+ ]+compileTypeRep (Tup5Type a b c d e) (sa,sb,sc,sd,se) = Struct+ [ ("member1", compileTypeRep a sa)+ , ("member2", compileTypeRep b sb)+ , ("member3", compileTypeRep c sc)+ , ("member4", compileTypeRep d sd)+ , ("member5", compileTypeRep e se)+ ]+compileTypeRep (Tup6Type a b c d e f) (sa,sb,sc,sd,se,sf) = Struct+ [ ("member1", compileTypeRep a sa)+ , ("member2", compileTypeRep b sb)+ , ("member3", compileTypeRep c sc)+ , ("member4", compileTypeRep d sd)+ , ("member5", compileTypeRep e se)+ , ("member6", compileTypeRep f sf)+ ]+compileTypeRep (Tup7Type a b c d e f g) (sa,sb,sc,sd,se,sf,sg) = Struct+ [ ("member1", compileTypeRep a sa)+ , ("member2", compileTypeRep b sb)+ , ("member3", compileTypeRep c sc)+ , ("member4", compileTypeRep d sd)+ , ("member5", compileTypeRep e se)+ , ("member6", compileTypeRep f sf)+ , ("member7", compileTypeRep g sg)+ ]+compileTypeRep (MutType a) _ = compileTypeRep a (defaultSize a)+compileTypeRep (RefType a) _ = compileTypeRep a (defaultSize a)+compileTypeRep (ArrayType a) (rs :> es) = if unboundedLength+ then Array $ compileTypeRep a es+ else SizedArray (fromEnum $ upperBound rs) $ compileTypeRep a es+ where+ unboundedLength+ = upperBound rs > fromIntegral (maxBound :: Int)+ -- This ensures that `fromEnum` succeeds+ || upperBound rs == maxBound+ -- This `maxBound` might be smaller than `maxBound :: Int`+compileTypeRep (MArrType a) _ = Array (compileTypeRep a (defaultSize a))+compileTypeRep (ParType a) _ = compileTypeRep a (defaultSize a)+compileTypeRep (IVarType a) _ = IVar $ compileTypeRep a $ defaultSize a+compileTypeRep (FunType _ b) sz = compileTypeRep b sz+compileTypeRep (FValType a) sz = IVar $ compileTypeRep a sz+compileTypeRep typ _ = error $ "compileTypeRep: missing " ++ show typ -- TODO++mkVarName :: VarId -> String+mkVarName v = 'v' : show v++mkVar :: Type -> VarId -> Expr+mkVar t = Var t . mkVarName++mkVariable :: Type -> VarId -> Var+mkVariable t = Variable t . mkVarName++freshId :: CodeWriter Integer+freshId = do+ s <- get+ let v = fresh s+ put (s {fresh = v + 1})+ return v++freshVar :: String -> TypeRep a -> Size a -> CodeWriter Expr -- TODO take just info instead of TypeRep and Size?+freshVar base t size = do+ v <- freshId+ let var =Var (compileTypeRep t size) $ base ++ show v+ declare var+ return var++declare :: Expr -> CodeWriter ()+declare (Var t n) = tellDecl [Def t n]+declare (Ptr t n) = tellDecl [Def t n]+declare expr = error $ "declare: cannot declare expression: " ++ show expr++tellDef :: [Ent] -> CodeWriter ()+tellDef es = tell $ mempty {def = es}++tellProg :: [Prog] -> CodeWriter ()+tellProg ps = tell $ mempty {block = Bl [] $ Seq ps}++tellDecl :: [Def] -> CodeWriter ()+tellDecl ds = tell $ mempty {block = Bl ds $ Seq []}++assign :: Location -> Expr -> CodeWriter ()+assign lhs rhs = if isArray $ typeof lhs+ then+ tellProg [ initArray lhs $ arrayLength rhs+ , copyProg lhs rhs]+ else+ tellProg [copyProg lhs rhs]++-- | Like 'listen', but also prevents the program from being written in the+-- monad.+confiscateBlock :: CodeWriter a -> CodeWriter (a, Block)+confiscateBlock m+ = liftM (second block)+ $ censor (\rec -> rec {block = mempty})+ $ listen m++withAlias :: VarId -> Expr -> CodeWriter a -> CodeWriter a+withAlias v0 expr =+ local (\e -> e {alias = (v0,expr) : alias e})++isVariableOrLiteral :: ( Project (Core.Variable :|| Core.Type) dom+ , Project (Core.Literal :|| Core.Type) dom)+ => AST (Decor info dom) a -> Bool+isVariableOrLiteral (prjF -> Just (C' (Core.Literal _))) = True+isVariableOrLiteral (prjF -> Just (C' (Core.Variable _))) = True+isVariableOrLiteral _ = False++mkLength :: ( Project (Core.Literal :|| Core.Type) dom+ , Project (Core.Variable :|| Core.Type) dom+ , Compile dom dom+ )+ => ASTF (Decor Info dom) a -> CodeWriter Expr+mkLength a | isVariableOrLiteral a = compileExpr a+ | otherwise = do+ let lentyp = IntType U N32+ lenvar <- freshVar "len" lentyp (defaultSize lentyp)+ compileProg lenvar a+ return lenvar+
+ lib/Feldspar/Compiler/Imperative/FromCore/Literal.hs view
@@ -0,0 +1,151 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.Literal where++++import Control.Monad.RWS+import Data.Complex+import GHC.Float (float2Double)++import Language.Syntactic++import Feldspar.Core.Types as Core+import Feldspar.Core.Interpretation+import Feldspar.Core.Constructs.Literal++import Feldspar.Range (upperBound)++import Feldspar.Compiler.Imperative.Frontend+import Feldspar.Compiler.Imperative.FromCore.Interpretation++instance Compile (Literal :|| Core.Type) dom+ where+ compileExprSym (C' (Literal a)) info Nil = literal (infoType info) (infoSize info) a++ compileProgSym (C' (Literal a)) info loc Nil = literalLoc loc (infoType info) (infoSize info) a++literal :: TypeRep a -> Size a -> a -> CodeWriter Expr+literal UnitType _ () = return $ LitI I32 0+literal BoolType _ a = return $ boolToExpr a+literal trep@IntType{} sz a = return $ LitI (compileTypeRep trep sz) (toInteger a)+literal FloatType _ a = return $ LitF $ float2Double a+literal (ComplexType t) _ (r:+i) = do re <- literal t (defaultSize t) r+ ie <- literal t (defaultSize t) i+ return $ LitC re ie+literal t s a = do loc <- freshVar "x" t s+ literalLoc loc t s a+ return loc++literalLoc :: Location -> TypeRep a -> Size a -> a -> CodeWriter ()+literalLoc loc (ArrayType t) (rs :> es) e+ = do+ tellProg [initArray loc $ LitI I32 $ toInteger $ upperBound rs]+ zipWithM_ (writeElement t es) (map (LitI I32) [0..]) e+ where writeElement :: TypeRep a -> Size a -> Expr -> a -> CodeWriter ()+ writeElement ty sz ix x = do+ expr <- literal ty sz x+ assign (loc :!: ix) expr++literalLoc loc (Tup2Type ta tb) (sa,sb) (a,b) =+ do aExpr <- literal ta sa a+ bExpr <- literal tb sb b+ assign (loc :.: "member1") aExpr+ assign (loc :.: "member2") bExpr++literalLoc loc (Tup3Type ta tb tc) (sa,sb,sc) (a,b,c) =+ do aExpr <- literal ta sa a+ bExpr <- literal tb sb b+ cExpr <- literal tc sc c+ assign (loc :.: "member1") aExpr+ assign (loc :.: "member2") bExpr+ assign (loc :.: "member3") cExpr+ +literalLoc loc (Tup4Type ta tb tc td) (sa,sb,sc,sd) (a,b,c,d) =+ do aExpr <- literal ta sa a+ bExpr <- literal tb sb b+ cExpr <- literal tc sc c+ dExpr <- literal td sd d+ assign (loc :.: "member1") aExpr+ assign (loc :.: "member2") bExpr+ assign (loc :.: "member3") cExpr+ assign (loc :.: "member4") dExpr+ +literalLoc loc (Tup5Type ta tb tc td te) (sa,sb,sc,sd,se) (a,b,c,d,e) =+ do aExpr <- literal ta sa a+ bExpr <- literal tb sb b+ cExpr <- literal tc sc c+ dExpr <- literal td sd d+ eExpr <- literal te se e+ assign (loc :.: "member1") aExpr+ assign (loc :.: "member2") bExpr+ assign (loc :.: "member3") cExpr+ assign (loc :.: "member4") dExpr+ assign (loc :.: "member5") eExpr+ +literalLoc loc (Tup6Type ta tb tc td te tf) (sa,sb,sc,sd,se,sf) (a,b,c,d,e,f) =+ do aExpr <- literal ta sa a+ bExpr <- literal tb sb b+ cExpr <- literal tc sc c+ dExpr <- literal td sd d+ eExpr <- literal te se e+ fExpr <- literal tf sf f+ assign (loc :.: "member1") aExpr+ assign (loc :.: "member2") bExpr+ assign (loc :.: "member3") cExpr+ assign (loc :.: "member4") dExpr+ assign (loc :.: "member5") eExpr+ assign (loc :.: "member6") fExpr+ +literalLoc loc (Tup7Type ta tb tc td te tf tg) (sa,sb,sc,sd,se,sf,sg) (a,b,c,d,e,f,g) =+ do aExpr <- literal ta sa a+ bExpr <- literal tb sb b+ cExpr <- literal tc sc c+ dExpr <- literal td sd d+ eExpr <- literal te se e+ fExpr <- literal tf sf f+ gExpr <- literal tg sg g+ assign (loc :.: "member1") aExpr+ assign (loc :.: "member2") bExpr+ assign (loc :.: "member3") cExpr+ assign (loc :.: "member4") dExpr+ assign (loc :.: "member5") eExpr+ assign (loc :.: "member6") fExpr+ assign (loc :.: "member7") gExpr++literalLoc loc t sz a =+ do rhs <- literal t sz a+ assign loc rhs+
+ lib/Feldspar/Compiler/Imperative/FromCore/Loop.hs view
@@ -0,0 +1,110 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.Loop where+++import Prelude hiding (init)++import Language.Syntactic+import Language.Syntactic.Constructs.Binding+import Language.Syntactic.Constructs.Binding.HigherOrder++import Feldspar.Core.Types+import Feldspar.Core.Interpretation+import Feldspar.Core.Constructs.Binding+import Feldspar.Core.Constructs.Loop hiding (For, While)+import Feldspar.Core.Constructs.Literal+import qualified Feldspar.Core.Constructs.Loop as Core++import Feldspar.Compiler.Imperative.Frontend hiding (Type)+import Feldspar.Compiler.Imperative.FromCore.Interpretation++instance ( Compile dom dom+ , Project (CLambda Type) dom+ , Project (Literal :|| Type) dom+ , Project (Variable :|| Type) dom+ )+ => Compile (Loop :|| Type) dom+ where+ compileProgSym (C' ForLoop) _ loc (len :* init :* (lam1 :$ (lam2 :$ ixf)) :* Nil)+ | Just (SubConstr2 (Lambda ix)) <- prjLambda lam1+ , Just (SubConstr2 (Lambda st)) <- prjLambda lam2+ = do+ let info1 = getInfo lam1+ info2 = getInfo lam2+ let (Var _ name) = mkVar (compileTypeRep (infoType info1) (infoSize info1)) ix+ let stvar = mkVar (compileTypeRep (infoType info2) (infoSize info2)) st+ len' <- mkLength len+ compileProg loc init+ (_, Bl ds body) <- withAlias st loc $ confiscateBlock $ compileProg stvar ixf >> assign loc stvar+ declare stvar+ tellProg [For name len' 1 (Block ds body)]++ compileProgSym (C' WhileLoop) _ loc (init :* (lam1 :$ cond) :* (lam2 :$ body) :* Nil)+ | Just (SubConstr2 (Lambda cv)) <- prjLambda lam1+ , Just (SubConstr2 (Lambda cb)) <- prjLambda lam2+ = do+ let info2 = getInfo lam2+ let stvar = mkVar (compileTypeRep (infoType info2) (infoSize info2)) cb+ compileProg loc init+ cond' <- withAlias cv loc $ compileExpr cond+ (_, Bl ds body') <- withAlias cb loc $ confiscateBlock $ compileProg stvar body >> assign loc stvar+ declare stvar+ tellProg [While Skip cond' (Block ds body')]++instance ( Compile dom dom+ , Project (CLambda Type) dom+ , Project (Literal :|| Type) dom+ , Project (Variable :|| Type) dom+ )+ => Compile (LoopM Mut) dom+ where+ compileProgSym Core.For _ loc (len :* (lam :$ ixf) :* Nil)+ | Just (SubConstr2 (Lambda v)) <- prjLambda lam+ = do+ let ta = argType $ infoType $ getInfo lam+ let sa = defaultSize ta+ let (Var _ name) = mkVar (compileTypeRep ta sa) v+ len' <- mkLength len+ (_, Bl _ body) <- confiscateBlock $ compileProg loc ixf+ tellProg [For name len' 1 body]++-- TODO Missing While+ compileProgSym Core.While _ loc (cond :* step :* Nil)+ = do+ cond' <- compileExpr cond+ (_, Bl _ step') <- confiscateBlock $ compileProg loc step+ tellProg [While Skip cond' step']+
+ lib/Feldspar/Compiler/Imperative/FromCore/Mutable.hs view
@@ -0,0 +1,134 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.Mutable where++++import Language.Syntactic+import Language.Syntactic.Constructs.Binding+import Language.Syntactic.Constructs.Binding.HigherOrder++import Feldspar.Core.Types+import Feldspar.Core.Interpretation+import Feldspar.Core.Constructs.Binding+import Feldspar.Core.Constructs.Mutable+import Feldspar.Core.Constructs.MutableArray+import Feldspar.Core.Constructs.MutableReference++import Feldspar.Compiler.Imperative.Frontend hiding (Type)+import Feldspar.Compiler.Imperative.FromCore.Interpretation++++instance (Compile dom dom, Project (CLambda Type) dom) => Compile (MONAD Mut) dom+ where+ compileProgSym Bind _ loc (ma :* (lam :$ body) :* Nil)+ | Just (SubConstr2 (Lambda v)) <- prjLambda lam+ = do+ e <- compileExpr ma+ withAlias v e $ compileProg loc body++{- TODO reenable this implementation! The case above inlines too much if v is used more than once in the body+ compileProgSym Bind _ loc (ma :* (Symbol (Decor info lam) :$ body) :* Nil)+ | Just (Lambda v) <- prjCtx typeCtx lam+ = do+ let var = mkVar (compileTypeRep $ argType $ infoType info) v+ withDecl var $ do+ compileProg var ma+ compileProg loc body+-}++ compileProgSym Then _ loc (ma :* mb :* Nil) = do+ compileExpr ma+ compileProg loc mb++ compileProgSym Return info loc (a :* Nil)+ | MutType UnitType <- infoType info = return ()+ | otherwise = compileProg loc a++ compileProgSym When _ loc (c :* action :* Nil) = do+ c' <- compileExpr c+ (_, Bl ds body) <- confiscateBlock $ compileProg loc action+ tellProg [If c' (Block ds body) Skip]++instance (Compile dom dom, Project (CLambda Type) dom) => Compile Mutable dom+ where+ compileProgSym Run _ loc (ma :* Nil) = compileProg loc ma++ compileExprSym Run _ (ma :* Nil) = compileExpr ma++instance (Compile dom dom, Project (CLambda Type) dom) => Compile MutableReference dom+ where+ compileProgSym NewRef _ loc (a :* Nil) = compileProg loc a+ compileProgSym GetRef _ loc (r :* Nil) = compileProg loc r+ compileProgSym SetRef _ _ (r :* a :* Nil) = do+ var <- compileExpr r+ compileProg var a++ compileExprSym GetRef _ (r :* Nil) = compileExpr r+ compileExprSym feat info args = compileProgFresh feat info args++instance (Compile dom dom, Project (CLambda Type) dom) => Compile MutableArray dom+ where+ compileProgSym NewArr_ _ loc (len :* Nil) = do+ l <- compileExpr len+ tellProg [initArray loc l]++ compileProgSym NewArr _ loc (len :* a :* Nil) = do+ let ix = Var U32 "i"+ a' <- compileExpr a+ l <- compileExpr len+ tellProg [initArray loc l]+ tellProg [For "i" l 1 (Seq [assignProg (loc :!: ix) a'])]++ compileProgSym GetArr _ loc (arr :* i :* Nil) = do+ arr' <- compileExpr arr+ i' <- compileExpr i+ assign loc (arr' :!: i')++ compileProgSym SetArr _ _ (arr :* i :* a :* Nil) = do+ arr' <- compileExpr arr+ i' <- compileExpr i+ a' <- compileExpr a+ assign (arr' :!: i') a'++ compileProgSym a info loc args = compileExprLoc a info loc args++ compileExprSym ArrLength info (arr :* Nil) = do+ a' <- compileExpr arr+ return $ Fun (compileTypeRep (infoType info) (infoSize info)) "getLength" [a']++ compileExprSym a info args = compileProgFresh a info args+
+ lib/Feldspar/Compiler/Imperative/FromCore/MutableToPure.hs view
@@ -0,0 +1,89 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.MutableToPure where++++import Language.Syntactic+import Language.Syntactic.Constructs.Binding+import Language.Syntactic.Constructs.Binding.HigherOrder++import Feldspar.Core.Types+import Feldspar.Core.Interpretation+import Feldspar.Core.Constructs.Binding+import Feldspar.Core.Constructs.MutableToPure++import Feldspar.Compiler.Imperative.Frontend hiding (Type,Variable)+import Feldspar.Compiler.Imperative.FromCore.Interpretation++++instance ( Compile dom dom+ , Project (CLambda Type) dom+ , Project (Variable :|| Type) dom+ )+ => Compile MutableToPure dom+ where+ compileProgSym WithArray _ loc (marr :* (lam :$ body) :* Nil)+ | Just (C' (Variable _)) <- prjF marr+ , Just (SubConstr2 (Lambda v1)) <- prjLambda lam+ = do+ e <- compileExpr marr+ withAlias v1 e $ do+ b <- compileExpr body+ tellProg [copyProg loc b]++ compileProgSym WithArray _ loc (marr :* (lam :$ body) :* Nil)+ | Just (SubConstr2 (Lambda v)) <- prjLambda lam+ = do+ let ta = argType $ infoType $ getInfo lam+ let sa = defaultSize ta+ let var = mkVar (compileTypeRep ta sa) v+ declare var+ compileProg var marr+ e <- compileExpr body+ tellProg [copyProg loc e]++ compileProgSym RunMutableArray _ loc (marr :* Nil) = compileProg loc marr++{- NOTES:++The trick of doing a copy at the end, i.e. `tellProg [copyProg loc+e]`, when compiling WithArray is important. It allows us to safely+return the pure array that is passed in as input. This is nice because+it allows us to implement `freezeArray` in terms of `withArray`.+In most cases I expect `withArray` to return a scalar as its final+result and then the copyProg is harmless.+-}
+ lib/Feldspar/Compiler/Imperative/FromCore/NoInline.hs view
@@ -0,0 +1,65 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.NoInline where++import Data.Map (elems)+import Data.List (partition)+import Language.Syntactic++import Feldspar.Core.Types (Type)+import Feldspar.Core.Constructs.NoInline+import Feldspar.Transformation (transform, Result(..))+import Feldspar.Compiler.Imperative.FromCore.Interpretation+import Feldspar.Compiler.Imperative.Frontend hiding (Type,Variable)+import Feldspar.Compiler.Imperative.Plugin.CollectFreeVars+import qualified Feldspar.Compiler.Imperative.Frontend as Front++instance Compile dom dom => Compile (NoInline :|| Type) dom+ where+ compileExprSym = compileProgFresh++ compileProgSym (C' NoInline) _ loc (p :* Nil) = do+ (_, Bl ds t) <- confiscateBlock $ compileProg loc p+ let b = Block ds t+ let vs = elems $ up $ transform Collect () () $ Front.fromInterface b+ let isInParam v = Front.vName v /= Front.lName loc+ let (ins,outs) = partition isInParam vs+ funId <- freshId+ let funname = "noinline" ++ show funId+ tellDef [ProcDf funname ins outs b]+ let ins' = map (\v -> Front.In $ Front.Var (vType v) (Front.vName v)) ins+ tellProg [Call funname $ ins' ++ [Out loc]]+
+ lib/Feldspar/Compiler/Imperative/FromCore/Par.hs view
@@ -0,0 +1,132 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.Par where++import Language.Syntactic+import Language.Syntactic.Constructs.Monad+import Language.Syntactic.Constructs.Binding+import Language.Syntactic.Constructs.Binding.HigherOrder++import Feldspar.Core.Types+import Feldspar.Core.Interpretation+import Feldspar.Core.Constructs.Binding+import Feldspar.Core.Constructs.Par++import Feldspar.Compiler.Imperative.Frontend hiding (Type,Variable)+import Feldspar.Compiler.Imperative.FromCore.Interpretation+import Feldspar.Compiler.Imperative.Plugin.CollectFreeVars+import qualified Feldspar.Compiler.Imperative.Frontend as Front+import qualified Feldspar.Compiler.Imperative.Representation as AIR+import Feldspar.Transformation (transform, Result(..))++import Data.Map (elems)++instance ( Compile dom dom+ , Project (CLambda Type) dom+ , Project ParFeature dom+ )+ => Compile (MONAD Par) dom+ where+ compileProgSym Bind _ loc (ma :* (lam :$ body) :* Nil)+ | Just (SubConstr2 (Lambda v)) <- prjLambda lam+ , Just ParNew <- prj ma+ = do+ let info = getInfo ma+ let var = mkVar (compileTypeRep (infoType info) (infoSize info)) v+ declare var+ tellProg [iVarInit var]+ compileProg loc body++ compileProgSym Bind _ loc (ma :* (lam :$ body) :* Nil)+ | Just (SubConstr2 (Lambda v)) <- prjLambda lam+ = do+ e <- compileExpr ma+ withAlias v e $ compileProg loc body++ compileProgSym Then _ loc (ma :* mb :* Nil) = do+ compileExpr ma+ compileProg loc mb++ compileProgSym Return info loc (a :* Nil)+ | ParType UnitType <- infoType info = return ()+ | otherwise = compileProg loc a++ compileProgSym When _ loc (c :* action :* Nil) = do+ c' <- compileExpr c+ (_, Bl ds body) <- confiscateBlock $ compileProg loc action+ tellProg [If c' (Block ds body) Skip]++instance ( Compile dom dom+ , Project (Variable :|| Type) dom+ )+ => Compile ParFeature dom+ where+ compileExprSym = compileProgFresh++ compileProgSym ParRun _ loc (p :* Nil) = compileProg loc p++ compileProgSym ParGet _ loc (r :* Nil) = do+ iv <- compileExpr r+ tellProg [iVarGet loc iv]++ compileProgSym ParPut _ _ (r :* a :* Nil) = do+ iv <- compileExpr r+ val <- compileExpr a+ i <- freshId+ let var = Var (AIR.typeof val) $ "msg" ++ show i+ declare var+ assign var val+ tellProg [iVarPut iv var]++ compileProgSym ParFork _ loc (p :* Nil) = do+ -- Task core:+ (_, Bl ds t) <- confiscateBlock $ compileProg loc p+ let b = Block ds t+ let vs = elems $ up $ transform Collect () () $ Front.fromInterface b+ funId <- freshId+ let coreName = "task_core" ++ show funId+ tellDef [ProcDf coreName vs [] b]+ -- Task:+ let taskName = "task" ++ show funId+ let runTask = run coreName vs+ tellDef [ProcDf taskName [] [Front.Variable Void "params"] runTask]+ -- Spawn:+ tellProg [spawn taskName vs]++ compileProgSym ParYield _ _ Nil = return ()++ compileProgSym ParNew _ _ Nil = return ()++
+ lib/Feldspar/Compiler/Imperative/FromCore/Primitive.hs view
@@ -0,0 +1,86 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.Primitive where++++import Language.Syntactic++import Feldspar.Core.Types (Type)+import Feldspar.Core.Interpretation+import Feldspar.Core.Constructs.Bits+import Feldspar.Core.Constructs.Complex+import Feldspar.Core.Constructs.Conversion+import Feldspar.Core.Constructs.Eq+import Feldspar.Core.Constructs.Floating+import Feldspar.Core.Constructs.Fractional+import Feldspar.Core.Constructs.Integral+import Feldspar.Core.Constructs.Logic+import Feldspar.Core.Constructs.Num+import Feldspar.Core.Constructs.Ord+import Feldspar.Core.Constructs.Trace++import Feldspar.Compiler.Imperative.Frontend hiding (Type)+import Feldspar.Compiler.Imperative.FromCore.Interpretation++++-- | Converts symbols to primitive function calls+instance Compile dom dom => Compile Semantics dom+ where+ compileExprSym (Sem name _) info args = do+ argExprs <- sequence $ listArgs compileExpr args+ return $ Fun (compileTypeRep (infoType info) (infoSize info)) name argExprs++-- | Convenient implementation of 'compileExprSym' for primitive functions+compilePrim :: (Semantic expr, Compile dom dom)+ => (expr :|| Type) a+ -> Info (DenResult a)+ -> Args (AST (Decor Info dom)) a+ -> CodeWriter Expr+compilePrim (C' s) = compileExprSym $ semantics s++instance Compile dom dom => Compile (BITS :|| Type) dom where compileExprSym = compilePrim+instance Compile dom dom => Compile (COMPLEX :|| Type) dom where compileExprSym = compilePrim+instance Compile dom dom => Compile (Conversion :|| Type) dom where compileExprSym = compilePrim+instance Compile dom dom => Compile (EQ :|| Type) dom where compileExprSym = compilePrim+instance Compile dom dom => Compile (FLOATING :|| Type) dom where compileExprSym = compilePrim+instance Compile dom dom => Compile (FRACTIONAL :|| Type) dom where compileExprSym = compilePrim+instance Compile dom dom => Compile (INTEGRAL :|| Type) dom where compileExprSym = compilePrim+instance Compile dom dom => Compile (Logic :|| Type) dom where compileExprSym = compilePrim+instance Compile dom dom => Compile (NUM :|| Type) dom where compileExprSym = compilePrim+instance Compile dom dom => Compile (ORD :|| Type) dom where compileExprSym = compilePrim+instance Compile dom dom => Compile (Trace :|| Type) dom where compileExprSym = compilePrim+
+ lib/Feldspar/Compiler/Imperative/FromCore/Save.hs view
@@ -0,0 +1,51 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.Save where++++import Language.Syntactic++import Feldspar.Core.Types (Type)+import Feldspar.Core.Constructs.Save++import Feldspar.Compiler.Imperative.FromCore.Interpretation++++instance Compile dom dom => Compile (Save :|| Type) dom+ where+ compileProgSym (C' Save) _ loc (a :* Nil) = compileProg loc a+
+ lib/Feldspar/Compiler/Imperative/FromCore/SizeProp.hs view
@@ -0,0 +1,53 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.SizeProp where++++import Language.Syntactic++import Feldspar.Core.Types (Type)+import Feldspar.Core.Constructs.SizeProp++import Feldspar.Compiler.Imperative.FromCore.Interpretation++++instance Compile dom dom => Compile (PropSize :|| Type) dom+ where+ compileProgSym (C' (PropSize _)) _ loc (_ :* b :* Nil) = compileProg loc b++ compileExprSym (C' (PropSize _)) _ (_ :* b :* Nil) = compileExpr b+
+ lib/Feldspar/Compiler/Imperative/FromCore/SourceInfo.hs view
@@ -0,0 +1,57 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.SourceInfo where++++import Language.Syntactic++import Feldspar.Core.Types+import Feldspar.Core.Constructs.SourceInfo++import Feldspar.Compiler.Imperative.Frontend hiding (Type)+import Feldspar.Compiler.Imperative.FromCore.Interpretation++++instance Compile dom dom => Compile ((Decor SourceInfo1 Identity) :|| Type) dom+ where+ compileProgSym (C' (Decor (SourceInfo1 info) Id)) _ loc (a :* Nil) = do+ tellProg [BComment info]+ compileProg loc a+ compileExprSym (C' (Decor (SourceInfo1 info) Id)) _ (a :* Nil) = do+ tellProg [BComment info]+ compileExpr a+
+ lib/Feldspar/Compiler/Imperative/FromCore/Tuple.hs view
@@ -0,0 +1,108 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.FromCore.Tuple where++++import Language.Syntactic++import Feldspar.Core.Types+import Feldspar.Core.Constructs.Tuple++import Feldspar.Compiler.Imperative.Frontend hiding (Type)+import Feldspar.Compiler.Imperative.FromCore.Interpretation++++instance Compile dom dom => Compile (Tuple :|| Type) dom+ where+ compileProgSym (C' Tup2) _ loc (m1 :* m2 :* Nil) = do+ compileExpr m1 >>= assign (loc :.: "member1")+ compileExpr m2 >>= assign (loc :.: "member2")+ compileProgSym (C' Tup3) _ loc (m1 :* m2 :* m3 :* Nil) = do+ compileExpr m1 >>= assign (loc :.: "member1")+ compileExpr m2 >>= assign (loc :.: "member2")+ compileExpr m3 >>= assign (loc :.: "member3")+ compileProgSym (C' Tup4) _ loc (m1 :* m2 :* m3 :* m4 :* Nil) = do+ compileExpr m1 >>= assign (loc :.: "member1")+ compileExpr m2 >>= assign (loc :.: "member2")+ compileExpr m3 >>= assign (loc :.: "member3")+ compileExpr m4 >>= assign (loc :.: "member4")+ compileProgSym (C' Tup5) _ loc (m1 :* m2 :* m3 :* m4 :* m5 :* Nil) = do+ compileExpr m1 >>= assign (loc :.: "member1")+ compileExpr m2 >>= assign (loc :.: "member2")+ compileExpr m3 >>= assign (loc :.: "member3")+ compileExpr m4 >>= assign (loc :.: "member4")+ compileExpr m5 >>= assign (loc :.: "member5")+ compileProgSym (C' Tup6) _ loc (m1 :* m2 :* m3 :* m4 :* m5 :* m6 :* Nil) = do+ compileExpr m1 >>= assign (loc :.: "member1")+ compileExpr m2 >>= assign (loc :.: "member2")+ compileExpr m3 >>= assign (loc :.: "member3")+ compileExpr m4 >>= assign (loc :.: "member4")+ compileExpr m5 >>= assign (loc :.: "member5")+ compileExpr m6 >>= assign (loc :.: "member6")+ compileProgSym (C' Tup7) _ loc (m1 :* m2 :* m3 :* m4 :* m5 :* m6 :* m7 :* Nil) = do+ compileExpr m1 >>= assign (loc :.: "member1")+ compileExpr m2 >>= assign (loc :.: "member2")+ compileExpr m3 >>= assign (loc :.: "member3")+ compileExpr m4 >>= assign (loc :.: "member4")+ compileExpr m5 >>= assign (loc :.: "member5")+ compileExpr m6 >>= assign (loc :.: "member6")+ compileExpr m7 >>= assign (loc :.: "member7")++instance Compile dom dom => Compile (Select :|| Type) dom+ where+ compileExprSym (C' Sel1) _ (tup :* Nil) = do+ tupExpr <- compileExpr tup+ return $ tupExpr :.: "member1"+ compileExprSym (C' Sel2) _ (tup :* Nil) = do+ tupExpr <- compileExpr tup+ return $ tupExpr :.: "member2"+ compileExprSym (C' Sel3) _ (tup :* Nil) = do+ tupExpr <- compileExpr tup+ return $ tupExpr :.: "member3"+ compileExprSym (C' Sel4) _ (tup :* Nil) = do+ tupExpr <- compileExpr tup+ return $ tupExpr :.: "member4"+ compileExprSym (C' Sel5) _ (tup :* Nil) = do+ tupExpr <- compileExpr tup+ return $ tupExpr :.: "member5"+ compileExprSym (C' Sel6) _ (tup :* Nil) = do+ tupExpr <- compileExpr tup+ return $ tupExpr :.: "member6"+ compileExprSym (C' Sel7) _ (tup :* Nil) = do+ tupExpr <- compileExpr tup+ return $ tupExpr :.: "member7"+
+ lib/Feldspar/Compiler/Imperative/Frontend.hs view
@@ -0,0 +1,476 @@+--+-- 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 ViewPatterns #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE RecordWildCards #-}++module Feldspar.Compiler.Imperative.Frontend where++import Data.List+import Data.Monoid+import Control.Arrow (second)++import Feldspar.Compiler.Imperative.Representation hiding (Type, UserType, Cast, In, Out, Variable, Block, Pointer, Comment, Spawn, Run)+import qualified Feldspar.Compiler.Imperative.Representation as AIR+++-- * Frontend data types++data Mod = Mod [Ent]+ deriving (Show)++data Ent+ = StructD String [(String, Type)]+ | ProcDf String [Var] [Var] Prog+ | ProcDcl String [Var] [Var]+ deriving (Eq,Show)++data Type+ = Void+ | Boolean+ | Bit+ | Floating+ | I8 | I16 | I32 | I40 | I64+ | U8 | U16 | U32 | U40 | U64+ | Complex Type+ | UserType String+ | Array Type+ | SizedArray Int Type+ | Struct [(String, Type)]+ | IVar Type+ deriving Eq++data Expr+ = Var Type String+ | Ptr Type String+ | Tr+ | Fl+ | LitI Type Integer+ | LitF Double+ | LitC Expr Expr+ | Expr :!: Expr+ | Expr :.: String+ | Binop Type String [Expr]+ | Fun Type String [Expr]+ | Cast Type Expr+ | SizeofE Expr+ | SizeofT Type+ deriving (Eq,Show)++data Prog+ = Skip+ | BComment String+ | Comment String+ | Expr := Expr+ | Call String [Param]+ | Seq [Prog]+ | If Expr Prog Prog+ | While Prog Expr Prog+ | For String Expr Int Prog+ | Block [Def] Prog+ deriving (Eq,Show)++instance Monoid Prog+ where+ mempty = Skip+ mappend Skip p = p+ mappend p Skip = p+ mappend (Seq pa) (Seq pb) = Seq $ mappend pa pb+ mappend pa pb = Seq [mappend pa pb]++data Param+ = In Expr+ | Out Expr+ | TypAuto Type+ | TypScalar Type+ | Fn String+ | FnAddr String+ deriving (Eq,Show)++data Block = Bl [Def] Prog+ deriving (Eq,Show)++instance Monoid Block+ where+ mempty = Bl [] Skip+ mappend (Bl da pa) (Bl db pb) = Bl (mappend da db) (mappend pa pb)++data Def+ = Init Type String Expr+ | Def Type String+ deriving (Eq,Show)++data Var+ = Variable Type String+ | Pointer Type String+ deriving (Eq,Show)++class Named a where+ getName :: a -> String+instance Named Def where+ getName (Init _ n _) = n+ getName (Def _ n) = n+instance Named Var where+ getName (Variable _ n) = n+ getName (Pointer _ n) = n++-- * Conversion between representation and frontend++class Interface t where+ type Repr t+ toInterface :: Repr t -> t+ fromInterface :: t -> Repr t++instance Interface Mod where+ type Repr Mod = AIR.Module ()+ toInterface (Module es ()) = Mod $ map toInterface es+ fromInterface (Mod es) = AIR.Module (map fromInterface es) ()++instance Interface Ent where+ type Repr Ent = AIR.Entity ()+ toInterface (AIR.StructDef name members () ()) =+ StructD name (map (\(StructMember mname mtyp ())->(mname,toInterface mtyp)) members)+ toInterface (AIR.ProcDef name inparams outparams body () ()) =+ ProcDf name (map toInterface inparams) (map toInterface outparams) (toProg body)+ toInterface (AIR.ProcDecl name inparams outparams () ()) =+ ProcDcl name (map toInterface inparams) (map toInterface outparams)+ toInterface AIR.TypeDef{} = error "TypeDef not handled"+ fromInterface (StructD name members) =+ AIR.StructDef name (map (\(mname,mtyp)->(StructMember mname (fromInterface mtyp) ())) members) () ()+ fromInterface (ProcDf name inparams outparams body) =+ AIR.ProcDef name (map fromInterface inparams) (map fromInterface outparams) (toBlock body) () ()+ fromInterface (ProcDcl name inparams outparams) =+ AIR.ProcDecl name (map fromInterface inparams) (map fromInterface outparams) () ()++instance Interface Type where+ type Repr Type = AIR.Type+ toInterface VoidType = Void+ toInterface Alias{} = error "Alias not handled"+ toInterface AIR.BoolType = Boolean+ toInterface BitType = Bit+ toInterface AIR.FloatType = Floating+ toInterface (NumType Signed S8) = I8+ toInterface (NumType Signed S16) = I16+ toInterface (NumType Signed S32) = I32+ toInterface (NumType Signed S40) = I40+ toInterface (NumType Signed S64) = I64+ toInterface (NumType Unsigned S8) = U8+ toInterface (NumType Unsigned S16) = U16+ toInterface (NumType Unsigned S32) = U32+ toInterface (NumType Unsigned S40) = U40+ toInterface (NumType Unsigned S64) = U64+ toInterface (AIR.ComplexType t) = Complex $ toInterface t+ toInterface (AIR.UserType s) = UserType s+ toInterface (AIR.ArrayType (LiteralLen l) t) = SizedArray l $ toInterface t+ toInterface (AIR.ArrayType _ t) = Array $ toInterface t+ toInterface (AIR.StructType fields) = Struct $ map (second toInterface) fields+ toInterface (AIR.IVarType t) = IVar $ toInterface t+ fromInterface Void = VoidType+ fromInterface Boolean = AIR.BoolType+ fromInterface Bit = BitType+ fromInterface Floating = AIR.FloatType+ fromInterface I8 = NumType Signed S8+ fromInterface I16 = NumType Signed S16+ fromInterface I32 = NumType Signed S32+ fromInterface I40 = NumType Signed S40+ fromInterface I64 = NumType Signed S64+ fromInterface U8 = NumType Unsigned S8+ fromInterface U16 = NumType Unsigned S16+ fromInterface U32 = NumType Unsigned S32+ fromInterface U40 = NumType Unsigned S40+ fromInterface U64 = NumType Unsigned S64+ fromInterface (Complex t) = AIR.ComplexType $ fromInterface t+ fromInterface (UserType s) = AIR.UserType s+ fromInterface (Array t) = AIR.ArrayType UndefinedLen $ fromInterface t+ fromInterface (SizedArray l t) = AIR.ArrayType (LiteralLen l) $ fromInterface t+ fromInterface (Struct fields) = AIR.StructType $ map (second fromInterface) fields+ fromInterface (IVar t) = AIR.IVarType $ fromInterface t++instance Interface Expr where+ type Repr Expr = Expression ()+ toInterface (VarExpr (AIR.Variable name t Value ()) ()) = Var (toInterface t) name+ toInterface (VarExpr (AIR.Variable name t AIR.Pointer ()) ()) = Ptr (toInterface t) name+ toInterface (ArrayElem arr idx () ()) = toInterface arr :!: toInterface idx+ toInterface (StructField str field () ()) = toInterface str :.: field+ toInterface (ConstExpr (BoolConst True () ()) ()) = Tr+ toInterface (ConstExpr (BoolConst False () ()) ()) = Fl+ toInterface (ConstExpr (IntConst x t () ()) ()) = LitI (toInterface t) x+ toInterface (ConstExpr (FloatConst x () ()) ()) = LitF x+ toInterface (ConstExpr (ComplexConst r i () ()) ()) = LitC (toInterface $ ConstExpr r ()) (toInterface $ ConstExpr i ())+ toInterface (FunctionCall (Function name t Prefix) ps () ()) = Fun (toInterface t) name $ map toInterface ps+ toInterface (FunctionCall (Function name t Infix) ps () ()) = Binop (toInterface t) name $ map toInterface ps+ toInterface (AIR.Cast t e () ()) = Cast (toInterface t) (toInterface e)+ toInterface (SizeOf (Left t) () ()) = SizeofT $ toInterface t+ toInterface (SizeOf (Right e) () ()) = SizeofE $ toInterface e+ fromInterface (Var t name) = VarExpr (AIR.Variable name (fromInterface t) Value ()) ()+ fromInterface (Ptr t name) = VarExpr (AIR.Variable name (fromInterface t) AIR.Pointer ()) ()+ fromInterface (Tr) = ConstExpr (BoolConst True () ()) ()+ fromInterface (Fl) = ConstExpr (BoolConst False () ()) ()+ fromInterface (LitI t x) = ConstExpr (IntConst x (fromInterface t) () ()) ()+ fromInterface (LitF x) = ConstExpr (FloatConst x () ()) ()+ fromInterface (LitC (fromInterface -> (ConstExpr r ())) (fromInterface -> (ConstExpr i ()))) =+ ConstExpr (ComplexConst r i () ()) ()+ fromInterface (LitC _ _) = error "Illegal LitC" -- TODO (?)+ fromInterface (Binop t name es) = FunctionCall (Function name (fromInterface t) Infix) (map fromInterface es) () ()+ fromInterface (Fun t name es) = FunctionCall (Function name (fromInterface t) Prefix) (map fromInterface es) () ()+ fromInterface (Cast t e) = AIR.Cast (fromInterface t) (fromInterface e) () ()+ fromInterface (SizeofE e) = SizeOf (Right $ fromInterface e) () ()+ fromInterface (SizeofT t) = SizeOf (Left $ fromInterface t) () ()+ fromInterface (arr :!: idx) = ArrayElem (fromInterface arr) (fromInterface idx) () ()+ fromInterface (str :.: field) = StructField (fromInterface str) field () ()++instance Interface Prog where+ type Repr Prog = AIR.Program ()+ toInterface (Empty () ()) = Skip+ toInterface (AIR.Comment True s () ()) = BComment s+ toInterface (AIR.Comment False s () ()) = Comment s+ toInterface Assign{..} = toInterface lhs := toInterface rhs+ toInterface (ProcedureCall s ps () ()) = Call s (map toInterface ps)+ toInterface (Sequence ps () ()) = Seq (map toInterface ps)+ toInterface (Branch e b1 b2 () ()) = If (toInterface e) (toProg b1) (toProg b2)+ toInterface (SeqLoop e pe b () ()) = While (toProg pe) (toInterface e) (toProg b)+ toInterface (ParLoop v e i b () ()) = For (varName v) (toInterface e) i (toProg b)+ toInterface (BlockProgram b ()) = Block (map toInterface $ locals b) (toInterface $ blockBody b)+ fromInterface (Skip) = Empty () ()+ fromInterface (BComment s) = AIR.Comment True s () ()+ fromInterface (Comment s) = AIR.Comment False s () ()+ fromInterface (lhs := rhs) = Assign (fromInterface lhs) (fromInterface rhs) () ()+ fromInterface (Call s ps) = ProcedureCall s (map fromInterface ps) () ()+ fromInterface (Seq ps) = Sequence (map fromInterface ps) () ()+ fromInterface (If e p1 p2) = Branch (fromInterface e) (toBlock p1) (toBlock p2) () ()+ fromInterface (While pe e p) = SeqLoop (fromInterface e) (toBlock pe) (toBlock p) () ()+ fromInterface (For s e i p) = ParLoop+ (AIR.Variable s (NumType Unsigned S32) Value ()) (fromInterface e) i (toBlock p) () ()+ fromInterface (Block ds p) = BlockProgram (AIR.Block (map fromInterface ds) (fromInterface p) ()) ()++instance Interface Param where+ type Repr Param = ActualParameter ()+ toInterface (AIR.In e ()) = In (toInterface e)+ toInterface (AIR.Out e ()) = Out (toInterface e)+ toInterface (AIR.TypeParameter e AIR.Auto ()) = TypAuto (toInterface e)+ toInterface (AIR.TypeParameter e AIR.Scalar ()) = TypScalar (toInterface e)+ toInterface (AIR.FunParameter n False ()) = Fn n+ toInterface (AIR.FunParameter n True ()) = FnAddr n+ fromInterface (In e) = AIR.In (fromInterface e) ()+ fromInterface (Out e) = AIR.Out (fromInterface e) ()+ fromInterface (TypAuto e) = AIR.TypeParameter (fromInterface e) Auto ()+ fromInterface (TypScalar e) = AIR.TypeParameter (fromInterface e) Scalar ()+ fromInterface (Fn n) = AIR.FunParameter n False ()+ fromInterface (FnAddr n) = AIR.FunParameter n True ()++instance Interface Def where+ type Repr Def = Declaration ()+ toInterface (Declaration v (Just e) ()) = Init (toInterface $ varType v) (varName v) (toInterface e)+ toInterface (Declaration v Nothing ()) = Def (toInterface $ varType v) (varName v)+ fromInterface (Init t s e) = Declaration (AIR.Variable s (fromInterface t) Value ()) (Just $ fromInterface e) ()+ fromInterface (Def t s) = Declaration (AIR.Variable s (fromInterface t) Value ()) Nothing ()++instance Interface Block where+ type Repr Block = AIR.Block ()+ toInterface (AIR.Block ds p ()) = Bl (map toInterface ds) (toInterface p)+ fromInterface (Bl ds p) = AIR.Block (map fromInterface ds) (fromInterface p) ()++instance Interface Var where+ type Repr Var = AIR.Variable ()+ toInterface (AIR.Variable name typ Value ()) = Variable (toInterface typ) name+ toInterface (AIR.Variable name typ AIR.Pointer ()) = Pointer (toInterface typ) name+ fromInterface (Variable typ name) = AIR.Variable name (fromInterface typ) Value ()+ fromInterface (Pointer typ name) = AIR.Variable name (fromInterface typ) AIR.Pointer ()++toBlock :: Prog -> AIR.Block ()+toBlock (Block ds p) = AIR.Block (map fromInterface ds) (fromInterface p) ()+toBlock p = AIR.Block [] (fromInterface p) ()++toProg :: AIR.Block () -> Prog+toProg (AIR.Block [] p ()) = toInterface p+toProg (AIR.Block ds p ()) = Block (map toInterface ds) (toInterface p)++boolToExpr :: Bool -> Expr+boolToExpr True = Tr+boolToExpr False = Fl++setLength :: Expr -> Expr -> Prog+setLength arr len = Call "setLength" [Out arr, In len]++copyProg :: Expr -> Expr -> Prog+copyProg outExp inExp = Call "copy" [Out outExp, In inExp]++copyProgPos :: Expr -> Expr -> Expr -> Prog+copyProgPos outExp shift inExp = Call "copyArrayPos" [Out outExp, In shift, In inExp]++copyProgLen :: Expr -> Expr -> Expr -> Prog+copyProgLen outExp inExp len = Call "copyArrayLen" [Out outExp, In inExp, In len]++initArray :: Expr -> Expr -> Prog+initArray arr len = Call "initArray" [Out arr, In s, In len]+ where+ s+ | isArray t = Binop U32 "-" [LitI U32 0,SizeofT t]+ | otherwise = SizeofT t+ t = case typeof arr of+ Array e -> e+ SizedArray _ e -> e+ _ -> error $ "Feldspar.Compiler.Imperative.Frontend.initArray: invalid type of array " ++ show arr ++ "::" ++ show (typeof arr)++assignProg :: Expr -> Expr -> Prog+assignProg lhs rhs+ | isArray (typeof lhs) = Seq [ini,cp]+ | otherwise = cp+ where+ ini = initArray lhs $ arrayLength rhs+ cp = copyProg lhs rhs++freeArray :: Var -> Prog+freeArray arr = Call "freeArray" [Out $ varToExpr arr]++arrayLength :: Expr -> Expr+arrayLength (Var (SizedArray n _) _) = LitI U32 $ fromIntegral n+arrayLength (Ptr (SizedArray n _) _) = LitI U32 $ fromIntegral n+arrayLength arr = Fun U32 "getLength" [arr]++iVarInit :: Expr -> Prog+iVarInit var = Call "ivar_init" [Out var]++iVarGet :: Expr -> Expr -> Prog+iVarGet loc ivar + | isArray typ = Call "ivar_get_array" [Out loc, In ivar]+ | otherwise = Call "ivar_get" [TypScalar typ, Out loc, In ivar]+ where+ typ = typeof loc++iVarPut :: Expr -> Expr -> Prog+iVarPut ivar msg+ | isArray typ = Call "ivar_put_array" [In ivar, Out msg]+ | otherwise = Call "ivar_put" [TypAuto typ, In ivar, Out msg]+ where+ typ = typeof msg++spawn :: String -> [Var] -> Prog+spawn taskName vs = Call spawnName allParams+ where+ spawnName = "spawn" ++ show (length vs)+ taskParam = FnAddr taskName+ typeParams = map (TypAuto . vType) vs+ varParams = map (\v -> In $ Var (vType v) (vName v)) vs+ allParams = taskParam : concat (zipWith (\a b -> [a,b]) typeParams varParams)++run :: String -> [Var] -> Prog+run taskName vs = Call runName allParams+ where+ runName = "run" ++ show (length vs)+ typeParams = map (TypAuto . vType) vs+ taskParam = Fn taskName+ allParams = taskParam : typeParams+ +instance Show Type+ where+ show Void = "void"+ show Boolean = "bool"+ show Bit = "bit"+ show Floating = "float"+ show I8 = "int8"+ show I16 = "int16"+ show I32 = "int32"+ show I40 = "int40"+ show I64 = "int64"+ show U8 = "uint8"+ show U16 = "uint16"+ show U32 = "uint32"+ show U40 = "uint40"+ show U64 = "uint64"+ show (Complex t) = "complexOf_" ++ show t+ show (UserType s) = "userType_" ++ s+ show (Array t) = "arrayOf_" ++ show t+ show (SizedArray i t) = "arrayOfSize_" ++ show i ++ "_" ++ show t+ show (Struct fields) = "struct_" ++ intercalate "_" (map (\(s,t) -> s ++ "_" ++ show t) fields)+ show (IVar t) = "ivarOf_" ++ show t++instance HasType Expr+ where+ type TypeOf Expr = Type+ typeof = toInterface . typeof . fromInterface++instance HasType Var+ where+ type TypeOf Var = Type+ typeof = toInterface . typeof . fromInterface++intWidth :: Type -> Maybe Integer+intWidth I8 = Just 8+intWidth I16 = Just 16+intWidth I32 = Just 32+intWidth I40 = Just 40+intWidth I64 = Just 64+intWidth U8 = Just 8+intWidth U16 = Just 16+intWidth U32 = Just 32+intWidth U40 = Just 40+intWidth U64 = Just 64+intWidth _ = Nothing++intSigned :: Type -> Maybe Bool+intSigned I8 = Just True+intSigned I16 = Just True+intSigned I32 = Just True+intSigned I40 = Just True+intSigned I64 = Just True+intSigned U8 = Just False+intSigned U16 = Just False+intSigned U32 = Just False+intSigned U40 = Just False+intSigned U64 = Just False+intSigned _ = Nothing++litB :: Bool -> Expr+litB True = Tr+litB False = Fl++isArray :: Type -> Bool+isArray (Array _) = True+isArray (SizedArray _ _) = True+isArray _ = False++vType :: Var -> Type+vType (Variable t _) = t+vType (Pointer t _) = t++vName :: Var -> String+vName (Variable _ s) = s+vName (Pointer _ s) = s++lName :: Expr -> String+lName (Var _ s) = s+lName (Ptr _ s) = s+lName (e :!: _) = lName e+lName (e :.: _) = lName e+lName e = error $ "Feldspar.Compiler.Imperative.Frontend.lName: invalid location: " ++ show e++varToExpr :: Var -> Expr+varToExpr (Variable t name) = Var t name+varToExpr (Pointer t name) = Ptr t name
+ lib/Feldspar/Compiler/Imperative/Plugin/CollectFreeVars.hs view
@@ -0,0 +1,82 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.Plugin.CollectFreeVars where++import Data.Map (Map)+import qualified Data.Map as Map+import qualified Feldspar.Compiler.Imperative.Frontend as Front+import Feldspar.Transformation++data Collect = Collect++type Collection = Map String Front.Var++instance Default Collection where+ def = Map.empty++instance Combine Collection where+ combine = Map.union++instance Transformation Collect+ where+ type From Collect = ()+ type To Collect = ()+ type Down Collect = ()+ type Up Collect = Collection+ type State Collect = ()++instance Plugin Collect+ where+ type ExternalInfo Collect = ()+ executePlugin _ externalInfo = result . transform Collect () externalInfo++instance Transformable Collect Variable where+ transform _ _ _ v = Result v () $ Map.singleton (varName v) (Front.toInterface v)++instance Transformable Collect Block where+ transform t _ _ bl = Result bl' () diff+ where+ Result bl' _ m = defaultTransform t () () bl+ localNames = map (varName . declVar) $ locals bl'+ localMap = Map.fromList $ map (\name -> (name,())) localNames+ diff = m `Map.difference` localMap++instance Transformable Collect Program where+ transform t _ _ pr@(ParLoop idxVar _ _ _ _ _) = Result pr' () diff+ where+ Result pr' _ m = defaultTransform t () () pr+ diff = Map.delete (varName idxVar) m+ transform t _ _ prog = defaultTransform t () () prog
+ lib/Feldspar/Compiler/Imperative/Plugin/ConstantFolding.hs view
@@ -0,0 +1,69 @@+--+-- 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.Imperative.Plugin.ConstantFolding where++import Feldspar.Transformation++data ConstantFolding = ConstantFolding++instance Plugin ConstantFolding where+ type ExternalInfo ConstantFolding = ()+ executePlugin ConstantFolding _ procedure = result $ transform ConstantFolding () () procedure++instance Transformation ConstantFolding where+ type From ConstantFolding = ()+ type To ConstantFolding = ()+ type Down ConstantFolding = ()+ type Up ConstantFolding = ()+ type State ConstantFolding = ()++instance Transformable ConstantFolding Expression where+ transform t s d f@FunctionCall{} = case funMode $ function f' of+ Infix -> case funName $ function f' of+ "+" -> tr' $ elimParamIf (isConstIntN 0) True $ result tr+ "-" -> tr' $ elimParamIf (isConstIntN 0) False $ result tr+ "*" -> tr' $ elimParamIf (isConstIntN 1) True $ result tr+ _ -> tr+ _ -> tr+ where+ tr = defaultTransform t s d f+ tr' x = tr {result = x}+ f' = result tr+ isConstIntN n (ConstExpr (IntConst i _ _ _) _) = n == i+ isConstIntN _ _ = False++ elimParamIf predicate flippable funCall@(FunctionCall (Function _ _ Infix) (x:xs) _ _)+ | predicate (head xs) = x+ | flippable && predicate x = head xs+ | otherwise = funCall+ elimParamIf _ _ funCall = funCall+ transform t s d e = defaultTransform t s d e
+ lib/Feldspar/Compiler/Imperative/Plugin/Free.hs view
@@ -0,0 +1,61 @@+--+-- 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 GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.Plugin.Free where++import Feldspar.Compiler.Imperative.Frontend (toInterface, fromInterface, isArray, freeArray)+import Feldspar.Transformation++data Free = Free++instance Transformation Free+ where+ type From Free = ()+ type To Free = ()+ type Down Free = ()+ type Up Free = ()+ type State Free = ()++instance Plugin Free+ where+ type ExternalInfo Free = ()+ executePlugin _ _ = result . transform Free () ()++instance Transformable Free Block where+ transform _ _ _ (Block locs b _) = Result bl' () ()+ where+ arrays = filter (isArray . typeof) $ map (toInterface . declVar) locs+ newBody = Sequence (b : map (fromInterface . freeArray) arrays) () ()+ bl' = Block locs newBody ()
+ lib/Feldspar/Compiler/Imperative/Plugin/IVars.hs view
@@ -0,0 +1,82 @@+--+-- 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 OverlappingInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.Plugin.IVars where++import Feldspar.Transformation++import Data.List (isPrefixOf)++data IVarPlugin = IVarPlugin++instance Transformation IVarPlugin+ where+ type From IVarPlugin = ()+ type To IVarPlugin = ()+ type Down IVarPlugin = Bool -- True if the code is in a task.+ type Up IVarPlugin = ()+ type State IVarPlugin = ()++instance Plugin IVarPlugin+ where+ type ExternalInfo IVarPlugin = ()+ executePlugin _ _ = result . transform IVarPlugin () False++instance Transformable IVarPlugin Entity where+ transform t _ _ p@ProcDef{} = defaultTransform t () (isTask p) p+ where+ isTask proc = "task" `isPrefixOf` procName proc -- TODO: this is hacky :)+ transform t _ d p = defaultTransform t () d p++instance Transformable IVarPlugin Program where+ transform _ _ d (ProcedureCall name ps _ _)+ | "ivar_get" `isPrefixOf` name+ = Result pc' () ()+ where+ pc' = ProcedureCall name' ps () ()+ name' | d = name+ | otherwise = name ++ "_nontask"+ transform t _ d x = defaultTransform t () d x++instance Transformable IVarPlugin Block where+ transform t _ d b = Result b{ blockBody = body' } () ()+ where+ body' = Sequence prg () ()+ prg = result (transform t () d $ blockBody b) : destrs+ iVars = filter isIVar $ map declVar $ locals b+ isIVar v = case varType v of+ IVarType _ -> True+ _ -> False+ ivarFun s v = ProcedureCall ("ivar_" ++ s) [p] () ()+ where+ p = Out (VarExpr v ()) ()+ destrs = map (ivarFun "destroy") iVars
+ lib/Feldspar/Compiler/Imperative/Plugin/Naming.hs view
@@ -0,0 +1,194 @@+--+-- 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.Imperative.Plugin.Naming where++import Data.List (isPrefixOf)++import Feldspar.Transformation++import qualified Feldspar.NameExtractor as Precompiler+import Feldspar.Compiler.Error+import Feldspar.Compiler.Backend.C.Library++import System.IO.Unsafe++-- ===========================================================================+-- == Precompilation plugin+-- ===========================================================================++data SignatureInformation = SignatureInformation {+ originalFunctionName :: String,+ generatedImperativeParameterNames :: [String],+ originalParameterNames :: Maybe [Maybe String]+} deriving (Show, Eq)++instance Default SignatureInformation where def = precompilationError InternalError "Default value should not be used"++precompilationError :: ErrorClass -> String -> a+precompilationError = handleError "PluginArch/Naming"++data Precompilation = Precompilation++instance Transformation Precompilation where+ type From Precompilation = ()+ type To Precompilation = ()+ type Down Precompilation = SignatureInformation+ type Up Precompilation = ()+ type State Precompilation = ()+++instance Transformable Precompilation Entity where+ transform t s d x@(ProcDef n i _ _ _ _)+ | n == "PLACEHOLDER" = tr { result = (result tr){ procName = n' } }+ where+ d' = d { generatedImperativeParameterNames = map varName i }+ tr = defaultTransform t s d' x+ n' = originalFunctionName d+ transform t s d x@(ProcDef n _ _ _ _ _)+ | any (n `isPrefixOf`) proceduresToPrefix = tr { result = (result tr){ procName = n' } }+ where+ n' = prefix d n+ tr = defaultTransform t s d' x+ d' = d{ generatedImperativeParameterNames = [] }+ transform t s d x@ProcDef{} = defaultTransform t s d' x+ where+ d' = d{ generatedImperativeParameterNames = [] }+ transform t s d x = defaultTransform t s d x+++instance Transformable Precompilation Variable where+ transform _ s d v = Result newVar s def+ where+ newVar = v + { varName = maybeStr2Str (getVariableName d $ varName v) ++ varName v+ , varLabel = ()+ }++instance Transformable Precompilation ActualParameter where+ transform _ s d (FunParameter n addr _)+ | any (n `isPrefixOf`) proceduresToPrefix+ = Result (FunParameter (prefix d n) addr ()) s def+ transform t s d x = defaultTransform t s d x++instance Transformable Precompilation Program where+ transform t s d c@(ProcedureCall n _ _ _)+ | any (n `isPrefixOf`) proceduresToPrefix = tr { result = (result tr){ procCallName = n' } }+ where+ tr = defaultTransform t s d c+ n' = prefix d n+ transform t s d x = defaultTransform t s d x++proceduresToPrefix :: [String]+proceduresToPrefix = ["noinline", "task"]++prefix :: SignatureInformation -> String -> String+prefix d n = originalFunctionName d ++ "_" ++ n++getVariableName :: SignatureInformation -> String -> Maybe String+getVariableName signatureInformation origname = case originalParameterNames signatureInformation of+ Just originalParameterNameList ->+ if length (generatedImperativeParameterNames signatureInformation) == length originalParameterNameList then+ case searchResults of+ [] -> Nothing+ _ -> snd $ head searchResults+ else+ Nothing+ -- precompilationError InternalError $ "parameter name list length mismatch:" +++ -- show (generatedImperativeParameterNames signatureInformation) ++ " " ++ show originalParameterNameList+ where+ searchResults = filter ((origname ==).fst)+ (zip (generatedImperativeParameterNames signatureInformation) originalParameterNameList)+ Nothing -> Nothing++maybeStr2Str :: Maybe String -> String+maybeStr2Str (Just s) = s ++ "_"+maybeStr2Str Nothing = ""++data PrecompilationExternalInfo = PrecompilationExternalInfo {+ originalFunctionSignature :: Precompiler.OriginalFunctionSignature, + inputParametersDescriptor :: [Int],+ numberOfFunctionArguments :: Int,+ compilationMode :: CompilationMode+}++addPostfixNumberToMaybeString :: (Maybe String, Int) -> Maybe String+addPostfixNumberToMaybeString (ms, num) = ms >>= \s -> return $ s ++ show num++inflate :: Int -> [Maybe String] -> [Maybe String]+inflate target list | length list < target = inflate target (list++[Nothing])+ | length list == target = list+ | otherwise = precompilationError InternalError "Unexpected situation in 'inflate'"++-- Replicates each element of the [parameter list given by the precompiler] based on the input parameter descriptor+parameterNameListConsolidator :: PrecompilationExternalInfo -> [Maybe String]+parameterNameListConsolidator externalInfo =+ if numberOfFunctionArguments externalInfo == length (inputParametersDescriptor externalInfo)+ then+ concatMap (uncurry replicate)+ (zip (inputParametersDescriptor externalInfo)+ (Precompiler.originalParameterNames $ originalFunctionSignature externalInfo))+ else+ precompilationError InternalError "numArgs should be equal to the length of the input parameters' descriptor"++instance Plugin Precompilation where+ type ExternalInfo Precompilation = PrecompilationExternalInfo+ executePlugin Precompilation externalInfo procedure = result+ $ transform Precompilation ({-state-}) SignatureInformation{+ originalFunctionName = Precompiler.originalFunctionName $ originalFunctionSignature externalInfo,+ generatedImperativeParameterNames = precompilationError InternalError "GIPN should have been overwritten", + originalParameterNames = case compilationMode externalInfo of+ Standalone ->+ if -- ultimate check, should be enough...+ numberOfFunctionArguments externalInfo ==+ length (Precompiler.originalParameterNames $ originalFunctionSignature externalInfo)+ then+ Just $ parameterNameListConsolidator externalInfo+ else+ unsafePerformIO $ do+ withColor Yellow $ putStrLn $ unwords [ "[WARNING @ PluginArch/Naming]:"+ , " not enough named parameters in function "+ , Precompiler.originalFunctionName (originalFunctionSignature externalInfo)+ ]+ withColor Yellow $ putStrLn $ "numArgs: " ++ show (numberOfFunctionArguments externalInfo) +++ ", parameter list: " ++ show (Precompiler.originalParameterNames $+ originalFunctionSignature externalInfo) + return $ Just $ parameterNameListConsolidator (externalInfo {+ originalFunctionSignature = (originalFunctionSignature externalInfo) {+ Precompiler.originalParameterNames =+ inflate (numberOfFunctionArguments externalInfo) $+ Precompiler.originalParameterNames $+ originalFunctionSignature externalInfo+ }+ })+ Interactive -> Nothing -- no parameter name handling in interactive mode+ } procedure+
+ lib/Feldspar/Compiler/Imperative/Plugin/Unroll.hs view
@@ -0,0 +1,285 @@+--+-- 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 ScopedTypeVariables #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.Plugin.Unroll where++import Feldspar.Compiler.Backend.C.Options+import Feldspar.Transformation++-- ============================+-- == Unroll's Semantic info ==+-- ============================++data SemInfPrg = SemInfPrg+ { position :: Int+ , varNames :: [String]+ , loopVar :: String+ } deriving (Eq, Show)++data UnrollSemInf++instance Annotation UnrollSemInf Module where+ type Label UnrollSemInf Module = ()++instance Annotation UnrollSemInf Entity where+ type Label UnrollSemInf Entity = ()++instance Annotation UnrollSemInf Struct where+ type Label UnrollSemInf Struct = ()++instance Annotation UnrollSemInf StructMember where+ type Label UnrollSemInf StructMember = ()++instance Annotation UnrollSemInf ProcDef where+ type Label UnrollSemInf ProcDef = ()++instance Annotation UnrollSemInf ProcDecl where+ type Label UnrollSemInf ProcDecl = ()++instance Annotation UnrollSemInf Block where+ type Label UnrollSemInf Block = ()++instance Annotation UnrollSemInf Program where+ type Label UnrollSemInf Program = Maybe SemInfPrg++instance Annotation UnrollSemInf Empty where+ type Label UnrollSemInf Empty = ()++instance Annotation UnrollSemInf Comment where+ type Label UnrollSemInf Comment = ()++instance Annotation UnrollSemInf Assign where+ type Label UnrollSemInf Assign = ()++instance Annotation UnrollSemInf ProcedureCall where+ type Label UnrollSemInf ProcedureCall = ()++instance Annotation UnrollSemInf Spawn where+ type Label UnrollSemInf Spawn = ()++instance Annotation UnrollSemInf Run where+ type Label UnrollSemInf Run = ()++instance Annotation UnrollSemInf Sequence where+ type Label UnrollSemInf Sequence = ()++instance Annotation UnrollSemInf Branch where+ type Label UnrollSemInf Branch = ()++instance Annotation UnrollSemInf SeqLoop where+ type Label UnrollSemInf SeqLoop = ()++instance Annotation UnrollSemInf ParLoop where+ type Label UnrollSemInf ParLoop = ()++instance Annotation UnrollSemInf ActualParameter where+ type Label UnrollSemInf ActualParameter = ()++instance Annotation UnrollSemInf Declaration where+ type Label UnrollSemInf Declaration = ()++instance Annotation UnrollSemInf Expression where+ type Label UnrollSemInf Expression = ()++instance Annotation UnrollSemInf FunctionCall where+ type Label UnrollSemInf FunctionCall = ()++instance Annotation UnrollSemInf Cast where+ type Label UnrollSemInf Cast = ()++instance Annotation UnrollSemInf SizeOf where+ type Label UnrollSemInf SizeOf = ()++instance Annotation UnrollSemInf ArrayElem where+ type Label UnrollSemInf ArrayElem = ()++instance Annotation UnrollSemInf StructField where+ type Label UnrollSemInf StructField = ()++instance Annotation UnrollSemInf Constant where+ type Label UnrollSemInf Constant = ()++instance Annotation UnrollSemInf IntConst where+ type Label UnrollSemInf IntConst = ()++instance Annotation UnrollSemInf FloatConst where+ type Label UnrollSemInf FloatConst = ()++instance Annotation UnrollSemInf BoolConst where+ type Label UnrollSemInf BoolConst = ()++instance Annotation UnrollSemInf ArrayConst where+ type Label UnrollSemInf ArrayConst = ()++instance Annotation UnrollSemInf ComplexConst where+ type Label UnrollSemInf ComplexConst = ()++instance Annotation UnrollSemInf Variable where+ type Label UnrollSemInf Variable = ()++-- ==+-- == Plugin+-- ==++instance Default Bool where+ def = False++instance Combine Bool where+ combine = (||)++instance Default (Maybe SemInfPrg) where def = Nothing +++instance Plugin UnrollPlugin where+ type ExternalInfo UnrollPlugin = UnrollStrategy+ executePlugin UnrollPlugin ei p = case ei of+ NoUnroll -> p+ Unroll unrollCount -> result $ transform Unroll2 () Nothing $ result $ transform Unroll1 () unrollCount p+ +data UnrollPlugin = UnrollPlugin+instance Transformation UnrollPlugin where+ type From UnrollPlugin = ()+ type To UnrollPlugin = ()+ type Down UnrollPlugin = ()+ type Up UnrollPlugin = ()+ type State UnrollPlugin = ()++data Unroll1 = Unroll1+instance Transformation Unroll1 where+ type From Unroll1 = ()+ type To Unroll1 = UnrollSemInf+ type Down Unroll1 = Int+ type Up Unroll1 = Bool+ type State Unroll1 = ()++instance Transformable Unroll1 Program where+ transform t s d p@ParLoop{}+ | not (up tr)+ , unrollPossible = tr'+ | otherwise = tr+ where+ tr = defaultTransform t s d p+ tr' = tr + { result = (result tr)+ { pLoopStep = d+ , pLoopBlock = loopCore+ { locals = unrollDecls+ , blockBody = Sequence prgs () Nothing+ }+ }+ , up = True+ }+ prgs = map (\(i,prg) -> prg{ programLabel = Just (SemInfPrg i vns loopCounter) }) $ zip [0,1..] replPrg+ replPrg = replicate d $ blockBody loopCore+ unrollDecls = concatMap (uncurry renameDecls) $ zip [0..] replDecls+ renameDecls (i :: Int) = map (\decl -> renameDeclaration decl (getVarNameDecl decl ++ "_u" ++ show i))+ replDecls = replicate d $ locals loopCore+ loopCore = pLoopBlock $ result tr + loopBound = pLoopBound $ result tr+ loopCounter = varName $ pLoopCounter $ result tr+ vns = map getVarNameDecl $ locals loopCore+ unrollPossible = case loopBound of+ (ConstExpr (IntConst i _ _ _) _) -> mod i (toInteger d) == 0+ _ -> False+ transform t s d p = defaultTransform t s d p+++data Unroll2 = Unroll2 +instance Transformation Unroll2 where+ type From Unroll2 = UnrollSemInf+ type To Unroll2 = ()+ type Down Unroll2 = Maybe SemInfPrg+ type Up Unroll2 = ()+ type State Unroll2 = ()++instance Transformable Unroll2 Program where+ transform t s d p = defaultTransform t s d' p where+ d' = case programLabel p of+ Nothing -> d+ x -> x ++instance Transformable Unroll2 Expression where+ transform t s d l = case d of+ Nothing -> tr+ Just x -> case l of+ VarExpr n _+ | varName n == loopVar x -> tr + { result = FunctionCall + { function = Function+ { funName = "+"+ , returnType = NumType Signed S32+ , funMode = Infix+ }+ , funCallParams = + [ result tr+ , ConstExpr (IntConst (toInteger $ position x) (NumType Signed S32) () ()) ()+ ]+ , funCallLabel = ()+ , exprLabel = ()+ }+ }+ | otherwise -> tr+ _ -> tr+ where+ tr = defaultTransform t s d l+++instance Transformable Unroll2 Variable where+ transform t s d v = case d of+ Just x+ | varName v `elem` varNames x -> tr+ { result = (result tr)+ { varName = varName v ++ "_u" ++ show (position x)+ , varLabel = ()+ }+ }+ | otherwise -> tr+ Nothing -> tr+ where+ tr = defaultTransform t s d v+++-- helper functions : +isJust :: Maybe t -> Bool+isJust (Just _) = True+isJust _ = False++getVarNameDecl :: Declaration t -> String+getVarNameDecl d = varName $ declVar d++renameDeclaration :: Declaration t -> String -> Declaration t+renameDeclaration d n = d { declVar = renameVariable (declVar d) n }++renameVariable :: Variable t -> String -> Variable t+renameVariable v n = v { varName = n }+
+ lib/Feldspar/Compiler/Imperative/Representation.hs view
@@ -0,0 +1,620 @@+--+-- 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 RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.Representation where++import Data.Typeable+import qualified Data.List as List (find)++import Feldspar.Compiler.Error++-- ===============================================================================================+-- == Class defining semantic information attached to different nodes in the imperative program ==+-- ===============================================================================================++class Annotation t (s :: * -> *) where+ type Label t s++instance Annotation () s where+ type Label () s = ()++-- =================================================+-- == Data stuctures to store imperative programs ==+-- =================================================++data Module t = Module+ { entities :: [Entity t]+ , moduleLabel :: Label t Module+ }+ deriving Typeable++deriving instance (ShowLabel t) => Show (Module t)+deriving instance (EqLabel t) => Eq (Module t)++data Entity t+ = StructDef+ { structName :: String+ , structMembers :: [StructMember t]+ , structLabel :: Label t Struct+ , definitionLabel :: Label t Entity+ }+ | TypeDef+ { actualType :: Type+ , typeName :: String+ , definitionLabel :: Label t Entity+ }+ | ProcDef+ { procName :: String+ , inParams :: [Variable t]+ , outParams :: [Variable t]+ , procBody :: Block t+ , procDefLabel :: Label t ProcDef+ , definitionLabel :: Label t Entity+ }+ | ProcDecl+ { procName :: String+ , inParams :: [Variable t]+ , outParams :: [Variable t]+ , procDeclLabel :: Label t ProcDecl+ , definitionLabel :: Label t Entity+ }+ deriving Typeable++deriving instance (ShowLabel t) => Show (Entity t)+deriving instance (EqLabel t) => Eq (Entity t) ++data StructMember t = StructMember+ { structMemberName :: String+ , structMemberType :: Type+ , structMemberLabel :: Label t StructMember+ }+ deriving Typeable++deriving instance (ShowLabel t) => Show (StructMember t)+deriving instance (EqLabel t) => Eq (StructMember t)++data Block t = Block+ { locals :: [Declaration t]+ , blockBody :: Program t+ , blockLabel :: Label t Block+ }+ deriving Typeable++deriving instance (ShowLabel t) => Show (Block t)+deriving instance (EqLabel t) => Eq (Block t)++data Program t+ = Empty+ { emptyLabel :: Label t Empty+ , programLabel :: Label t Program+ }+ | Comment+ { isBlockComment :: Bool+ , commentValue :: String+ , commentLabel :: Label t Comment+ , programLabel :: Label t Program+ }+ | Assign+ { lhs :: Expression t+ , rhs :: Expression t+ , assignLabel :: Label t Assign+ , programLabel :: Label t Program+ }+ | ProcedureCall+ { procCallName :: String+ , procCallParams :: [ActualParameter t]+ , procCallLabel :: Label t ProcedureCall+ , programLabel :: Label t Program+ }+ | Sequence+ { sequenceProgs :: [Program t]+ , sequenceLabel :: Label t Sequence+ , programLabel :: Label t Program+ }+ | Branch+ { branchCond :: Expression t+ , thenBlock :: Block t+ , elseBlock :: Block t+ , branchLabel :: Label t Branch+ , programLabel :: Label t Program+ }+ | SeqLoop+ { sLoopCond :: Expression t+ , sLoopCondCalc :: Block t+ , sLoopBlock :: Block t+ , sLoopLabel :: Label t SeqLoop+ , programLabel :: Label t Program+ }+ | ParLoop+ { pLoopCounter :: Variable t+ , pLoopBound :: Expression t+ , pLoopStep :: Int+ , pLoopBlock :: Block t+ , pLoopLabel :: Label t ParLoop+ , programLabel :: Label t Program+ }+ | BlockProgram+ { blockProgram :: Block t+ , programLabel :: Label t Program+ }+ deriving Typeable++deriving instance (ShowLabel t) => Show (Program t)+deriving instance (EqLabel t) => Eq (Program t)++data ActualParameter t+ = In+ { inParam :: Expression t+ , actParamLabel :: Label t ActualParameter+ }+ | Out+ { outParam :: Expression t+ , actParamLabel :: Label t ActualParameter+ }+ | TypeParameter+ { typeParam :: Type+ , typeParamMode :: TypeParameterMode+ , actParamLabel :: Label t ActualParameter+ }+ | FunParameter+ { funParamName :: String+ , addressNeeded :: Bool+ , actParamLabel :: Label t ActualParameter+ }+ deriving Typeable++deriving instance (ShowLabel t) => Show (ActualParameter t)+deriving instance (EqLabel t) => Eq (ActualParameter t)++data Declaration t = Declaration+ { declVar :: Variable t+ , initVal :: Maybe (Expression t)+ , declLabel :: Label t Declaration+ }+ deriving Typeable++deriving instance (ShowLabel t) => Show (Declaration t)+deriving instance (EqLabel t) => Eq (Declaration t)++data Expression t+ = VarExpr+ { var :: Variable t+ , exprLabel :: Label t Expression+ }+ | ArrayElem+ { array :: Expression t+ , arrayIndex :: Expression t+ , arrayLabel :: Label t ArrayElem+ , exprLabel :: Label t Expression+ }+ | StructField+ { struct :: Expression t+ , fieldName :: String+ , structFieldLabel :: Label t StructField+ , exprLabel :: Label t Expression+ }+ | ConstExpr+ { constExpr :: Constant t+ , exprLabel :: Label t Expression+ }+ | FunctionCall+ { function :: Function+ , funCallParams :: [Expression t]+ , funCallLabel :: Label t FunctionCall+ , exprLabel :: Label t Expression+ }+ | Cast+ { castType :: Type+ , castExpr :: Expression t+ , castLabel :: Label t Cast+ , exprLabel :: Label t Expression+ }+ | SizeOf+ { sizeOf :: Either Type (Expression t)+ , sizeOfLabel :: Label t SizeOf+ , exprLabel :: Label t Expression+ }+ deriving Typeable++deriving instance (ShowLabel t) => Show (Expression t)+deriving instance (EqLabel t) => Eq (Expression t)++data Function = Function {+ funName :: String+ , returnType :: Type+ , funMode :: FunctionMode+} deriving (Eq, Show)++data Constant t+ = IntConst+ { intValue :: Integer+ , intType :: Type+ , intConstLabel :: Label t IntConst+ , constLabel :: Label t Constant+ }+ | FloatConst+ { floatValue :: Double+ , floatConstLabel :: Label t FloatConst+ , constLabel :: Label t Constant+ }+ | BoolConst+ { boolValue :: Bool+ , boolConstLabel :: Label t BoolConst+ , constLabel :: Label t Constant+ }+ | ComplexConst+ { realPartComplexValue :: Constant t+ , imagPartComplexValue :: Constant t+ , complexConstLabel :: Label t ComplexConst+ , constLabel :: Label t Constant+ }+ deriving Typeable++deriving instance (ShowLabel t) => Show (Constant t)+deriving instance (EqLabel t) => Eq (Constant t)++data Variable t = Variable+ { varName :: String+ , varType :: Type+ , varRole :: VariableRole+ , varLabel :: Label t Variable+ }+ deriving Typeable++deriving instance (ShowLabel t) => Show (Variable t)+deriving instance (EqLabel t) => Eq (Variable t)++-- ======================+-- == Basic structures ==+-- ======================++data Length =+ LiteralLen Int+ | UndefinedLen+ deriving (Eq,Show)++data Size = S8 | S16 | S32 | S40 | S64+ deriving (Eq,Show)++data Signedness = Signed | Unsigned+ deriving (Eq,Show)++data Type =+ VoidType+ | BoolType+ | BitType+ | FloatType+ | NumType Signedness Size+ | ComplexType Type+ | UserType String+ | Alias Type String+ | ArrayType Length Type+ | StructType [(String, Type)]+ | IVarType Type+ deriving (Eq,Show)++data FunctionMode = Prefix | Infix+ deriving (Eq,Show)++data VariableRole = Value | Pointer+ deriving (Eq,Show)++data Place+ = Declaration_pl+ | MainParameter_pl+ | ValueNeed_pl+ | AddressNeed_pl+ | FunctionCallIn_pl+ deriving (Eq,Show)++data TypeParameterMode = Auto | Scalar+ deriving (Eq,Show)++----------------------+-- Type inference --+----------------------++class HasType a where+ type TypeOf a+ typeof :: a -> TypeOf a++instance HasType (Variable t) where+ type TypeOf (Variable t) = Type+ typeof Variable{..} = varType++instance (ShowLabel t) => HasType (Constant t) where+ type TypeOf (Constant t) = Type+ typeof IntConst{..} = intType+ typeof FloatConst{} = FloatType+ typeof BoolConst{} = BoolType+ typeof ComplexConst{..} = ComplexType $ typeof realPartComplexValue++instance (ShowLabel t) => HasType (Expression t) where+ type TypeOf (Expression t) = Type+ typeof VarExpr{..} = typeof var+ typeof ArrayElem{..} = decrArrayDepth $ typeof array+ where+ decrArrayDepth :: Type -> Type+ decrArrayDepth (ArrayType _ t) = t+ decrArrayDepth t = reprError InternalError $ "Non-array variable is indexed! " ++ show array ++ " :: " ++ show t+ typeof StructField{..} = getStructFieldType fieldName $ typeof struct+ where+ getStructFieldType :: String -> Type -> Type+ getStructFieldType f (StructType l) = case List.find (\(a,_) -> a == f) l of+ Just (_,t) -> t+ Nothing -> structFieldNotFound f+ getStructFieldType f (Alias t _) = getStructFieldType f t+ getStructFieldType f t = reprError InternalError $+ "Trying to get a struct field from not a struct typed expression\n" ++ "Field: " ++ f ++ "\nType: " ++ show t+ structFieldNotFound f = reprError InternalError $ "Not found struct field with this name: " ++ f+ typeof ConstExpr{..} = typeof constExpr+ typeof FunctionCall{..} = returnType function+ typeof Cast{..} = castType+ typeof SizeOf{..} = NumType Signed S32++instance (ShowLabel t) => HasType (ActualParameter t) where+ type TypeOf (ActualParameter t) = Type+ typeof In{..} = typeof inParam+ typeof Out{..} = typeof outParam+ typeof TypeParameter{..} = typeParam+ typeof FunParameter{} = VoidType+++reprError :: forall a. ErrorClass -> String -> a+reprError = handleError "Feldspar.Compiler.Imperative.Representation"++-- =====================+-- == Technical types ==+-- =====================++data Struct t+data ProcDef t+data ProcDecl t+data Empty t+data Comment t+data Assign t+data ProcedureCall t+data Spawn t+data Run t+data Sequence t+data Branch t+data SeqLoop t+data ParLoop t+data FunctionCall t+data Cast t+data SizeOf t+data ArrayElem t+data StructField t+data LeftFunCall t+data IntConst t+data FloatConst t+data BoolConst t+data ArrayConst t+data ComplexConst t++-- ==========================+-- == Show and Eq instance ==+-- ==========================++class ( Show (Label t Module)+ , Show (Label t Entity)+ , Show (Label t Struct)+ , Show (Label t ProcDef)+ , Show (Label t ProcDecl)+ , Show (Label t StructMember)+ , Show (Label t Block)+ , Show (Label t Program)+ , Show (Label t Empty)+ , Show (Label t Comment)+ , Show (Label t Assign)+ , Show (Label t ProcedureCall)+ , Show (Label t Spawn)+ , Show (Label t Run)+ , Show (Label t Sequence)+ , Show (Label t Branch)+ , Show (Label t SeqLoop)+ , Show (Label t ParLoop)+ , Show (Label t ActualParameter)+ , Show (Label t Declaration)+ , Show (Label t Expression)+ , Show (Label t FunctionCall)+ , Show (Label t Cast)+ , Show (Label t SizeOf)+ , Show (Label t ArrayElem)+ , Show (Label t StructField)+ , Show (Label t Constant)+ , Show (Label t IntConst)+ , Show (Label t FloatConst)+ , Show (Label t BoolConst)+ , Show (Label t ArrayConst)+ , Show (Label t ComplexConst)+ , Show (Label t Variable)+ ) => ShowLabel t++instance ( Show (Label t Module)+ , Show (Label t Entity)+ , Show (Label t Struct)+ , Show (Label t ProcDef)+ , Show (Label t ProcDecl)+ , Show (Label t StructMember)+ , Show (Label t Block)+ , Show (Label t Program)+ , Show (Label t Empty)+ , Show (Label t Comment)+ , Show (Label t Assign)+ , Show (Label t ProcedureCall)+ , Show (Label t Spawn)+ , Show (Label t Run)+ , Show (Label t Sequence)+ , Show (Label t Branch)+ , Show (Label t SeqLoop)+ , Show (Label t ParLoop)+ , Show (Label t ActualParameter)+ , Show (Label t Declaration)+ , Show (Label t Expression)+ , Show (Label t FunctionCall)+ , Show (Label t Cast)+ , Show (Label t SizeOf)+ , Show (Label t ArrayElem)+ , Show (Label t StructField)+ , Show (Label t Constant)+ , Show (Label t IntConst)+ , Show (Label t FloatConst)+ , Show (Label t BoolConst)+ , Show (Label t ArrayConst)+ , Show (Label t ComplexConst)+ , Show (Label t Variable)+ ) => ShowLabel t++class ( Eq (Label t Module)+ , Eq (Label t Entity)+ , Eq (Label t Struct)+ , Eq (Label t ProcDef)+ , Eq (Label t ProcDecl)+ , Eq (Label t StructMember)+ , Eq (Label t Block)+ , Eq (Label t Program)+ , Eq (Label t Empty)+ , Eq (Label t Comment)+ , Eq (Label t Assign)+ , Eq (Label t ProcedureCall)+ , Eq (Label t Spawn)+ , Eq (Label t Run)+ , Eq (Label t Sequence)+ , Eq (Label t Branch)+ , Eq (Label t SeqLoop)+ , Eq (Label t ParLoop)+ , Eq (Label t ActualParameter)+ , Eq (Label t Declaration)+ , Eq (Label t Expression)+ , Eq (Label t FunctionCall)+ , Eq (Label t Cast)+ , Eq (Label t SizeOf)+ , Eq (Label t StructField)+ , Eq (Label t ArrayElem)+ , Eq (Label t Constant)+ , Eq (Label t IntConst)+ , Eq (Label t FloatConst)+ , Eq (Label t BoolConst)+ , Eq (Label t ArrayConst)+ , Eq (Label t ComplexConst)+ , Eq (Label t Variable)+ ) => EqLabel t++instance ( Eq (Label t Module)+ , Eq (Label t Entity)+ , Eq (Label t Struct)+ , Eq (Label t ProcDef)+ , Eq (Label t ProcDecl)+ , Eq (Label t StructMember)+ , Eq (Label t Block)+ , Eq (Label t Program)+ , Eq (Label t Empty)+ , Eq (Label t Comment)+ , Eq (Label t Assign)+ , Eq (Label t ProcedureCall)+ , Eq (Label t Spawn)+ , Eq (Label t Run)+ , Eq (Label t Sequence)+ , Eq (Label t Branch)+ , Eq (Label t SeqLoop)+ , Eq (Label t ParLoop)+ , Eq (Label t ActualParameter)+ , Eq (Label t Declaration)+ , Eq (Label t Expression)+ , Eq (Label t FunctionCall)+ , Eq (Label t Cast)+ , Eq (Label t SizeOf)+ , Eq (Label t StructField)+ , Eq (Label t ArrayElem)+ , Eq (Label t Constant)+ , Eq (Label t IntConst)+ , Eq (Label t FloatConst)+ , Eq (Label t BoolConst)+ , Eq (Label t ArrayConst)+ , Eq (Label t ComplexConst)+ , Eq (Label t Variable)+ ) => EqLabel t++-- * Set and get labels++class Labeled c where+ label :: c t -> Label t c+ setLabel :: c t -> Label t c -> c t++instance Labeled Module where+ label = moduleLabel+ setLabel c lab = c{ moduleLabel = lab }++instance Labeled Entity where+ label = definitionLabel+ setLabel c lab = c{ definitionLabel = lab }++instance Labeled Program where+ label = programLabel+ setLabel c lab = c{ programLabel = lab }++instance Labeled Declaration where+ label = declLabel+ setLabel c lab = c{ declLabel = lab }++instance Labeled Constant where+ label = constLabel+ setLabel c lab = c{ constLabel = lab }++instance Labeled StructMember where+ label = structMemberLabel+ setLabel c lab = c{ structMemberLabel = lab }++instance Labeled Variable where+ label = varLabel+ setLabel c lab = c{ varLabel = lab }++instance Labeled Expression where+ label = exprLabel+ setLabel c lab = c{ exprLabel = lab }++instance Labeled ActualParameter where+ label = actParamLabel+ setLabel c lab = c{ actParamLabel = lab }++instance Labeled Block where+ label = blockLabel+ setLabel c lab = c{ blockLabel = lab }
+ lib/Feldspar/Compiler/Imperative/TransformationInstance.hs view
@@ -0,0 +1,180 @@+--+-- 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 FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Compiler.Imperative.TransformationInstance where+++import Feldspar.Transformation.Framework+import Feldspar.Compiler.Imperative.Representation++-- =========================================+-- == Classes for the plugin architecture ==+-- =========================================++-- class to simplify contexts+class (Transformation t, Convert (Label (From t) s) (Label (To t) s), Default (Label (To t) s)) => Conversion t s++instance (Transformation t, Convert (Label (From t) s) (Label (To t) s), Default (Label (To t) s)) => Conversion t s++-- ====================+-- == Transformation ==+-- ====================++instance (Transformable1 t [] Entity, Conversion t Module)+ => DefaultTransformable t Module where+ defaultTransform t s d (Module m inf) = Result (Module (result1 tr) $ convert inf) (state1 tr) (up1 tr) where+ tr = transform1 t s d m++instance (Transformable1 t [] StructMember, Transformable1 t [] Variable, Transformable t Block, Transformable t Declaration, Conversion t Entity, Conversion t Struct, Conversion t ProcDef, Conversion t ProcDecl)+ => DefaultTransformable t Entity where+ defaultTransform t s d (StructDef n m inf1 inf2) =+ Result (StructDef n (result1 tr) (convert inf1) $ convert inf2) (state1 tr) (up1 tr) where+ tr = transform1 t s d m+ defaultTransform _ s _ (TypeDef typ n inf) =+ Result (TypeDef typ n (convert inf)) s def+ defaultTransform t s d (ProcDef n i o p inf1 inf2) =+ Result (ProcDef n (result1 tr1) (result1 tr2) (result tr3) (convert inf1) $ convert inf2)+ (state tr3) (foldl combine (up1 tr1) [up1 tr2, up tr3]) where+ tr1 = transform1 t s d i+ tr2 = transform1 t (state1 tr1) d o+ tr3 = transform t (state1 tr2) d p+ defaultTransform t s d (ProcDecl name inp outp inf1 inf2) =+ Result (ProcDecl name (result1 tr1) (result1 tr2) (convert inf1) (convert inf2))+ (state1 tr2) (foldl1 combine [up1 tr1, up1 tr2]) where+ tr1 = transform1 t s d inp+ tr2 = transform1 t (state1 tr1) d outp++instance (Conversion t StructMember, Default (Up t))+ => DefaultTransformable t StructMember where+ defaultTransform _ s _ (StructMember n typ inf) = Result (StructMember n typ $ convert inf) s def++instance (Transformable1 t [] Declaration, Transformable t Program, Conversion t Block)+ => DefaultTransformable t Block where+ defaultTransform t s d (Block l b inf) = Result (Block (result1 tr1) (result tr2) $ convert inf) (state tr2) (combine (up1 tr1) (up tr2)) where+ tr1 = transform1 t s d l+ tr2 = transform t (state1 tr1) d b++instance (Transformable1 t [] Program, Transformable t Expression, Transformable1 t [] ActualParameter, Transformable t Block, Transformable t Variable, Conversion t Program, Conversion t Empty, Conversion t Comment, Conversion t Assign, Conversion t ProcedureCall, Conversion t Spawn, Conversion t Run, Conversion t Sequence, Conversion t Branch, Conversion t SeqLoop, Conversion t ParLoop, Default (Up t))+ => DefaultTransformable t Program where+ defaultTransform _ s _ (Empty inf1 inf2) = Result (Empty (convert inf1) $ convert inf2) s def+ defaultTransform _ s _ (Comment b c inf1 inf2) = Result (Comment b c (convert inf1) $ convert inf2) s def+ defaultTransform t s d (Assign l r inf1 inf2) = Result (Assign (result tr1) (result tr2) (convert inf1) $ convert inf2) (state tr2) (combine (up tr1) (up tr2)) where+ tr1 = transform t s d l+ tr2 = transform t (state tr1) d r+ defaultTransform t s d (ProcedureCall f par inf1 inf2) = Result (ProcedureCall f (result1 tr) (convert inf1) $ convert inf2) (state1 tr) (up1 tr) where+ tr = transform1 t s d par+ defaultTransform t s d (Sequence p inf1 inf2) = Result (Sequence (result1 tr) (convert inf1) $ convert inf2) (state1 tr) (up1 tr) where+ tr = transform1 t s d p+ defaultTransform t s d (Branch e p1 p2 inf1 inf2) = Result (Branch (result tr1) (result tr2) (result tr3) (convert inf1) $ convert inf2) (state tr3) (foldl combine (up tr1) [up tr2, up tr3]) where+ tr1 = transform t s d e+ tr2 = transform t (state tr1) d p1+ tr3 = transform t (state tr2) d p2+ defaultTransform t s d (SeqLoop v c p inf1 inf2) = Result (SeqLoop (result tr1) (result tr2) (result tr3) (convert inf1) $ convert inf2) (state tr3) (foldl combine (up tr1) [up tr2, up tr3]) where+ tr1 = transform t s d v+ tr2 = transform t (state tr1) d c+ tr3 = transform t (state tr2) d p+ defaultTransform t s d (ParLoop v b i p inf1 inf2) = Result (ParLoop (result tr1) (result tr2) i (result tr3) (convert inf1) $ convert inf2) (state tr3) (foldl combine (up tr1) [up tr2, up tr3]) where+ tr1 = transform t s d v+ tr2 = transform t (state tr1) d b+ tr3 = transform t (state tr2) d p+ defaultTransform t s d (BlockProgram b inf) = Result (BlockProgram (result tr) $ convert inf) (state tr) (up tr) where+ tr = transform t s d b++instance (Transformable t Expression, Conversion t ActualParameter)+ => DefaultTransformable t ActualParameter where+ defaultTransform t s d (In p inf) = Result (In (result tr) $ convert inf) (state tr) (up tr) where+ tr = transform t s d p+ defaultTransform t s d (Out p inf) = Result (Out (result tr) $ convert inf) (state tr) (up tr) where+ tr = transform t s d p+ defaultTransform _ s _ (TypeParameter p r inf) = Result (TypeParameter p r $ convert inf) s def+ defaultTransform _ s _ (FunParameter n b inf) = Result (FunParameter n b $ convert inf) s def++instance (Transformable t Variable, Transformable1 t Maybe Expression, Conversion t Declaration)+ => DefaultTransformable t Declaration where+ defaultTransform 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 d v+ tr2 = transform1 t (state tr1) d i++instance (Transformable t Expression, Transformable t Variable, Transformable t Constant, Transformable1 t [] Expression, Conversion t Expression, Conversion t FunctionCall, Conversion t ArrayElem, Conversion t StructField, Conversion t SizeOf, Conversion t Cast, Default (Up t))+ => DefaultTransformable t Expression where+ defaultTransform t s d (VarExpr v inf) = Result (VarExpr (result tr) $ convert inf) (state tr) (up tr) where+ tr = transform t s d v+ defaultTransform t s d (ArrayElem a i inf1 inf2) = Result (ArrayElem (result tr1) (result tr2) (convert inf1) (convert inf2)) (state tr2) (combine (up tr1) (up tr2)) where+ tr1 = transform t s d a+ tr2 = transform t (state tr1) d i+ defaultTransform t s d (StructField l n inf1 inf2) = Result (StructField (result tr) n (convert inf1) $ convert inf2) (state tr) (up tr) where+ tr = transform t s d l+ defaultTransform t s d (ConstExpr c inf) = Result (ConstExpr (result tr) $ convert inf) (state tr) (up tr) where+ tr = transform t s d c+ defaultTransform t s d (FunctionCall f par inf1 inf2) =+ Result (FunctionCall f (result1 tr) (convert inf1) $ convert inf2) (state1 tr) (up1 tr) where+ tr = transform1 t s d par+ defaultTransform t s d (Cast typ ex inf1 inf2) = Result (Cast typ (result tr) (convert inf1) $ convert inf2) (state tr) (up tr) where+ tr = transform t s d ex+ defaultTransform t s d (SizeOf par inf1 inf2) = case par of+ Left typ -> Result (SizeOf (Left typ) (convert inf1) $ convert inf2) s def+ Right ex -> Result (SizeOf (Right $ result tr) (convert inf1) $ convert inf2) (state tr) (up tr) where+ tr = transform t s d ex++instance (Transformable t Constant, Transformable1 t [] Constant, Conversion t Constant, Conversion t IntConst, Conversion t FloatConst, Conversion t BoolConst, Conversion t ArrayConst, Conversion t ComplexConst, Default (Up t))+ => DefaultTransformable t Constant where+ defaultTransform _ s _ (IntConst c typ inf1 inf2) = Result (IntConst c typ (convert inf1) $ convert inf2) s def+ defaultTransform _ s _ (FloatConst c inf1 inf2) = Result (FloatConst c (convert inf1) $ convert inf2) s def+ defaultTransform _ s _ (BoolConst c inf1 inf2) = Result (BoolConst c (convert inf1) $ convert inf2) s def+ -- defaultTransform t s d (ArrayConst c inf1 inf2) = Result (ArrayConst (result1 tr) (convert inf1) $ convert inf2) (state1 tr) (up1 tr) where+ -- tr = transform1 t s d c+ defaultTransform t s d (ComplexConst re im inf1 inf2) = Result (ComplexConst (result tr1) (result tr2) (convert inf1) $ convert inf2) (state tr2) (combine (up tr1) $ up tr2) where+ tr1 = transform t s d re+ tr2 = transform t (state tr1) d im++instance (Conversion t Variable, Default (Up t))+ => DefaultTransformable t Variable where+ defaultTransform _ s _ (Variable name typ role inf) = Result (Variable name typ role $ convert inf) s def+++instance (Transformable t a, Default (Up t), Combine (Up t), Transformation t)+ => DefaultTransformable1 t [] a where+ defaultTransform1 _ s _ [] = Result1 [] s def+ defaultTransform1 t s d [x] = Result1 [result tr] (state tr) (up tr) where+ tr = transform t s d x+ defaultTransform1 t s d (x:xs) = Result1 (result tr1 : result1 tr2) (state1 tr2) (combine (up tr1) (up1 tr2)) where+ tr1 = transform t s d x+ tr2 = transform1 t (state tr1) d xs++instance (Transformable t a, Default (Up t), Transformation t)+ => DefaultTransformable1 t Maybe a where+ defaultTransform1 _ s _ Nothing = Result1 Nothing s def+ defaultTransform1 t s d (Just x) = Result1 (Just $ result tr) (state tr) (up tr) where+ tr = transform t s d x
+ lib/Feldspar/NameExtractor.hs view
@@ -0,0 +1,159 @@+--+-- 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.NameExtractor where++import System.IO+import System.IO.Unsafe+import Language.Haskell.Exts+import Feldspar.Compiler.Error+import Feldspar.Compiler.Backend.C.Library++data OriginalFunctionSignature = OriginalFunctionSignature {+ originalFunctionName :: String,+ originalParameterNames :: [Maybe String]+} deriving (Show, Eq)++nameExtractorError :: ErrorClass -> String -> a+nameExtractorError = handleError "NameExtractor"++neutralName :: String+neutralName = "\\"++ r 4 ++"/\\"++ r 7 ++"\n ) ( ')"++ r 6 ++"\n( / )"++ r 7 ++"\n \\(__)|"+ where r n = replicate n ' '++ignore :: OriginalFunctionSignature+ignore = OriginalFunctionSignature neutralName []++warning :: String -> a -> a+warning msg retval = unsafePerformIO $ do+ withColor Yellow $ putStrLn $ "Warning: " ++ msg+ return retval++-- Module SrcLoc ModuleName [OptionPragma] (Maybe WarningText) (Maybe [ExportSpec]) [ImportDecl] [Decl]+stripModule :: Module -> [Decl]+stripModule x = case x of+ Module _ _ _ _ _ _ g -> g++stripFunBind :: Decl -> OriginalFunctionSignature+stripFunBind x = case x of+ FunBind [Match _ b c _ _ _] ->+ OriginalFunctionSignature (stripName b) (map stripPattern c) -- going for name and parameter list+ -- "Match SrcLoc Name [Pat] (Maybe Type) Rhs Binds"+ FunBind l@(Match _ b _ _ _ _ : _) | length l > 1 -> warning+ ("Ignoring function " ++ stripName b +++ ": multi-pattern function definitions are not compilable as Feldspar functions.") ignore+ PatBind _ b _ _ _ -> case stripPattern b of+ Just functionName -> OriginalFunctionSignature functionName [] -- parameterless declarations (?)+ Nothing -> nameExtractorError InternalError ("Unsupported pattern binding: " ++ show b)+ TypeSig{} -> ignore --head b -- we don't need the type signature (yet)+ DataDecl{} -> ignore+ InstDecl{} -> ignore+ -- TypeDecl SrcLoc Name [TyVarBind] Type+ TypeDecl{} -> ignore+ unknown -> nameExtractorError InternalError ("Unexpected language element [SFB/1]: " ++ show unknown+ ++ "\nPlease file a feature request with an example attached.")++stripPattern :: Pat -> Maybe String+stripPattern (PVar x) = Just $ stripName x+stripPattern PWildCard = Nothing+stripPattern (PAsPat x _) = Just $ stripName x+stripPattern (PParen pattern) = stripPattern pattern+stripPattern _ = Nothing++stripName :: Name -> String+stripName (Ident a) = a+stripName (Symbol a) = a++stripModule2 :: Module -> ModuleName+stripModule2 (Module _ b _ _ _ _ _) = b++stripModuleName :: ModuleName -> String+stripModuleName (ModuleName x) = x++getModuleName :: FilePath -> String -> String -- filename, filecontents -> modulename+getModuleName fileName = stripModuleName . stripModule2 . fromParseResult . customizedParse fileName++usedExtensions :: [Extension]+usedExtensions = glasgowExts ++ [ExplicitForAll]++-- Ultimate debug function+getParseOutput :: FilePath -> IO (ParseResult Module)+getParseOutput = parseFileWithMode (defaultParseMode { extensions = usedExtensions })++customizedParse :: FilePath -> FilePath -> ParseResult Module+customizedParse fileName = parseFileContentsWithMode+ (defaultParseMode+ { extensions = usedExtensions+ , parseFilename = fileName+ })++getFullDeclarationListWithParameterList :: FilePath -> String -> [OriginalFunctionSignature]+getFullDeclarationListWithParameterList fileName fileContents =+ map stripFunBind (stripModule $ fromParseResult $ customizedParse fileName fileContents )++functionNameNeeded :: String -> Bool+functionNameNeeded functionName = functionName /= neutralName++stripUnnecessary :: [String] -> [String]+stripUnnecessary = filter functionNameNeeded++printDeclarationList :: FilePath -> IO (String -> [String])+printDeclarationList fileName = do+ handle <- openFile fileName ReadMode+ fileContents <- hGetContents handle+ return $ getDeclarationList fileContents++printDeclarationListWithParameterList :: FilePath -> IO ()+printDeclarationListWithParameterList fileName = do+ handle <- openFile fileName ReadMode+ fileContents <- hGetContents handle+ print $ filter (functionNameNeeded . originalFunctionName) (getFullDeclarationListWithParameterList fileName fileContents)++printParameterListOfFunction :: FilePath -> String -> IO [Maybe String]+printParameterListOfFunction = getParameterList++-- The interface+getDeclarationList :: FilePath -> String -> [String] -- filename, filecontents -> Stringlist+getDeclarationList fileName = stripUnnecessary . map originalFunctionName . getFullDeclarationListWithParameterList fileName++getExtendedDeclarationList :: FilePath -> String -> [OriginalFunctionSignature] -- filename, filecontents -> ExtDeclList+getExtendedDeclarationList fileName fileContents =+ filter (functionNameNeeded . originalFunctionName)+ (getFullDeclarationListWithParameterList fileName fileContents)++getParameterListOld :: FilePath -> String -> String -> [Maybe String]+getParameterListOld fileName fileContents funName = originalParameterNames $ head $+ filter ((==funName) . originalFunctionName)+ (getExtendedDeclarationList fileName fileContents)++getParameterList :: FilePath -> String -> IO [Maybe String]+getParameterList fileName funName = do+ handle <- openFile fileName ReadMode+ fileContents <- hGetContents handle+ return $ originalParameterNames $ head $+ filter ((==funName) . originalFunctionName) (getExtendedDeclarationList fileName fileContents)
+ lib/Feldspar/Transformation.hs view
@@ -0,0 +1,47 @@+--+-- 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, FlexibleContexts, Rank2Types #-}++module Feldspar.Transformation+ ( module Feldspar.Transformation+ , module X+ ) where++import Feldspar.Transformation.Framework as X+import Feldspar.Compiler.Imperative.TransformationInstance as X+import Feldspar.Compiler.Imperative.Representation as X++-- ================================================================================================+-- == Plugin class+-- ================================================================================================+++class (Transformable t Module) => Plugin t where+ type ExternalInfo t+ executePlugin :: t -> ExternalInfo t -> Module (From t) -> Module (To t)
+ lib/Feldspar/Transformation/Framework.hs view
@@ -0,0 +1,151 @@+--+-- 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 RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Feldspar.Transformation.Framework where++import Feldspar.Compiler.Error++transformationError :: String -> a+transformationError = handleError "PluginArch/TransformationFramework" InternalError++-- ===========+-- == Utils ==+-- ===========++class Default t where+ def :: t+ def = transformationError "Default value requested."++class Combine t where+ combine :: t -> t -> t+ combine = transformationError "Default combination function used."++class Convert a b where+ convert :: a -> b++instance Default () where+ def = ()++instance Default [a] where+ def = []++instance Default Int where+ def = 0++instance (Default a, Default b) => Default (a,b) where+ def = (def, def)++instance (Default a, Default b, Default c) => Default (a,b,c) where+ def = (def, def, def)++instance Combine () where+ combine _ _ = ()++instance Combine String where+ combine s1 s2 = s1 ++ s2++instance Combine Int where+ combine i1 i2 = i1 + i2++instance (Combine a, Combine b)+ => Combine (a,b) where+ combine (x,y) (v,w) = (combine x v, combine y w)++instance Default b => Convert a b where+ convert _ = def++-- =============================+-- == TransformationFramework ==+-- =============================++class (Default (Up t), Combine (Up t))+ => Transformation t where+ type From t+ type To t++ type State t+ type Down t+ type Up t++data Result t s+ = Result+ { result :: s (To t)+ , state :: State t+ , up :: Up t+ }++deriving instance (Transformation t, Show (s (To t)), Show (State t), Show (Up t)) => Show (Result t s)++data Result1 t s a+ = Result1+ { result1 :: s (a (To t))+ , state1 :: State t+ , up1 :: Up t+ }++deriving instance (Transformation t, Show (s (b (To t))), Show (State t), Show (Up t)) => Show (Result1 t s b)++-- The following classes used to have `Transformation t` as super-class, but+-- this resulted in looping dictionaries (at run time) after switching to+-- GHC-7.4. This may or may not be related to the following (unconfirmed) bug:+--+-- http://hackage.haskell.org/trac/ghc/ticket/5913+--+-- The constraint `Transformation t` has currently been moved to the relevant+-- instances.++class Transformable t s where+ transform :: t -> State t -> Down t -> s (From t) -> Result t s++class Transformable1 t s a where+ transform1 :: t -> State t -> Down t -> s (a (From t)) -> Result1 t s a++class DefaultTransformable t s where+ defaultTransform :: t -> State t -> Down t -> s (From t) -> Result t s++class DefaultTransformable1 t s a where+ defaultTransform1 :: t -> State t -> Down t -> s (a (From t)) -> Result1 t s a++instance (DefaultTransformable t s)+ => Transformable t s where+ transform = defaultTransform++instance (DefaultTransformable1 t s a)+ => Transformable1 t s a where+ transform1 = defaultTransform1+
+ src/Feldspar/Compiler/Frontend/CommandLine/API.hs view
@@ -0,0 +1,155 @@+--+-- 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 CPP #-}+module Feldspar.Compiler.Frontend.CommandLine.API where++import qualified Feldspar.NameExtractor as NameExtractor+import Feldspar.Compiler.Backend.C.Options+import Feldspar.Compiler.Compiler+import Feldspar.Compiler.Imperative.FromCore+import Feldspar.Compiler.Frontend.CommandLine.API.Library+import Feldspar.Compiler.Backend.C.Library+import Language.Haskell.Interpreter+import Language.Haskell.Interpreter.Unsafe+import qualified Data.Typeable as T+import Control.Monad++-- ====================================== System imports ==================================+import System.Directory+import System.FilePath+import System.IO+import System.Exit+import System.Environment+import System.Console.GetOpt++import Control.Exception (catch, IOException)++data CompilationResult+ = CompilationSuccess+ | CompilationFailure+ deriving (Eq, Show, T.Typeable)++#ifdef RELEASE+releaseMode = True+#else+releaseMode = False+#endif++ -- A general interpreter body for interpreting an expression+generalInterpreterBody :: forall a . (T.Typeable (IO a))+ => String -- the expression to interpret+ -> Interpreter (IO a)+generalInterpreterBody expression = interpret expression (as::IO a)++-- A high-level interface for calling the interpreter+highLevelInterpreter :: T.Typeable (IO a)+ => String -- the module name (for example My.Module)+ -> String -- the input file name (for example "My/Module.hs")+ -> [String] -- globalImportList+ -> Bool -- need to import global modules qualified?+ -> Interpreter (IO a) -- ^ an interpreter body+ -> IO CompilationResult+highLevelInterpreter moduleName inputFileName importList needQualify interpreterBody = do+ actionToExecute <- runInterpreter $ do+ set [ languageExtensions := [GADTs, ScopedTypeVariables, TypeSynonymInstances, StandaloneDeriving,+ DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,+ FunctionalDependencies, ExistentialQuantification, Rank2Types, TypeOperators,+ EmptyDataDecls, GeneralizedNewtypeDeriving, TypeFamilies, ViewPatterns,+ UnknownExtension "ImplicitPrelude" ]+ ]+ unsafeSetGhcOption "-fcontext-stack=100"+ -- in relesae mode, globalImportList modules are package modules and shouldn't be loaded, only imported+ -- in normal mode, we need to load them before importing them+ loadModules $ inputFileName : if not releaseMode then importList else []+ setTopLevelModules [moduleName]+ -- Import modules qualified to prevent name collisions with user defined entities+ if needQualify+ then setImportsQ $ zip importList $ map Just importList+ else setImports importList+ interpreterBody+ case actionToExecute of+ Left err -> do+ printInterpreterError err+ return CompilationFailure+ Right action -> do+ action+ return CompilationSuccess+ -- either printInterpreterError id actionToExecute++printInterpreterError :: InterpreterError -> IO ()+printInterpreterError (WontCompile []) = return ()+printInterpreterError (WontCompile (x:xs)) = do+ printGhcError x+ printInterpreterError (WontCompile xs)+ where+ printGhcError (GhcError {errMsg=s}) = hPutStrLn stderr s+printInterpreterError e = hPutStrLn stderr $ "Code generation failed: " ++ show e++handleOptions :: [OptDescr (a -> IO a)] -> a -> String -> IO (a, String)+handleOptions descriptors startOptions helpHeader = do+ args <- getArgs++ when (null args) (do+ putStrLn $ usageInfo helpHeader descriptors+ exitSuccess)++ -- Parse options, getting a list of option actions+ let (actions, nonOptions, errors) = getOpt Permute descriptors args++ when (length errors > 0) (do+ putStrLn $ concat errors+ putStrLn $ usageInfo helpHeader descriptors+ exitWith (ExitFailure 1))++ -- Here we thread startOptions through all supplied option actions+ opts <- foldl (>>=) (return startOptions) actions++ when (length nonOptions /= 1) (do+ putStrLn "ERROR: Exactly one input file expected."+ exitWith (ExitFailure 1))++ let inputFileName = replace (head nonOptions) "\\" "/" -- change it for multi-file operation++ return (opts, inputFileName)++removeFileIfPossible :: String -> IO ()+removeFileIfPossible filename = removeFile filename `Control.Exception.catch` (\(e :: IOException) -> return ())++prepareInputFile :: String -> IO ()+prepareInputFile inputFileName = do+ removeFileIfPossible $ replaceExtension inputFileName ".hi"+ removeFileIfPossible $ replaceExtension inputFileName ".o"++standaloneCompile :: (Compilable t internal) =>+ t -> FilePath -> FilePath -> NameExtractor.OriginalFunctionSignature -> Options -> IO ()+standaloneCompile prg inputFileName outputFileName originalFunctionSignature opts = do+ appendFile (makeCFileName outputFileName) $ sourceCode $ sctccrSource compilationResult+ appendFile (makeHFileName outputFileName) $ sourceCode $ sctccrHeader compilationResult+ where+ compilationResult = compileToCCore Standalone prg (Just outputFileName) IncludesNeeded originalFunctionSignature opts
+ src/Feldspar/Compiler/Frontend/CommandLine/API/Constants.hs view
@@ -0,0 +1,36 @@+--+-- 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.Frontend.CommandLine.API.Constants where++globalImportList = ["Feldspar.Compiler.Compiler"]++warningPrefix = "[WARNING]: "+errorPrefix = "[ERROR ]: "++
+ src/Feldspar/Compiler/Frontend/CommandLine/API/Library.hs view
@@ -0,0 +1,72 @@+--+-- 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.Frontend.CommandLine.API.Library where+++import Data.Char+import Language.Haskell.Interpreter+import System.Console.ANSI+import Feldspar.Compiler.Backend.C.Library++lowerFirst :: String -> String+lowerFirst (first:rest) = toLower first : rest+lowerFirst s = s++upperFirst :: String -> String+upperFirst (first:rest) = toUpper first : rest+upperFirst s = s++formatStringListCore :: [String] -> String+formatStringListCore [] = ""+formatStringListCore [x] = x+formatStringListCore (x:xs) = x ++ " | " ++ formatStringListCore xs++formatStringList :: [String] -> String+formatStringList list | not (null list) = "(" ++ formatStringListCore list ++ ")"+formatStringList _ = error "This list should not be empty."++rpad :: Int -> String -> String+rpad target = rpadWith target ' '++rpadWith :: Int -> Char -> String -> String+rpadWith target padchar s+ | length s >= target = s+ | otherwise = rpadWith target padchar (s ++ [padchar])++iPutStrLn :: String -> Interpreter ()+iPutStrLn = liftIO . putStrLn++iPutStr :: String -> Interpreter ()+iPutStr = liftIO . putStr++fancyWrite :: String -> IO ()+fancyWrite s = do+ withColor Blue $ putStr "=== [ "+ withColor Cyan $ putStr $ rpad 70 s+ withColor Blue $ putStrLn " ] ==="
+ src/Feldspar/Compiler/Frontend/CommandLine/API/Options.hs view
@@ -0,0 +1,135 @@+--+-- 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.Frontend.CommandLine.API.Options where++import qualified Feldspar.Compiler.Backend.C.Options as CompilerCoreOptions+import qualified Feldspar.Compiler.Compiler as CompilerCore+import qualified Feldspar.Compiler.Frontend.CommandLine.API.Library as StandaloneLib+import Feldspar.Compiler.Frontend.CommandLine.API.Constants+import Feldspar.Compiler.Backend.C.Platforms++import Data.List+import Data.Char+import Data.Maybe (fromMaybe)++import System.Console.GetOpt+import System.Exit+import System.Environment+import System.IO+import System.Process+import System.Info+import System.Directory++availablePlatformsStrRep = StandaloneLib.formatStringList $+ map (StandaloneLib.upperFirst . CompilerCoreOptions.name) availablePlatforms++data StandaloneMode = SingleFunction String | MultiFunction++data Options = Options { optStandaloneMode :: StandaloneMode+ , optOutputFileName :: Maybe String+ , optCompilerMode :: CompilerCoreOptions.Options+ }++-- | Default options+startOptions :: Options+startOptions = Options { optStandaloneMode = MultiFunction+ , optOutputFileName = Nothing+ , optCompilerMode = CompilerCore.defaultOptions+ }++helpHeader = "Standalone Feldspar Compiler\nUsage: feldspar [options] inputfile\n" +++ "Notes: \n" +++ " * When no output file name is specified, the input file's name with .c extension is used\n" +++ " * The inputfile parameter is always needed, even in single-function mode\n" +++ "\nAvailable options: \n"++-- | Option descriptions for getOpt+optionDescriptors :: [ OptDescr (Options -> IO Options) ]+optionDescriptors =+ [ Option "f" ["singlefunction"]+ (ReqArg+ (\arg opt -> return opt { optStandaloneMode = SingleFunction arg })+ "FUNCTION")+ "Enables single-function compilation"+ , Option "o" ["output"]+ (ReqArg+ (\arg opt -> return opt { optOutputFileName = Just arg })+ "outputfile")+ "Overrides the file names for the generated output code"++ , Option "p" ["platform"]+ (ReqArg+ (\arg opt -> return opt { optCompilerMode = (optCompilerMode opt)+ { CompilerCoreOptions.platform = decodePlatform arg } })+ "<platform>")+ ("Overrides the target platform " ++ availablePlatformsStrRep)+ , Option "u" ["unroll"]+ (ReqArg+ (\arg opt -> return opt {+ optCompilerMode = (optCompilerMode opt) {+ CompilerCoreOptions.unroll = CompilerCoreOptions.Unroll (parseInt arg "Invalid unroll count")+ }+ })+ "<unrollCount>")+ "Enables loop unrolling"+ , Option "D" ["debuglevel"]+ (ReqArg+ (\arg opt -> return opt { optCompilerMode = (optCompilerMode opt)+ { CompilerCoreOptions.debug = decodeDebug arg } })+ "<level>")+ "Specifies debug level (currently the only possible option is NoPrimitiveInstructionHandling)"+ , Option "h" ["help"]+ (NoArg+ (\_ -> do+ --prg <- getProgName+ hPutStrLn stderr (usageInfo helpHeader optionDescriptors)+ exitSuccess))+ "Show this help message"+ ]++-- ==============================================================================+-- == Option Decoders+-- ==============================================================================++findPlatformByName :: String -> Maybe CompilerCoreOptions.Platform+findPlatformByName platformName = -- Finds a platform by name using case-insensitive comparison+ find (\platform -> map toLower platformName == map toLower (CompilerCoreOptions.name platform))+ availablePlatforms++decodePlatform :: String -> CompilerCoreOptions.Platform+decodePlatform s = fromMaybe (error $ "Invalid platform specified. Valid platforms are: " ++ availablePlatformsStrRep)+ $ findPlatformByName s++decodeDebug "NoPrimitiveInstructionHandling" = CompilerCoreOptions.NoPrimitiveInstructionHandling+decodeDebug _ = error "Invalid debug level specified"++parseInt :: String -> String -> Int+parseInt arg message = case reads arg of+ [(x, "")] -> x+ _ -> error message
+ src/Feldspar/Compiler/Frontend/CommandLine/Main.hs view
@@ -0,0 +1,219 @@+--+-- 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 ScopedTypeVariables #-}++module Main where+-- ====================================== Feldspar imports ==================================+import Feldspar.NameExtractor+import Feldspar.Compiler.Compiler+import qualified Feldspar.Compiler.Compiler as CompilerCore+import Feldspar.Compiler.Backend.C.Options+import qualified Feldspar.Compiler.Backend.C.Options as CoreOptions+import Feldspar.Compiler.Frontend.CommandLine.API.Options as StandaloneOptions+import Feldspar.Compiler.Frontend.CommandLine.API.Constants+import Feldspar.Compiler.Frontend.CommandLine.API.Library as StandaloneLib+import Feldspar.Compiler.Backend.C.Library+import Feldspar.Compiler.Frontend.CommandLine.API+import Feldspar.Compiler.Imperative.Representation+import Feldspar.Compiler.Backend.C.CodeGeneration+import Feldspar.Compiler.Error+import Feldspar.Compiler.Backend.C.Plugin.PrettyPrint+-- ====================================== System imports ==================================+import System.IO+import System.Exit+import System.Info+import System.Process+import System.IO.Error+import System.FilePath+import System.Directory+import System.Environment+import System.Console.GetOpt+-- ====================================== Control imports ==================================+import Control.Monad+import Control.Exception+import Control.Monad.Error+import Control.Monad.CatchIO+-- ====================================== Other imports ==================================+import Data.List+import Data.Maybe (fromMaybe)+import Debug.Trace+import Language.Haskell.Interpreter+++data CompilationError =+ InterpreterError InterpreterError+ | InternalErrorCall String++compileFunction :: String -> String -> CoreOptions.Options -> OriginalFunctionSignature+ -> Interpreter (String, Either SplitModuleDescriptor CompilationError)+compileFunction inFileName outFileName coreOptions originalFunctionSignature = do+ let functionName = originalFunctionName originalFunctionSignature+ (SomeCompilable prg) <- interpret ("SomeCompilable " ++ functionName) (as::SomeCompilable)+ let splitModuleDescriptor = executePluginChain Standalone prg originalFunctionSignature coreOptions+ -- XXX force evaluation in order to be able to catch the exceptions+ -- liftIO $ evaluate $ compToC coreOptions compilationUnit -- XXX somehow not enough(?!) -- counter-example: structexamples+ liftIO $ do+ tempdir <- Control.Exception.catch getTemporaryDirectory (\(_ :: IOException) -> return ".")+ (tempfile, temph) <- openTempFile tempdir "feldspar-temp.txt"+ let core = compileToCCore Standalone prg (Just outFileName) IncludesNeeded originalFunctionSignature coreOptions+ Control.Exception.finally (do hPutStrLn temph $ sourceCode $ sctccrSource core+ hPutStrLn temph $ sourceCode $ sctccrHeader core)+ (do hClose temph+ removeFileIfPossible tempfile)+ return (functionName, Left splitModuleDescriptor)++compileAllFunctions :: String -> String -> CoreOptions.Options -> [OriginalFunctionSignature]+ -> Interpreter [(String, Either SplitModuleDescriptor CompilationError)]+compileAllFunctions inFileName outFileName options [] = return []+compileAllFunctions inFileName outFileName options (x:xs) = do+ let functionName = originalFunctionName x+ resultCurrent <- catchError (compileFunction inFileName outFileName options x)+ (\(e::InterpreterError) -> return (functionName, Right $ InterpreterError e))+ `Control.Monad.CatchIO.catch`+ (\msg -> return (functionName,+ Right $ InternalErrorCall $ errorPrefix ++ show (msg::Control.Exception.ErrorCall)))+ resultRest <- compileAllFunctions inFileName outFileName options xs+ return $ resultCurrent : resultRest++-- | Interpreter body for single-function compilation+singleFunctionCompilationBody :: String -> String -> CoreOptions.Options -> OriginalFunctionSignature+ -> Interpreter (IO ())+singleFunctionCompilationBody inFileName outFileName coreOptions originalFunctionSignature = do+ liftIO $ fancyWrite $ "Compiling function " ++ originalFunctionName originalFunctionSignature ++ "..."+ SomeCompilable prg <-+ interpret ("SomeCompilable " ++ originalFunctionName originalFunctionSignature) (as::SomeCompilable)+ liftIO $ standaloneCompile prg inFileName outFileName originalFunctionSignature coreOptions+ return $ return ()++mergeModules :: [Module ()] -> Module ()+mergeModules [] = handleError "Standalone" InvariantViolation "Called mergeModules with an empty list"+mergeModules [x] = x+mergeModules l@(x:xs) = Module {+ entities = nub $ entities x ++ entities (mergeModules xs), -- nub is in fact a "global plugin" here+ moduleLabel = ()+}++padFunctionName :: String -> String+padFunctionName n = StandaloneLib.rpadWith 50 '.' $ "Function " ++ n++writeErrors :: (String, Either a CompilationError) -> IO ()+writeErrors (functionName, Left x) = return ()+writeErrors (functionName, Right err) = case err of + InterpreterError ie -> do+ withColor Red $ putStrLn $ "Error in function " ++ functionName ++ ":"+ printInterpreterError ie+ InternalErrorCall ec -> do+ withColor Red $ putStrLn $ "Error in function " ++ functionName ++ ":"+ withColor Red $ putStrLn ec++writeSummary :: (String, Either a CompilationError) -> IO ()+writeSummary (functionName, Left x) = do+ withColor Cyan $ putStr $ padFunctionName functionName+ withColor Green $ putStrLn "[OK]"+writeSummary (functionName, Right msg) = do+ withColor Cyan $ putStr $ padFunctionName functionName+ withColor Red $ putStrLn "[FAILED]"++filterLefts :: [(String, Either a b)] -> [a]+filterLefts [] = []+filterLefts [(_,Left x)] = [x]+filterLefts [(_,Right _)] = []+filterLefts ((_,Left x):xs) = x : filterLefts xs+filterLefts ((_,Right _):xs) = filterLefts xs++-- | Interpreter body for multi-function compilation+multiFunctionCompilationBody :: String -> String -> CoreOptions.Options -> [OriginalFunctionSignature] -> Interpreter (IO ())+multiFunctionCompilationBody inFileName outFileName coreOptions declarationList = do+ let (hIncludes, hLineNum) = genIncludeLines coreOptions Nothing+ let (cIncludes, cLineNum) = genIncludeLines coreOptions (Just outFileName)+ liftIO $ appendFile (makeHFileName outFileName) hIncludes+ liftIO $ appendFile (makeCFileName outFileName) cIncludes+ modules <- compileAllFunctions inFileName outFileName coreOptions declarationList+ liftIO $ do+ mapM_ writeErrors modules+ withColor Blue $ putStrLn "\n================= [ Summary of compilation results ] =================\n"+ mapM_ writeSummary modules+ let mergedCModules = mergeModules $ map smdSource $ filterLefts modules+ let mergedHModules = mergeModules $ map smdHeader $ filterLefts modules+ let cCompToCResult = compToCWithInfos ((coreOptions, Declaration_pl), cLineNum) mergedCModules+ let hCompToCResult = compToCWithInfos ((coreOptions, Declaration_pl), hLineNum) mergedHModules+ appendFile (makeCFileName outFileName) (fst $ snd cCompToCResult) `Control.Exception.catch` errorHandler+ appendFile (makeHFileName outFileName) (fst $ snd hCompToCResult) `Control.Exception.catch` errorHandler+ writeFile (makeDebugCFileName outFileName) (show $ fst cCompToCResult) `Control.Exception.catch` errorHandler+ writeFile (makeDebugHFileName outFileName) (show $ fst hCompToCResult) `Control.Exception.catch` errorHandler+ return $ return ()+ where+ errorHandler msg = withColor Red $ putStrLn $ errorPrefix ++ show (msg::Control.Exception.ErrorCall)++-- | Calculates the output file name.+convertOutputFileName :: String -> Maybe String -> String+convertOutputFileName inputFileName = fromMaybe (takeFileName $ dropExtension inputFileName)++makeBackup :: String -> IO ()+makeBackup filename = renameFile filename (filename ++ ".bak") `Control.Exception.catch` (\(_ :: IOException) -> return ())++main = do+ (opts, inputFileName) <- handleOptions optionDescriptors startOptions helpHeader+ let outputFileName = convertOutputFileName inputFileName (optOutputFileName opts)++ prepareInputFile inputFileName+ makeBackup $ makeHFileName outputFileName+ makeBackup $ makeCFileName outputFileName+ makeBackup $ makeDebugHFileName outputFileName+ makeBackup $ makeDebugCFileName outputFileName++ fileDescriptor <- openFile inputFileName ReadMode+ fileContents <- hGetContents fileDescriptor++ let declarationList = getExtendedDeclarationList inputFileName fileContents+ let moduleName = getModuleName inputFileName fileContents+ fancyWrite $ "Compilation target: module " ++ moduleName+ fancyWrite $ "Output file: " ++ outputFileName++ let highLevelInterpreterWithModuleInfo =+ highLevelInterpreter moduleName inputFileName globalImportList False++ -- C code generation+ case optStandaloneMode opts of+ MultiFunction+ | null declarationList -> putStrLn "No functions to compile."+ | otherwise -> do+ fancyWrite $ "Number of functions to compile: " ++ show (length declarationList)+ highLevelInterpreterWithModuleInfo+ (multiFunctionCompilationBody inputFileName outputFileName (optCompilerMode opts) declarationList)+ return ()+ SingleFunction funName -> do+ let originalFunctionSignatureNeeded =+ case filter ((==funName).originalFunctionName) declarationList of+ [a] -> a+ [] -> error $ "Function " ++ funName ++ " not found"+ _ -> error "Unexpected error SC/01"+ highLevelInterpreterWithModuleInfo+ (singleFunctionCompilationBody inputFileName outputFileName (optCompilerMode opts) originalFunctionSignatureNeeded)+ return ()