packages feed

feldspar-compiler 0.2.1 → 0.3

raw patch · 35 files changed

+6221/−3433 lines, 35 filesdep +ansi-terminaldep ~basedep ~feldspar-languagesetup-changed

Dependencies added: ansi-terminal

Dependency ranges changed: base, feldspar-language

Files

− Feldspar/C/feldspar.c 
@@ -1,269 +0,0 @@-/*- * Copyright (c) 2009-2010, 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.h"
-
-
-
-int mod_fun_signed_int( int a, int b )
-{
-    if ((a > 0 && b > 0) || (a < 0 && b < 0)) return a % b;
-    return (a % b) * (-1);
-}
-
-int mod_fun_unsigned_int( unsigned int a, unsigned int b )
-{
-    return a % b;
-}
-
-long mod_fun_signed_long( long a, long b )
-{
-    if ((a > 0 && b > 0) || (a < 0 && b < 0)) return a % b;
-    return (a % b) * (-1);
-}
-
-long mod_fun_unsigned_long( unsigned long a, unsigned long b )
-{
-    return a % b;
-}
-
-
-
-int pow_fun_signed_int( int a, int b)
-{
-    int out = 1;
-    int i;
-    for(i=0; i<b; i++) out *= a;
-    return out;
-}
-
-int pow_fun_unsigned_int( unsigned int a, unsigned int b )
-{
-    int out = 1;
-    unsigned int i;
-    for(i=0; i<b; i++) out *= a;
-    return out;
-}
-
-
-
-int bit_fun_signed_int( int i )
-{
-    return 1 << i;
-}
-
-int setBit_fun_signed_int( int x, int i )
-{
-    return x ^ 1 << i;
-}
-
-int clearBit_fun_signed_int( int x, int i )
-{
-    return x & ~(1 << i);
-}
-
-int complementBit_fun_signed_int( int x, int i )
-{
-    return x | 1 << i;
-}
-
-int testBit_fun_signed_int( int x, int i )
-{
-    return (x & (1 << i)) != 0;
-}
-
-
-int bit_shift_fun_signed_int( int x, int i )
- {
-     if (i < 0) return x >> -i;
-     if (i > 0) return x << i;
-     return x;
- }
-
-
-int bit_rotate_fun_signed_int( int x, int i )
-{
-    if (i < 0 && x < 0) {
-      int left = i + sizeof(x) * 8;
-      return ((x >> -i) & ~bit_shift_fun_signed_int(-1, left)) ^ bit_shift_fun_signed_int(x, left);
-    }
-    if (i < 0) return x >> -i ^ bit_shift_fun_signed_int(x, i + sizeof(x) * 8);
-    else if (i == 0) return x;
-    else return x << i ^ bit_shift_fun_signed_int(x, i - sizeof(x) * 8);
-}
-
-int rotateL_fun_signed_int( int x, int i )
-{
-    return bit_rotate_fun_signed_int(x, i);
-}
-
-int rotateR_fun_signed_int( int x, int i )
-{
-    return bit_rotate_fun_signed_int(x, -i);
-}
-
-
-
-
-int bitSize_fun_signed_int( int x )
-{
-    return sizeof x * 8;
-}
-
-int isSigned_fun_signed_int( int x )
-{
-    (void) x;
-    return 1;
-}
-
-
-
-int abs_fun_signed_int( int a )
-{
-    if (a < 0) return a*(-1);
-    return a;
-}
-
-int abs_fun_unsigned_int( unsigned int a )
-{
-    return a;
-}
-
-long abs_fun_signed_long( long a )
-{
-    if (a < 0) return a*(-1);
-    return a;
-}
-
-long abs_fun_unsigned_long( unsigned long a )
-{
-    return a;
-}
-
-double abs_fun_float( float a )
-{
-    if (a < 0) return a*(-1);
-    return a;
-}
-
-double abs_fun_double( double a )
-{
-    if (a < 0) return a*(-1);
-    return a;
-}
-
-
-
-int signum_fun_signed_int( int a )
-{
-    if (a < 0) return -1;
-    if (a > 0) return 1;
-    return 0;
-}
-
-int signum_fun_unsigned_int( unsigned int a )
-{
-    if (a > 0) return 1;
-    return 0;
-}
-
-long signum_fun_signed_long( long a )
-{
-    if (a < 0) return -1;
-    if (a > 0) return 1;
-    return 0;
-}
-
-long signum_fun_unsigned_long( unsigned long a )
-{
-    if (a > 0) return 1;
-    return 0;
-}
-
-double signum_fun_float( float a )
-{
-    if (a < 0) return -1;
-    if (a > 0) return 1;
-    return 0;
-}
-
-double signum_fun_double( double a )
-{
-    if (a < 0) return -1;
-    if (a > 0) return 1;
-    return 0;
-}
-
-
-
-void copy_arrayOf_signed_int( int* a, int a1, int* b)
-{
-    int i;
-    for( i=0; i<a1; ++i )
-        b[i] = a[i];
-}
-
-void copy_arrayOf_unsigned_int( unsigned int* a, int a1, unsigned int* b )
-{
-    int i;
-    for( i=0; i<a1; ++i )
-        b[i] = a[i];
-}
-
-void copy_arrayOf_signed_long( long* a, int a1, long* b )
-{
-    int i;
-    for( i=0; i<a1; ++i )
-        b[i] = a[i];
-}
-
-void copy_arrayOf_unsigned_long( unsigned long* a, int a1, unsigned long* b )
-{
-    int i;
-    for( i=0; i<a1; ++i )
-        b[i] = a[i];
-}
-
-void copy_arrayOf_float( float* a, int a1, float* b )
-{
-    int i;
-    for( i=0; i<a1; ++i )
-        b[i] = a[i];
-}
-
-
-void copy_arrayOf_double( double* a, int a1, double* b )
-{
-    int i;
-    for( i=0; i<a1; ++i )
-        b[i] = a[i];
-}
− Feldspar/C/feldspar.h 
@@ -1,78 +0,0 @@-/*- * Copyright (c) 2009-2010, 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_H
-#define FELDSPAR_H
-
-int mod_fun_signed_int( int, int );
-int mod_fun_unsigned_int( unsigned int, unsigned int );
-long mod_fun_signed_long( long, long );
-long mod_fun_unsigned_long( unsigned long, unsigned long );
-
-int pow_fun_signed_int( int, int );
-int pow_fun_unsigned_int( unsigned int, unsigned int );
-
-int bit_fun_signed_int( int );
-int setBit_fun_signed_int( int, int );
-int clearBit_fun_signed_int( int, int );
-int complementBit_fun_signed_int( int, int );
-int testBit_fun_signed_int( int, int );
-int rotateL_fun_signed_int( int, int );
-int rotateR_fun_signed_int( int, int );
-// int bit_shift_fun_signed_int( int, int );
-// int bit_rotate_fun_signed_int( int, int );
-int bitSize_fun_signed_int( int );
-int isSigned_fun_signed_int( int );
-
-int abs_fun_signed_int( int );
-int abs_fun_unsigned_int( unsigned int );
-long abs_fun_signed_long( long );
-long abs_fun_unsigned_long( unsigned long );
-double abs_fun_float( float );
-double abs_fun_double( double );
-
-int signum_fun_signed_int( int );
-int signum_fun_unsigned_int( unsigned int );
-long signum_fun_signed_long( long );
-long signum_fun_unsigned_long( unsigned long );
-double signum_fun_float( float );
-double signum_fun_double( double );
-
-void copy_arrayOf_signed_int( int*, int, int* );
-void copy_arrayOf_unsigned_int( unsigned int*, int, unsigned int* );
-void copy_arrayOf_signed_long( long*, int, long* );
-void copy_arrayOf_unsigned_long( unsigned long*, int, unsigned long* );
-void copy_arrayOf_float( float*, int, float* );
-void copy_arrayOf_double( double*, int, double* );
-
-
-#endif
+ Feldspar/C/feldspar_c99.c view
@@ -0,0 +1,1008 @@+//+// Copyright (c) 2009-2010, 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>++#if defined(WIN32)+  #include <windows.h>+#else+  #include <sys/time.h>+  #include <time.h>+#endif /* WIN32 */++++/*--------------------------------------------------------------------------*+ *                 pow(), abs(), signum()                                   *+ *--------------------------------------------------------------------------*/++int8_t pow_fun_int8( int8_t a, int8_t b )+{+    if (b < 0) {+        fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);+        exit(1);+    }+    int8_t r = 1;+    int i;+    for(i = 0; i < b; ++i)+        r *= a;+    return r;+}++int16_t pow_fun_int16( int16_t a, int16_t b )+{+    if (b < 0) {+        fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);+        exit(1);+    }+    int16_t r = 1;+    int i;+    for(i = 0; i < b; ++i)+        r *= a;+    return r;+}++int32_t pow_fun_int32( int32_t a, int32_t b )+{+    if (b < 0) {+        fprintf(stderr, "Negative exponent in function pow_fun_(): %d `pow` %d", a, b);+        exit(1);+    }+    int32_t r = 1;+    int i;+    for(i = 0; i < b; ++i)+        r *= a;+    return r;+}++int64_t pow_fun_int64( int64_t a, int64_t b )+{+    if (b < 0) {+        fprintf(stderr, "Negative exponent in function pow_fun_(): %lld `pow` %lld", a, b);+        exit(1);+    }+    int64_t r = 1;+    int i;+    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);+}++++/*--------------------------------------------------------------------------*+ *                 Bit operations                                           *+ *--------------------------------------------------------------------------*/++int8_t bit_fun_int8( int32_t i )+{+    return 1 << i;+}++int16_t bit_fun_int16( int32_t i )+{+    return 1 << i;+}++int32_t bit_fun_int32( int32_t i )+{+    return 1 << i;+}++int64_t bit_fun_int64( int32_t i )+{+    return 1 << i;+}++uint8_t bit_fun_uint8( int32_t i )+{+    return 1 << i;+}++uint16_t bit_fun_uint16( int32_t i )+{+    return 1 << i;+}++uint32_t bit_fun_uint32( int32_t i )+{+    return 1 << i;+}++uint64_t bit_fun_uint64( int32_t i )+{+    return 1 << i;+}++++int8_t setBit_fun_int8( int8_t x, int32_t i )+{+    return x | 1 << i;+}++int16_t setBit_fun_int16( int16_t x, int32_t i )+{+    return x | 1 << i;+}++int32_t setBit_fun_int32( int32_t x, int32_t i )+{+    return x | 1 << i;+}++int64_t setBit_fun_int64( int64_t x, int32_t i )+{+    return x | 1 << i;+}++uint8_t setBit_fun_uint8( uint8_t x, int32_t i )+{+    return x | 1 << i;+}++uint16_t setBit_fun_uint16( uint16_t x, int32_t i )+{+    return x | 1 << i;+}++uint32_t setBit_fun_uint32( uint32_t x, int32_t i )+{+    return x | 1 << i;+}++uint64_t setBit_fun_uint64( uint64_t x, int32_t i )+{+    return x | 1 << i;+}++++int8_t clearBit_fun_int8( int8_t x, int32_t i )+{+    return x & ~(1 << i);+}++int16_t clearBit_fun_int16( int16_t x, int32_t i )+{+    return x & ~(1 << i);+}++int32_t clearBit_fun_int32( int32_t x, int32_t i )+{+    return x & ~(1 << i);+}++int64_t clearBit_fun_int64( int64_t x, int32_t i )+{+    return x & ~(1 << i);+}++uint8_t clearBit_fun_uint8( uint8_t x, int32_t i )+{+    return x & ~(1 << i);+}++uint16_t clearBit_fun_uint16( uint16_t x, int32_t i )+{+    return x & ~(1 << i);+}++uint32_t clearBit_fun_uint32( uint32_t x, int32_t i )+{+    return x & ~(1 << i);+}++uint64_t clearBit_fun_uint64( uint64_t x, int32_t i )+{+    return x & ~(1 << i);+}++++int8_t complementBit_fun_int8( int8_t x, int32_t i )+{+    return x ^ 1 << i;+}++int16_t complementBit_fun_int16( int16_t x, int32_t i )+{+    return x ^ 1 << i;+}++int32_t complementBit_fun_int32( int32_t x, int32_t i )+{+    return x ^ 1 << i;+}++int64_t complementBit_fun_int64( int64_t x, int32_t i )+{+    return x ^ 1 << i;+}++uint8_t complementBit_fun_uint8( uint8_t x, int32_t i )+{+    return x ^ 1 << i;+}++uint16_t complementBit_fun_uint16( uint16_t x, int32_t i )+{+    return x ^ 1 << i;+}++uint32_t complementBit_fun_uint32( uint32_t x, int32_t i )+{+    return x ^ 1 << i;+}++uint64_t complementBit_fun_uint64( uint64_t x, int32_t i )+{+    return x ^ 1 << i;+}++++int testBit_fun_int8( int8_t x, int32_t i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_int16( int16_t x, int32_t i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_int32( int32_t x, int32_t i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_int64( int64_t x, int32_t i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_uint8( uint8_t x, int32_t i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_uint16( uint16_t x, int32_t i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_uint32( uint32_t x, int32_t i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_uint64( uint64_t x, int32_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 x << 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;+}++++int32_t bitScan_fun_int8( int8_t x )+{+    if (x == 0) return 7;+    int32_t r = 0;+    int8_t s = (x & 0x80);+    while (((x <<= 1) & 0x80) == s)+        ++r;+    return r;+}++int32_t bitScan_fun_int16( int16_t x )+{+    if (x == 0) return 15;+    int32_t r = 0;+    int16_t s = (x & 0x8000);+    while (((x <<= 1) & 0x8000) == s)+        ++r;+    return r;+}++int32_t bitScan_fun_int32( int32_t x )+{+    if (x == 0) return 31;+    int32_t r = 0;+    int32_t s = (x & 0x80000000);+    while (((x <<= 1) & 0x80000000) == s)+        ++r;+    return r;+}++int32_t bitScan_fun_int64( int64_t x )+{+    if (x == 0) return 63;+    int32_t r = 0;+    int64_t s = (x & 0x8000000000000000ll);+    while (((x <<= 1) & 0x8000000000000000ll) == s)+        ++r;+    return r;+}++int32_t bitScan_fun_uint8( uint8_t x )+{+    int32_t r = 8;+    while (x)+    {+        --r;+        x >>= 1;+    }+    return r;+}++int32_t bitScan_fun_uint16( uint16_t x )+{+    int32_t r = 16;+    while (x)+    {+        --r;+        x >>= 1;+    }+    return r;+}++int32_t bitScan_fun_uint32( uint32_t x )+{+    int32_t r = 32;+    while (x)+    {+        --r;+        x >>= 1;+    }+    return r;+}++int32_t bitScan_fun_uint64( uint64_t x )+{+    int32_t r = 64;+    while (x)+    {+        --r;+        x >>= 1;+    }+    return r;+}++int32_t bitCount_fun_int8( int8_t x )+{+    int32_t r = x & 1;+    for (x = x >> 1 & 0x7f; x; x >>= 1)+        r += x & 1;+    return r;+}++int32_t bitCount_fun_int16( int16_t x )+{+    int32_t r = x & 1;+    for (x = x >> 1 & 0x7fff; x; x >>= 1)+        r += x & 1;+    return r;+}++int32_t bitCount_fun_int32( int32_t x )+{+    int32_t r = x & 1;+    for (x = x >> 1 & 0x7fffffff; x; x >>= 1)+        r += x & 1;+    return r;+}++int32_t bitCount_fun_int64( int64_t x )+{+    int32_t r = x & 1;+    for (x = x >> 1 & 0x7fffffffffffffffll; x; x >>= 1)+        r += x & 1;+    return r;+}++int32_t bitCount_fun_uint8( uint8_t x )+{+    int32_t r = x & 1;+    while (x >>= 1)+        r += x & 1;+    return r;+}++int32_t bitCount_fun_uint16( uint16_t x )+{+    int32_t r = x & 1;+    while (x >>= 1)+        r += x & 1;+    return r;+}++int32_t bitCount_fun_uint32( uint32_t x )+{+    int32_t r = x & 1;+    while (x >>= 1)+        r += x & 1;+    return r;+}++int32_t bitCount_fun_uint64( uint64_t x )+{+    int32_t r = x & 1;+    while (x >>= 1)+        r += x & 1;+    return r;+}++++/*--------------------------------------------------------------------------*+ *                 copy_arrayOf()                                           *+ *--------------------------------------------------------------------------*/++void copy_arrayOf_int8( int8_t* a, int32_t a1, int8_t* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_int16( int16_t* a, int32_t a1, int16_t* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_int32( int32_t* a, int32_t a1, int32_t* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_int64( int64_t* a, int32_t a1, int64_t* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_uint8( uint8_t* a, int32_t a1, uint8_t* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_uint16( uint16_t* a, int32_t a1, uint16_t* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_uint32( uint32_t* a, int32_t a1, uint32_t* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_uint64( uint64_t* a, int32_t a1, uint64_t* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_float( float* a, signed int a1, float* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++++/*--------------------------------------------------------------------------*+ *                 Trace functions                                          *+ *--------------------------------------------------------------------------*/++static FILE *trace_log_file;++#if defined(WIN32)++static DWORD trace_start_time;++void traceStart()+{+    SYSTEMTIME lt;+    GetLocalTime(&lt);+    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, +          "The 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();+}++inline 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, "The logging started at %s.\n", timestr);+    fflush(trace_log_file);+    gettimeofday(&trace_start_time, NULL);+}++inline 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.%06ld", tv.tv_sec, tv.tv_usec);+}++#endif /* WIN32 */++void traceEnd()+{+    fprintf(trace_log_file, "The 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);+}
+ Feldspar/C/feldspar_c99.h view
@@ -0,0 +1,179 @@+//+// Copyright (c) 2009-2010, 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>++++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 );++++int8_t bit_fun_int8( int32_t );+int16_t bit_fun_int16( int32_t );+int32_t bit_fun_int32( int32_t );+int64_t bit_fun_int64( int32_t );+uint8_t bit_fun_uint8( int32_t );+uint16_t bit_fun_uint16( int32_t );+uint32_t bit_fun_uint32( int32_t );+uint64_t bit_fun_uint64( int32_t );++int8_t setBit_fun_int8( int8_t, int32_t );+int16_t setBit_fun_int16( int16_t, int32_t );+int32_t setBit_fun_int32( int32_t, int32_t );+int64_t setBit_fun_int64( int64_t, int32_t );+uint8_t setBit_fun_uint8( uint8_t, int32_t );+uint16_t setBit_fun_uint16( uint16_t, int32_t );+uint32_t setBit_fun_uint32( uint32_t, int32_t );+uint64_t setBit_fun_uint64( uint64_t, int32_t );++int8_t clearBit_fun_int8( int8_t, int32_t );+int16_t clearBit_fun_int16( int16_t, int32_t );+int32_t clearBit_fun_int32( int32_t, int32_t );+int64_t clearBit_fun_int64( int64_t, int32_t );+uint8_t clearBit_fun_uint8( uint8_t, int32_t );+uint16_t clearBit_fun_uint16( uint16_t, int32_t );+uint32_t clearBit_fun_uint32( uint32_t, int32_t );+uint64_t clearBit_fun_uint64( uint64_t, int32_t );++int8_t complementBit_fun_int8( int8_t, int32_t );+int16_t complementBit_fun_int16( int16_t, int32_t );+int32_t complementBit_fun_int32( int32_t, int32_t );+int64_t complementBit_fun_int64( int64_t, int32_t );+uint8_t complementBit_fun_uint8( uint8_t, int32_t );+uint16_t complementBit_fun_uint16( uint16_t, int32_t );+uint32_t complementBit_fun_uint32( uint32_t, int32_t );+uint64_t complementBit_fun_uint64( uint64_t, int32_t );++int testBit_fun_int8( int8_t, int32_t );+int testBit_fun_int16( int16_t, int32_t );+int testBit_fun_int32( int32_t, int32_t );+int testBit_fun_int64( int64_t, int32_t );+int testBit_fun_uint8( uint8_t, int32_t );+int testBit_fun_uint16( uint16_t, int32_t );+int testBit_fun_uint32( uint32_t, int32_t );+int testBit_fun_uint64( uint64_t, int32_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 );++int32_t bitScan_fun_int8( int8_t );+int32_t bitScan_fun_int16( int16_t );+int32_t bitScan_fun_int32( int32_t );+int32_t bitScan_fun_int64( int64_t );+int32_t bitScan_fun_uint8( uint8_t );+int32_t bitScan_fun_uint16( uint16_t );+int32_t bitScan_fun_uint32( uint32_t );+int32_t bitScan_fun_uint64( uint64_t );++int32_t bitCount_fun_int8( int8_t );+int32_t bitCount_fun_int16( int16_t );+int32_t bitCount_fun_int32( int32_t );+int32_t bitCount_fun_int64( int64_t );+int32_t bitCount_fun_uint8( uint8_t );+int32_t bitCount_fun_uint16( uint16_t );+int32_t bitCount_fun_uint32( uint32_t );+int32_t bitCount_fun_uint64( uint64_t );++++void copy_arrayOf_int8( int8_t*, int32_t, int8_t* );+void copy_arrayOf_int16( int16_t*, int32_t, int16_t* );+void copy_arrayOf_int32( int32_t*, int32_t, int32_t* );+void copy_arrayOf_int64( int64_t*, int32_t, int64_t* );+void copy_arrayOf_uint8( uint8_t*, int32_t, uint8_t* );+void copy_arrayOf_uint16( uint16_t*, int32_t, uint16_t* );+void copy_arrayOf_uint32( uint32_t*, int32_t, uint32_t* );+void copy_arrayOf_uint64( uint64_t*, int32_t, uint64_t* );+void copy_arrayOf_float( float*, int32_t, 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 );++#endif /* FELDSPAR_C99_H */
+ Feldspar/C/feldspar_tic64x.c view
@@ -0,0 +1,1078 @@+//+// Copyright (c) 2009-2010, 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>++++/*--------------------------------------------------------------------------*+ *                 pow(), abs(), signum()                                   *+ *--------------------------------------------------------------------------*/++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);+}++++/*--------------------------------------------------------------------------*+ *                 Bit operations                                           *+ *--------------------------------------------------------------------------*/++char setBit_fun_char( char x, int i )+{+    return x | 1 << i;+}++short setBit_fun_short( short x, int i )+{+    return x | 1 << i;+}++int setBit_fun_int( int x, int i )+{+    return x | 1 << i;+}++long setBit_fun_long( long x, int i )+{+    return x | 1 << i;+}++long long setBit_fun_llong( long long x, int i )+{+    return x | 1 << i;+}++unsigned char setBit_fun_uchar( unsigned char x, int i )+{+    return x | 1 << i;+}++unsigned short setBit_fun_ushort( unsigned short x, int i )+{+    return x | 1 << i;+}++unsigned setBit_fun_uint( unsigned x, int i )+{+    return x | 1 << i;+}++unsigned long setBit_fun_ulong( unsigned long x, int i )+{+    return x | 1 << i;+}++unsigned long long setBit_fun_ullong( unsigned long long x, int i )+{+    return x | 1 << i;+}++++char clearBit_fun_char( char x, int i )+{+    return x & ~(1 << i);+}++short clearBit_fun_short( short x, int i )+{+    return x & ~(1 << i);+}++int clearBit_fun_int( int x, int i )+{+    return x & ~(1 << i);+}++long clearBit_fun_long( long x, int i )+{+    return x & ~(1 << i);+}++long long clearBit_fun_llong( long long x, int i )+{+    return x & ~(1 << i);+}++unsigned char clearBit_fun_uchar( unsigned char x, int i )+{+    return x & ~(1 << i);+}++unsigned short clearBit_fun_ushort( unsigned short x, int i )+{+    return x & ~(1 << i);+}++unsigned clearBit_fun_uint( unsigned x, int i )+{+    return x & ~(1 << i);+}++unsigned long clearBit_fun_ulong( unsigned long x, int i )+{+    return x & ~(1 << i);+}++unsigned long long clearBit_fun_ullong( unsigned long long x, int i )+{+    return x & ~(1 << i);+}++++char complementBit_fun_char( char x, int i )+{+    return x ^ 1 << i;+}++short complementBit_fun_short( short x, int i )+{+    return x ^ 1 << i;+}++int complementBit_fun_int( int x, int i )+{+    return x ^ 1 << i;+}++long complementBit_fun_long( long x, int i )+{+    return x ^ 1 << i;+}++long long complementBit_fun_llong( long long x, int i )+{+    return x ^ 1 << i;+}++unsigned char complementBit_fun_uchar( unsigned char x, int i )+{+    return x ^ 1 << i;+}++unsigned short complementBit_fun_ushort( unsigned short x, int i )+{+    return x ^ 1 << i;+}++unsigned complementBit_fun_uint( unsigned x, int i )+{+    return x ^ 1 << i;+}++unsigned long complementBit_fun_ulong( unsigned long x, int i )+{+    return x ^ 1 << i;+}++unsigned long long complementBit_fun_ullong( unsigned long long x, int i )+{+    return x ^ 1 << i;+}++++int testBit_fun_char( char x, int i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_short( short x, int i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_int( int x, int i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_long( long x, int i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_llong( long long x, int i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_uchar( unsigned char x, int i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_ushort( unsigned short x, int i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_uint( unsigned x, int i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_ulong( unsigned long x, int i )+{+    return (x & 1 << i) != 0;+}++int testBit_fun_ullong( unsigned long long x, int 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)));+}++int rotateL_fun_int( int x, int i )+{+    return (int)_rotl((unsigned)x, (unsigned)i);+/*    if ((i %= 32) == 0) return x;+    return (x << i) | ((0x7fffffff >> (31 - i)) & (x >> (32 - 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)));+}++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 x << 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;+}++++int bitScan_fun_char( char x )+{+    int r = 0;+    char s = (x & 0x80);+    if (x == 0) return 7;+    while (((x <<= 1) & 0x80) == s)+        ++r;+    return r;+}++int bitScan_fun_short( short x )+{+    int r = 0;+    short s = (x & 0x8000);+    if (x == 0) return 15;+    while (((x <<= 1) & 0x8000) == s)+        ++r;+    return r;+}++int bitScan_fun_int( int x )+{+    int r = 0;+    int s = (x & 0x80000000);+    if (x == 0) return 31;+    while (((x <<= 1) & 0x80000000) == s)+        ++r;+    return r;+}++int bitScan_fun_long( long x )+{+    int r = 0;+    long s = (x & 0x8000000000l);+    if (x == 0) return 39;+    while (((x <<= 1) & 0x8000000000l) == s)+        ++r;+    return r;+}++int bitScan_fun_llong( long long x )+{+    int r = 0;+    long long s = (x & 0x8000000000000000ll);+    if (x == 0) return 63;+    while (((x <<= 1) & 0x8000000000000000ll) == s)+        ++r;+    return r;+}++int bitScan_fun_uchar( unsigned char x )+{+    int r = 8;+    while (x)+    {+        --r;+        x >>= 1;+    }+    return r;+}++int bitScan_fun_ushort( unsigned short x )+{+    int r = 16;+    while (x)+    {+        --r;+        x >>= 1;+    }+    return r;+}++int bitScan_fun_uint( unsigned x )+{+    int r = 32;+    while (x)+    {+        --r;+        x >>= 1;+    }+    return r;+}++int bitScan_fun_ulong( unsigned long x )+{+    int r = 40;+    while (x)+    {+        --r;+        x >>= 1;+    }+    return r;+}++int bitScan_fun_ullong( unsigned long long x )+{+    int r = 64;+    while (x)+    {+        --r;+        x >>= 1;+    }+    return r;+}++int bitCount_fun_char( char x )+{+    int r = x & 1;+    for (x = x >> 1 & 0x7f; x; x >>= 1)+        r += x & 1;+    return r;+}++int bitCount_fun_short( short x )+{+    int r = x & 1;+    for (x = x >> 1 & 0x7fff; x; x >>= 1)+        r += x & 1;+    return r;+}++int bitCount_fun_int( int x )+{+    int r = x & 1;+    for (x = x >> 1 & 0x7fffffff; x; x >>= 1)+        r += x & 1;+    return r;+}++int bitCount_fun_long( long x )+{+    int r = x & 1;+    for (x = x >> 1 & 0x7fffffffffl; x; x >>= 1)+        r += x & 1;+    return r;+}++int bitCount_fun_llong( long long x )+{+    int r = x & 1;+    for (x = x >> 1 & 0x7fffffffffffffffll; x; x >>= 1)+        r += x & 1;+    return r;+}++int bitCount_fun_uchar( unsigned char x )+{+    int r = x & 1;+    while (x >>= 1)+        r += x & 1;+    return r;+}++int bitCount_fun_ushort( unsigned short x )+{+    int r = x & 1;+    while (x >>= 1)+        r += x & 1;+    return r;+}++int bitCount_fun_ulong( unsigned long x )+{+    int r = x & 1;+    while (x >>= 1)+        r += x & 1;+    return r;+}++int bitCount_fun_ullong( unsigned long long x )+{+    int r = x & 1;+    while (x >>= 1)+        r += x & 1;+    return r;+}++++/*--------------------------------------------------------------------------*+ *                 copy_arrayOf()                                             *+ *--------------------------------------------------------------------------*/++void copy_arrayOf_char( char* a, int a1, char* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_short( short* a, int a1, short* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_int( int* a, int a1, int* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_long( long* a, int a1, long* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_llong( long long* a, int a1, long long* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_uchar( unsigned char* a, int a1, unsigned char* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_ushort( unsigned short* a, int a1, unsigned short* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_uint( unsigned* a, int a1, unsigned* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_ulong( unsigned long* a, int a1, unsigned long* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_ullong( unsigned long long* a, int a1, unsigned long long* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++void copy_arrayOf_float( float* a, signed int a1, float* b )+{+    int i;+    for(i = 0; i < a1; ++i)+        b[i] = a[i];+}++++/*--------------------------------------------------------------------------*+ *                 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, "The logging started at %s.\n", timestr);+    fflush(trace_log_file);+    trace_start_time = time(NULL);+}++inline void elapsedTimeString( char* str )+{+    sprintf(str, "%ld.000", time(NULL) - trace_start_time);+}++void traceEnd()+{+    fprintf(trace_log_file, "The 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);+}
+ Feldspar/C/feldspar_tic64x.h view
@@ -0,0 +1,191 @@+//+// Copyright (c) 2009-2010, 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 );++++char setBit_fun_char( char, int );+short setBit_fun_short( short, int );+int setBit_fun_int( int, int );+long setBit_fun_long( long, int );+long long setBit_fun_llong( long long, int );+unsigned char setBit_fun_uchar( unsigned char, int );+unsigned short setBit_fun_ushort( unsigned short, int );+unsigned setBit_fun_uint( unsigned, int );+unsigned long setBit_fun_ulong( unsigned long, int );+unsigned long long setBit_fun_ullong( unsigned long long, int );++char clearBit_fun_char( char, int );+short clearBit_fun_short( short, int );+int clearBit_fun_int( int, int );+long clearBit_fun_long( long, int );+long long clearBit_fun_llong( long long, int );+unsigned char clearBit_fun_uchar( unsigned char, int );+unsigned short clearBit_fun_ushort( unsigned short, int );+unsigned clearBit_fun_uint( unsigned, int );+unsigned long clearBit_fun_ulong( unsigned long, int );+unsigned long long clearBit_fun_ullong( unsigned long long, int );++char complementBit_fun_char( char, int );+short complementBit_fun_short( short, int );+int complementBit_fun_int( int, int );+long complementBit_fun_long( long, int );+long long complementBit_fun_llong( long long, int );+unsigned char complementBit_fun_uchar( unsigned char, int );+unsigned short complementBit_fun_ushort( unsigned short, int );+unsigned complementBit_fun_uint( unsigned, int );+unsigned long complementBit_fun_ulong( unsigned long, int );+unsigned long long complementBit_fun_ullong( unsigned long long, int );++int testBit_fun_char( char, int );+int testBit_fun_short( short, int );+int testBit_fun_int( int, int );+int testBit_fun_long( long, int );+int testBit_fun_llong( long long, int );+int testBit_fun_uchar( unsigned char, int );+int testBit_fun_ushort( unsigned short, int );+int testBit_fun_uint( unsigned, int );+int testBit_fun_ulong( unsigned long, int );+int testBit_fun_ullong( unsigned long long, int );++char rotateL_fun_char( char, int );+short rotateL_fun_short( short, int );+int rotateL_fun_int( int, int );+long rotateL_fun_long( long, int );+long long rotateL_fun_llong( long long, 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 );++int bitScan_fun_char( char );+int bitScan_fun_short( short );+int bitScan_fun_int( int );+int bitScan_fun_long( long );+int bitScan_fun_llong( long long );+int bitScan_fun_uchar( unsigned char );+int bitScan_fun_ushort( unsigned short );+int bitScan_fun_uint( unsigned );+int bitScan_fun_ulong( unsigned long );+int bitScan_fun_ullong( unsigned long long );++int bitCount_fun_char( char );+int bitCount_fun_short( short );+int bitCount_fun_int( int );+int bitCount_fun_long( long );+int bitCount_fun_llong( long long );+int bitCount_fun_uchar( unsigned char );+int bitCount_fun_ushort( unsigned short );+int bitCount_fun_ulong( unsigned long );+int bitCount_fun_ullong( unsigned long long );++++void copy_arrayOf_char( char*, int, char* );+void copy_arrayOf_short( short*, int, short* );+void copy_arrayOf_int( int*, int, int* );+void copy_arrayOf_long( long*, int, long* );+void copy_arrayOf_llong( long long*, int, long long* );+void copy_arrayOf_uchar( unsigned char*, int, unsigned char* );+void copy_arrayOf_ushort( unsigned short*, int, unsigned short* );+void copy_arrayOf_uint( unsigned*, int, unsigned* );+void copy_arrayOf_ulong( unsigned long*, int, unsigned long* );+void copy_arrayOf_ullong( unsigned long long*, int, unsigned long long* );+void copy_arrayOf_float( float*, int, float* );++++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 );++#endif /* FELDSPAR_TI_C64X_H */
Feldspar/Compiler.hs view
@@ -1,42 +1,38 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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     ( compile     , icompile     , icompile'     , defaultOptions+    , tic64xPlatformOptions     , unrollOptions-    , c99Options     , noSimplification     , noPrimitiveInstructionHandling     ) where
Feldspar/Compiler/Compiler.hs view
@@ -1,34 +1,30 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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     ( compile@@ -36,11 +32,12 @@     , icompile     , icompile'     , defaultOptions+    , tic64xPlatformOptions     , unrollOptions-    , c99Options     , noSimplification     , noPrimitiveInstructionHandling-    , includeGeneration+    , fixFunctionName+    , c99Options     ) where  import Data.Map@@ -50,6 +47,7 @@ import qualified Feldspar.Core.Expr as Expr import Feldspar.Core.Types import Feldspar.Compiler.Options+import Feldspar.Compiler.Platforms import Feldspar.Compiler.Transformation.GraphToImperative import Feldspar.Compiler.Transformation.Lifting @@ -60,8 +58,9 @@ import Feldspar.Compiler.Plugins.HandlePrimitives import Feldspar.Compiler.Plugins.PrettyPrint import Feldspar.Compiler.Plugins.Unroll-import Feldspar.Compiler.Plugins.ConstantFolding+--import Feldspar.Compiler.Plugins.ConstantFolding + import Feldspar.Compiler.Transformation.GraphUtils import Feldspar.Compiler.Imperative.Semantics import Feldspar.Compiler.Imperative.Representation@@ -69,12 +68,7 @@ import qualified Feldspar.Compiler.Precompiler.Precompiler as Precompiler import System.IO ---------------------------------------------- Header file for generated C programs --------------------------------------------- -intro = "#include \"feldspar.h\"\n\n"- type Writer t = (CompilationMode -> t -> FilePath -> Precompiler.OriginalFeldsparFunctionSignature -> Options -> IO ())  -------------------------@@ -100,13 +94,9 @@ -- Standalone compiler -- ------------------------- -includeGeneration :: FilePath -> IO ()-includeGeneration fileName-   = appendFile fileName intro- standaloneWrite :: (Reify.Program t) => Writer t standaloneWrite compilationMode prg outFileName originalFeldsparFunctionSignature opts-   = appendFile outFileName $ compToC $ executePluginChain compilationMode prg originalFeldsparFunctionSignature opts+   = appendFile outFileName $ compToC (platform opts) $ executePluginChain compilationMode prg originalFeldsparFunctionSignature opts  standaloneCompile :: (Reify.Program t) => t -> FilePath -> FilePath -> Precompiler.OriginalFeldsparFunctionSignature -> Options -> IO () standaloneCompile prg inputFileName outputFileName originalFeldsparFunctionSignature opts@@ -118,7 +108,7 @@  fileWrite :: (Reify.Program t) => Writer t fileWrite compilationMode prg fileName originalFeldsparFunctionSignature opts-  = writeFile fileName $ intro ++ (compToC $ executePluginChain compilationMode prg originalFeldsparFunctionSignature opts)+  = writeFile fileName $ (incList $ includes $ platform $ opts) ++ (compToC (platform opts) $ executePluginChain compilationMode prg originalFeldsparFunctionSignature opts)  compile :: (Reify.Program t) => t -> FilePath -> String -> Options -> IO () compile prg fileName functionName opts@@ -126,7 +116,7 @@  writeOut :: (Reify.Program t) => Writer t writeOut compilationMode prg fileName functionName opts-   = putStrLn $ intro ++ (compToC $ executePluginChain compilationMode prg functionName opts)+   = putStrLn $ (incList $ includes $ platform $ opts) ++ (compToC (platform opts) $ executePluginChain compilationMode prg functionName opts)  icompile :: (Reify.Program t) => t -> IO () icompile prg@@ -136,21 +126,27 @@ icompile' prg functionName opts   = coreCompile writeOut Interactive prg "" "" (Precompiler.OriginalFeldsparFunctionSignature functionName []) opts +incList :: [String] -> String+incList []   = "\n"+incList (x:xs) = "#include " ++ x ++ "\n" ++ (incList xs)+ ------------------------ -- Predefined options -- ------------------------  defaultOptions     = Options-    { platform          = AnsiC+    { platform          = c99     , unroll            = NoUnroll     , debug             = NoDebug     , defaultArraySize  = 16     } -c99Options -    = defaultOptions { platform = C99 } +c99Options = defaultOptions +tic64xPlatformOptions+    = defaultOptions { platform = tic64x }+ unrollOptions     = defaultOptions { unroll = Unroll 8 } @@ -167,7 +163,7 @@ pluginChain :: ExternalInfoCollection -> Procedure InitSemInf -> Procedure PrettyPrintSemanticInfo pluginChain externalInfo     = (executePlugin PrettyPrint (prettyPrintExternalInfo externalInfo))-    . (executePlugin ConstantFolding ())+--    . (executePlugin ConstantFolding ())     . (executePlugin UnrollPlugin (unrollExternalInfo externalInfo))     . (executePlugin Precompilation (precompilationExternalInfo externalInfo))     . (executePlugin ForwardPropagation (forwardPropagationExternalInfo externalInfo))@@ -195,7 +191,7 @@         },         prettyPrintExternalInfo = (platform opt, defaultArraySize opt),         unrollExternalInfo      = unroll opt,-        handlePrimitivesExternalInfo  = (defaultArraySize opt, debug opt),+        handlePrimitivesExternalInfo  = (defaultArraySize opt, debug opt, platform opt),         forwardPropagationExternalInfo = debug opt,         backwardPropagationExternalInfo = debug opt     })
Feldspar/Compiler/CompilerMain.hs view
@@ -1,40 +1,40 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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 Main where  import Feldspar.Compiler.Precompiler.Precompiler-import qualified Feldspar.Compiler.Compiler -- ONLY for improving compilation speed in normal mode+import qualified Feldspar.Compiler.Compiler as CompilerCore+import qualified Feldspar.Compiler.Options as CoreOptions+import qualified Feldspar.Compiler.Standalone.Options as StandaloneOptions+import Feldspar.Compiler.Standalone.Constants+import Feldspar.Compiler.Standalone.Library as StandaloneLib  import System.Exit import System.Environment@@ -50,59 +50,68 @@  import Data.List import System.Console.GetOpt+import System.Console.ANSI import System.FilePath  import Language.Haskell.Interpreter -warningPrefix = "[WARNING]: "-errorPrefix   = "[ERROR  ]: "- serializeOriginalFeldsparFunctionSignature originalFeldsparFunctionSignature =-    "(OriginalFeldsparFunctionSignature \"" ++ (originalFeldsparFunctionName originalFeldsparFunctionSignature) ++ "\" " ++ (show $ originalFeldsparParameterNames originalFeldsparFunctionSignature) ++ ")"+    "(OriginalFeldsparFunctionSignature \"" ++ (originalFeldsparFunctionName originalFeldsparFunctionSignature) +++        "\" " ++ (show $ originalFeldsparParameterNames originalFeldsparFunctionSignature) ++ ")" -generateCompileCode :: String -> String -> String -> OriginalFeldsparFunctionSignature -> String-generateCompileCode inputFileName outputFileName options originalFeldsparFunctionSignature =-    "standaloneCompile " ++ (originalFeldsparFunctionName originalFeldsparFunctionSignature) ++ " \"" ++ inputFileName ++ "\" " ++ " \""++-     outputFileName ++"\" " ++ (serializeOriginalFeldsparFunctionSignature originalFeldsparFunctionSignature) ++ " " ++ options+generateCompileCode :: String -> String -> CoreOptions.Options -> OriginalFeldsparFunctionSignature -> String+generateCompileCode inputFileName outputFileName coreOptions originalFeldsparFunctionSignature =+    "standaloneCompile " ++ (originalFeldsparFunctionName originalFeldsparFunctionSignature) +++        " \"" ++ inputFileName ++ "\" " ++ " \"" ++ outputFileName ++ "\" " +++        (serializeOriginalFeldsparFunctionSignature originalFeldsparFunctionSignature) +++        " (Options " +++        "{ platform = " ++ (CoreOptions.name $ CoreOptions.platform coreOptions) +++        ", unroll = " ++ (show $ CoreOptions.unroll coreOptions) +++        ", debug = " ++ (show $ CoreOptions.debug coreOptions) +++        ", defaultArraySize = " ++ (show $ CoreOptions.defaultArraySize coreOptions) +++        "})" -compileFunction :: String -> String -> String -> OriginalFeldsparFunctionSignature -> Interpreter ()+compileFunction :: String -> String -> CoreOptions.Options -> OriginalFeldsparFunctionSignature -> Interpreter () compileFunction inFileName outFileName options originalFeldsparFunctionSignature = do-    iPutStr $ "Compiling function " ++ (originalFeldsparFunctionName originalFeldsparFunctionSignature) ++ "...\t"+    iPutStr $ StandaloneLib.rpadWith 50 '.' $+        "Compiling function " ++ (originalFeldsparFunctionName originalFeldsparFunctionSignature)     --result <- catchError ( interpret (generateCompileCode outputFileName options functionName) (as::IO()) ) (\_->error "error")     result <- interpret (generateCompileCode inFileName outFileName options originalFeldsparFunctionSignature) (as::IO())     lift result-    iPutStrLn "[OK]"+    liftIO $ withColor Green (putStrLn "[OK]") -compileAllFunctions :: String -> String -> String -> [OriginalFeldsparFunctionSignature] -> Interpreter ()+compileAllFunctions :: String -> String -> CoreOptions.Options -> [OriginalFeldsparFunctionSignature] -> Interpreter () compileAllFunctions inFileName outFileName options [] = return() compileAllFunctions inFileName outFileName options (x:xs) = do-    (catchError (compileFunction inFileName outFileName options x) ( const $ iPutStrLn "[FAILED]"))+    (catchError (compileFunction inFileName outFileName options x)+                (const $ liftIO $ withColor Red (putStrLn "[FAILED]")))         `Control.Monad.CatchIO.catch`-            (\msg -> iPutStrLn $ errorPrefix ++ show (msg::Control.Exception.ErrorCall))+        (\msg -> liftIO $ withColor Red $ putStrLn $ errorPrefix ++ show (msg::Control.Exception.ErrorCall))     compileAllFunctions inFileName outFileName options xs -globalImportList = ["Feldspar.Fs2dot", "Feldspar.Compiler.Compiler", "Feldspar.Compiler.Precompiler.Precompiler"]+buildIncludeString :: [String] -> String+buildIncludeString includes = concatMap (\x -> "#include " ++ x ++ "\n") includes -generateIncludeLine :: String -> Interpreter ()-generateIncludeLine outputFileName = do-    result <- interpret ("includeGeneration \"" ++ outputFileName ++ "\"") (as::IO())-    lift result+includeGeneration :: FilePath -> CoreOptions.Options -> IO ()+includeGeneration fileName coreOptions+   = appendFile fileName $ buildIncludeString (CoreOptions.includes $ CoreOptions.platform coreOptions)  -- | Interpreter body for single-function compilation-singleFunctionCompilationBody :: String -> String -> String -> OriginalFeldsparFunctionSignature -> Interpreter (IO ())-singleFunctionCompilationBody inFileName outFileName options originalFeldsparFunctionSignature = do+singleFunctionCompilationBody :: String -> String -> CoreOptions.Options -> OriginalFeldsparFunctionSignature -> Interpreter (IO ())+singleFunctionCompilationBody inFileName outFileName coreOptions originalFeldsparFunctionSignature = do     iPutStrLn $ "Output file: " ++ outFileName     iPutStrLn $ "Compiling function " ++ (originalFeldsparFunctionName originalFeldsparFunctionSignature) ++ "..."-    generateIncludeLine outFileName-    result <- interpret (generateCompileCode inFileName outFileName options originalFeldsparFunctionSignature) (as::IO())+    liftIO $ includeGeneration outFileName coreOptions+    -- iPutStrLn $ generateCompileCode inFileName outFileName coreOptions originalFeldsparFunctionSignature+    result <- interpret (generateCompileCode inFileName outFileName coreOptions originalFeldsparFunctionSignature) (as::IO())     return result  -- | Interpreter body for multi-function compilation-multiFunctionCompilationBody :: String -> String -> String -> [OriginalFeldsparFunctionSignature] -> Interpreter (IO ())-multiFunctionCompilationBody inFileName outFileName compilerOptions declarationList = do+multiFunctionCompilationBody :: String -> String -> CoreOptions.Options -> [OriginalFeldsparFunctionSignature] -> Interpreter (IO ())+multiFunctionCompilationBody inFileName outFileName coreOptions declarationList = do     iPutStrLn $ "Output file: " ++ outFileName-    generateIncludeLine outFileName-    compileAllFunctions inFileName outFileName compilerOptions declarationList+    liftIO $ includeGeneration outFileName coreOptions+    compileAllFunctions inFileName outFileName coreOptions declarationList     return(return())  -- | A general interpreter body for interpreting an expression@@ -142,66 +151,6 @@     printInterpreterError (WontCompile xs) printInterpreterError e = putStrLn $ "Code generation failed: " ++ (show e) -data FunctionMode = SingleFunction String | MultiFunction--data Options = Options  { optSingleFunction     :: FunctionMode-                        , optOutputFileName     :: Maybe String-                        , optDotGeneration      :: Bool-                        , optDotFileName        :: Maybe String-                        , optCompilerMode       :: String-                        }---- | Default options-startOptions :: Options-startOptions = Options  { optSingleFunction = MultiFunction-                        , optOutputFileName = Nothing-                        , optDotGeneration  = False-                        , optDotFileName    = Nothing-                        , optCompilerMode   = "defaultOptions"-                        }---- | Option descriptions for getOpt-options :: [ OptDescr (Options -> IO Options) ]-options =-    [ Option "f" ["singlefunction"]-        (ReqArg-            (\arg opt -> return opt { optSingleFunction = SingleFunction arg })-            "FUNCTION")-        "Enables single-function compilation"--    , Option "o" ["output"]-        (ReqArg-            (\arg opt -> return opt { optOutputFileName = Just arg })-            "outputfile.c")-        "Overrides the file name for the generated output code"--    , Option "d" ["todot"]-        (OptArg-            (\arg opt -> return opt { optDotFileName = arg, optDotGeneration = True })-            "dotfile.dot")-        "Enables dot generation (outputs to stdout if no filename is specified)"--    , Option "c" ["compilermode"]-        (ReqArg-            (\arg opt -> return opt { optCompilerMode = arg })-            "compilerMode")-        "Changes compiler mode. Valid options are: unrollOptions, noSimplification, noPrimitiveInstructionHandling, c99Options"--    , Option "h" ["help"]-        (NoArg-            (\_ -> do-                --prg <- getProgName-                hPutStrLn stderr (usageInfo header options)-                exitWith ExitSuccess))-        "Show this help message"-    ]--header = "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"- -- | Calculates the output file name. convertOutputFileName :: String -> Maybe String -> String convertOutputFileName inputFileName maybeOutputFileName = case maybeOutputFileName of@@ -212,37 +161,33 @@     args <- getArgs      when (length args == 0) (do-        putStrLn $ usageInfo header options+        putStrLn $ usageInfo helpHeader StandaloneOptions.optionDescriptors         exitWith ExitSuccess)      -- Parse options, getting a list of option actions-    let (actions, nonOptions, errors) = getOpt Permute options args+    let (actions, nonOptions, errors) = getOpt Permute StandaloneOptions.optionDescriptors args      when (length errors > 0) (do         putStrLn $ concat errors-        putStrLn $ usageInfo header options+        putStrLn $ usageInfo helpHeader StandaloneOptions.optionDescriptors         exitWith (ExitFailure 1))      -- Here we thread startOptions through all supplied option actions-    opts <- foldl (>>=) (return startOptions) actions+    opts <- foldl (>>=) (return StandaloneOptions.startOptions) actions      when (length nonOptions /= 1) (do         putStrLn "ERROR: Exactly one input file expected."         exitWith (ExitFailure 1)) -    let Options { optSingleFunction = functionMode-                , optOutputFileName = maybeOutputFileName-                , optDotGeneration  = dotGeneration-                , optDotFileName    = dotFileName-                , optCompilerMode   = compilerMode } = opts+    let StandaloneOptions.Options {+                  StandaloneOptions.optSingleFunction = functionMode+                , StandaloneOptions.optOutputFileName = maybeOutputFileName+                , StandaloneOptions.optDotGeneration  = dotGeneration+                , StandaloneOptions.optDotFileName    = dotFileName+                , StandaloneOptions.optCompilerMode   = compilerMode } = opts     let inputFileName = head nonOptions -- change it for multi-file operation     let outputFileName = convertOutputFileName inputFileName maybeOutputFileName -    when (not $ compilerMode `elem`-            ["defaultOptions", "unrollOptions", "noSimplification", "noPrimitiveInstructionHandling", "c99Options"]) (do-        putStrLn $ "Invalid compiler mode \"" ++ compilerMode ++ "\""-        exitWith (ExitFailure 1))-     compilationCore functionMode inputFileName outputFileName opts dotGeneration dotFileName compilerMode  compilationCore functionMode inputFileName outputFileName commandLineOptions dotGeneration dotFileName compilerMode = do@@ -263,28 +208,29 @@      -- Dot generation     case commandLineOptions of-        Options { optDotGeneration = True} -> do+        StandaloneOptions.Options { StandaloneOptions.optDotGeneration = True} -> do             putStrLn "Dot generation enabled"             case functionMode of-                SingleFunction funName -> case dotFileName of+                StandaloneOptions.SingleFunction funName -> case dotFileName of                     Just fileName -> highLevelInterpreterWithModuleInfo                                      (generalInterpreterBody $ "writeDot \"" ++ fileName ++ "\" " ++ funName)                     Nothing       -> highLevelInterpreterWithModuleInfo                                      (generalInterpreterBody $ "putStr $ fs2dot " ++ funName)-                MultiFunction -> putStrLn $ "ERROR: Dot generation requested, but not supported in multi-function mode\n"+++                StandaloneOptions.MultiFunction ->+                    putStrLn $ "ERROR: Dot generation requested, but not supported in multi-function mode\n"++                                             "(use the \"-f function\" option to enable single-function mode)"         _ -> putStrLn "Dot generation disabled"      -- C code generation     case functionMode of-        MultiFunction +        StandaloneOptions.MultiFunction            | length declarationList == 0 -> putStrLn "Multi-function mode: Nothing to do."           | otherwise -> do               if length declarationList > 1                 then putStrLn $ "Multi-function mode, compiling " ++ (show $ length declarationList) ++ " functions..."                 else putStrLn $ "Multi-function mode, compiling the only function (" ++ (originalFeldsparFunctionName $ head declarationList) ++ ")..."                highLevelInterpreterWithModuleInfo (multiFunctionCompilationBody inputFileName outputFileName compilerMode declarationList)-        SingleFunction funName -> do+        StandaloneOptions.SingleFunction funName -> do             putStrLn $ "Single-function mode, compiling function " ++ funName ++ "..."             let originalFeldsparFunctionSignatureNeeded = case filter ((==funName).originalFeldsparFunctionName) declarationList of                                                                     [a] -> a@@ -293,8 +239,4 @@             highLevelInterpreterWithModuleInfo                 (singleFunctionCompilationBody inputFileName outputFileName compilerMode originalFeldsparFunctionSignatureNeeded) -iPutStrLn :: String -> Interpreter ()-iPutStrLn = liftIO . putStrLn -iPutStr :: String -> Interpreter ()-iPutStr = liftIO . putStr
Feldspar/Compiler/Error.hs view
@@ -1,34 +1,30 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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
Feldspar/Compiler/Imperative/CodeGeneration.hs view
@@ -1,34 +1,30 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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 #-}
 
@@ -37,8 +33,10 @@ import Feldspar.Compiler.Imperative.Representation
 import Feldspar.Compiler.Imperative.Semantics
 import Feldspar.Compiler.Error
-import qualified Data.List as List (last)
+import Feldspar.Compiler.Options
 
+import qualified Data.List as List (last,find)
+
 ------------------------
 -- C code generation --
 ------------------------
@@ -63,46 +61,36 @@       --input of fun 
     deriving (Eq,Show)
 
-compToC :: ToC a => a -> String
-compToC = toC Declaration_pl
+compToC :: ToC a => Platform -> a -> String
+compToC m = toC m Declaration_pl
 
 class ToC a where
-    toC :: Place -> a -> String
-
-instance ToC Size where
-    toC _ S8 = "char"
-    toC _ S16 = "short"
-    toC _ S32 = "int"
-    toC _ S64 = "long long"
-
-instance ToC Signedness where
-    toC _ ImpSigned = "signed"
-    toC _ ImpUnsigned = "unsigned"
+    toC :: Platform -> Place -> a -> String
 
 instance ToC Type where
-    toC _ BoolType = "int"
-    toC _ FloatType = "float"
-    toC p (Numeric s t) = listprint id " " [toC p s, toC p t]
+    toC m _ t = case (List.find (\(t',_,_) -> t == t') $ types m) of
+        Just (_,s,_)  -> s
+        Nothing       -> codeGenerationError InternalError $ "Unhandled type in platform " ++ name m
     --arraytype handled in variable
 
 instance ToC (Variable PrettyPrintSemanticInfo) where
-    toC p a@(Variable (VariableData r t n) _) = show_variable r p t n NoRestrict
+    toC m p a@(Variable r t n _) = show_variable m p r t n NoRestrict
 
-show_variable :: VariableRole -> Place -> Type -> String -> IsRestrict -> String
-show_variable r p t n restr = listprint (id) " " [variableType, show_name r p t n ++ arrLn] --concat [addSpace $ variableType, show_name r p t n, arrLn]
+show_variable :: Platform -> Place -> VariableRole -> Type -> String -> IsRestrict -> String
+show_variable m p r t n restr = listprint (id) " " [variableType, show_name r p t n ++ arrLn] --concat [addSpace $ variableType, show_name r p t n, arrLn]
     where
         (variableType,arrLn) = show_type p t restr
         show_type :: Place -> Type -> IsRestrict -> (String,String)
         show_type MainParameter_pl (ImpArrayType s t@(ImpArrayType s2 t2)) restr = decl_matr_type s t2 s2 restr         
         show_type Declaration_pl (ImpArrayType s t) restr = decl_arr_type t s ("","") 
         show_type MainParameter_pl (ImpArrayType s t) restr = decl_arr_type_0 t s restr
-        show_type Declaration_pl t _ = (toC p t,"")
-        show_type MainParameter_pl t _ = (toC p t,"")
+        show_type Declaration_pl t _ = (toC m p t,"")
+        show_type MainParameter_pl t _ = (toC m p t,"")
         show_type _ _ _ = ("","")
         
         decl_arr_type_0 :: Type -> Length -> IsRestrict -> (String,String)
-        decl_arr_type_0 t s Restrict = ((toC Declaration_pl t) ++ " * const restrict",  "") 
-        decl_arr_type_0 t s _        = ((toC Declaration_pl t) ++ " *",  "")
+        decl_arr_type_0 t s Restrict = ((toC m Declaration_pl t) ++ " * const restrict",  "") 
+        decl_arr_type_0 t s _        = ((toC m Declaration_pl t) ++ " *",  "")
         
         decl_matr_type :: Length -> Type -> Length -> IsRestrict -> (String,String)
         decl_matr_type mb t2 s2 Restrict = decl_arr_type t2 s2 (" (* const restrict", ")")       
@@ -110,7 +98,7 @@         
         decl_arr_type :: Type -> Length -> (String,String) -> (String,String)
         decl_arr_type (ImpArrayType s2 t2) mb (st1,st2) = decl_arr_type t2 s2 (st1,st2 ++ (show_brackets mb))
-        decl_arr_type t mb (st1,st2) =  ((toC Declaration_pl t) ++ st1,  st2 ++ show_brackets mb)
+        decl_arr_type t mb (st1,st2) =  ((toC m Declaration_pl t) ++ st1,  st2 ++ show_brackets mb)
         
         show_brackets :: Length -> String
         show_brackets Undefined = codeGenerationError InternalError $ "Unattended unknown array size"
@@ -128,7 +116,8 @@             | place == AddressNeed_pl = "&" ++ n
             | otherwise = n
         show_name FunOut place t n
-            | place == AddressNeed_pl = n
+            | place == AddressNeed_pl && List.last n == ']' = "&" ++ n
+            | place == AddressNeed_pl && List.last n /= ']' = n
             | place == Declaration_pl = codeGenerationError InternalError $ "You can't declare output variable of the function"
             | place == MainParameter_pl = "* " ++ n
             | List.last n == ']' = n
@@ -139,105 +128,120 @@         genIndex _ = ""
 
 instance ToC (Constant PrettyPrintSemanticInfo) where
-    toC _ (IntConstant i) = show (intConstantValue i)
-    toC _ (FloatConstant i) = show (floatConstantValue i) ++ "f"
-    toC _ (BoolConstant (BoolConstantType True _)) = "1"
-    toC _ (BoolConstant (BoolConstantType False _)) = "0"
-    toC p a@(ArrayConstant l) = "{" ++ (toCArray p a) ++ "}"
+    toC m p c = toC m p $ constantData c
 
-toCArray :: Place -> Constant PrettyPrintSemanticInfo -> String
-toCArray p (ArrayConstant l) = listprint (toCArray p) "," (arrayConstantValue l)
-toCArray p i = toC p i
+instance ToC (ConstantData PrettyPrintSemanticInfo) where
+    toC m p a@(ArrayConstant l) = "{" ++ (toCArray m p a) ++ "}"
+    toC m _ c = case (List.find (\(t',_) -> t' == typeof c) $ values m) of
+        Just (_,f) -> f c
+        Nothing    -> case c of
+            (IntConstant i)   -> show (intConstantValue i)
+            (FloatConstant i) -> show (floatConstantValue i) ++ "f"
+            (BoolConstant (BoolConstantType True _))  -> "1"
+            (BoolConstant (BoolConstantType False _)) -> "0"
+            _ -> codeGenerationError InternalError $ "Unhandled constant in platform " ++ name m
 
+toCArray :: Platform -> Place -> ConstantData PrettyPrintSemanticInfo -> String
+toCArray m p (ArrayConstant l) = listprint (toCArray m p) "," (map constantData $ arrayConstantValue l)
+toCArray m p i = toC m p i
+
 instance ToC (LeftValue PrettyPrintSemanticInfo) where
-    toC p (VariableLeftValue (VariableInLeftValue v _)) = toC p v
-    toC p (ArrayElemReferenceLeftValue leftArrayElemReference) = toC p $ insertIndex (arrayName $ arrayElemReferenceData leftArrayElemReference) where
+    toC m p lv = toC m p $ leftValueData lv
+
+instance ToC (LeftValueData PrettyPrintSemanticInfo) where
+    toC m p (VariableLeftValue v) = toC m p v
+    toC m p (ArrayElemReferenceLeftValue leftArrayElemReference) = toC m p $ insertIndex (arrayName leftArrayElemReference) where
         insertIndex :: LeftValue PrettyPrintSemanticInfo -> LeftValue PrettyPrintSemanticInfo
-        insertIndex (VariableLeftValue (VariableInLeftValue variable semInf)) = VariableLeftValue $ VariableInLeftValue 
-            (variable {
-                variableData = (variableData variable) {
-                    variableType = decrArrayDepth (variableType $ variableData variable),
-                    variableName = (concat[variableName $ variableData variable,"[",
-                                           toC ValueNeed_pl (arrayIndex $ arrayElemReferenceData leftArrayElemReference), "]"])
-                }
+        insertIndex (LeftValue (VariableLeftValue variable) semInf) = LeftValue (VariableLeftValue $
+            variable {
+                variableType = decrArrayDepth (variableType variable),
+                variableName = (concat[variableName variable,"[",
+                                       toC m ValueNeed_pl (arrayIndex leftArrayElemReference), "]"])
             }) semInf
-        insertIndex (ArrayElemReferenceLeftValue leftArrayElemReference) =
+        insertIndex (LeftValue (ArrayElemReferenceLeftValue leftArrayElemReference) semInf) = LeftValue (
             ArrayElemReferenceLeftValue $ leftArrayElemReference {
-                arrayElemReferenceData = ArrayElemReferenceData (insertIndex (arrayName $ arrayElemReferenceData leftArrayElemReference))
-                                                                (arrayIndex $ arrayElemReferenceData leftArrayElemReference)
-            }
-            
+                arrayName  = (insertIndex (arrayName leftArrayElemReference)),
+                arrayIndex = (arrayIndex leftArrayElemReference)
+            }) semInf
 instance ToC (ActualParameter PrettyPrintSemanticInfo) where
-    toC p (InputActualParameter (InputActualParameterType e _)) = toC FunctionCallIn_pl e
-    toC p (OutputActualParameter (OutputActualParameterType l _)) = toC AddressNeed_pl l
+    toC m p ap = toC m p $ actualParameterData ap
+              
+instance ToC (ActualParameterData PrettyPrintSemanticInfo) where
+    toC m p (InputActualParameter e) = toC m FunctionCallIn_pl e
+    toC m p (OutputActualParameter l) = toC m AddressNeed_pl l
 
 instance ToC (Expression PrettyPrintSemanticInfo) where
-    toC p (LeftValueExpression (LeftValueInExpression lv _)) = toC p lv
-    toC p (ConstantExpression c) = toC p c
-    toC p (FunctionCallExpression (FunctionCall (FunctionCallData InfixOp _ f [a,b]) _)) = concat["(",toC p a," ",f," ",toC p b,")"]
-    toC p (FunctionCallExpression (FunctionCall (FunctionCallData _ t f x) _)) = concat [f,"(",listprint (toC p) ", " x,")"]
+    toC m p expr = toC m p (expressionData expr)
 
+instance ToC (ExpressionData PrettyPrintSemanticInfo) where
+    toC m p (LeftValueExpression lv) = toC m p lv
+    toC m p (ConstantExpression c) = toC m p c
+    toC m p (FunctionCallExpression (FunctionCall InfixOp _ f [a,b] _)) = concat["(",toC m p a," ",f," ",toC m p b,")"]
+    toC m p (FunctionCallExpression (FunctionCall _ t f x _)) = concat [f,"(",listprint (toC m p) ", " x,")"]
+
 instance ToC (Procedure PrettyPrintSemanticInfo) where
-    toC p (Procedure n il ol pr semInf) = concat ["void ",n,"(",param,")\n{\n",prog,"}\n"]
+    toC m p (Procedure n il ol pr semInf) = concat ["void ",n,"(",param,")\n{\n",prog,"}\n"]
         where
-            param = listprint (toC MainParameter_pl) ", " (il ++ ol)
-            prog = ind (toC Declaration_pl) pr
+            param = listprint (toC m MainParameter_pl) ", " (il ++ ol)
+            prog = ind (toC m Declaration_pl) pr
 
 instance ToC (Block PrettyPrintSemanticInfo) where
-    toC p (Block (BlockData d pr) semInf) = listprint id "\n" [decl,toC p pr]
+    toC m p (Block d pr semInf) = listprint id "\n" [decl,toC m p pr]
         where
-            decl = concat $ map (\a->toC Declaration_pl a ++ ";\n") d
+            decl = concat $ map (\a->toC m Declaration_pl a ++ ";\n") d
 
 instance ToC (FormalParameter PrettyPrintSemanticInfo) where
-    toC p (FormalParameter v restr) = (helper p v restr) 
+    toC m p (FormalParameter v restr) = (helper p v restr) 
         where
             helper :: Place -> Variable PrettyPrintSemanticInfo -> IsRestrict -> String
-            helper MainParameter_pl (Variable (VariableData r t n) _) restr 
-                    = show_variable r MainParameter_pl t n restr 
-            helper _                (Variable (VariableData r t n) _) restr 
-                    = show_variable r Declaration_pl t n restr
+            helper MainParameter_pl (Variable r t n _) restr
+                    = show_variable m MainParameter_pl r t n restr
+            helper _                (Variable r t n _) restr
+                    = show_variable m Declaration_pl r t n restr
 
 instance ToC (LocalDeclaration PrettyPrintSemanticInfo) where
-    toC p (LocalDeclaration (LocalDeclarationData v i) isDefArrSize) = (helper p v i) 
+    toC m p (LocalDeclaration v i isDefArrSize) = (helper p v i)
         where
             helper :: Place -> Variable PrettyPrintSemanticInfo -> (Maybe (Expression PrettyPrintSemanticInfo)) -> String
-            helper MainParameter_pl v i = concat [toC MainParameter_pl v,init i]
-            helper _            v i = concat [toC Declaration_pl v,init i]
+            helper MainParameter_pl v i = concat [toC m MainParameter_pl v,init i]
+            helper _            v i = concat [toC m Declaration_pl v,init i]
             init :: Maybe (Expression PrettyPrintSemanticInfo) -> String
             init Nothing = ""
-            init (Just e) = " = " ++ toC ValueNeed_pl e
+            init (Just e) = " = " ++ toC m ValueNeed_pl e
 
 instance ToC (Instruction PrettyPrintSemanticInfo) where
-    toC p (AssignmentInstruction assignment) =
-        concat [toC ValueNeed_pl (assignmentLhs $ assignmentData assignment)," = ",toC ValueNeed_pl (assignmentRhs $ assignmentData assignment),";\n"]
-    toC p (ProcedureCallInstruction procedureCall) =
-        concat [nameOfProcedureToCall $ procedureCallData procedureCall,"(",
-                listprint (toC p) ", " (actualParametersOfProcedureToCall $ procedureCallData procedureCall),");\n"]
-        -- TODO ProcedureCall.actualParameters procedureCall -----> External helper functions !!!
-        
+    toC m p instruction = toC m p $ instructionData instruction
+
+instance ToC (InstructionData PrettyPrintSemanticInfo) where
+    toC m p (AssignmentInstruction assignment) =
+        concat [toC m ValueNeed_pl (assignmentLhs assignment)," = ",toC m ValueNeed_pl (assignmentRhs assignment),";\n"]
+    toC m p (ProcedureCallInstruction procedureCall) =
+        concat [nameOfProcedureToCall procedureCall,"(",
+                listprint (toC m p) ", " (actualParametersOfProcedureToCall procedureCall),");\n"]
+
 instance ToC (Program PrettyPrintSemanticInfo) where
-    toC p (Program (EmptyProgram (Empty i)) seminf) = ""
-    toC p (Program (PrimitiveProgram (Primitive i seminf)) psi) = toC p i
-    toC p (Program (SequenceProgram (Sequence ps _)) psi) = listprint (toC p) "" ps
-    toC p (Program (BranchProgram (Branch (BranchData con tPrg ePrg) _)) psi)
-        = concat ["if(",toC ValueNeed_pl con,")\n{\n", ind (toC p) tPrg,"}\nelse\n{\n",ind (toC p) ePrg,"}\n"]
-    toC p (Program (SequentialLoopProgram (SequentialLoop (SequentialLoopData condVar condCalc loopBody) _)) psi) = concat["{\n",ind id whereBody,"}\n"] 
+    toC m p (Program (EmptyProgram (Empty i)) seminf) = ""
+    toC m p (Program (PrimitiveProgram (Primitive i seminf)) psi) = toC m p i
+    toC m p (Program (SequenceProgram (Sequence ps _)) psi) = listprint (toC m p) "" ps
+    toC m p (Program (BranchProgram (Branch con tPrg ePrg _)) psi)
+        = concat ["if(",toC m ValueNeed_pl con,")\n{\n", ind (toC m p) tPrg,"}\nelse\n{\n",ind (toC m p) ePrg,"}\n"]
+    toC m p (Program (SequentialLoopProgram (SequentialLoop condVar condCalc loopBody _)) psi) = concat["{\n",ind id whereBody,"}\n"]
         where
-            whereBody = concat [toC p condCalc,"while(",toC ValueNeed_pl condVar,")\n",
-                                "{\n",ind (toC p) loopBody,ind (toC p) (blockInstructions $ blockData condCalc),"}\n"]
-    toC p (Program (ParallelLoopProgram (ParallelLoop (ParallelLoopData v num step prg) _)) psi) = concat ["{\n",ind id for_seq,"}\n"]
+            whereBody = concat [toC m p condCalc,"while(",toC m ValueNeed_pl condVar,")\n",
+                                "{\n",ind (toC m p) loopBody,ind (toC m p) (blockInstructions condCalc),"}\n"]
+    toC m p (Program (ParallelLoopProgram (ParallelLoop v num step prg _)) psi) = concat ["{\n",ind id for_seq,"}\n"]
         where
-            for_seq = concat [toC Declaration_pl v,";\nfor(",for_init,for_test,for_inc,")\n{\n",ind (toC p) prg,"}\n"]
-            for_init = concat [toC ValueNeed_pl v," = 0; "]
-            for_test = concat [toC ValueNeed_pl v," < ",toC ValueNeed_pl num,"; "]
-            for_inc = concat [toC ValueNeed_pl v," += ",show step]
+            for_seq = concat [toC m Declaration_pl v,";\nfor(",for_init,for_test,for_inc,")\n{\n",ind (toC m p) prg,"}\n"]
+            for_init = concat [toC m ValueNeed_pl v," = 0; "]
+            for_test = concat [toC m ValueNeed_pl v," < ",toC m ValueNeed_pl num,"; "]
+            for_inc = concat [toC m ValueNeed_pl v," += ",show step]
 
 instance ToC a => ToC (Maybe a) where
-     toC p Nothing = ""
-     toC p (Just a) = toC p a
+     toC _ p Nothing = ""
+     toC m p (Just a) = toC m p a
 
 instance (ToC a) => ToC [a] where
-    toC p xs = listprint (toC p) "\n" xs
+    toC m p xs = listprint (toC m p) "\n" xs
 
 ----------------------
 --   Type           --
@@ -247,14 +251,20 @@     typeof :: a -> Type
 
 instance (SemanticInfo t) => HasType (Variable t) where
-    typeof (Variable (VariableData r t s) _) = t
+    typeof (Variable r t s _) = t
 
 instance (SemanticInfo t) => HasType (LeftValue t) where
-    typeof (VariableLeftValue (VariableInLeftValue v _)) = typeof v
+    typeof lv = typeof $ leftValueData lv 
+
+instance (SemanticInfo t) => HasType (LeftValueData t) where
+    typeof (VariableLeftValue v) = typeof v
     typeof (ArrayElemReferenceLeftValue arrayElemReference) =
-        decrArrayDepth (typeof (arrayName $ arrayElemReferenceData arrayElemReference))
+        decrArrayDepth (typeof (arrayName arrayElemReference))
 
 instance (SemanticInfo t) => HasType (Constant t) where
+    typeof c = typeof $ constantData c
+
+instance (SemanticInfo t) => HasType (ConstantData t) where
     typeof (IntConstant _) = Numeric ImpSigned S32
     typeof (FloatConstant _) = FloatType
     typeof (BoolConstant _) = BoolType
@@ -271,14 +281,20 @@                 | otherwise = codeGenerationError InternalError $ "Different element types in constant array: " ++ show arr
 
 instance (SemanticInfo t) => HasType (Expression t) where
-    typeof (LeftValueExpression lve) = typeof $ leftValueExpressionContents lve
+    typeof e = typeof $ expressionData e
+
+instance (SemanticInfo t) => HasType (ExpressionData t) where
+    typeof (LeftValueExpression lve) = typeof lve
     typeof (ConstantExpression c) = typeof c
-    typeof (FunctionCallExpression functionCallExpression) = typeOfFunctionToCall $ functionCallData functionCallExpression
+    typeof (FunctionCallExpression functionCallExpression) = typeOfFunctionToCall functionCallExpression
 
 instance (SemanticInfo t) => HasType (ActualParameter t) where
-    typeof (InputActualParameter (InputActualParameterType e _)) = typeof e
-    typeof (OutputActualParameter (OutputActualParameterType l _)) = typeof l
+    typeof ap = typeof $ actualParameterData ap
 
+instance (SemanticInfo t) => HasType (ActualParameterData t) where
+    typeof (InputActualParameter e) = typeof e
+    typeof (OutputActualParameter l) = typeof l
+
 ----------------------
 -- Helper functions --
 ----------------------
@@ -293,9 +309,8 @@     listprint' s (x:y:xs) = x ++ s ++ listprint' s (y:xs)
 
 parameterToExpression :: (SemanticInfo t) => ActualParameter t -> Expression t
-parameterToExpression (InputActualParameter (InputActualParameterType e _)) = e
-parameterToExpression (OutputActualParameter (OutputActualParameterType lv _)) =
-    LeftValueExpression $ LeftValueInExpression lv undefined -- TODO undefined
+parameterToExpression (ActualParameter (InputActualParameter e) _) = e
+parameterToExpression (ActualParameter (OutputActualParameter lv) _) = Expression (LeftValueExpression lv) undefined -- TODO undefined
 
 decrArrayDepth :: Type -> Type
 decrArrayDepth (ImpArrayType _ t) = t
@@ -306,22 +321,21 @@ simpleType (Numeric _ _) = True
 simpleType FloatType = True
 simpleType (ImpArrayType _ _) = False
+simpleType (UserType _) = True
 
 toLeftValue :: (SemanticInfo t) => Expression t -> LeftValue t
-toLeftValue (LeftValueExpression (LeftValueInExpression lv _)) = lv
+toLeftValue (Expression (LeftValueExpression lv) _) = lv
 toLeftValue e = codeGenerationError InternalError $ show e ++ " is not a left value."
 
 contains :: (SemanticInfo t) => String -> Expression t -> Bool
-contains n (LeftValueExpression (LeftValueInExpression lv _)) = contains' n lv where
-    contains' n (VariableLeftValue 
-                    (VariableInLeftValue (Variable (VariableData _ _ n' ) _) _)
-                ) = n == n'
-    contains' n (ArrayElemReferenceLeftValue arrayElemReference) = contains' n (arrayName $ arrayElemReferenceData arrayElemReference) ||
-                                                                   contains n (arrayIndex $ arrayElemReferenceData arrayElemReference)
-contains _ (ConstantExpression _) = False
-contains n (FunctionCallExpression functionCallExpression) =
-    any (contains n) (actualParametersOfFunctionToCall $ functionCallData functionCallExpression)
+contains n (Expression (LeftValueExpression lv) _) = contains' n (leftValueData lv) where
+    contains' n (VariableLeftValue (Variable _ _ n' _) ) = n == n'
+    contains' n (ArrayElemReferenceLeftValue arrayElemReference) = contains' n (leftValueData $ arrayName arrayElemReference) ||
+                                                                contains n (arrayIndex arrayElemReference)
+contains _ (Expression (ConstantExpression _) _) = False
+contains n (Expression (FunctionCallExpression functionCallExpression) _)=
+    any (contains n) (actualParametersOfFunctionToCall functionCallExpression)
 
 getVarName :: (SemanticInfo t) => LeftValue t -> String
-getVarName (VariableLeftValue (VariableInLeftValue ( Variable (VariableData _ _ n) _ ) _ )) = n
-getVarName (ArrayElemReferenceLeftValue arrayElemReference) = getVarName (arrayName $ arrayElemReferenceData arrayElemReference)
+getVarName (LeftValue (VariableLeftValue ( Variable _ _ n _ )) _) = n
+getVarName (LeftValue (ArrayElemReferenceLeftValue arrayElemReference) _) = getVarName (arrayName arrayElemReference)
Feldspar/Compiler/Imperative/Representation.hs view
@@ -1,34 +1,30 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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 #-} @@ -36,259 +32,203 @@  import Feldspar.Compiler.Imperative.Semantics --- ===========================================================================---  == Representation of imperative programs--- ===========================================================================---- ========================= [ Procedure ] ===================================-+-- ====================================================================================================+--   == Representation of imperative programs+-- ==================================================================================================== data (SemanticInfo t) => Procedure t = Procedure {-    procedureName        :: String,-    inParameters         :: [FormalParameter t],-    outParameters        :: [FormalParameter t],-    procedureBody        :: Block t,-    procedureSemInf :: ProcedureInfo t-} deriving (Eq,Show)---- ========================= [ Block ] =======================================+    procedureName                            :: String,+    inParameters                             :: [FormalParameter t],+    outParameters                            :: [FormalParameter t],+    procedureBody                            :: Block t,+    procedureSemInf                          :: ProcedureInfo t+} deriving (Eq, Show)  data (SemanticInfo t) => Block t = Block {-    blockData   :: BlockData t,-    blockSemInf :: BlockInfo t-} deriving (Eq,Show)--data (SemanticInfo t) => BlockData t = BlockData {-    blockDeclarations  :: [LocalDeclaration t],-    blockInstructions  :: Program t-} deriving (Eq,Show)---- ========================= [ Program ] =====================================+    blockDeclarations                        :: [LocalDeclaration t],+    blockInstructions                        :: Program t,+    blockSemInf                              :: BlockInfo t+} deriving (Eq, Show)  data (SemanticInfo t) => Program t = Program {-    programConstruction :: ProgramConstruction t,-    programSemInf       :: ProgramInfo t-} deriving (Eq,Show)+    programConstruction                      :: ProgramConstruction t,+    programSemInf                            :: ProgramInfo t+} deriving (Eq, Show) -data (SemanticInfo t) => ProgramConstruction t =+data (SemanticInfo t) => ProgramConstruction t =        EmptyProgram (Empty t)     | PrimitiveProgram (Primitive t)     | SequenceProgram (Sequence t)     | BranchProgram (Branch t)     | SequentialLoopProgram (SequentialLoop t)     | ParallelLoopProgram (ParallelLoop t)-    deriving (Eq,Show)+    deriving (Eq, Show)  data (SemanticInfo t) => Empty t = Empty {-    emptySemInf :: EmptyInfo t-} deriving (Eq,Show)-    +    emptySemInf                              :: EmptyInfo t+} deriving (Eq, Show)+ data (SemanticInfo t) => Primitive t = Primitive {-    primitiveInstruction :: Instruction t,-    primitiveSemInf :: PrimitiveInfo t-} deriving (Eq,Show)+    primitiveInstruction                     :: Instruction t,+    primitiveSemInf                          :: PrimitiveInfo t+} deriving (Eq, Show)  data (SemanticInfo t) => Sequence t = Sequence {-    sequenceProgramList :: [Program t],-    sequenceSemInf :: SequenceInfo t-} deriving (Eq,Show)+    sequenceProgramList                      :: [Program t],+    sequenceSemInf                           :: SequenceInfo t+} deriving (Eq, Show)  data (SemanticInfo t) => Branch t = Branch {-    branchData   :: BranchData t,-    branchSemInf :: BranchInfo t-} deriving (Eq,Show)--data (SemanticInfo t) => BranchData t = BranchData {-    branchConditionVariable :: Variable t, -- ???-    thenBlock               :: Block t,-    elseBlock               :: Block t+    branchConditionVariable                  :: Variable t,+    thenBlock                                :: Block t,+    elseBlock                                :: Block t,+    branchSemInf                             :: BranchInfo t } deriving (Eq, Show)  data (SemanticInfo t) => SequentialLoop t = SequentialLoop {-    sequentialLoopData   :: SequentialLoopData t,-    sequentialLoopSemInf :: SequentialLoopInfo t-} deriving (Eq,Show)--data (SemanticInfo t) => SequentialLoopData t = SequentialLoopData {-    sequentialLoopCondition         :: Expression t,-    conditionCalculation            :: Block t, -- ???-    sequentialLoopCore              :: Block t+    sequentialLoopCondition                  :: Expression t,+    conditionCalculation                     :: Block t,+    sequentialLoopCore                       :: Block t,+    sequentialLoopSemInf                     :: SequentialLoopInfo t } deriving (Eq, Show)  data (SemanticInfo t) => ParallelLoop t = ParallelLoop {-    parallelLoopData   :: ParallelLoopData t,-    parallelLoopSemInf :: ParallelLoopInfo t-} deriving (Eq,Show)--data (SemanticInfo t) => ParallelLoopData t = ParallelLoopData {-    parallelLoopConditionVariable :: Variable t,-    numberOfIterations            :: Expression t, -- ???-    parallelLoopStep              :: Int, -- ???-    parallelLoopCore              :: Block t+    parallelLoopConditionVariable            :: Variable t,+    numberOfIterations                       :: Expression t,+    parallelLoopStep                         :: Int,+    parallelLoopCore                         :: Block t,+    parallelLoopSemInf                       :: ParallelLoopInfo t } deriving (Eq, Show) --- ========================= [ FormalParameter ] =============================- data (SemanticInfo t) => FormalParameter t = FormalParameter {-    formalParameterVariable :: Variable t,-    formalParameterSemInf   :: FormalParameterInfo t-} deriving (Eq,Show)---- ========================= [ LocalDeclaration ] ============================+    formalParameterVariable                  :: Variable t,+    formalParameterSemInf                    :: FormalParameterInfo t+} deriving (Eq, Show)  data (SemanticInfo t) => LocalDeclaration t = LocalDeclaration {-    localDeclarationData   :: LocalDeclarationData t,-    localDeclarationSemInf :: LocalDeclarationInfo t-} deriving (Eq,Show)--data (SemanticInfo t) => LocalDeclarationData t = LocalDeclarationData {-    localVariable          :: Variable t,-    localInitValue         :: Maybe (Expression t)-} deriving (Eq,Show)+    localVariable                            :: Variable t,+    localInitValue                           :: Maybe (Expression t),+    localDeclarationSemInf                   :: LocalDeclarationInfo t+} deriving (Eq, Show) --- ========================= [ Expression ] ==================================+data (SemanticInfo t) => Expression t = Expression {+    expressionData                           :: ExpressionData t,+    expressionSemInf                         :: ExpressionInfo t+} deriving (Eq, Show) -data (SemanticInfo t) => Expression t =-      LeftValueExpression (LeftValueInExpression t)+data (SemanticInfo t) => ExpressionData t = +      LeftValueExpression (LeftValue t)     | ConstantExpression (Constant t)     | FunctionCallExpression (FunctionCall t)     deriving (Eq, Show) -data (SemanticInfo t) => LeftValueInExpression t = LeftValueInExpression {-    leftValueExpressionContents :: LeftValue t,-    leftValueExpressionSemInf   :: LeftValueExpressionInfo t+data (SemanticInfo t) => Constant t = Constant {+    constantData                             :: ConstantData t,+    constantSemInf                           :: ConstantInfo t } deriving (Eq, Show)  data (SemanticInfo t) => FunctionCall t = FunctionCall {-    functionCallData   :: FunctionCallData t,-    functionCallSemInf :: FunctionCallInfo t +    roleOfFunctionToCall                     :: FunctionRole,+    typeOfFunctionToCall                     :: Type,+    nameOfFunctionToCall                     :: String,+    actualParametersOfFunctionToCall         :: [Expression t],+    functionCallSemInf                       :: FunctionCallInfo t } deriving (Eq, Show) -data (SemanticInfo t) => FunctionCallData t = FunctionCallData { -    roleOfFunctionToCall             :: FunctionRole,-    typeOfFunctionToCall             :: Type,-    nameOfFunctionToCall             :: String,-    actualParametersOfFunctionToCall :: [Expression t] -} deriving (Eq,Show)---- ========================= [ LeftValue ] ===================================+data (SemanticInfo t) => LeftValue t = LeftValue {+    leftValueData                            :: LeftValueData t,+    leftValueSemInf                          :: LeftValueInfo t+} deriving (Eq, Show) -data (SemanticInfo t) => LeftValue t =-      VariableLeftValue (VariableInLeftValue t)+data (SemanticInfo t) => LeftValueData t = +      VariableLeftValue (Variable t)     | ArrayElemReferenceLeftValue (ArrayElemReference t)-    deriving (Eq,Show)--data (SemanticInfo t) => VariableInLeftValue t = VariableInLeftValue {-    variableLeftValueContents :: Variable t,-    variableLeftValueSemInf :: VariableInLeftValueInfo t-} deriving (Eq,Show)+    deriving (Eq, Show)  data (SemanticInfo t) => ArrayElemReference t = ArrayElemReference {-    arrayElemReferenceData   :: ArrayElemReferenceData t,-    arrayElemReferenceSemInf :: ArrayElemReferenceInfo t -} deriving (Eq,Show)--data (SemanticInfo t) => ArrayElemReferenceData t = ArrayElemReferenceData {-    arrayName  :: LeftValue t,-    arrayIndex :: Expression t-} deriving (Eq,Show)+    arrayName                                :: LeftValue t,+    arrayIndex                               :: Expression t,+    arrayElemReferenceSemInf                 :: ArrayElemReferenceInfo t+} deriving (Eq, Show) --- ========================= [ Instruction ] =================================+data (SemanticInfo t) => Instruction t = Instruction {+    instructionData                          :: InstructionData t,+    instructionSemInf                        :: InstructionInfo t+} deriving (Eq, Show) -data (SemanticInfo t) => Instruction t =+data (SemanticInfo t) => InstructionData t =        AssignmentInstruction (Assignment t)     | ProcedureCallInstruction (ProcedureCall t)-    deriving (Eq,Show)+    deriving (Eq, Show)  data (SemanticInfo t) => Assignment t = Assignment {-    assignmentData   :: AssignmentData t,-    assignmentSemInf :: AssignmentInfo t-} deriving (Eq,Show)--data (SemanticInfo t) => AssignmentData t = AssignmentData {-    assignmentLhs :: LeftValue t,-    assignmentRhs :: Expression t-} deriving (Eq,Show)+    assignmentLhs                            :: LeftValue t,+    assignmentRhs                            :: Expression t,+    assignmentSemInf                         :: AssignmentInfo t+} deriving (Eq, Show)  data (SemanticInfo t) => ProcedureCall t = ProcedureCall {-    procedureCallData   :: ProcedureCallData t,-    procedureCallSemInf :: ProcedureCallInfo t-} deriving (Eq,Show)--data (SemanticInfo t) => ProcedureCallData t = ProcedureCallData {-    nameOfProcedureToCall             :: String,-    actualParametersOfProcedureToCall :: [ActualParameter t]-} deriving (Eq,Show)---- ========================= [ ActualParameter ] =============================--data (SemanticInfo t) => ActualParameter t =-      InputActualParameter (InputActualParameterType t)-    | OutputActualParameter (OutputActualParameterType t)-    deriving (Eq,Show)+    nameOfProcedureToCall                    :: String,+    actualParametersOfProcedureToCall        :: [ActualParameter t],+    procedureCallSemInf                      :: ProcedureCallInfo t+} deriving (Eq, Show) -data (SemanticInfo t) => InputActualParameterType t = InputActualParameterType {-    inputActualParameterExpression :: Expression t,-    inputActualParameterSemInf :: InputActualParameterInfo t-} deriving (Eq,Show)+data (SemanticInfo t) => ActualParameter t = ActualParameter {+    actualParameterData                      :: ActualParameterData t,+    actualParameterSemInf                    :: ActualParameterInfo t+} deriving (Eq, Show) -data (SemanticInfo t) => OutputActualParameterType t = OutputActualParameterType {-    outputActualParameterLeftValue :: LeftValue t,-    outputActualParameterSemInf :: OutputActualParameterInfo t-} deriving (Eq,Show)+data (SemanticInfo t) => ActualParameterData t = +      InputActualParameter (Expression t)+    | OutputActualParameter (LeftValue t)+    deriving (Eq, Show) --- ========================= [ Constant ] ====================================+data (SemanticInfo t) => ConstantData t = +      IntConstant (IntConstantType t)+    | FloatConstant (FloatConstantType t)+    | BoolConstant (BoolConstantType t)+    | ArrayConstant (ArrayConstantType t)+    deriving (Eq, Show) -data Constant t = IntConstant (IntConstantType t)-                | FloatConstant (FloatConstantType t)-                | BoolConstant (BoolConstantType t)-                | ArrayConstant (ArrayConstantType t)-    deriving (Eq,Show)-     data (SemanticInfo t) => IntConstantType t = IntConstantType {-    intConstantValue  :: Int,-    intConstantSemInf :: IntConstantInfo t+    intConstantValue                         :: Int,+    intConstantSemInf                        :: IntConstantInfo t } deriving (Eq, Show)  data (SemanticInfo t) => FloatConstantType t = FloatConstantType {-    floatConstantValue  :: Float,-    floatConstantSemInf :: FloatConstantInfo t+    floatConstantValue                       :: Float,+    floatConstantSemInf                      :: FloatConstantInfo t } deriving (Eq, Show)  data (SemanticInfo t) => BoolConstantType t = BoolConstantType {-    boolConstantValue  :: Bool,-    boolConstantSemInf :: BoolConstantInfo t+    boolConstantValue                        :: Bool,+    boolConstantSemInf                       :: BoolConstantInfo t } deriving (Eq, Show)  data (SemanticInfo t) => ArrayConstantType t = ArrayConstantType {-    arrayConstantValue :: [Constant t],-    arrayConstantSemInf :: ArrayConstantInfo t+    arrayConstantValue                       :: [Constant t],+    arrayConstantSemInf                      :: ArrayConstantInfo t } deriving (Eq, Show) --- ========================= [ Variable ] ====================================- data (SemanticInfo t) => Variable t = Variable {-    variableData   :: VariableData,-    variableSemInf :: VariableInfo t-} deriving (Eq,Show)+    variableRole                             :: VariableRole,+    variableType                             :: Type,+    variableName                             :: String,+    variableSemInf                           :: VariableInfo t+} deriving (Eq, Show) -data VariableData = VariableData {-    variableRole   :: VariableRole,-    variableType   :: Type,-    variableName   :: String-} deriving (Eq,Show)  -- ========================= [ Basic structures ] ============================  data Length = Norm Int | Defined Int | Undefined       deriving (Eq,Show) -data Size = S8 | S16 | S32 | S64+data Size = S8 | S16 | S32 | S40 | S64     deriving (Eq,Show)  data Signedness = ImpSigned | ImpUnsigned     deriving (Eq,Show) -data Type = BoolType | FloatType | Numeric Signedness Size | ImpArrayType Length Type+data Type = BoolType | FloatType | Numeric Signedness Size | ImpArrayType Length Type | UserType String     deriving (Eq,Show)      data FunctionRole = SimpleFun | InfixOp | PrefixOp
Feldspar/Compiler/Imperative/Semantics.hs view
@@ -1,73 +1,73 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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, EmptyDataDecls, FlexibleContexts #-} module Feldspar.Compiler.Imperative.Semantics where --- ===========================================================================---  == Semantic info class--- ===========================================================================+data InitSemInf+data PrettyPrintSemanticInfo -class (Show (ProcedureInfo t),-       Show (BlockInfo t),-       Show (ProgramInfo t),-       Show (EmptyInfo t), Show (PrimitiveInfo t), Show (SequenceInfo t), Show (BranchInfo t), Show (SequentialLoopInfo t), Show (ParallelLoopInfo t),-       Show (FormalParameterInfo t),-       Show (LocalDeclarationInfo t),-       Show (FunctionCallInfo t),-       Show (LeftValueExpressionInfo t), -       Show (VariableInLeftValueInfo t),-       Show (ArrayElemReferenceInfo t),-       Show (InputActualParameterInfo t), Show (OutputActualParameterInfo t),-       Show (AssignmentInfo t),-       Show (ProcedureCallInfo t),-       Show (IntConstantInfo t), Show (FloatConstantInfo t), Show (BoolConstantInfo t), Show (ArrayConstantInfo t),-       Show (VariableInfo     t),-       Eq (ProcedureInfo t),-       Eq (BlockInfo t),-       Eq (ProgramInfo t),-       Eq (EmptyInfo t), Eq (PrimitiveInfo t), Eq (SequenceInfo t), Eq (BranchInfo t), Eq (SequentialLoopInfo t), Eq (ParallelLoopInfo t),-       Eq (FormalParameterInfo t),-       Eq (LocalDeclarationInfo t),-       Eq (FunctionCallInfo t),-       Eq (LeftValueExpressionInfo t),-       Eq (VariableInLeftValueInfo t),-       Eq (ArrayElemReferenceInfo t),-       Eq (InputActualParameterInfo t), Eq (OutputActualParameterInfo t),-       Eq (AssignmentInfo t),-       Eq (ProcedureCallInfo t),-       Eq (IntConstantInfo t), Eq (FloatConstantInfo t), Eq (BoolConstantInfo t), Eq (ArrayConstantInfo t),-       Eq (VariableInfo     t))-            => SemanticInfo t where+data IsRestrict = Restrict | NoRestrict+    deriving (Show,Eq)++data IsDefaultArraySize = DefaultArraySize | NoDefaultArraySize+    deriving (Show,Eq)++-- ====================================================================================================+--   == Semantic info class+-- ====================================================================================================+class (+    Show(ProcedureInfo t),                   Eq(ProcedureInfo t),+    Show(BlockInfo t),                       Eq(BlockInfo t),+    Show(ProgramInfo t),                     Eq(ProgramInfo t),+    Show(EmptyInfo t),                       Eq(EmptyInfo t),+    Show(PrimitiveInfo t),                   Eq(PrimitiveInfo t),+    Show(SequenceInfo t),                    Eq(SequenceInfo t),+    Show(BranchInfo t),                      Eq(BranchInfo t),+    Show(SequentialLoopInfo t),              Eq(SequentialLoopInfo t),+    Show(ParallelLoopInfo t),                Eq(ParallelLoopInfo t),+    Show(FormalParameterInfo t),             Eq(FormalParameterInfo t),+    Show(LocalDeclarationInfo t),            Eq(LocalDeclarationInfo t),+    Show(ExpressionInfo t),                  Eq(ExpressionInfo t),+    Show(ConstantInfo t),                    Eq(ConstantInfo t),+    Show(FunctionCallInfo t),                Eq(FunctionCallInfo t),+    Show(LeftValueInfo t),                   Eq(LeftValueInfo t),+    Show(ArrayElemReferenceInfo t),          Eq(ArrayElemReferenceInfo t),+    Show(InstructionInfo t),                 Eq(InstructionInfo t),+    Show(AssignmentInfo t),                  Eq(AssignmentInfo t),+    Show(ProcedureCallInfo t),               Eq(ProcedureCallInfo t),+    Show(ActualParameterInfo t),             Eq(ActualParameterInfo t),+    Show(IntConstantInfo t),                 Eq(IntConstantInfo t),+    Show(FloatConstantInfo t),               Eq(FloatConstantInfo t),+    Show(BoolConstantInfo t),                Eq(BoolConstantInfo t),+    Show(ArrayConstantInfo t),               Eq(ArrayConstantInfo t),+    Show(VariableInfo t),                    Eq(VariableInfo t)+        ) => SemanticInfo t where     type ProcedureInfo t     type BlockInfo t     type ProgramInfo t@@ -79,117 +79,99 @@     type ParallelLoopInfo t     type FormalParameterInfo t     type LocalDeclarationInfo t-    type LeftValueExpressionInfo t-    type VariableInLeftValueInfo t+    type ExpressionInfo t+    type ConstantInfo t+    type FunctionCallInfo t+    type LeftValueInfo t     type ArrayElemReferenceInfo t-    type InputActualParameterInfo t-    type OutputActualParameterInfo t+    type InstructionInfo t     type AssignmentInfo t     type ProcedureCallInfo t-    type FunctionCallInfo t+    type ActualParameterInfo t     type IntConstantInfo t     type FloatConstantInfo t     type BoolConstantInfo t     type ArrayConstantInfo t     type VariableInfo t---- ===========================================================================---  == Unit semantic info instance--- ===========================================================================-+     instance SemanticInfo () where-    type ProcedureInfo () = ()-    type BlockInfo () = ()-    type ProgramInfo () = ()-    type EmptyInfo () = ()-    type PrimitiveInfo () = ()-    type SequenceInfo () = ()-    type BranchInfo () = ()-    type SequentialLoopInfo () = ()-    type ParallelLoopInfo () = ()-    type FormalParameterInfo () = ()-    type LocalDeclarationInfo () = ()-    type LeftValueExpressionInfo () = ()-    type VariableInLeftValueInfo () = ()-    type ArrayElemReferenceInfo () = ()-    type InputActualParameterInfo () = ()-    type OutputActualParameterInfo () = ()-    type AssignmentInfo () = ()-    type ProcedureCallInfo () = ()-    type FunctionCallInfo () = ()-    type IntConstantInfo () = ()-    type FloatConstantInfo () = ()-    type BoolConstantInfo () = ()-    type ArrayConstantInfo () = ()-    type VariableInfo () = ()---- ===========================================================================---  == Basic semantic info instance--- ===========================================================================--data InitSemInf+    type ProcedureInfo             () = ()+    type BlockInfo                 () = ()+    type ProgramInfo               () = ()+    type EmptyInfo                 () = ()+    type PrimitiveInfo             () = ()+    type SequenceInfo              () = ()+    type BranchInfo                () = ()+    type SequentialLoopInfo        () = ()+    type ParallelLoopInfo          () = ()+    type FormalParameterInfo       () = ()+    type LocalDeclarationInfo      () = ()+    type ExpressionInfo            () = ()+    type ConstantInfo              () = ()+    type FunctionCallInfo          () = ()+    type LeftValueInfo             () = ()+    type ArrayElemReferenceInfo    () = ()+    type InstructionInfo           () = ()+    type AssignmentInfo            () = ()+    type ProcedureCallInfo         () = ()+    type ActualParameterInfo       () = ()+    type IntConstantInfo           () = ()+    type FloatConstantInfo         () = ()+    type BoolConstantInfo          () = ()+    type ArrayConstantInfo         () = ()+    type VariableInfo              () = ()  instance SemanticInfo InitSemInf where-    type ProcedureInfo InitSemInf = ()-    type BlockInfo InitSemInf = ()-    type ProgramInfo InitSemInf = ()-    type EmptyInfo InitSemInf = ()-    type PrimitiveInfo InitSemInf = Bool-    type SequenceInfo InitSemInf = ()-    type BranchInfo InitSemInf = ()-    type SequentialLoopInfo InitSemInf = ()-    type ParallelLoopInfo InitSemInf = ()-    type FormalParameterInfo InitSemInf = ()-    type LocalDeclarationInfo InitSemInf = ()-    type LeftValueExpressionInfo InitSemInf = ()-    type VariableInLeftValueInfo InitSemInf = ()-    type ArrayElemReferenceInfo InitSemInf = ()-    type InputActualParameterInfo InitSemInf = ()-    type OutputActualParameterInfo InitSemInf = ()-    type AssignmentInfo InitSemInf = ()-    type ProcedureCallInfo InitSemInf = ()-    type FunctionCallInfo InitSemInf = ()-    type IntConstantInfo InitSemInf = ()-    type FloatConstantInfo InitSemInf = ()-    type BoolConstantInfo InitSemInf = ()-    type ArrayConstantInfo InitSemInf = ()-    type VariableInfo InitSemInf = ()---- ===========================================================================---  == PrettyPrint semantic info instance--- ===========================================================================---data IsRestrict = Restrict | NoRestrict-    deriving (Show,Eq)--data IsDefaultArraySize = DefaultArraySize | NoDefaultArraySize-    deriving (Show,Eq)--data PrettyPrintSemanticInfo+    type ProcedureInfo             InitSemInf = ()+    type BlockInfo                 InitSemInf = ()+    type ProgramInfo               InitSemInf = ()+    type EmptyInfo                 InitSemInf = ()+    type PrimitiveInfo             InitSemInf = Bool+    type SequenceInfo              InitSemInf = ()+    type BranchInfo                InitSemInf = ()+    type SequentialLoopInfo        InitSemInf = ()+    type ParallelLoopInfo          InitSemInf = ()+    type FormalParameterInfo       InitSemInf = ()+    type LocalDeclarationInfo      InitSemInf = ()+    type ExpressionInfo            InitSemInf = ()+    type ConstantInfo              InitSemInf = ()+    type FunctionCallInfo          InitSemInf = ()+    type LeftValueInfo             InitSemInf = ()+    type ArrayElemReferenceInfo    InitSemInf = ()+    type InstructionInfo           InitSemInf = ()+    type AssignmentInfo            InitSemInf = ()+    type ProcedureCallInfo         InitSemInf = ()+    type ActualParameterInfo       InitSemInf = ()+    type IntConstantInfo           InitSemInf = ()+    type FloatConstantInfo         InitSemInf = ()+    type BoolConstantInfo          InitSemInf = ()+    type ArrayConstantInfo         InitSemInf = ()+    type VariableInfo              InitSemInf = ()  instance SemanticInfo PrettyPrintSemanticInfo where-    type ProcedureInfo PrettyPrintSemanticInfo = ()-    type BlockInfo PrettyPrintSemanticInfo = ()-    type ProgramInfo PrettyPrintSemanticInfo = ()-    type EmptyInfo PrettyPrintSemanticInfo = ()-    type PrimitiveInfo PrettyPrintSemanticInfo = ()-    type SequenceInfo PrettyPrintSemanticInfo = ()-    type BranchInfo PrettyPrintSemanticInfo = ()-    type SequentialLoopInfo PrettyPrintSemanticInfo = ()-    type ParallelLoopInfo PrettyPrintSemanticInfo = ()-    type FormalParameterInfo PrettyPrintSemanticInfo = IsRestrict-    type LocalDeclarationInfo PrettyPrintSemanticInfo = ()-    type LeftValueExpressionInfo PrettyPrintSemanticInfo = ()-    type VariableInLeftValueInfo PrettyPrintSemanticInfo = ()-    type ArrayElemReferenceInfo PrettyPrintSemanticInfo = ()-    type InputActualParameterInfo PrettyPrintSemanticInfo = ()-    type OutputActualParameterInfo PrettyPrintSemanticInfo = ()-    type AssignmentInfo PrettyPrintSemanticInfo = ()-    type ProcedureCallInfo PrettyPrintSemanticInfo = ()-    type FunctionCallInfo PrettyPrintSemanticInfo = ()-    type IntConstantInfo PrettyPrintSemanticInfo = ()-    type FloatConstantInfo PrettyPrintSemanticInfo = ()-    type BoolConstantInfo PrettyPrintSemanticInfo = ()-    type ArrayConstantInfo PrettyPrintSemanticInfo = ()-    type VariableInfo PrettyPrintSemanticInfo = ()+    type ProcedureInfo             PrettyPrintSemanticInfo = ()+    type BlockInfo                 PrettyPrintSemanticInfo = ()+    type ProgramInfo               PrettyPrintSemanticInfo = ()+    type EmptyInfo                 PrettyPrintSemanticInfo = ()+    type PrimitiveInfo             PrettyPrintSemanticInfo = ()+    type SequenceInfo              PrettyPrintSemanticInfo = ()+    type BranchInfo                PrettyPrintSemanticInfo = ()+    type SequentialLoopInfo        PrettyPrintSemanticInfo = ()+    type ParallelLoopInfo          PrettyPrintSemanticInfo = ()+    type FormalParameterInfo       PrettyPrintSemanticInfo = IsRestrict+    type LocalDeclarationInfo      PrettyPrintSemanticInfo = ()+    type ExpressionInfo            PrettyPrintSemanticInfo = ()+    type ConstantInfo              PrettyPrintSemanticInfo = ()+    type FunctionCallInfo          PrettyPrintSemanticInfo = ()+    type LeftValueInfo             PrettyPrintSemanticInfo = ()+    type ArrayElemReferenceInfo    PrettyPrintSemanticInfo = ()+    type InstructionInfo           PrettyPrintSemanticInfo = ()+    type AssignmentInfo            PrettyPrintSemanticInfo = ()+    type ProcedureCallInfo         PrettyPrintSemanticInfo = ()+    type ActualParameterInfo       PrettyPrintSemanticInfo = ()+    type IntConstantInfo           PrettyPrintSemanticInfo = ()+    type FloatConstantInfo         PrettyPrintSemanticInfo = ()+    type BoolConstantInfo          PrettyPrintSemanticInfo = ()+    type ArrayConstantInfo         PrettyPrintSemanticInfo = ()+    type VariableInfo              PrettyPrintSemanticInfo = ()+
Feldspar/Compiler/Options.hs view
@@ -1,46 +1,141 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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.Options where ++import Feldspar.Compiler.Imperative.Representation+import Feldspar.Compiler.Imperative.Semantics(IsRestrict, PrettyPrintSemanticInfo)+++ data Options =     Options     { platform          :: Platform     , unroll            :: UnrollStrategy     , debug             :: DebugOption     , defaultArraySize  :: Int-    }+    } deriving (Eq, Show) -data Platform = AnsiC | C99 + data UnrollStrategy = NoUnroll | Unroll Int+    deriving (Eq, Show)++ data DebugOption = NoDebug | NoSimplification | NoPrimitiveInstructionHandling-    deriving Eq+    deriving (Eq, Show)++++data Platform = Platform {+    name        :: String,+    types       :: [(Type, String, String)],+    values      :: [(Type, ShowValue)],+    primitives  :: [(FeldPrimDesc, Either CPrimDesc TransformPrim)],+    includes    :: [String],+    isRestrict  :: IsRestrict+} deriving (Eq, Show)+++data FeldPrimDesc = FeldPrimDesc {+    fName   :: String,+    inputs  :: [TypeDesc]+} deriving (Eq, Show)+++data CPrimDesc = Op1 {+    cOp         :: String+} | Op2 {+    cOp         :: String+} | Fun {+    cName       :: String,+    funPf       :: FunPostfixDescr+} | Proc {+    cName       :: String,+    funPf       :: FunPostfixDescr+} | Assig+  | InvalidDesc+  deriving (Eq, Show)+++data TypeDesc+    = AllT+    | BoolT+    | FloatT+    | IntT | IntTS | IntTU | IntTS_ Size | IntTU_ Size | IntT_ Size+    | UserT String+  deriving (Eq, Show)+++data FunPostfixDescr = FunPostfixDescr {+    useInputs   :: Int,+    useOutputs  :: Int+} deriving (Eq, Show)++noneFP      = FunPostfixDescr 0 0+firstInFP   = FunPostfixDescr 1 0+firstOutFP  = FunPostfixDescr 0 1+++type ShowValue = (ConstantData PrettyPrintSemanticInfo -> String)++instance Eq ShowValue where+    (==) _ _ = True++instance Show ShowValue where+    show _ = "<<ShowValue>>"+++type TransformPrim+    = FeldPrimDesc+    -> [Expression ()]+    -> [LeftValue ()]+    -> [(CPrimDesc, [Expression ()], [LeftValue ()])]++instance Eq TransformPrim where+    (==) _ _ = True++instance Show TransformPrim where+    show _ = "<<TransformPrim>>"++++machTypes :: TypeDesc -> Type -> Bool+machTypes AllT _                    = True+machTypes BoolT BoolType            = True+machTypes FloatT FloatType          = True+machTypes IntT (Numeric _ _)        = True+machTypes IntTS (Numeric ImpSigned _)         = True+machTypes IntTU (Numeric ImpUnsigned _)       = True+machTypes (IntTS_ s) (Numeric ImpSigned s')   = s == s'+machTypes (IntTU_ s) (Numeric ImpUnsigned s') = s == s'+machTypes (IntT_ s) (Numeric _ s')  = s == s'+machTypes (UserT s) (UserType s')   = s == s'+machTypes _ _                       = False++
+ Feldspar/Compiler/Platforms.hs view
@@ -0,0 +1,223 @@+--+-- Copyright (c) 2009-2010, 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.Platforms+    ( availablePlatforms+    , c99+    , tic64x+    ) where+++import Feldspar.Compiler.Options+import Feldspar.Compiler.Imperative.Representation+import Feldspar.Compiler.Imperative.Semantics(IsRestrict(..))+import Feldspar.Compiler.Imperative.CodeGeneration (typeof)++++availablePlatforms :: [Platform]+availablePlatforms = [ c99, tic64x ]+++-- ansiC = Platform "ansiC" undefined [] [] ["\"feldspar.h\""] NoRestrict+++c99 = Platform {+    name = "c99",+    types =+        [ (Numeric ImpSigned S8,    "int8_t",   "int8")+        , (Numeric ImpSigned S16,   "int16_t",  "int16")+        , (Numeric ImpSigned S32,   "int32_t",  "int32")+        , (Numeric ImpSigned S64,   "int64_t",  "int64")+        , (Numeric ImpUnsigned S8,  "uint8_t",  "uint8")+        , (Numeric ImpUnsigned S16, "uint16_t", "uint16")+        , (Numeric ImpUnsigned S32, "uint32_t", "uint32")+        , (Numeric ImpUnsigned S64, "uint64_t", "uint64")+        , (BoolType,  "int",    "int")+        , (FloatType, "float",  "float")+        ] ,+    values = [] ,+    primitives =+        [ (FeldPrimDesc "(==)" [AllT, AllT],    Left $ Op2 "==")+        , (FeldPrimDesc "(/=)" [AllT, AllT],    Left $ Op2 "!=")+        , (FeldPrimDesc "(<)" [AllT, AllT],     Left $ Op2 "<")+        , (FeldPrimDesc "(>)" [AllT, AllT],     Left $ Op2 ">")+        , (FeldPrimDesc "(<=)" [AllT, AllT],    Left $ Op2 "<=")+        , (FeldPrimDesc "(>=)" [AllT, AllT],    Left $ Op2 ">=")+        , (FeldPrimDesc "not" [BoolT],          Left $ Op1 "!")+        , (FeldPrimDesc "(&&)" [BoolT, BoolT],  Left $ Op2 "&&")+        , (FeldPrimDesc "(||)" [BoolT, BoolT],  Left $ Op2 "||")+        +        , (FeldPrimDesc "quot" [AllT, AllT],    Right optimizedDivide)+        , (FeldPrimDesc "rem" [AllT, AllT],     Left $ Op2 "%")+        , (FeldPrimDesc "(^)" [AllT, AllT],     Left $ Fun "pow" firstInFP)+        , (FeldPrimDesc "negate" [AllT],        Left $ Op1 "-")+        , (FeldPrimDesc "abs" [IntTU],          Left Assig)+        , (FeldPrimDesc "abs" [FloatT],         Left $ Fun "fabsf" noneFP)+        , (FeldPrimDesc "abs" [AllT],           Left $ Fun "abs" firstInFP)+        , (FeldPrimDesc "signum" [AllT],        Left $ Fun "signum" firstInFP)+        , (FeldPrimDesc "(+)" [AllT, AllT],     Left $ Op2 "+")+        , (FeldPrimDesc "(-)" [AllT, AllT],     Left $ Op2 "-")+        , (FeldPrimDesc "(*)" [AllT, AllT],     Right optimizedMultiply)+        , (FeldPrimDesc "(/)" [AllT, AllT],     Left $ Op2 "/")+        +        , (FeldPrimDesc "(.&.)" [IntT, IntT],   Left $ Op2 "&")+        , (FeldPrimDesc "(.|.)" [IntT, IntT],   Left $ Op2 "|")+        , (FeldPrimDesc "xor" [IntT, IntT],     Left $ Op2 "^")+        , (FeldPrimDesc "complement" [IntT],    Left $ Op1 "~")+        , (FeldPrimDesc "bit" [IntT],           Right bitFunToShift)+        , (FeldPrimDesc "setBit" [IntT, IntT],  Left $ Fun "setBit" firstInFP)+        , (FeldPrimDesc "clearBit" [IntT, IntT],      Left $ Fun "clearBit" firstInFP)+        , (FeldPrimDesc "complementBit" [IntT, IntT], Left $ Fun "complementBit" firstInFP)+        , (FeldPrimDesc "testBit" [IntT, IntT], Left $ Fun "testBit" firstInFP)+        , (FeldPrimDesc "shiftL" [IntT, IntT],  Left $ Op2 "<<")+        , (FeldPrimDesc "shiftR" [IntT, IntT],  Left $ Op2 ">>")+        , (FeldPrimDesc "rotateL" [IntT, IntT], Left $ Fun "rotateL" firstInFP)+        , (FeldPrimDesc "rotateR" [IntT, IntT], Left $ Fun "rotateR" firstInFP)+        , (FeldPrimDesc "reverseBits" [IntT],   Left $ Fun "reverseBits" firstInFP)+        , (FeldPrimDesc "bitScan" [IntT],       Left $ Fun "bitScan" firstInFP)+        , (FeldPrimDesc "bitCount" [IntT],      Left $ Fun "bitCount" firstInFP)+        , (FeldPrimDesc "bitSize" [IntT],       Right bitSizeFunToConst)+        , (FeldPrimDesc "isSigned" [IntT],      Right isSignedFunToConst)+        ] ,+    includes = ["\"feldspar_c99.h\"", "<stdint.h>", "<math.h>"],+    isRestrict = NoRestrict+}+++tic64x = Platform {+    name = "tic64x",+    types =+        [ (Numeric ImpSigned S8,    "char",     "char")+        , (Numeric ImpSigned S16,   "short",    "short")+        , (Numeric ImpSigned S32,   "int",      "int")+        , (Numeric ImpSigned S40,   "long",     "long")+        , (Numeric ImpSigned S64,   "long long","llong")+        , (Numeric ImpUnsigned S8,  "unsigned char",  "uchar")+        , (Numeric ImpUnsigned S16, "unsigned short", "ushort")+        , (Numeric ImpUnsigned S32, "unsigned",       "uint")+        , (Numeric ImpUnsigned S40, "unsigned long",  "ulong")+        , (Numeric ImpUnsigned S64, "unsigned long long", "ullong")+        , (BoolType,  "int",    "int")+        , (FloatType, "float",  "float")+        ] ,+    values = [] ,+    primitives =+        [ (FeldPrimDesc "abs" [IntTS_ S32],           Left $ Fun "_abs" noneFP)+        , (FeldPrimDesc "abs" [FloatT],               Left $ Fun "_fabsf" noneFP)+        , (FeldPrimDesc "rotateL" [IntTU_ S32, IntT], Left $ Fun "_rotl" noneFP)+        , (FeldPrimDesc "reverseBits" [IntTU_ S32],   Left $ Fun "_bitr" noneFP)+        , (FeldPrimDesc "bitCount" [IntTU_ S32],      Right optimizedBitCount)+        ]+        ++ primitives c99,+    includes = ["\"feldspar_tic64x.h\"", "<c6x.h>"],+    isRestrict = Restrict+}+++optimizedMultiply :: TransformPrim+optimizedMultiply _ [x, y] [o] = case (x,y) of+    (_, (Expression (ConstantExpression (Constant (IntConstant _) _)) _)) -> optimizedMultiply' x y+    ((Expression (ConstantExpression (Constant (IntConstant _) _)) _), _) -> optimizedMultiply' y x+    (_, _) -> [(Op2 "*", [x, y], [o])]+  where+    optimizedMultiply' int con+        | (machTypes IntT $ typeof int) +          && (con' >= 0) +          && (2 ^ (numberOfTwoPrimeFactors con') == con')+              = [ (Op2 "<<", [int, (intToCe $ numberOfTwoPrimeFactors con')], [o]) ]+        | (machTypes IntT $ typeof int) +          && (con' < 0) +          && (2 ^ (numberOfTwoPrimeFactors $ con'*(-1)) == con'*(-1))+              = [ (Op2 "<<", [int, (intToCe $ numberOfTwoPrimeFactors $ con'*(-1))], [o])+                , (Op1 "-", [lToe o], [o])+                ]+        | otherwise = [(Op2 "*", [x, y], [o])]+      where+        con' = ceToInt con+++optimizedDivide :: TransformPrim+optimizedDivide _ [x, y] [o] = case (x,y) of+    (_, (Expression (ConstantExpression (Constant (IntConstant _) _)) _)) -> optimizedDivide' x y+    (_, _) -> [(Op2 "/", [x, y], [o])]+  where+    optimizedDivide' int con+        | (machTypes IntT $ typeof int) +          && (con' >= 0) +          && (2 ^ (numberOfTwoPrimeFactors con') == con')+              = [ (Op2 ">>", [int, (intToCe $ numberOfTwoPrimeFactors con')], [o]) ]+        | (machTypes IntT $ typeof int) +          && (con' < 0) +          && (2 ^ (numberOfTwoPrimeFactors $ con'*(-1)) == con'*(-1))+              = [ (Op2 ">>", [int, (intToCe $ numberOfTwoPrimeFactors $ con'*(-1))], [o])+                , (Op1 "-", [lToe o], [o])+                ]+        | otherwise = [(Op2 "/", [x, y], [o])]+      where+        con' = ceToInt con+++bitFunToShift _ [i] [o] = [ (Op2 "<<", [intToCe 1, i], [o]) ]+++bitSizeFunToConst :: TransformPrim+bitSizeFunToConst _ [i] [o] = case (typeof i) of+    (Numeric _ S8)  -> [ (Assig, [intToCe 8], [o]) ]+    (Numeric _ S16) -> [ (Assig, [intToCe 16], [o]) ]+    (Numeric _ S32) -> [ (Assig, [intToCe 32], [o]) ]+    (Numeric _ S40) -> [ (Assig, [intToCe 40], [o]) ]+    (Numeric _ S64) -> [ (Assig, [intToCe 64], [o]) ]+++isSignedFunToConst :: TransformPrim+isSignedFunToConst _ [i] [o] = case (typeof i) of+    (Numeric ImpSigned _)   -> [ (Assig, [boolToCe True], [o]) ]+    (Numeric ImpUnsigned _) -> [ (Assig, [boolToCe False], [o]) ]+++optimizedBitCount :: TransformPrim+optimizedBitCount _ [i] [o]+    = [ (Fun "_bitc4" noneFP, [i], [o])+      , (Fun "_dotpu4" noneFP, [lToe o, intToCe 0x01010101], [o])+      ]+++numberOfTwoPrimeFactors 2 = 1+numberOfTwoPrimeFactors x | x `mod` 2 == 0  = (numberOfTwoPrimeFactors $ x `div` 2) + 1+                          | otherwise       = 0++++ceToInt (Expression (ConstantExpression (Constant (IntConstant (IntConstantType x _)) _)) _) = x+intToCe x = Expression (ConstantExpression $ Constant (IntConstant $ IntConstantType x ()) ()) ()+boolToCe x = Expression (ConstantExpression $ Constant (BoolConstant $ BoolConstantType x ()) ()) ()++lToe x = Expression (LeftValueExpression x) ()++
Feldspar/Compiler/PluginArchitecture.hs view
@@ -1,808 +1,1026 @@-{-- - Copyright (c) 2009-2010, 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.Compiler.PluginArchitecture (-    module Feldspar.Compiler.PluginArchitecture,-    module Feldspar.Compiler.Imperative.Representation,-    module Feldspar.Compiler.Imperative.Semantics,-    module Feldspar.Compiler.PluginArchitecture.DefaultConvert-) where--import Feldspar.Compiler.Imperative.Representation-import Feldspar.Compiler.Imperative.Semantics-import Feldspar.Compiler.PluginArchitecture.DefaultConvert---- ==================================================================================================================================---  == Plugin class--- ==================================================================================================================================--type Walker t construction = (TransformationPhase t) => t -> Downwards t -> construction (From t) -> (construction (To t), Upwards t)--class (TransformationPhase t) => Plugin t where-    type ExternalInfo t-    executePlugin :: t -> ExternalInfo t -> Procedure (From t) -> Procedure (To t)--class (SemanticInfo (From t), SemanticInfo (To t)-    , ConvertAllInfos (From t) (To t)-    , Combine (Upwards t), Default (Upwards t)) => TransformationPhase t where-    type From t-    type To t-    type Downwards t-    type Upwards t--    executeTransformationPhase :: Walker t Procedure-    executeTransformationPhase = walkProcedure---- ==================================================================================================================================---  == Node Transformers specification--- ==================================================================================================================================--    downwardsProcedure               :: t -> Downwards t -> Procedure (From t)        -> Downwards t-    transformProcedure               :: t -> Downwards t -> Procedure (From t)        -> InfosFromProcedureParts t -> Procedure (To t)-    upwardsProcedure                 :: t -> Downwards t -> Procedure (From t)        -> InfosFromProcedureParts t -> Procedure (To t) -> Upwards t--    downwardsBlock                   :: t -> Downwards t -> Block (From t)            -> Downwards t-    transformBlock                   :: t -> Downwards t -> Block (From t)            -> InfosFromBlockParts t -> Block (To t)-    upwardsBlock                     :: t -> Downwards t -> Block (From t)            -> InfosFromBlockParts t -> Block (To t) -> Upwards t--    downwardsProgram                 :: t -> Downwards t -> Program (From t)          -> Downwards t-    transformProgram                 :: t -> Downwards t -> Program (From t)          -> InfosFromProgramParts t -> Program (To t)-    upwardsProgram                   :: t -> Downwards t -> Program (From t)          -> InfosFromProgramParts t -> Program (To t) -> Upwards t--    transformEmpty                   :: t -> Downwards t -> Empty (From t)            -> ProgramConstruction (To t)-    upwardsEmpty                     :: t -> Downwards t -> Empty (From t)            -> ProgramConstruction (To t) -> Upwards t-    -    downwardsPrimitive               :: t -> Downwards t -> Primitive (From t)        -> Downwards t-    transformPrimitive               :: t -> Downwards t -> Primitive (From t)        -> InfosFromPrimitiveParts t -> ProgramConstruction (To t)-    upwardsPrimitive                 :: t -> Downwards t -> Primitive (From t)        -> InfosFromPrimitiveParts t -> ProgramConstruction (To t) -> Upwards t-    -    downwardsSequence                :: t -> Downwards t -> Sequence (From t)         -> Downwards t-    transformSequence                :: t -> Downwards t -> Sequence (From t)         -> InfosFromSequenceParts t -> ProgramConstruction (To t)-    upwardsSequence                  :: t -> Downwards t -> Sequence (From t)         -> InfosFromSequenceParts t -> ProgramConstruction (To t) -> Upwards t-    -    downwardsBranch                  :: t -> Downwards t -> Branch (From t)           -> Downwards t-    transformBranch                  :: t -> Downwards t -> Branch (From t)           -> InfosFromBranchParts t -> ProgramConstruction (To t)-    upwardsBranch                    :: t -> Downwards t -> Branch (From t)           -> InfosFromBranchParts t -> ProgramConstruction (To t) -> Upwards t-    -    downwardsSequentialLoop          :: t -> Downwards t -> SequentialLoop (From t)   -> Downwards t-    transformSequentialLoop          :: t -> Downwards t -> SequentialLoop (From t)   -> InfosFromSequentialLoopParts t -> ProgramConstruction (To t)-    upwardsSequentialLoop            :: t -> Downwards t -> SequentialLoop (From t)   -> InfosFromSequentialLoopParts t -> ProgramConstruction (To t) -> Upwards t-    -    downwardsParallelLoop            :: t -> Downwards t -> ParallelLoop (From t)     -> Downwards t-    transformParallelLoop            :: t -> Downwards t -> ParallelLoop (From t)     -> InfosFromParallelLoopParts t -> ProgramConstruction (To t)-    upwardsParallelLoop              :: t -> Downwards t -> ParallelLoop (From t)     -> InfosFromParallelLoopParts t -> ProgramConstruction (To t) -> Upwards t-    -    downwardsFormalParameter         :: t -> Downwards t -> FormalParameter (From t)  -> Downwards t-    transformFormalParameter         :: t -> Downwards t -> FormalParameter (From t)  -> InfosFromFormalParameterParts t -> FormalParameter (To t)-    upwardsFormalParameter           :: t -> Downwards t -> FormalParameter (From t)  -> InfosFromFormalParameterParts t -> FormalParameter (To t) -> Upwards t-    -    downwardsLocalDeclaration        :: t -> Downwards t -> LocalDeclaration (From t) -> Downwards t-    transformLocalDeclaration        :: t -> Downwards t -> LocalDeclaration (From t) -> InfosFromLocalDeclarationParts t -> LocalDeclaration (To t)-    upwardsLocalDeclaration          :: t -> Downwards t -> LocalDeclaration (From t) -> InfosFromLocalDeclarationParts t -> LocalDeclaration (To t) -> Upwards t-    -    downwardsAssignment              :: t -> Downwards t -> Assignment (From t)       -> Downwards t-    transformAssignment              :: t -> Downwards t -> Assignment (From t)       -> InfosFromAssignmentParts t -> Instruction (To t)-    upwardsAssignment                :: t -> Downwards t -> Assignment (From t)       -> InfosFromAssignmentParts t -> Instruction (To t) -> Upwards t-    -    downwardsProcedureCall           :: t -> Downwards t -> ProcedureCall (From t)    -> Downwards t-    transformProcedureCall           :: t -> Downwards t -> ProcedureCall (From t)    -> InfosFromProcedureCallParts t -> Instruction (To t)-    upwardsProcedureCall             :: t -> Downwards t -> ProcedureCall (From t)    -> InfosFromProcedureCallParts t -> Instruction (To t) -> Upwards t-    -    downwardsInputActualParameter    :: t -> Downwards t -> InputActualParameterType (From t) -> Downwards t-    transformInputActualParameter    :: t -> Downwards t -> InputActualParameterType (From t) -> InfosFromInputActualParameterParts t -> ActualParameter (To t)-    upwardsInputActualParameter      :: t -> Downwards t -> InputActualParameterType (From t) -> InfosFromInputActualParameterParts t -> ActualParameter (To t) -> Upwards t-    -    downwardsOutputActualParameter   :: t -> Downwards t -> OutputActualParameterType (From t) -> Downwards t-    transformOutputActualParameter   :: t -> Downwards t -> OutputActualParameterType (From t) -> InfosFromOutputActualParameterParts t -> ActualParameter (To t)-    upwardsOutputActualParameter     :: t -> Downwards t -> OutputActualParameterType (From t) -> InfosFromOutputActualParameterParts t -> ActualParameter (To t) -> Upwards t-    -    downwardsVariableInLeftValue     :: t -> Downwards t -> VariableInLeftValue (From t)     -> Downwards t-    transformVariableInLeftValue     :: t -> Downwards t -> VariableInLeftValue (From t)     -> InfosFromVariableLeftValueParts t -> LeftValue (To t)-    upwardsVariableInLeftValue       :: t -> Downwards t -> VariableInLeftValue (From t)     -> InfosFromVariableLeftValueParts t -> LeftValue (To t) -> Upwards t-    -    downwardsArrayElemReference      :: t -> Downwards t -> ArrayElemReference (From t)      -> Downwards t-    transformArrayElemReference      :: t -> Downwards t -> ArrayElemReference (From t)      -> InfosFromArrayElemReferenceParts t -> LeftValue (To t)-    upwardsArrayElemReference        :: t -> Downwards t -> ArrayElemReference (From t)      -> InfosFromArrayElemReferenceParts t -> LeftValue (To t) -> Upwards t-    -    downwardsLeftValueExpression     :: t -> Downwards t -> LeftValueInExpression (From t)   -> Downwards t-    transformLeftValueExpression     :: t -> Downwards t -> LeftValueInExpression (From t)   -> InfosFromLeftValueExpressionParts t -> Expression (To t)-    upwardsLeftValueExpression       :: t -> Downwards t -> LeftValueInExpression (From t)   -> InfosFromLeftValueExpressionParts t -> Expression (To t) -> Upwards t-    -    downwardsFunctionCall            :: t -> Downwards t -> FunctionCall (From t)            -> Downwards t-    transformFunctionCall            :: t -> Downwards t -> FunctionCall (From t)            -> InfosFromFunctionCallParts t -> Expression (To t)-    upwardsFunctionCall              :: t -> Downwards t -> FunctionCall (From t)            -> InfosFromFunctionCallParts t -> Expression (To t) -> Upwards t-    -    transformIntConstant             :: t -> Downwards t -> IntConstantType (From t)         -> Constant (To t)-    upwardsIntConstant               :: t -> Downwards t -> IntConstantType (From t)         -> Constant (To t) -> Upwards t-    -    transformFloatConstant           :: t -> Downwards t -> FloatConstantType (From t)       -> Constant (To t)-    upwardsFloatConstant             :: t -> Downwards t -> FloatConstantType (From t)       -> Constant (To t) -> Upwards t-    -    transformBoolConstant            :: t -> Downwards t -> BoolConstantType (From t)        -> Constant (To t)-    upwardsBoolConstant              :: t -> Downwards t -> BoolConstantType (From t)        -> Constant (To t) -> Upwards t-    -    downwardsArrayConstant           :: t -> Downwards t -> ArrayConstantType (From t)       -> Downwards t-    transformArrayConstant           :: t -> Downwards t -> ArrayConstantType (From t)       -> InfosFromArrayConstantParts t -> Constant (To t)-    upwardsArrayConstant             :: t -> Downwards t -> ArrayConstantType (From t)       -> InfosFromArrayConstantParts t -> Constant (To t) -> Upwards t-        -    transformVariable                :: t -> Downwards t -> Variable (From t)                -> Variable (To t)-    upwardsVariable                  :: t -> Downwards t -> Variable (From t)                -> Variable (To t) -> Upwards t---- ==================================================================================================================================---  == Node Transformer defaults--- ==================================================================================================================================--    downwardsProcedure self = const-    transformProcedure self fromAbove originalProcedure fromBelow = originalProcedure {-        inParameters = recursivelyTransformedInParameters fromBelow,-        outParameters = recursivelyTransformedOutParameters fromBelow,-        procedureBody = recursivelyTransformedProcedureBody fromBelow,-        procedureSemInf = convert $ procedureSemInf originalProcedure-    }-    upwardsProcedure self fromAbove originalProcedure fromBelow transformedProcedure = foldl combine (upwardsInfoFromProcedureBody fromBelow)-        ((upwardsInfoFromInParameters fromBelow)++(upwardsInfoFromOutParameters fromBelow))-    -    downwardsBlock self = const-    transformBlock self fromAbove originalBlock fromBelow = Block {-        blockData = recursivelyTransformedBlockData fromBelow,-        blockSemInf = convert $ blockSemInf originalBlock-    }-    upwardsBlock self fromAbove originalBlock fromBelow transformedBlock = foldl combine-        (upwardsInfoFromBlockInstructions fromBelow) (upwardsInfoFromBlockDeclarations fromBelow)-    -    downwardsProgram self = const-    transformProgram self fromAbove originalProgram fromBelow = Program {-        programConstruction = recursivelyTransformedProgramConstruction fromBelow,-        programSemInf = convert $ programSemInf originalProgram-    }-    upwardsProgram self fromAbove originalProgram fromBelow transformedProgram = upwardsInfoFromProgramConstruction fromBelow-        -    transformEmpty self fromAbove originalEmpty = EmptyProgram $ Empty {-        emptySemInf = convert $ emptySemInf originalEmpty-    }-    upwardsEmpty self fromAbove originalEmpty transformedEmpty = defaultValue-    -    downwardsPrimitive self = const-    transformPrimitive self fromAbove originalPrimitive fromBelow = PrimitiveProgram $ Primitive {-        primitiveInstruction = recursivelyTransformedPrimitiveInstruction fromBelow,-        primitiveSemInf = convert $ primitiveSemInf originalPrimitive-    }-    upwardsPrimitive self fromAbove originalPrimitive fromBelow transformedPrimitive = upwardsInfoFromPrimitiveInstruction fromBelow-    -    downwardsSequence self = const-    transformSequence self fromAbove originalSequence fromBelow = SequenceProgram $ Sequence {-        sequenceProgramList = recursivelyTransformedSequenceProgramList fromBelow,-        sequenceSemInf = convert $ sequenceSemInf originalSequence-    }-    upwardsSequence self fromAbove originalSequence fromBelow transformedSequence = case ul of-        [] -> defaultValue-        otherwise -> foldl combine (head ul) (tail ul)-        where ul = upwardsInfoFromSequenceProgramList fromBelow-    -    downwardsBranch self = const-    transformBranch self fromAbove originalBranch fromBelow = BranchProgram $ Branch {-        branchData = recursivelyTransformedBranchData fromBelow,-        branchSemInf = convert $ branchSemInf originalBranch-    }-    upwardsBranch self fromAbove originalBranch fromBelow transformedBranch = -        foldl combine (upwardsInfoFromBranchConditionVariable fromBelow) [upwardsInfoFromThenBlock fromBelow, upwardsInfoFromElseBlock fromBelow]-    -    downwardsSequentialLoop self = const-    transformSequentialLoop self fromAbove originalSequentialLoop fromBelow = SequentialLoopProgram $ SequentialLoop {-        sequentialLoopData = recursivelyTransformedSequentialLoopData fromBelow,-        sequentialLoopSemInf = convert $ sequentialLoopSemInf originalSequentialLoop-    }-    upwardsSequentialLoop self fromAbove originalSequentialLoop fromBelow transformedSequentialLoop =-        foldl combine (upwardsInfoFromSequentialLoopConditionVariable fromBelow)-                      [upwardsInfoFromSequentialLoopConditionCalculation fromBelow, upwardsInfoFromSequentialLoopCore fromBelow]-    -    downwardsParallelLoop self = const-    transformParallelLoop self fromAbove originalParallelLoop fromBelow = ParallelLoopProgram $ ParallelLoop {-        parallelLoopData = recursivelyTransformedParallelLoopData fromBelow,-        parallelLoopSemInf = convert $ parallelLoopSemInf originalParallelLoop-    }-    upwardsParallelLoop self fromAbove originalParallelLoop fromBelow transformedParallelLoop =-        foldl combine (upwardsInfoFromParallelLoopConditionVariable fromBelow)-                      [upwardsInfoFromNumberOfIterations fromBelow, upwardsInfoFromParallelLoopCore fromBelow]-    -    downwardsFormalParameter self = const-    transformFormalParameter self fromAbove originalFormalParameter fromBelow = FormalParameter {-        formalParameterVariable = recursivelyTransformedFormalParameterVariable fromBelow,-        formalParameterSemInf   = convert $ formalParameterSemInf originalFormalParameter-    }-    upwardsFormalParameter self fromAbove originalFormalParameter fromBelow transformedFormalParameter =-        upwardsInfoFromFormalParameterVariable fromBelow-    -    downwardsLocalDeclaration self = const-    transformLocalDeclaration self fromAbove originalLocalDeclaration fromBelow = LocalDeclaration {-        localDeclarationData = recursivelyTransformedLocalDeclarationData fromBelow,-        localDeclarationSemInf = convert $ localDeclarationSemInf originalLocalDeclaration-    }-    upwardsLocalDeclaration self fromAbove originalLocalDeclaration fromBelow transformedLocalDeclaration =-        case (upwardsInfoFromLocalInitValue fromBelow) of-              Nothing -> (upwardsInfoFromLocalVariable fromBelow)-              Just justUpFromLocalInitValue -> combine (upwardsInfoFromLocalVariable fromBelow) justUpFromLocalInitValue-    -    downwardsAssignment self = const-    transformAssignment self fromAbove originalAssignment fromBelow = AssignmentInstruction $ Assignment {-        assignmentData = recursivelyTransformedAssignmentData fromBelow,-        assignmentSemInf = convert $ assignmentSemInf originalAssignment-    }-    upwardsAssignment self fromAbove originalAssignment fromBelow transformedAssignment =-        combine (upwardsInfoFromAssignmentLhs fromBelow) (upwardsInfoFromAssignmentRhs fromBelow)-    -    downwardsProcedureCall self = const-    transformProcedureCall self fromAbove originalProcedureCall fromBelow = ProcedureCallInstruction $ ProcedureCall {-        procedureCallData = recursivelyTransformedProcedureCallData fromBelow,-        procedureCallSemInf = convert $ procedureCallSemInf originalProcedureCall-    }-    upwardsProcedureCall self fromAbove originalProcedureCall fromBelow transformedProcedureCall =-        case ul of-             [] -> defaultValue-             otherwise -> foldl combine (head ul) (tail ul)-        where-            ul = upwardsInfoFromActualParametersOfProcedureToCall fromBelow-    -    downwardsInputActualParameter self = const-    transformInputActualParameter self fromAbove originalInputActualParameter fromBelow = InputActualParameter $ InputActualParameterType {-        inputActualParameterExpression = recursivelyTransformedInputActualParameterExpression fromBelow,-        inputActualParameterSemInf = convert $ inputActualParameterSemInf originalInputActualParameter-    }-    upwardsInputActualParameter self fromAbove originalInputActualParameter fromBelow transformedInputActualParameter =-        upwardsInfoFromInputActualParameter fromBelow-    -    downwardsOutputActualParameter self = const-    transformOutputActualParameter self fromAbove originalOutputActualParameter fromBelow = OutputActualParameter $ OutputActualParameterType {-        outputActualParameterLeftValue = recursivelyTransformedOutputActualParameterLeftValue fromBelow,-        outputActualParameterSemInf = convert $ outputActualParameterSemInf originalOutputActualParameter-    }-    upwardsOutputActualParameter self fromAbove originalOutputActualParameter fromBelow transformedOutputActualParameter =-        upwardsInfoFromOutputActualParameterLeftValue fromBelow-    -    downwardsVariableInLeftValue self = const-    transformVariableInLeftValue self fromAbove originalVariableInLeftValue fromBelow = VariableLeftValue $ VariableInLeftValue {-        variableLeftValueContents = recursivelyTransformedVariableLeftValueContents fromBelow,-        variableLeftValueSemInf = convert $ variableLeftValueSemInf originalVariableInLeftValue-    }-    upwardsVariableInLeftValue self fromAbove originalVariableInLeftValue fromBelow transformedVariableInLeftValue =-        upwardsInfoFromVariableLeftValueContents fromBelow-    -    downwardsArrayElemReference self = const-    transformArrayElemReference self fromAbove originalArrayElemReference fromBelow = ArrayElemReferenceLeftValue $ ArrayElemReference {-        arrayElemReferenceData = recursivelyTransformedArrayElemReferenceData fromBelow,-        arrayElemReferenceSemInf = convert $ arrayElemReferenceSemInf originalArrayElemReference-    }-    upwardsArrayElemReference self fromAbove originalArrayElemReference fromBelow transformedArrayElemReference =-        combine (upwardsInfoFromArrayName fromBelow) (upwardsInfoFromArrayIndex fromBelow)-    -    downwardsLeftValueExpression self = const-    transformLeftValueExpression self fromAbove originalLeftValueExpression fromBelow = LeftValueExpression $ LeftValueInExpression {-        leftValueExpressionContents = recursivelyTransformedLeftValueExpressionContents fromBelow,-        leftValueExpressionSemInf = convert $ leftValueExpressionSemInf originalLeftValueExpression-    }-    upwardsLeftValueExpression self fromAbove originalLeftValueExpression fromBelow transformedLeftValueExpression = -        upwardsInfoFromLeftValueExpressionContents fromBelow-    -    downwardsFunctionCall self = const-    transformFunctionCall self fromAbove originalFunctionCall fromBelow = FunctionCallExpression $ FunctionCall {-        functionCallData = recursivelyTransformedFunctionCallData fromBelow,-        functionCallSemInf = convert $ functionCallSemInf originalFunctionCall-    }-    upwardsFunctionCall self fromAbove originalFunctionCall fromBelow transformedFunctionCall = case ul of-        [] -> defaultValue-        otherwise -> foldl combine (head ul) (tail ul)-        where ul = upwardsInfoFromActualParametersOfFunctionToCall fromBelow-    -    transformIntConstant self fromAbove originalIntConstant = IntConstant originalIntConstant {-        intConstantSemInf = convert $ intConstantSemInf originalIntConstant-    }-    upwardsIntConstant self fromAbove originalIntConstant transformedIntConstant = defaultValue-    -    transformFloatConstant self fromAbove originalFloatConstant = FloatConstant originalFloatConstant {-        floatConstantSemInf = convert $ floatConstantSemInf originalFloatConstant-    }-    upwardsFloatConstant self fromAbove originalFloatConstant transformedFloatConstant = defaultValue-    -    transformBoolConstant self fromAbove originalBoolConstant = BoolConstant originalBoolConstant {-        boolConstantSemInf = convert $ boolConstantSemInf originalBoolConstant-    }-    upwardsBoolConstant self fromAbove originalBoolConstant transformedBoolConstant = defaultValue-    -    downwardsArrayConstant self = const-    transformArrayConstant self fromAbove originalArrayConstant fromBelow = ArrayConstant $ ArrayConstantType {-        arrayConstantValue = recursivelyTransformedArrayConstantValue fromBelow,-        arrayConstantSemInf = convert $ arrayConstantSemInf originalArrayConstant-    }-    upwardsArrayConstant self fromAbove originalArrayConstant fromBelow transformedArrayConstant = case ul of-        [] -> defaultValue-        otherwise -> foldl combine (head ul) (tail ul)-        where ul = upwardsInfoFromConstantList fromBelow-    -    transformVariable self fromAbove originalVariable = originalVariable {-        variableSemInf = convert $ variableSemInf originalVariable-    }-    upwardsVariable self fromAbove originalVariable transformedVariable = defaultValue---- ==================================================================================================================================---  == Walker defaults--- ==================================================================================================================================--    walkProcedure :: Walker t Procedure-    walkProcedure selfpointer fromAbove construction = (transformedProcedure, toAbove)-        where-            toBelow = downwardsProcedure selfpointer fromAbove construction-            transformedInParameters = map (walkFormalParameter selfpointer toBelow) $ inParameters construction-            transformedOutParameters = map (walkFormalParameter selfpointer toBelow) $ outParameters construction-            transformedProcedureBody = (walkBlock selfpointer toBelow) $ procedureBody construction-            fromBelow = InfosFromProcedureParts {-                recursivelyTransformedInParameters = map fst transformedInParameters,-                upwardsInfoFromInParameters = map snd transformedInParameters,-                recursivelyTransformedOutParameters = map fst transformedOutParameters,-                upwardsInfoFromOutParameters = map snd transformedOutParameters,-                recursivelyTransformedProcedureBody = fst transformedProcedureBody,-                upwardsInfoFromProcedureBody = snd transformedProcedureBody-            }-            transformedProcedure = transformProcedure selfpointer fromAbove construction fromBelow-            toAbove = upwardsProcedure selfpointer fromAbove construction fromBelow transformedProcedure-    -    walkFormalParameter :: Walker t FormalParameter-    walkFormalParameter selfpointer fromAbove p = (transformedFormalParameter, toAbove)-        where-            toBelow             = downwardsFormalParameter selfpointer fromAbove p-            transformedVariable = walkVariable selfpointer toBelow (formalParameterVariable p)-            fromBelow = InfosFromFormalParameterParts {-                recursivelyTransformedFormalParameterVariable = fst transformedVariable,-                upwardsInfoFromFormalParameterVariable = snd transformedVariable-            }-            transformedFormalParameter = transformFormalParameter selfpointer fromAbove p fromBelow-            toAbove = upwardsFormalParameter selfpointer fromAbove p fromBelow transformedFormalParameter-    -    walkBlock :: Walker t Block-    walkBlock selfpointer fromAbove block = (transformedBlock, toAbove)-        where-            toBelow                       = downwardsBlock selfpointer fromAbove block-            transformedLocalDeclarations  = map (walkLocalDeclaration selfpointer toBelow) $ blockDeclarations $ blockData block-            transformedProgram            = walkProgram selfpointer toBelow $ blockInstructions $ blockData block-            fromBelow = InfosFromBlockParts {-                recursivelyTransformedBlockData = BlockData {-                    blockDeclarations = map fst transformedLocalDeclarations,-                    blockInstructions = fst transformedProgram-                },-                upwardsInfoFromBlockDeclarations = map snd transformedLocalDeclarations,-                upwardsInfoFromBlockInstructions = snd transformedProgram-            }-            transformedBlock = transformBlock selfpointer fromAbove block fromBelow-            toAbove = upwardsBlock selfpointer fromAbove block fromBelow transformedBlock-    -    walkProgram :: Walker t Program-    walkProgram selfpointer fromAbove program = (transformedProgram, toAbove)-        where-            toBelow = downwardsProgram selfpointer fromAbove program-            transformedProgramConstruction = case programConstruction program of-                EmptyProgram empty                    -> walkEmpty selfpointer toBelow empty -                PrimitiveProgram primitive            -> walkPrimitive selfpointer toBelow primitive-                SequenceProgram sequence              -> walkSequence selfpointer toBelow sequence-                BranchProgram branch                  -> walkBranch selfpointer toBelow branch-                SequentialLoopProgram sequentialLoop  -> walkSequentialLoop selfpointer toBelow sequentialLoop -                ParallelLoopProgram parallelLoop      -> walkParallelLoop selfpointer toBelow parallelLoop-            fromBelow = InfosFromProgramParts {-                recursivelyTransformedProgramConstruction = fst transformedProgramConstruction,-                upwardsInfoFromProgramConstruction = snd transformedProgramConstruction-            }-            transformedProgram = transformProgram selfpointer fromAbove program fromBelow-            toAbove = upwardsProgram selfpointer fromAbove program fromBelow transformedProgram-            -    walkEmpty :: (TransformationPhase t) => t -> Downwards t -> Empty (From t) -> (ProgramConstruction (To t), Upwards t)-    walkEmpty selfpointer fromAbove empty = (transformedEmpty, toAbove)-        where-            transformedEmpty = transformEmpty selfpointer fromAbove empty-            toAbove = upwardsEmpty selfpointer fromAbove empty transformedEmpty-                -    walkPrimitive :: (TransformationPhase t) => t -> Downwards t -> Primitive (From t) -> (ProgramConstruction (To t), Upwards t)-    walkPrimitive selfpointer fromAbove primitive = (transformedPrimitive, toAbove)-        where-            toBelow = downwardsPrimitive selfpointer fromAbove primitive-            transformedPrimitiveInstruction =-                walkInstruction selfpointer toBelow (primitiveInstruction primitive)-            fromBelow = InfosFromPrimitiveParts {-                recursivelyTransformedPrimitiveInstruction = fst transformedPrimitiveInstruction,-                upwardsInfoFromPrimitiveInstruction = snd transformedPrimitiveInstruction-            }-            transformedPrimitive = transformPrimitive selfpointer fromAbove primitive fromBelow-            toAbove = upwardsPrimitive selfpointer fromAbove primitive fromBelow transformedPrimitive--    walkSequence :: (TransformationPhase t) => t -> Downwards t -> Sequence (From t) -> (ProgramConstruction (To t), Upwards t)-    walkSequence selfpointer fromAbove sequence = (transformedSequence, toAbove)-        where-            toBelow = downwardsSequence selfpointer fromAbove sequence-            transformedProgramList =-                map (walkProgram selfpointer toBelow) (sequenceProgramList sequence)-            fromBelow = InfosFromSequenceParts {-                recursivelyTransformedSequenceProgramList = map fst transformedProgramList,-                upwardsInfoFromSequenceProgramList = map snd transformedProgramList-            }-            transformedSequence = transformSequence selfpointer fromAbove sequence fromBelow-            toAbove = upwardsSequence selfpointer fromAbove sequence fromBelow transformedSequence-                    -    walkBranch :: (TransformationPhase t) => t -> Downwards t -> Branch (From t) -> (ProgramConstruction (To t), Upwards t)-    walkBranch selfpointer fromAbove branch = (transformedBranch, toAbove)-        where-            toBelow = downwardsBranch selfpointer fromAbove branch-            transformedBranchConditionVariable = walkVariable selfpointer toBelow (branchConditionVariable $ branchData branch) -            transformedThenBlock = walkBlock selfpointer toBelow (thenBlock $ branchData branch)-            transformedElseBlock = walkBlock selfpointer toBelow (elseBlock $ branchData branch)-            fromBelow = InfosFromBranchParts {-                recursivelyTransformedBranchData = BranchData {-                    branchConditionVariable = fst transformedBranchConditionVariable,-                    thenBlock               = fst transformedThenBlock,-                    elseBlock               = fst transformedElseBlock-                },-                upwardsInfoFromBranchConditionVariable = snd transformedBranchConditionVariable,-                upwardsInfoFromThenBlock               = snd transformedThenBlock,-                upwardsInfoFromElseBlock               = snd transformedElseBlock-            } -            transformedBranch = transformBranch selfpointer fromAbove branch fromBelow-            toAbove = upwardsBranch selfpointer fromAbove branch fromBelow transformedBranch--    walkSequentialLoop :: (TransformationPhase t) => t -> Downwards t -> SequentialLoop (From t) -> (ProgramConstruction (To t), Upwards t)-    walkSequentialLoop selfpointer fromAbove loop = (transformedSequentialLoop, toAbove)-        where-            toBelow = downwardsSequentialLoop selfpointer fromAbove loop-            transformedLoopConditionVariable =-                walkExpression selfpointer toBelow (sequentialLoopCondition $ sequentialLoopData loop) -            transformedConditionCalculation =-                walkBlock selfpointer toBelow (conditionCalculation $ sequentialLoopData loop)-            transformedSequentialLoopCore =-                walkBlock selfpointer toBelow (sequentialLoopCore $ sequentialLoopData loop)-            fromBelow = InfosFromSequentialLoopParts {-                recursivelyTransformedSequentialLoopData = SequentialLoopData {-                    sequentialLoopCondition         = fst transformedLoopConditionVariable,-                    conditionCalculation            = fst transformedConditionCalculation,-                    sequentialLoopCore              = fst transformedSequentialLoopCore-                },-                upwardsInfoFromSequentialLoopConditionVariable    = snd transformedLoopConditionVariable,-                upwardsInfoFromSequentialLoopConditionCalculation = snd transformedConditionCalculation,-                upwardsInfoFromSequentialLoopCore                 = snd transformedSequentialLoopCore-            }-            transformedSequentialLoop = transformSequentialLoop selfpointer fromAbove loop fromBelow-            toAbove = upwardsSequentialLoop selfpointer fromAbove loop fromBelow transformedSequentialLoop-                    -    walkParallelLoop :: (TransformationPhase t) => t -> Downwards t -> ParallelLoop (From t) -> (ProgramConstruction (To t), Upwards t)-    walkParallelLoop selfpointer fromAbove loop = (transformedParallelLoop, toAbove)-        where-            toBelow = downwardsParallelLoop selfpointer fromAbove loop-            transformedParallelLoopConditionVariable =-                walkVariable selfpointer toBelow (parallelLoopConditionVariable $ parallelLoopData loop)-            transformedNumberOfIterations =-                walkExpression selfpointer toBelow (numberOfIterations $ parallelLoopData loop) -            transformedParallelLoopCore =-                walkBlock selfpointer toBelow (parallelLoopCore $ parallelLoopData loop)-            fromBelow = InfosFromParallelLoopParts {-                recursivelyTransformedParallelLoopData = ParallelLoopData {-                    parallelLoopConditionVariable = fst transformedParallelLoopConditionVariable,-                    numberOfIterations            = fst transformedNumberOfIterations,-                    parallelLoopStep              = parallelLoopStep $ parallelLoopData loop,-                    parallelLoopCore              = fst transformedParallelLoopCore-                },-                upwardsInfoFromParallelLoopConditionVariable    = snd transformedParallelLoopConditionVariable,-                upwardsInfoFromNumberOfIterations               = snd transformedNumberOfIterations,-                upwardsInfoFromParallelLoopCore                 = snd transformedParallelLoopCore-            }-            transformedParallelLoop = transformParallelLoop selfpointer fromAbove loop fromBelow-            toAbove = upwardsParallelLoop selfpointer fromAbove loop fromBelow transformedParallelLoop-    -    walkLocalDeclaration :: Walker t LocalDeclaration-    walkLocalDeclaration selfpointer fromAbove local = (transformedLocalDeclaration, toAbove)-        where-            toBelow = downwardsLocalDeclaration selfpointer fromAbove local-            transformedLocalVariable = walkVariable selfpointer toBelow (localVariable $ localDeclarationData local)-            transformedLocalInitValue = case localInitValue $ localDeclarationData local of-                Nothing -> (Nothing, Nothing)-                Just localInitExpression -> (Just (fst transformedLocalInitExpression), Just (snd transformedLocalInitExpression))-                    where transformedLocalInitExpression = walkExpression selfpointer toBelow localInitExpression-            fromBelow = InfosFromLocalDeclarationParts {-                recursivelyTransformedLocalDeclarationData = LocalDeclarationData {-                    localVariable = fst transformedLocalVariable,-                    localInitValue = fst transformedLocalInitValue-                },-                upwardsInfoFromLocalVariable  = snd transformedLocalVariable,-                upwardsInfoFromLocalInitValue = snd transformedLocalInitValue -            }-            transformedLocalDeclaration = transformLocalDeclaration selfpointer fromAbove local fromBelow-            toAbove = upwardsLocalDeclaration selfpointer fromAbove local fromBelow transformedLocalDeclaration-                    -    walkExpression :: Walker t Expression-    walkExpression selfpointer fromAbove expression = case expression of-        LeftValueExpression leftValueExpression -> (transformedLeftValueExpression, toAbove)-            where-                toBelow = downwardsLeftValueExpression selfpointer fromAbove leftValueExpression-                transformedLeftValueExpressionContents = walkLeftValue selfpointer-                    toBelow (leftValueExpressionContents leftValueExpression) -                fromBelow = InfosFromLeftValueExpressionParts {-                    recursivelyTransformedLeftValueExpressionContents = fst transformedLeftValueExpressionContents,-                    upwardsInfoFromLeftValueExpressionContents = snd transformedLeftValueExpressionContents-                }-                transformedLeftValueExpression = transformLeftValueExpression selfpointer fromAbove leftValueExpression fromBelow-                toAbove = upwardsLeftValueExpression selfpointer fromAbove leftValueExpression fromBelow transformedLeftValueExpression-        ConstantExpression constant -> ((ConstantExpression $ fst transformedConstant), snd transformedConstant) -            where-                toBelow = fromAbove -- calculations are done in WalkConstant, used only in the ArrayConstant branch-                transformedConstant = walkConstant selfpointer toBelow constant-        FunctionCallExpression functionCall -> (transformedFunctionCallExpression, toAbove)-            where-                toBelow = downwardsFunctionCall selfpointer fromAbove functionCall-                transformedActualParametersOfFunctionToCall = map-                    (walkExpression selfpointer toBelow)-                    (actualParametersOfFunctionToCall $ functionCallData functionCall)-                fromBelow = InfosFromFunctionCallParts {-                    recursivelyTransformedFunctionCallData = (functionCallData functionCall) {-                        actualParametersOfFunctionToCall = map fst transformedActualParametersOfFunctionToCall-                    },-                    upwardsInfoFromActualParametersOfFunctionToCall = map snd transformedActualParametersOfFunctionToCall-                }-                transformedFunctionCallExpression = transformFunctionCall selfpointer fromAbove functionCall fromBelow-                toAbove = upwardsFunctionCall selfpointer fromAbove functionCall fromBelow transformedFunctionCallExpression-    -    walkConstant :: Walker t Constant-    walkConstant selfpointer fromAbove constant = case constant of-        IntConstant intConstant -> (transformedIntConstant, toAbove)-            where-                transformedIntConstant = transformIntConstant selfpointer fromAbove intConstant-                toAbove = upwardsIntConstant selfpointer fromAbove intConstant transformedIntConstant-        FloatConstant floatConstant -> (transformedFloatConstant, toAbove)-            where-                transformedFloatConstant = transformFloatConstant selfpointer fromAbove floatConstant-                toAbove = upwardsFloatConstant selfpointer fromAbove floatConstant transformedFloatConstant-        BoolConstant boolConstant   -> (transformedBoolConstant, toAbove)-            where-                transformedBoolConstant = transformBoolConstant selfpointer fromAbove boolConstant-                toAbove = upwardsBoolConstant selfpointer fromAbove boolConstant transformedBoolConstant-        ArrayConstant arrayConstant -> (transformedArrayConstant, toAbove) -            where-                toBelow = downwardsArrayConstant selfpointer fromAbove arrayConstant-                transformedConstantList = map (walkConstant selfpointer toBelow) (arrayConstantValue arrayConstant) -                fromBelow = InfosFromArrayConstantParts {-                    recursivelyTransformedArrayConstantValue = map fst transformedConstantList,-                    upwardsInfoFromConstantList = map snd transformedConstantList-                }-                transformedArrayConstant = transformArrayConstant selfpointer fromAbove arrayConstant fromBelow-                toAbove = upwardsArrayConstant selfpointer fromAbove arrayConstant fromBelow transformedArrayConstant-                -    walkLeftValue :: Walker t LeftValue-    walkLeftValue selfpointer fromAbove leftValue = case leftValue of-        VariableLeftValue lvt -> (transformedVariableLeftValue, toAbove)-            where-                toBelow = downwardsVariableInLeftValue selfpointer fromAbove lvt-                transformedVariableLeftValueContents =-                    walkVariable selfpointer toBelow (variableLeftValueContents lvt) -                fromBelow = InfosFromVariableLeftValueParts {-                    recursivelyTransformedVariableLeftValueContents = fst transformedVariableLeftValueContents,-                    upwardsInfoFromVariableLeftValueContents = snd transformedVariableLeftValueContents-                }-                transformedVariableLeftValue = transformVariableInLeftValue selfpointer fromAbove lvt fromBelow-                toAbove = upwardsVariableInLeftValue selfpointer fromAbove lvt fromBelow transformedVariableLeftValue-        ArrayElemReferenceLeftValue arrayElemReference -> (transformedArrayElemReference, toAbove)-            where-                toBelow = downwardsArrayElemReference selfpointer fromAbove arrayElemReference-                transformedArrayName =-                    walkLeftValue selfpointer toBelow (arrayName $ arrayElemReferenceData arrayElemReference)-                transformedArrayIndex =-                    walkExpression selfpointer toBelow (arrayIndex $ arrayElemReferenceData arrayElemReference) -                fromBelow = InfosFromArrayElemReferenceParts {-                    recursivelyTransformedArrayElemReferenceData = ArrayElemReferenceData {-                        arrayName  = fst transformedArrayName,-                        arrayIndex = fst transformedArrayIndex-                    },-                    upwardsInfoFromArrayName = snd transformedArrayName,-                    upwardsInfoFromArrayIndex = snd transformedArrayIndex-                }-                transformedArrayElemReference = transformArrayElemReference selfpointer fromAbove arrayElemReference fromBelow-                toAbove = upwardsArrayElemReference selfpointer fromAbove arrayElemReference fromBelow transformedArrayElemReference-    -    walkActualParameter :: Walker t ActualParameter-    walkActualParameter selfpointer fromAbove actualParameter = case actualParameter of-        InputActualParameter input -> (transformedInputActualParameter, toAbove)-            where-                toBelow = downwardsInputActualParameter selfpointer fromAbove input-                transformedInputActualParameterExpression =-                    walkExpression selfpointer toBelow (inputActualParameterExpression input) -                fromBelow = InfosFromInputActualParameterParts {-                    recursivelyTransformedInputActualParameterExpression = fst transformedInputActualParameterExpression,-                    upwardsInfoFromInputActualParameter = snd transformedInputActualParameterExpression-                }-                transformedInputActualParameter = transformInputActualParameter selfpointer fromAbove input fromBelow-                toAbove = upwardsInputActualParameter selfpointer fromAbove input fromBelow transformedInputActualParameter-        OutputActualParameter output -> (transformedOutputActualParameter, toAbove)-            where-                toBelow = downwardsOutputActualParameter selfpointer fromAbove output-                transformedOutputActualParameterLeftValue =-                    walkLeftValue selfpointer toBelow (outputActualParameterLeftValue output)-                fromBelow = InfosFromOutputActualParameterParts {-                    recursivelyTransformedOutputActualParameterLeftValue = fst transformedOutputActualParameterLeftValue,-                    upwardsInfoFromOutputActualParameterLeftValue = snd transformedOutputActualParameterLeftValue -                }-                transformedOutputActualParameter = transformOutputActualParameter selfpointer fromAbove output fromBelow-                toAbove = upwardsOutputActualParameter selfpointer fromAbove output fromBelow transformedOutputActualParameter-            -    -    walkInstruction :: Walker t Instruction-    walkInstruction selfpointer fromAbove instruction = case instruction of-        AssignmentInstruction assignment -> (transformedAssignment, toAbove)-            where-                toBelow = downwardsAssignment selfpointer fromAbove assignment-                transformedAssignmentLhs = walkLeftValue selfpointer toBelow (assignmentLhs $ assignmentData assignment)-                transformedAssignmentRhs = walkExpression selfpointer toBelow (assignmentRhs $ assignmentData assignment) -                fromBelow = InfosFromAssignmentParts {-                    recursivelyTransformedAssignmentData = AssignmentData {-                        assignmentLhs = fst transformedAssignmentLhs,-                        assignmentRhs = fst transformedAssignmentRhs-                    },-                    upwardsInfoFromAssignmentLhs = snd transformedAssignmentLhs,-                    upwardsInfoFromAssignmentRhs = snd transformedAssignmentRhs-                }-                transformedAssignment = transformAssignment selfpointer fromAbove assignment fromBelow-                toAbove = upwardsAssignment selfpointer fromAbove assignment fromBelow transformedAssignment-        ProcedureCallInstruction procedureCall -> (transformedProcedureCall, toAbove)-            where-                toBelow = downwardsProcedureCall selfpointer fromAbove procedureCall-                transformedActualParametersOfProcedureToCall = map (walkActualParameter selfpointer toBelow)-                                                                (actualParametersOfProcedureToCall $ procedureCallData procedureCall)-                fromBelow = InfosFromProcedureCallParts {-                    recursivelyTransformedProcedureCallData = (procedureCallData procedureCall) {-                        actualParametersOfProcedureToCall = map fst transformedActualParametersOfProcedureToCall-                    },-                    upwardsInfoFromActualParametersOfProcedureToCall = map snd transformedActualParametersOfProcedureToCall -                }-                transformedProcedureCall = transformProcedureCall selfpointer fromAbove procedureCall fromBelow-                toAbove = upwardsProcedureCall selfpointer fromAbove procedureCall fromBelow transformedProcedureCall-    -    walkVariable :: Walker t Variable-    walkVariable selfpointer fromAbove v = (transformedVariable, toAbove)-        where-            transformedVariable = transformVariable selfpointer fromAbove v-            toAbove = upwardsVariable selfpointer fromAbove v transformedVariable---- ==================================================================================================================================---  == Upwards infos--- ==================================================================================================================================--data (TransformationPhase t) => InfosFromProcedureParts t = InfosFromProcedureParts {-    recursivelyTransformedInParameters :: [FormalParameter (To t)],-    upwardsInfoFromInParameters :: [Upwards t],-    recursivelyTransformedOutParameters :: [FormalParameter (To t)],-    upwardsInfoFromOutParameters :: [Upwards t],-    recursivelyTransformedProcedureBody :: Block (To t),-    upwardsInfoFromProcedureBody :: Upwards t-}--data (TransformationPhase t) => InfosFromBlockParts t = InfosFromBlockParts {-    recursivelyTransformedBlockData  :: BlockData (To t),-    upwardsInfoFromBlockDeclarations :: [Upwards t],-    upwardsInfoFromBlockInstructions :: Upwards t-}--data (TransformationPhase t) => InfosFromProgramParts t = InfosFromProgramParts {-    recursivelyTransformedProgramConstruction  :: ProgramConstruction (To t),-    upwardsInfoFromProgramConstruction :: Upwards t-}--data (TransformationPhase t) => InfosFromPrimitiveParts t = InfosFromPrimitiveParts {-    recursivelyTransformedPrimitiveInstruction :: Instruction (To t),-    upwardsInfoFromPrimitiveInstruction :: Upwards t-}--data (TransformationPhase t) => InfosFromSequenceParts t = InfosFromSequenceParts {-    recursivelyTransformedSequenceProgramList :: [Program (To t)],-    upwardsInfoFromSequenceProgramList :: [Upwards t]-}--data (TransformationPhase t) => InfosFromBranchParts t = InfosFromBranchParts {-    recursivelyTransformedBranchData :: BranchData (To t),-    upwardsInfoFromBranchConditionVariable :: Upwards t,-    upwardsInfoFromThenBlock               :: Upwards t,-    upwardsInfoFromElseBlock               :: Upwards t-}--data (TransformationPhase t) => InfosFromSequentialLoopParts t = InfosFromSequentialLoopParts {-    recursivelyTransformedSequentialLoopData :: SequentialLoopData (To t),-    upwardsInfoFromSequentialLoopConditionVariable    :: Upwards t,-    upwardsInfoFromSequentialLoopConditionCalculation :: Upwards t,-    upwardsInfoFromSequentialLoopCore                 :: Upwards t-}--data (TransformationPhase t) => InfosFromParallelLoopParts t = InfosFromParallelLoopParts {-    recursivelyTransformedParallelLoopData :: ParallelLoopData (To t),-    upwardsInfoFromParallelLoopConditionVariable :: Upwards t,-    upwardsInfoFromNumberOfIterations            :: Upwards t,-    upwardsInfoFromParallelLoopCore              :: Upwards t-}--data (TransformationPhase t) => InfosFromFormalParameterParts t = InfosFromFormalParameterParts {-    recursivelyTransformedFormalParameterVariable :: Variable (To t),-    upwardsInfoFromFormalParameterVariable :: Upwards t-}--data (TransformationPhase t) => InfosFromLocalDeclarationParts t = InfosFromLocalDeclarationParts {-    recursivelyTransformedLocalDeclarationData :: LocalDeclarationData (To t),-    upwardsInfoFromLocalVariable  :: Upwards t,-    upwardsInfoFromLocalInitValue :: Maybe (Upwards t)-}--data (TransformationPhase t) => InfosFromAssignmentParts t = InfosFromAssignmentParts {-    recursivelyTransformedAssignmentData :: AssignmentData (To t),-    upwardsInfoFromAssignmentLhs  :: Upwards t,-    upwardsInfoFromAssignmentRhs  :: Upwards t-}--data (TransformationPhase t) => InfosFromProcedureCallParts t = InfosFromProcedureCallParts {-    recursivelyTransformedProcedureCallData :: ProcedureCallData (To t),-    upwardsInfoFromActualParametersOfProcedureToCall :: [Upwards t]-}--data (TransformationPhase t) => InfosFromInputActualParameterParts t = InfosFromInputActualParameterParts {-    recursivelyTransformedInputActualParameterExpression :: Expression (To t),-    upwardsInfoFromInputActualParameter :: Upwards t-}--data (TransformationPhase t) => InfosFromOutputActualParameterParts t = InfosFromOutputActualParameterParts {-    recursivelyTransformedOutputActualParameterLeftValue :: LeftValue (To t),-    upwardsInfoFromOutputActualParameterLeftValue :: Upwards t-}--data (TransformationPhase t) => InfosFromArrayElemReferenceParts t = InfosFromArrayElemReferenceParts {-    recursivelyTransformedArrayElemReferenceData :: ArrayElemReferenceData (To t),-    upwardsInfoFromArrayName  :: Upwards t,-    upwardsInfoFromArrayIndex :: Upwards t-}--data (TransformationPhase t) => InfosFromVariableLeftValueParts t =  InfosFromVariableLeftValueParts {-    recursivelyTransformedVariableLeftValueContents :: Variable (To t),-    upwardsInfoFromVariableLeftValueContents :: Upwards t-}--data (TransformationPhase t) => InfosFromLeftValueExpressionParts t = InfosFromLeftValueExpressionParts {-    recursivelyTransformedLeftValueExpressionContents :: LeftValue (To t),-    upwardsInfoFromLeftValueExpressionContents :: Upwards t-}--data (TransformationPhase t) => InfosFromFunctionCallParts t = InfosFromFunctionCallParts {-    recursivelyTransformedFunctionCallData :: FunctionCallData (To t),-    upwardsInfoFromActualParametersOfFunctionToCall :: [Upwards t]-}--data (TransformationPhase t) => InfosFromArrayConstantParts t = InfosFromArrayConstantParts {-    recursivelyTransformedArrayConstantValue :: [Constant (To t)],-    upwardsInfoFromConstantList :: [Upwards t]-}-+--+-- Copyright (c) 2009-2010, 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.Compiler.PluginArchitecture (+    module Feldspar.Compiler.PluginArchitecture,+    module Feldspar.Compiler.Imperative.Representation,+    module Feldspar.Compiler.Imperative.Semantics,+    module Feldspar.Compiler.PluginArchitecture.DefaultConvert+) where++import Feldspar.Compiler.Imperative.Representation+import Feldspar.Compiler.Imperative.Semantics+import Feldspar.Compiler.PluginArchitecture.DefaultConvert++foldlist :: (Default a, Combine a) => [a] -> a+foldlist ul = case ul of+    [] -> defaultValue+    otherwise -> foldl combine (head ul) (tail ul)+    +convertMaybeList :: Maybe [a] -> [a]+convertMaybeList ul = case ul of+    Nothing -> []+    Just x -> x++convertMaybe :: Maybe a -> [a]+convertMaybe ul = case ul of+    Nothing -> []+    Just x -> [x]+++-- ==================================================================================================================================+--  == Plugin class+-- ==================================================================================================================================++type Walker t construction = (TransformationPhase t) => t -> Downwards t -> construction (From t) -> (construction (To t), Upwards t)++class (TransformationPhase t) => Plugin t where+    type ExternalInfo t+    executePlugin :: t -> ExternalInfo t -> Procedure (From t) -> Procedure (To t)++class (SemanticInfo (From t), SemanticInfo (To t)+    , ConvertAllInfos (From t) (To t)+    , Combine (Upwards t), Default (Upwards t)) => TransformationPhase t where+    type From t+    type To t+    type Downwards t+    type Upwards t++    executeTransformationPhase :: Walker t Procedure+    executeTransformationPhase = walkProcedure++-- ====================================================================================================+--   == Node transformers (downwards-transform-upwards)+-- ====================================================================================================+    -- ====================================================================================================+    --   == Node transformers for Procedure+    -- ====================================================================================================+    downwardsProcedure :: t -> Downwards t -> Procedure (From t) -> Downwards t+    downwardsProcedure self = const+    transformProcedure :: t -> Downwards t -> Procedure (From t) -> InfoFromProcedureParts t -> Procedure (To t)+    transformProcedure self fromAbove originalProcedure fromBelow = originalProcedure {+        inParameters = recursivelyTransformedInParameters fromBelow,+        outParameters = recursivelyTransformedOutParameters fromBelow,+        procedureBody = recursivelyTransformedProcedureBody fromBelow,+        procedureSemInf = convert $ procedureSemInf originalProcedure+    }+    upwardsProcedure :: t -> Downwards t -> Procedure (From t) -> InfoFromProcedureParts t -> Procedure (To t) -> Upwards t+    upwardsProcedure self fromAbove originalProcedure fromBelow transformedProcedure = foldlist ((upwardsInfoFromInParameters fromBelow) ++ (upwardsInfoFromOutParameters fromBelow) ++ [(upwardsInfoFromProcedureBody fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for Block+    -- ====================================================================================================+    downwardsBlock :: t -> Downwards t -> Block (From t) -> Downwards t+    downwardsBlock self = const+    transformBlock :: t -> Downwards t -> Block (From t) -> InfoFromBlockParts t -> Block (To t)+    transformBlock self fromAbove originalBlock fromBelow = originalBlock {+        blockDeclarations = recursivelyTransformedBlockDeclarations fromBelow,+        blockInstructions = recursivelyTransformedBlockInstructions fromBelow,+        blockSemInf = convert $ blockSemInf originalBlock+    }+    upwardsBlock :: t -> Downwards t -> Block (From t) -> InfoFromBlockParts t -> Block (To t) -> Upwards t+    upwardsBlock self fromAbove originalBlock fromBelow transformedBlock = foldlist ((upwardsInfoFromBlockDeclarations fromBelow) ++ [(upwardsInfoFromBlockInstructions fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for Program+    -- ====================================================================================================+    downwardsProgram :: t -> Downwards t -> Program (From t) -> Downwards t+    downwardsProgram self = const+    transformProgram :: t -> Downwards t -> Program (From t) -> InfoFromProgramParts t -> Program (To t)+    transformProgram self fromAbove originalProgram fromBelow = originalProgram {+        programConstruction = recursivelyTransformedProgramConstruction fromBelow,+        programSemInf = convert $ programSemInf originalProgram+    }+    upwardsProgram :: t -> Downwards t -> Program (From t) -> InfoFromProgramParts t -> Program (To t) -> Upwards t+    upwardsProgram self fromAbove originalProgram fromBelow transformedProgram = foldlist ([(upwardsInfoFromProgramConstruction fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for Empty(current basetype: ProgramConstruction)+    -- ====================================================================================================+    transformEmptyProgramInProgram :: t -> Downwards t -> Empty (From t) -> ProgramConstruction (To t)+    transformEmptyProgramInProgram self fromAbove originalEmpty = EmptyProgram $ originalEmpty {+        emptySemInf = convert $ emptySemInf originalEmpty+    }+    upwardsEmptyProgramInProgram :: t -> Downwards t -> Empty (From t) -> ProgramConstruction (To t) -> Upwards t+    upwardsEmptyProgramInProgram self fromAbove originalEmpty transformedEmpty = defaultValue+    -- ====================================================================================================+    --   == Node transformers for Primitive(current basetype: ProgramConstruction)+    -- ====================================================================================================+    downwardsPrimitiveProgramInProgram :: t -> Downwards t -> Primitive (From t) -> Downwards t+    downwardsPrimitiveProgramInProgram self = const+    transformPrimitiveProgramInProgram :: t -> Downwards t -> Primitive (From t) -> InfoFromPrimitiveParts t -> ProgramConstruction (To t)+    transformPrimitiveProgramInProgram self fromAbove originalPrimitive fromBelow = PrimitiveProgram $ originalPrimitive {+        primitiveInstruction = recursivelyTransformedPrimitiveInstruction fromBelow,+        primitiveSemInf = convert $ primitiveSemInf originalPrimitive+    }+    upwardsPrimitiveProgramInProgram :: t -> Downwards t -> Primitive (From t) -> InfoFromPrimitiveParts t -> ProgramConstruction (To t) -> Upwards t+    upwardsPrimitiveProgramInProgram self fromAbove originalPrimitive fromBelow transformedPrimitive = foldlist ([(upwardsInfoFromPrimitiveInstruction fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for Sequence(current basetype: ProgramConstruction)+    -- ====================================================================================================+    downwardsSequenceProgramInProgram :: t -> Downwards t -> Sequence (From t) -> Downwards t+    downwardsSequenceProgramInProgram self = const+    transformSequenceProgramInProgram :: t -> Downwards t -> Sequence (From t) -> InfoFromSequenceParts t -> ProgramConstruction (To t)+    transformSequenceProgramInProgram self fromAbove originalSequence fromBelow = SequenceProgram $ originalSequence {+        sequenceProgramList = recursivelyTransformedSequenceProgramList fromBelow,+        sequenceSemInf = convert $ sequenceSemInf originalSequence+    }+    upwardsSequenceProgramInProgram :: t -> Downwards t -> Sequence (From t) -> InfoFromSequenceParts t -> ProgramConstruction (To t) -> Upwards t+    upwardsSequenceProgramInProgram self fromAbove originalSequence fromBelow transformedSequence = foldlist ((upwardsInfoFromSequenceProgramList fromBelow))+    -- ====================================================================================================+    --   == Node transformers for Branch(current basetype: ProgramConstruction)+    -- ====================================================================================================+    downwardsBranchProgramInProgram :: t -> Downwards t -> Branch (From t) -> Downwards t+    downwardsBranchProgramInProgram self = const+    transformBranchProgramInProgram :: t -> Downwards t -> Branch (From t) -> InfoFromBranchParts t -> ProgramConstruction (To t)+    transformBranchProgramInProgram self fromAbove originalBranch fromBelow = BranchProgram $ originalBranch {+        branchConditionVariable = recursivelyTransformedBranchConditionVariable fromBelow,+        thenBlock = recursivelyTransformedThenBlock fromBelow,+        elseBlock = recursivelyTransformedElseBlock fromBelow,+        branchSemInf = convert $ branchSemInf originalBranch+    }+    upwardsBranchProgramInProgram :: t -> Downwards t -> Branch (From t) -> InfoFromBranchParts t -> ProgramConstruction (To t) -> Upwards t+    upwardsBranchProgramInProgram self fromAbove originalBranch fromBelow transformedBranch = foldlist ([(upwardsInfoFromBranchConditionVariable fromBelow)] ++ [(upwardsInfoFromThenBlock fromBelow)] ++ [(upwardsInfoFromElseBlock fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for SequentialLoop(current basetype: ProgramConstruction)+    -- ====================================================================================================+    downwardsSequentialLoopProgramInProgram :: t -> Downwards t -> SequentialLoop (From t) -> Downwards t+    downwardsSequentialLoopProgramInProgram self = const+    transformSequentialLoopProgramInProgram :: t -> Downwards t -> SequentialLoop (From t) -> InfoFromSequentialLoopParts t -> ProgramConstruction (To t)+    transformSequentialLoopProgramInProgram self fromAbove originalSequentialLoop fromBelow = SequentialLoopProgram $ originalSequentialLoop {+        sequentialLoopCondition = recursivelyTransformedSequentialLoopCondition fromBelow,+        conditionCalculation = recursivelyTransformedConditionCalculation fromBelow,+        sequentialLoopCore = recursivelyTransformedSequentialLoopCore fromBelow,+        sequentialLoopSemInf = convert $ sequentialLoopSemInf originalSequentialLoop+    }+    upwardsSequentialLoopProgramInProgram :: t -> Downwards t -> SequentialLoop (From t) -> InfoFromSequentialLoopParts t -> ProgramConstruction (To t) -> Upwards t+    upwardsSequentialLoopProgramInProgram self fromAbove originalSequentialLoop fromBelow transformedSequentialLoop = foldlist ([(upwardsInfoFromSequentialLoopCondition fromBelow)] ++ [(upwardsInfoFromConditionCalculation fromBelow)] ++ [(upwardsInfoFromSequentialLoopCore fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for ParallelLoop(current basetype: ProgramConstruction)+    -- ====================================================================================================+    downwardsParallelLoopProgramInProgram :: t -> Downwards t -> ParallelLoop (From t) -> Downwards t+    downwardsParallelLoopProgramInProgram self = const+    transformParallelLoopProgramInProgram :: t -> Downwards t -> ParallelLoop (From t) -> InfoFromParallelLoopParts t -> ProgramConstruction (To t)+    transformParallelLoopProgramInProgram self fromAbove originalParallelLoop fromBelow = ParallelLoopProgram $ originalParallelLoop {+        parallelLoopConditionVariable = recursivelyTransformedParallelLoopConditionVariable fromBelow,+        numberOfIterations = recursivelyTransformedNumberOfIterations fromBelow,+        parallelLoopCore = recursivelyTransformedParallelLoopCore fromBelow,+        parallelLoopSemInf = convert $ parallelLoopSemInf originalParallelLoop+    }+    upwardsParallelLoopProgramInProgram :: t -> Downwards t -> ParallelLoop (From t) -> InfoFromParallelLoopParts t -> ProgramConstruction (To t) -> Upwards t+    upwardsParallelLoopProgramInProgram self fromAbove originalParallelLoop fromBelow transformedParallelLoop = foldlist ([(upwardsInfoFromParallelLoopConditionVariable fromBelow)] ++ [(upwardsInfoFromNumberOfIterations fromBelow)] ++ [(upwardsInfoFromParallelLoopCore fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for FormalParameter+    -- ====================================================================================================+    downwardsFormalParameter :: t -> Downwards t -> FormalParameter (From t) -> Downwards t+    downwardsFormalParameter self = const+    transformFormalParameter :: t -> Downwards t -> FormalParameter (From t) -> InfoFromFormalParameterParts t -> FormalParameter (To t)+    transformFormalParameter self fromAbove originalFormalParameter fromBelow = originalFormalParameter {+        formalParameterVariable = recursivelyTransformedFormalParameterVariable fromBelow,+        formalParameterSemInf = convert $ formalParameterSemInf originalFormalParameter+    }+    upwardsFormalParameter :: t -> Downwards t -> FormalParameter (From t) -> InfoFromFormalParameterParts t -> FormalParameter (To t) -> Upwards t+    upwardsFormalParameter self fromAbove originalFormalParameter fromBelow transformedFormalParameter = foldlist ([(upwardsInfoFromFormalParameterVariable fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for LocalDeclaration+    -- ====================================================================================================+    downwardsLocalDeclaration :: t -> Downwards t -> LocalDeclaration (From t) -> Downwards t+    downwardsLocalDeclaration self = const+    transformLocalDeclaration :: t -> Downwards t -> LocalDeclaration (From t) -> InfoFromLocalDeclarationParts t -> LocalDeclaration (To t)+    transformLocalDeclaration self fromAbove originalLocalDeclaration fromBelow = originalLocalDeclaration {+        localVariable = recursivelyTransformedLocalVariable fromBelow,+        localInitValue = recursivelyTransformedLocalInitValue fromBelow,+        localDeclarationSemInf = convert $ localDeclarationSemInf originalLocalDeclaration+    }+    upwardsLocalDeclaration :: t -> Downwards t -> LocalDeclaration (From t) -> InfoFromLocalDeclarationParts t -> LocalDeclaration (To t) -> Upwards t+    upwardsLocalDeclaration self fromAbove originalLocalDeclaration fromBelow transformedLocalDeclaration = foldlist ([(upwardsInfoFromLocalVariable fromBelow)] ++ convertMaybe (upwardsInfoFromLocalInitValue fromBelow))+    -- ====================================================================================================+    --   == Node transformers for Expression+    -- ====================================================================================================+    downwardsExpression :: t -> Downwards t -> Expression (From t) -> Downwards t+    downwardsExpression self = const+    transformExpression :: t -> Downwards t -> Expression (From t) -> InfoFromExpressionParts t -> Expression (To t)+    transformExpression self fromAbove originalExpression fromBelow = originalExpression {+        expressionData = recursivelyTransformedExpressionData fromBelow,+        expressionSemInf = convert $ expressionSemInf originalExpression+    }+    upwardsExpression :: t -> Downwards t -> Expression (From t) -> InfoFromExpressionParts t -> Expression (To t) -> Upwards t+    upwardsExpression self fromAbove originalExpression fromBelow transformedExpression = foldlist ([(upwardsInfoFromExpressionData fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for LeftValue(current basetype: ExpressionData)+    -- ====================================================================================================+    downwardsLeftValueExpressionInExpression :: t -> Downwards t -> LeftValue (From t) -> Downwards t+    downwardsLeftValueExpressionInExpression self = const+    transformLeftValueExpressionInExpression :: t -> Downwards t -> LeftValue (From t) -> InfoFromLeftValueParts t -> ExpressionData (To t)+    transformLeftValueExpressionInExpression self fromAbove originalLeftValue fromBelow = LeftValueExpression $ originalLeftValue {+        leftValueData = recursivelyTransformedLeftValueData fromBelow,+        leftValueSemInf = convert $ leftValueSemInf originalLeftValue+    }+    upwardsLeftValueExpressionInExpression :: t -> Downwards t -> LeftValue (From t) -> InfoFromLeftValueParts t -> ExpressionData (To t) -> Upwards t+    upwardsLeftValueExpressionInExpression self fromAbove originalLeftValue fromBelow transformedLeftValue = foldlist ([(upwardsInfoFromLeftValueData fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for Constant(current basetype: ExpressionData)+    -- ====================================================================================================+    downwardsConstantExpressionInExpression :: t -> Downwards t -> Constant (From t) -> Downwards t+    downwardsConstantExpressionInExpression self = const+    transformConstantExpressionInExpression :: t -> Downwards t -> Constant (From t) -> InfoFromConstantParts t -> ExpressionData (To t)+    transformConstantExpressionInExpression self fromAbove originalConstant fromBelow = ConstantExpression $ originalConstant {+        constantData = recursivelyTransformedConstantData fromBelow,+        constantSemInf = convert $ constantSemInf originalConstant+    }+    upwardsConstantExpressionInExpression :: t -> Downwards t -> Constant (From t) -> InfoFromConstantParts t -> ExpressionData (To t) -> Upwards t+    upwardsConstantExpressionInExpression self fromAbove originalConstant fromBelow transformedConstant = foldlist ([(upwardsInfoFromConstantData fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for FunctionCall(current basetype: ExpressionData)+    -- ====================================================================================================+    downwardsFunctionCallExpressionInExpression :: t -> Downwards t -> FunctionCall (From t) -> Downwards t+    downwardsFunctionCallExpressionInExpression self = const+    transformFunctionCallExpressionInExpression :: t -> Downwards t -> FunctionCall (From t) -> InfoFromFunctionCallParts t -> ExpressionData (To t)+    transformFunctionCallExpressionInExpression self fromAbove originalFunctionCall fromBelow = FunctionCallExpression $ originalFunctionCall {+        actualParametersOfFunctionToCall = recursivelyTransformedActualParametersOfFunctionToCall fromBelow,+        functionCallSemInf = convert $ functionCallSemInf originalFunctionCall+    }+    upwardsFunctionCallExpressionInExpression :: t -> Downwards t -> FunctionCall (From t) -> InfoFromFunctionCallParts t -> ExpressionData (To t) -> Upwards t+    upwardsFunctionCallExpressionInExpression self fromAbove originalFunctionCall fromBelow transformedFunctionCall = foldlist ((upwardsInfoFromActualParametersOfFunctionToCall fromBelow))+    -- ====================================================================================================+    --   == Node transformers for Constant+    -- ====================================================================================================+    downwardsConstant :: t -> Downwards t -> Constant (From t) -> Downwards t+    downwardsConstant self = const+    transformConstant :: t -> Downwards t -> Constant (From t) -> InfoFromConstantParts t -> Constant (To t)+    transformConstant self fromAbove originalConstant fromBelow = originalConstant {+        constantData = recursivelyTransformedConstantData fromBelow,+        constantSemInf = convert $ constantSemInf originalConstant+    }+    upwardsConstant :: t -> Downwards t -> Constant (From t) -> InfoFromConstantParts t -> Constant (To t) -> Upwards t+    upwardsConstant self fromAbove originalConstant fromBelow transformedConstant = foldlist ([(upwardsInfoFromConstantData fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for IntConstantType(current basetype: ConstantData)+    -- ====================================================================================================+    transformIntConstantInConstant :: t -> Downwards t -> IntConstantType (From t) -> ConstantData (To t)+    transformIntConstantInConstant self fromAbove originalIntConstantType = IntConstant $ originalIntConstantType {+        intConstantSemInf = convert $ intConstantSemInf originalIntConstantType+    }+    upwardsIntConstantInConstant :: t -> Downwards t -> IntConstantType (From t) -> ConstantData (To t) -> Upwards t+    upwardsIntConstantInConstant self fromAbove originalIntConstantType transformedIntConstantType = defaultValue+    -- ====================================================================================================+    --   == Node transformers for FloatConstantType(current basetype: ConstantData)+    -- ====================================================================================================+    transformFloatConstantInConstant :: t -> Downwards t -> FloatConstantType (From t) -> ConstantData (To t)+    transformFloatConstantInConstant self fromAbove originalFloatConstantType = FloatConstant $ originalFloatConstantType {+        floatConstantSemInf = convert $ floatConstantSemInf originalFloatConstantType+    }+    upwardsFloatConstantInConstant :: t -> Downwards t -> FloatConstantType (From t) -> ConstantData (To t) -> Upwards t+    upwardsFloatConstantInConstant self fromAbove originalFloatConstantType transformedFloatConstantType = defaultValue+    -- ====================================================================================================+    --   == Node transformers for BoolConstantType(current basetype: ConstantData)+    -- ====================================================================================================+    transformBoolConstantInConstant :: t -> Downwards t -> BoolConstantType (From t) -> ConstantData (To t)+    transformBoolConstantInConstant self fromAbove originalBoolConstantType = BoolConstant $ originalBoolConstantType {+        boolConstantSemInf = convert $ boolConstantSemInf originalBoolConstantType+    }+    upwardsBoolConstantInConstant :: t -> Downwards t -> BoolConstantType (From t) -> ConstantData (To t) -> Upwards t+    upwardsBoolConstantInConstant self fromAbove originalBoolConstantType transformedBoolConstantType = defaultValue+    -- ====================================================================================================+    --   == Node transformers for ArrayConstantType(current basetype: ConstantData)+    -- ====================================================================================================+    downwardsArrayConstantInConstant :: t -> Downwards t -> ArrayConstantType (From t) -> Downwards t+    downwardsArrayConstantInConstant self = const+    transformArrayConstantInConstant :: t -> Downwards t -> ArrayConstantType (From t) -> InfoFromArrayConstantParts t -> ConstantData (To t)+    transformArrayConstantInConstant self fromAbove originalArrayConstantType fromBelow = ArrayConstant $ originalArrayConstantType {+        arrayConstantValue = recursivelyTransformedArrayConstantValue fromBelow,+        arrayConstantSemInf = convert $ arrayConstantSemInf originalArrayConstantType+    }+    upwardsArrayConstantInConstant :: t -> Downwards t -> ArrayConstantType (From t) -> InfoFromArrayConstantParts t -> ConstantData (To t) -> Upwards t+    upwardsArrayConstantInConstant self fromAbove originalArrayConstantType fromBelow transformedArrayConstantType = foldlist ((upwardsInfoFromArrayConstantValue fromBelow))+    -- ====================================================================================================+    --   == Node transformers for LeftValue+    -- ====================================================================================================+    downwardsLeftValue :: t -> Downwards t -> LeftValue (From t) -> Downwards t+    downwardsLeftValue self = const+    transformLeftValue :: t -> Downwards t -> LeftValue (From t) -> InfoFromLeftValueParts t -> LeftValue (To t)+    transformLeftValue self fromAbove originalLeftValue fromBelow = originalLeftValue {+        leftValueData = recursivelyTransformedLeftValueData fromBelow,+        leftValueSemInf = convert $ leftValueSemInf originalLeftValue+    }+    upwardsLeftValue :: t -> Downwards t -> LeftValue (From t) -> InfoFromLeftValueParts t -> LeftValue (To t) -> Upwards t+    upwardsLeftValue self fromAbove originalLeftValue fromBelow transformedLeftValue = foldlist ([(upwardsInfoFromLeftValueData fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for Variable(current basetype: LeftValueData)+    -- ====================================================================================================+    transformVariableLeftValueInLeftValue :: t -> Downwards t -> Variable (From t) -> LeftValueData (To t)+    transformVariableLeftValueInLeftValue self fromAbove originalVariable = VariableLeftValue $ originalVariable {+        variableSemInf = convert $ variableSemInf originalVariable+    }+    upwardsVariableLeftValueInLeftValue :: t -> Downwards t -> Variable (From t) -> LeftValueData (To t) -> Upwards t+    upwardsVariableLeftValueInLeftValue self fromAbove originalVariable transformedVariable = defaultValue+    -- ====================================================================================================+    --   == Node transformers for ArrayElemReference(current basetype: LeftValueData)+    -- ====================================================================================================+    downwardsArrayElemReferenceLeftValueInLeftValue :: t -> Downwards t -> ArrayElemReference (From t) -> Downwards t+    downwardsArrayElemReferenceLeftValueInLeftValue self = const+    transformArrayElemReferenceLeftValueInLeftValue :: t -> Downwards t -> ArrayElemReference (From t) -> InfoFromArrayElemReferenceParts t -> LeftValueData (To t)+    transformArrayElemReferenceLeftValueInLeftValue self fromAbove originalArrayElemReference fromBelow = ArrayElemReferenceLeftValue $ originalArrayElemReference {+        arrayName = recursivelyTransformedArrayName fromBelow,+        arrayIndex = recursivelyTransformedArrayIndex fromBelow,+        arrayElemReferenceSemInf = convert $ arrayElemReferenceSemInf originalArrayElemReference+    }+    upwardsArrayElemReferenceLeftValueInLeftValue :: t -> Downwards t -> ArrayElemReference (From t) -> InfoFromArrayElemReferenceParts t -> LeftValueData (To t) -> Upwards t+    upwardsArrayElemReferenceLeftValueInLeftValue self fromAbove originalArrayElemReference fromBelow transformedArrayElemReference = foldlist ([(upwardsInfoFromArrayName fromBelow)] ++ [(upwardsInfoFromArrayIndex fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for Instruction+    -- ====================================================================================================+    downwardsInstruction :: t -> Downwards t -> Instruction (From t) -> Downwards t+    downwardsInstruction self = const+    transformInstruction :: t -> Downwards t -> Instruction (From t) -> InfoFromInstructionParts t -> Instruction (To t)+    transformInstruction self fromAbove originalInstruction fromBelow = originalInstruction {+        instructionData = recursivelyTransformedInstructionData fromBelow,+        instructionSemInf = convert $ instructionSemInf originalInstruction+    }+    upwardsInstruction :: t -> Downwards t -> Instruction (From t) -> InfoFromInstructionParts t -> Instruction (To t) -> Upwards t+    upwardsInstruction self fromAbove originalInstruction fromBelow transformedInstruction = foldlist ([(upwardsInfoFromInstructionData fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for Assignment(current basetype: InstructionData)+    -- ====================================================================================================+    downwardsAssignmentInstructionInInstruction :: t -> Downwards t -> Assignment (From t) -> Downwards t+    downwardsAssignmentInstructionInInstruction self = const+    transformAssignmentInstructionInInstruction :: t -> Downwards t -> Assignment (From t) -> InfoFromAssignmentParts t -> InstructionData (To t)+    transformAssignmentInstructionInInstruction self fromAbove originalAssignment fromBelow = AssignmentInstruction $ originalAssignment {+        assignmentLhs = recursivelyTransformedAssignmentLhs fromBelow,+        assignmentRhs = recursivelyTransformedAssignmentRhs fromBelow,+        assignmentSemInf = convert $ assignmentSemInf originalAssignment+    }+    upwardsAssignmentInstructionInInstruction :: t -> Downwards t -> Assignment (From t) -> InfoFromAssignmentParts t -> InstructionData (To t) -> Upwards t+    upwardsAssignmentInstructionInInstruction self fromAbove originalAssignment fromBelow transformedAssignment = foldlist ([(upwardsInfoFromAssignmentLhs fromBelow)] ++ [(upwardsInfoFromAssignmentRhs fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for ProcedureCall(current basetype: InstructionData)+    -- ====================================================================================================+    downwardsProcedureCallInstructionInInstruction :: t -> Downwards t -> ProcedureCall (From t) -> Downwards t+    downwardsProcedureCallInstructionInInstruction self = const+    transformProcedureCallInstructionInInstruction :: t -> Downwards t -> ProcedureCall (From t) -> InfoFromProcedureCallParts t -> InstructionData (To t)+    transformProcedureCallInstructionInInstruction self fromAbove originalProcedureCall fromBelow = ProcedureCallInstruction $ originalProcedureCall {+        actualParametersOfProcedureToCall = recursivelyTransformedActualParametersOfProcedureToCall fromBelow,+        procedureCallSemInf = convert $ procedureCallSemInf originalProcedureCall+    }+    upwardsProcedureCallInstructionInInstruction :: t -> Downwards t -> ProcedureCall (From t) -> InfoFromProcedureCallParts t -> InstructionData (To t) -> Upwards t+    upwardsProcedureCallInstructionInInstruction self fromAbove originalProcedureCall fromBelow transformedProcedureCall = foldlist ((upwardsInfoFromActualParametersOfProcedureToCall fromBelow))+    -- ====================================================================================================+    --   == Node transformers for ActualParameter+    -- ====================================================================================================+    downwardsActualParameter :: t -> Downwards t -> ActualParameter (From t) -> Downwards t+    downwardsActualParameter self = const+    transformActualParameter :: t -> Downwards t -> ActualParameter (From t) -> InfoFromActualParameterParts t -> ActualParameter (To t)+    transformActualParameter self fromAbove originalActualParameter fromBelow = originalActualParameter {+        actualParameterData = recursivelyTransformedActualParameterData fromBelow,+        actualParameterSemInf = convert $ actualParameterSemInf originalActualParameter+    }+    upwardsActualParameter :: t -> Downwards t -> ActualParameter (From t) -> InfoFromActualParameterParts t -> ActualParameter (To t) -> Upwards t+    upwardsActualParameter self fromAbove originalActualParameter fromBelow transformedActualParameter = foldlist ([(upwardsInfoFromActualParameterData fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for Expression(current basetype: ActualParameterData)+    -- ====================================================================================================+    downwardsInputActualParameterInActualParameter :: t -> Downwards t -> Expression (From t) -> Downwards t+    downwardsInputActualParameterInActualParameter self = const+    transformInputActualParameterInActualParameter :: t -> Downwards t -> Expression (From t) -> InfoFromExpressionParts t -> ActualParameterData (To t)+    transformInputActualParameterInActualParameter self fromAbove originalExpression fromBelow = InputActualParameter $ originalExpression {+        expressionData = recursivelyTransformedExpressionData fromBelow,+        expressionSemInf = convert $ expressionSemInf originalExpression+    }+    upwardsInputActualParameterInActualParameter :: t -> Downwards t -> Expression (From t) -> InfoFromExpressionParts t -> ActualParameterData (To t) -> Upwards t+    upwardsInputActualParameterInActualParameter self fromAbove originalExpression fromBelow transformedExpression = foldlist ([(upwardsInfoFromExpressionData fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for LeftValue(current basetype: ActualParameterData)+    -- ====================================================================================================+    downwardsOutputActualParameterInActualParameter :: t -> Downwards t -> LeftValue (From t) -> Downwards t+    downwardsOutputActualParameterInActualParameter self = const+    transformOutputActualParameterInActualParameter :: t -> Downwards t -> LeftValue (From t) -> InfoFromLeftValueParts t -> ActualParameterData (To t)+    transformOutputActualParameterInActualParameter self fromAbove originalLeftValue fromBelow = OutputActualParameter $ originalLeftValue {+        leftValueData = recursivelyTransformedLeftValueData fromBelow,+        leftValueSemInf = convert $ leftValueSemInf originalLeftValue+    }+    upwardsOutputActualParameterInActualParameter :: t -> Downwards t -> LeftValue (From t) -> InfoFromLeftValueParts t -> ActualParameterData (To t) -> Upwards t+    upwardsOutputActualParameterInActualParameter self fromAbove originalLeftValue fromBelow transformedLeftValue = foldlist ([(upwardsInfoFromLeftValueData fromBelow)])+    -- ====================================================================================================+    --   == Node transformers for IntConstantType+    -- ====================================================================================================+    transformIntConstant :: t -> Downwards t -> IntConstantType (From t) -> IntConstantType (To t)+    transformIntConstant self fromAbove originalIntConstantType = originalIntConstantType {+        intConstantSemInf = convert $ intConstantSemInf originalIntConstantType+    }+    upwardsIntConstant :: t -> Downwards t -> IntConstantType (From t) -> IntConstantType (To t) -> Upwards t+    upwardsIntConstant self fromAbove originalIntConstantType transformedIntConstantType = defaultValue+    -- ====================================================================================================+    --   == Node transformers for FloatConstantType+    -- ====================================================================================================+    transformFloatConstant :: t -> Downwards t -> FloatConstantType (From t) -> FloatConstantType (To t)+    transformFloatConstant self fromAbove originalFloatConstantType = originalFloatConstantType {+        floatConstantSemInf = convert $ floatConstantSemInf originalFloatConstantType+    }+    upwardsFloatConstant :: t -> Downwards t -> FloatConstantType (From t) -> FloatConstantType (To t) -> Upwards t+    upwardsFloatConstant self fromAbove originalFloatConstantType transformedFloatConstantType = defaultValue+    -- ====================================================================================================+    --   == Node transformers for BoolConstantType+    -- ====================================================================================================+    transformBoolConstant :: t -> Downwards t -> BoolConstantType (From t) -> BoolConstantType (To t)+    transformBoolConstant self fromAbove originalBoolConstantType = originalBoolConstantType {+        boolConstantSemInf = convert $ boolConstantSemInf originalBoolConstantType+    }+    upwardsBoolConstant :: t -> Downwards t -> BoolConstantType (From t) -> BoolConstantType (To t) -> Upwards t+    upwardsBoolConstant self fromAbove originalBoolConstantType transformedBoolConstantType = defaultValue+    -- ====================================================================================================+    --   == Node transformers for Variable+    -- ====================================================================================================+    transformVariable :: t -> Downwards t -> Variable (From t) -> Variable (To t)+    transformVariable self fromAbove originalVariable = originalVariable {+        variableSemInf = convert $ variableSemInf originalVariable+    }+    upwardsVariable :: t -> Downwards t -> Variable (From t) -> Variable (To t) -> Upwards t+    upwardsVariable self fromAbove originalVariable transformedVariable = defaultValue+-- ====================================================================================================+--   == Walker functions+-- ====================================================================================================+    -- ====================================================================================================+    --   == Walker for Procedure+    -- ====================================================================================================+    walkProcedure :: Walker t Procedure+    walkProcedure selfpointer fromAbove construction = (transformedProcedure, toAbove)+        where+            toBelow = downwardsProcedure selfpointer fromAbove construction+            transformedInParameters = map (walkFormalParameter selfpointer toBelow) $ inParameters construction+            transformedOutParameters = map (walkFormalParameter selfpointer toBelow) $ outParameters construction+            transformedProcedureBody = (walkBlock selfpointer toBelow) $ procedureBody construction+            fromBelow = InfoFromProcedureParts {+                recursivelyTransformedInParameters = map fst transformedInParameters,+                upwardsInfoFromInParameters = map snd transformedInParameters,+                recursivelyTransformedOutParameters = map fst transformedOutParameters,+                upwardsInfoFromOutParameters = map snd transformedOutParameters,+                recursivelyTransformedProcedureBody = fst transformedProcedureBody,+                upwardsInfoFromProcedureBody = snd transformedProcedureBody+            }+            transformedProcedure = transformProcedure selfpointer fromAbove construction fromBelow+            toAbove = upwardsProcedure selfpointer fromAbove construction fromBelow transformedProcedure+    -- ====================================================================================================+    --   == Walker for Block+    -- ====================================================================================================+    walkBlock :: Walker t Block+    walkBlock selfpointer fromAbove construction = (transformedBlock, toAbove)+        where+            toBelow = downwardsBlock selfpointer fromAbove construction+            transformedBlockDeclarations = map (walkLocalDeclaration selfpointer toBelow) $ blockDeclarations construction+            transformedBlockInstructions = (walkProgram selfpointer toBelow) $ blockInstructions construction+            fromBelow = InfoFromBlockParts {+                recursivelyTransformedBlockDeclarations = map fst transformedBlockDeclarations,+                upwardsInfoFromBlockDeclarations = map snd transformedBlockDeclarations,+                recursivelyTransformedBlockInstructions = fst transformedBlockInstructions,+                upwardsInfoFromBlockInstructions = snd transformedBlockInstructions+            }+            transformedBlock = transformBlock selfpointer fromAbove construction fromBelow+            toAbove = upwardsBlock selfpointer fromAbove construction fromBelow transformedBlock+    -- ====================================================================================================+    --   == Walker for Program+    -- ====================================================================================================+    walkProgram :: Walker t Program+    walkProgram selfpointer fromAbove construction = (transformedProgram, toAbove)+        where+            toBelow = downwardsProgram selfpointer fromAbove construction+            transformedProgramConstruction = case programConstruction construction of+                EmptyProgram construction -> (walkEmptyProgramInProgram selfpointer toBelow) construction+                PrimitiveProgram construction -> (walkPrimitiveProgramInProgram selfpointer toBelow) construction+                SequenceProgram construction -> (walkSequenceProgramInProgram selfpointer toBelow) construction+                BranchProgram construction -> (walkBranchProgramInProgram selfpointer toBelow) construction+                SequentialLoopProgram construction -> (walkSequentialLoopProgramInProgram selfpointer toBelow) construction+                ParallelLoopProgram construction -> (walkParallelLoopProgramInProgram selfpointer toBelow) construction+            fromBelow = InfoFromProgramParts {+                recursivelyTransformedProgramConstruction = fst transformedProgramConstruction,+                upwardsInfoFromProgramConstruction = snd transformedProgramConstruction+            }+            transformedProgram = transformProgram selfpointer fromAbove construction fromBelow+            toAbove = upwardsProgram selfpointer fromAbove construction fromBelow transformedProgram+    -- ====================================================================================================+    --   == Walker for Empty, current base type: ProgramConstruction+    -- ====================================================================================================+    walkEmptyProgramInProgram :: (TransformationPhase t) => t -> Downwards t -> Empty (From t) -> (ProgramConstruction (To t), Upwards t)+    walkEmptyProgramInProgram selfpointer fromAbove construction = (transformedEmpty, toAbove)+        where+            transformedEmpty = transformEmptyProgramInProgram selfpointer fromAbove construction+            toAbove = upwardsEmptyProgramInProgram selfpointer fromAbove construction transformedEmpty+    -- ====================================================================================================+    --   == Walker for Primitive, current base type: ProgramConstruction+    -- ====================================================================================================+    walkPrimitiveProgramInProgram :: (TransformationPhase t) => t -> Downwards t -> Primitive (From t) -> (ProgramConstruction (To t), Upwards t)+    walkPrimitiveProgramInProgram selfpointer fromAbove construction = (transformedPrimitive, toAbove)+        where+            toBelow = downwardsPrimitiveProgramInProgram selfpointer fromAbove construction+            transformedPrimitiveInstruction = (walkInstruction selfpointer toBelow) $ primitiveInstruction construction+            fromBelow = InfoFromPrimitiveParts {+                recursivelyTransformedPrimitiveInstruction = fst transformedPrimitiveInstruction,+                upwardsInfoFromPrimitiveInstruction = snd transformedPrimitiveInstruction+            }+            transformedPrimitive = transformPrimitiveProgramInProgram selfpointer fromAbove construction fromBelow+            toAbove = upwardsPrimitiveProgramInProgram selfpointer fromAbove construction fromBelow transformedPrimitive+    -- ====================================================================================================+    --   == Walker for Sequence, current base type: ProgramConstruction+    -- ====================================================================================================+    walkSequenceProgramInProgram :: (TransformationPhase t) => t -> Downwards t -> Sequence (From t) -> (ProgramConstruction (To t), Upwards t)+    walkSequenceProgramInProgram selfpointer fromAbove construction = (transformedSequence, toAbove)+        where+            toBelow = downwardsSequenceProgramInProgram selfpointer fromAbove construction+            transformedSequenceProgramList = map (walkProgram selfpointer toBelow) $ sequenceProgramList construction+            fromBelow = InfoFromSequenceParts {+                recursivelyTransformedSequenceProgramList = map fst transformedSequenceProgramList,+                upwardsInfoFromSequenceProgramList = map snd transformedSequenceProgramList+            }+            transformedSequence = transformSequenceProgramInProgram selfpointer fromAbove construction fromBelow+            toAbove = upwardsSequenceProgramInProgram selfpointer fromAbove construction fromBelow transformedSequence+    -- ====================================================================================================+    --   == Walker for Branch, current base type: ProgramConstruction+    -- ====================================================================================================+    walkBranchProgramInProgram :: (TransformationPhase t) => t -> Downwards t -> Branch (From t) -> (ProgramConstruction (To t), Upwards t)+    walkBranchProgramInProgram selfpointer fromAbove construction = (transformedBranch, toAbove)+        where+            toBelow = downwardsBranchProgramInProgram selfpointer fromAbove construction+            transformedBranchConditionVariable = (walkVariable selfpointer toBelow) $ branchConditionVariable construction+            transformedThenBlock = (walkBlock selfpointer toBelow) $ thenBlock construction+            transformedElseBlock = (walkBlock selfpointer toBelow) $ elseBlock construction+            fromBelow = InfoFromBranchParts {+                recursivelyTransformedBranchConditionVariable = fst transformedBranchConditionVariable,+                upwardsInfoFromBranchConditionVariable = snd transformedBranchConditionVariable,+                recursivelyTransformedThenBlock = fst transformedThenBlock,+                upwardsInfoFromThenBlock = snd transformedThenBlock,+                recursivelyTransformedElseBlock = fst transformedElseBlock,+                upwardsInfoFromElseBlock = snd transformedElseBlock+            }+            transformedBranch = transformBranchProgramInProgram selfpointer fromAbove construction fromBelow+            toAbove = upwardsBranchProgramInProgram selfpointer fromAbove construction fromBelow transformedBranch+    -- ====================================================================================================+    --   == Walker for SequentialLoop, current base type: ProgramConstruction+    -- ====================================================================================================+    walkSequentialLoopProgramInProgram :: (TransformationPhase t) => t -> Downwards t -> SequentialLoop (From t) -> (ProgramConstruction (To t), Upwards t)+    walkSequentialLoopProgramInProgram selfpointer fromAbove construction = (transformedSequentialLoop, toAbove)+        where+            toBelow = downwardsSequentialLoopProgramInProgram selfpointer fromAbove construction+            transformedSequentialLoopCondition = (walkExpression selfpointer toBelow) $ sequentialLoopCondition construction+            transformedConditionCalculation = (walkBlock selfpointer toBelow) $ conditionCalculation construction+            transformedSequentialLoopCore = (walkBlock selfpointer toBelow) $ sequentialLoopCore construction+            fromBelow = InfoFromSequentialLoopParts {+                recursivelyTransformedSequentialLoopCondition = fst transformedSequentialLoopCondition,+                upwardsInfoFromSequentialLoopCondition = snd transformedSequentialLoopCondition,+                recursivelyTransformedConditionCalculation = fst transformedConditionCalculation,+                upwardsInfoFromConditionCalculation = snd transformedConditionCalculation,+                recursivelyTransformedSequentialLoopCore = fst transformedSequentialLoopCore,+                upwardsInfoFromSequentialLoopCore = snd transformedSequentialLoopCore+            }+            transformedSequentialLoop = transformSequentialLoopProgramInProgram selfpointer fromAbove construction fromBelow+            toAbove = upwardsSequentialLoopProgramInProgram selfpointer fromAbove construction fromBelow transformedSequentialLoop+    -- ====================================================================================================+    --   == Walker for ParallelLoop, current base type: ProgramConstruction+    -- ====================================================================================================+    walkParallelLoopProgramInProgram :: (TransformationPhase t) => t -> Downwards t -> ParallelLoop (From t) -> (ProgramConstruction (To t), Upwards t)+    walkParallelLoopProgramInProgram selfpointer fromAbove construction = (transformedParallelLoop, toAbove)+        where+            toBelow = downwardsParallelLoopProgramInProgram selfpointer fromAbove construction+            transformedParallelLoopConditionVariable = (walkVariable selfpointer toBelow) $ parallelLoopConditionVariable construction+            transformedNumberOfIterations = (walkExpression selfpointer toBelow) $ numberOfIterations construction+            transformedParallelLoopCore = (walkBlock selfpointer toBelow) $ parallelLoopCore construction+            fromBelow = InfoFromParallelLoopParts {+                recursivelyTransformedParallelLoopConditionVariable = fst transformedParallelLoopConditionVariable,+                upwardsInfoFromParallelLoopConditionVariable = snd transformedParallelLoopConditionVariable,+                recursivelyTransformedNumberOfIterations = fst transformedNumberOfIterations,+                upwardsInfoFromNumberOfIterations = snd transformedNumberOfIterations,+                recursivelyTransformedParallelLoopCore = fst transformedParallelLoopCore,+                upwardsInfoFromParallelLoopCore = snd transformedParallelLoopCore+            }+            transformedParallelLoop = transformParallelLoopProgramInProgram selfpointer fromAbove construction fromBelow+            toAbove = upwardsParallelLoopProgramInProgram selfpointer fromAbove construction fromBelow transformedParallelLoop+    -- ====================================================================================================+    --   == Walker for FormalParameter+    -- ====================================================================================================+    walkFormalParameter :: Walker t FormalParameter+    walkFormalParameter selfpointer fromAbove construction = (transformedFormalParameter, toAbove)+        where+            toBelow = downwardsFormalParameter selfpointer fromAbove construction+            transformedFormalParameterVariable = (walkVariable selfpointer toBelow) $ formalParameterVariable construction+            fromBelow = InfoFromFormalParameterParts {+                recursivelyTransformedFormalParameterVariable = fst transformedFormalParameterVariable,+                upwardsInfoFromFormalParameterVariable = snd transformedFormalParameterVariable+            }+            transformedFormalParameter = transformFormalParameter selfpointer fromAbove construction fromBelow+            toAbove = upwardsFormalParameter selfpointer fromAbove construction fromBelow transformedFormalParameter+    -- ====================================================================================================+    --   == Walker for LocalDeclaration+    -- ====================================================================================================+    walkLocalDeclaration :: Walker t LocalDeclaration+    walkLocalDeclaration selfpointer fromAbove construction = (transformedLocalDeclaration, toAbove)+        where+            toBelow = downwardsLocalDeclaration selfpointer fromAbove construction+            transformedLocalVariable = (walkVariable selfpointer toBelow) $ localVariable construction+            transformedLocalInitValue = case localInitValue construction of+                Nothing -> (Nothing, Nothing)+                Just justLocalInitValue -> (Just (fst transformedJustLocalInitValue), Just (snd transformedJustLocalInitValue))+                    where transformedJustLocalInitValue = (walkExpression selfpointer toBelow) $ justLocalInitValue+            fromBelow = InfoFromLocalDeclarationParts {+                recursivelyTransformedLocalVariable = fst transformedLocalVariable,+                upwardsInfoFromLocalVariable = snd transformedLocalVariable,+                recursivelyTransformedLocalInitValue = fst transformedLocalInitValue,+                upwardsInfoFromLocalInitValue = snd transformedLocalInitValue+            }+            transformedLocalDeclaration = transformLocalDeclaration selfpointer fromAbove construction fromBelow+            toAbove = upwardsLocalDeclaration selfpointer fromAbove construction fromBelow transformedLocalDeclaration+    -- ====================================================================================================+    --   == Walker for Expression+    -- ====================================================================================================+    walkExpression :: Walker t Expression+    walkExpression selfpointer fromAbove construction = (transformedExpression, toAbove)+        where+            toBelow = downwardsExpression selfpointer fromAbove construction+            transformedExpressionData = case expressionData construction of+                LeftValueExpression construction -> (walkLeftValueExpressionInExpression selfpointer toBelow) construction+                ConstantExpression construction -> (walkConstantExpressionInExpression selfpointer toBelow) construction+                FunctionCallExpression construction -> (walkFunctionCallExpressionInExpression selfpointer toBelow) construction+            fromBelow = InfoFromExpressionParts {+                recursivelyTransformedExpressionData = fst transformedExpressionData,+                upwardsInfoFromExpressionData = snd transformedExpressionData+            }+            transformedExpression = transformExpression selfpointer fromAbove construction fromBelow+            toAbove = upwardsExpression selfpointer fromAbove construction fromBelow transformedExpression+    -- ====================================================================================================+    --   == Walker for LeftValue, current base type: ExpressionData+    -- ====================================================================================================+    walkLeftValueExpressionInExpression :: (TransformationPhase t) => t -> Downwards t -> LeftValue (From t) -> (ExpressionData (To t), Upwards t)+    walkLeftValueExpressionInExpression selfpointer fromAbove construction = (transformedLeftValue, toAbove)+        where+            toBelow = downwardsLeftValueExpressionInExpression selfpointer fromAbove construction+            transformedLeftValueData = case leftValueData construction of+                VariableLeftValue construction -> (walkVariableLeftValueInLeftValue selfpointer toBelow) construction+                ArrayElemReferenceLeftValue construction -> (walkArrayElemReferenceLeftValueInLeftValue selfpointer toBelow) construction+            fromBelow = InfoFromLeftValueParts {+                recursivelyTransformedLeftValueData = fst transformedLeftValueData,+                upwardsInfoFromLeftValueData = snd transformedLeftValueData+            }+            transformedLeftValue = transformLeftValueExpressionInExpression selfpointer fromAbove construction fromBelow+            toAbove = upwardsLeftValueExpressionInExpression selfpointer fromAbove construction fromBelow transformedLeftValue+    -- ====================================================================================================+    --   == Walker for Constant, current base type: ExpressionData+    -- ====================================================================================================+    walkConstantExpressionInExpression :: (TransformationPhase t) => t -> Downwards t -> Constant (From t) -> (ExpressionData (To t), Upwards t)+    walkConstantExpressionInExpression selfpointer fromAbove construction = (transformedConstant, toAbove)+        where+            toBelow = downwardsConstantExpressionInExpression selfpointer fromAbove construction+            transformedConstantData = case constantData construction of+                IntConstant construction -> (walkIntConstantInConstant selfpointer toBelow) construction+                FloatConstant construction -> (walkFloatConstantInConstant selfpointer toBelow) construction+                BoolConstant construction -> (walkBoolConstantInConstant selfpointer toBelow) construction+                ArrayConstant construction -> (walkArrayConstantInConstant selfpointer toBelow) construction+            fromBelow = InfoFromConstantParts {+                recursivelyTransformedConstantData = fst transformedConstantData,+                upwardsInfoFromConstantData = snd transformedConstantData+            }+            transformedConstant = transformConstantExpressionInExpression selfpointer fromAbove construction fromBelow+            toAbove = upwardsConstantExpressionInExpression selfpointer fromAbove construction fromBelow transformedConstant+    -- ====================================================================================================+    --   == Walker for FunctionCall, current base type: ExpressionData+    -- ====================================================================================================+    walkFunctionCallExpressionInExpression :: (TransformationPhase t) => t -> Downwards t -> FunctionCall (From t) -> (ExpressionData (To t), Upwards t)+    walkFunctionCallExpressionInExpression selfpointer fromAbove construction = (transformedFunctionCall, toAbove)+        where+            toBelow = downwardsFunctionCallExpressionInExpression selfpointer fromAbove construction+            transformedActualParametersOfFunctionToCall = map (walkExpression selfpointer toBelow) $ actualParametersOfFunctionToCall construction+            fromBelow = InfoFromFunctionCallParts {+                recursivelyTransformedActualParametersOfFunctionToCall = map fst transformedActualParametersOfFunctionToCall,+                upwardsInfoFromActualParametersOfFunctionToCall = map snd transformedActualParametersOfFunctionToCall+            }+            transformedFunctionCall = transformFunctionCallExpressionInExpression selfpointer fromAbove construction fromBelow+            toAbove = upwardsFunctionCallExpressionInExpression selfpointer fromAbove construction fromBelow transformedFunctionCall+    -- ====================================================================================================+    --   == Walker for Constant+    -- ====================================================================================================+    walkConstant :: Walker t Constant+    walkConstant selfpointer fromAbove construction = (transformedConstant, toAbove)+        where+            toBelow = downwardsConstant selfpointer fromAbove construction+            transformedConstantData = case constantData construction of+                IntConstant construction -> (walkIntConstantInConstant selfpointer toBelow) construction+                FloatConstant construction -> (walkFloatConstantInConstant selfpointer toBelow) construction+                BoolConstant construction -> (walkBoolConstantInConstant selfpointer toBelow) construction+                ArrayConstant construction -> (walkArrayConstantInConstant selfpointer toBelow) construction+            fromBelow = InfoFromConstantParts {+                recursivelyTransformedConstantData = fst transformedConstantData,+                upwardsInfoFromConstantData = snd transformedConstantData+            }+            transformedConstant = transformConstant selfpointer fromAbove construction fromBelow+            toAbove = upwardsConstant selfpointer fromAbove construction fromBelow transformedConstant+    -- ====================================================================================================+    --   == Walker for IntConstantType, current base type: ConstantData+    -- ====================================================================================================+    walkIntConstantInConstant :: (TransformationPhase t) => t -> Downwards t -> IntConstantType (From t) -> (ConstantData (To t), Upwards t)+    walkIntConstantInConstant selfpointer fromAbove construction = (transformedIntConstantType, toAbove)+        where+            transformedIntConstantType = transformIntConstantInConstant selfpointer fromAbove construction+            toAbove = upwardsIntConstantInConstant selfpointer fromAbove construction transformedIntConstantType+    -- ====================================================================================================+    --   == Walker for FloatConstantType, current base type: ConstantData+    -- ====================================================================================================+    walkFloatConstantInConstant :: (TransformationPhase t) => t -> Downwards t -> FloatConstantType (From t) -> (ConstantData (To t), Upwards t)+    walkFloatConstantInConstant selfpointer fromAbove construction = (transformedFloatConstantType, toAbove)+        where+            transformedFloatConstantType = transformFloatConstantInConstant selfpointer fromAbove construction+            toAbove = upwardsFloatConstantInConstant selfpointer fromAbove construction transformedFloatConstantType+    -- ====================================================================================================+    --   == Walker for BoolConstantType, current base type: ConstantData+    -- ====================================================================================================+    walkBoolConstantInConstant :: (TransformationPhase t) => t -> Downwards t -> BoolConstantType (From t) -> (ConstantData (To t), Upwards t)+    walkBoolConstantInConstant selfpointer fromAbove construction = (transformedBoolConstantType, toAbove)+        where+            transformedBoolConstantType = transformBoolConstantInConstant selfpointer fromAbove construction+            toAbove = upwardsBoolConstantInConstant selfpointer fromAbove construction transformedBoolConstantType+    -- ====================================================================================================+    --   == Walker for ArrayConstantType, current base type: ConstantData+    -- ====================================================================================================+    walkArrayConstantInConstant :: (TransformationPhase t) => t -> Downwards t -> ArrayConstantType (From t) -> (ConstantData (To t), Upwards t)+    walkArrayConstantInConstant selfpointer fromAbove construction = (transformedArrayConstantType, toAbove)+        where+            toBelow = downwardsArrayConstantInConstant selfpointer fromAbove construction+            transformedArrayConstantValue = map (walkConstant selfpointer toBelow) $ arrayConstantValue construction+            fromBelow = InfoFromArrayConstantParts {+                recursivelyTransformedArrayConstantValue = map fst transformedArrayConstantValue,+                upwardsInfoFromArrayConstantValue = map snd transformedArrayConstantValue+            }+            transformedArrayConstantType = transformArrayConstantInConstant selfpointer fromAbove construction fromBelow+            toAbove = upwardsArrayConstantInConstant selfpointer fromAbove construction fromBelow transformedArrayConstantType++    -- ====================================================================================================+    --   == Walker for LeftValue+    -- ====================================================================================================+    walkLeftValue :: Walker t LeftValue+    walkLeftValue selfpointer fromAbove construction = (transformedLeftValue, toAbove)+        where+            toBelow = downwardsLeftValue selfpointer fromAbove construction+            transformedLeftValueData = case leftValueData construction of+                VariableLeftValue construction -> (walkVariableLeftValueInLeftValue selfpointer toBelow) construction+                ArrayElemReferenceLeftValue construction -> (walkArrayElemReferenceLeftValueInLeftValue selfpointer toBelow) construction+            fromBelow = InfoFromLeftValueParts {+                recursivelyTransformedLeftValueData = fst transformedLeftValueData,+                upwardsInfoFromLeftValueData = snd transformedLeftValueData+            }+            transformedLeftValue = transformLeftValue selfpointer fromAbove construction fromBelow+            toAbove = upwardsLeftValue selfpointer fromAbove construction fromBelow transformedLeftValue+    -- ====================================================================================================+    --   == Walker for Variable, current base type: LeftValueData+    -- ====================================================================================================+    walkVariableLeftValueInLeftValue :: (TransformationPhase t) => t -> Downwards t -> Variable (From t) -> (LeftValueData (To t), Upwards t)+    walkVariableLeftValueInLeftValue selfpointer fromAbove construction = (transformedVariable, toAbove)+        where+            transformedVariable = transformVariableLeftValueInLeftValue selfpointer fromAbove construction+            toAbove = upwardsVariableLeftValueInLeftValue selfpointer fromAbove construction transformedVariable+    -- ====================================================================================================+    --   == Walker for ArrayElemReference, current base type: LeftValueData+    -- ====================================================================================================+    walkArrayElemReferenceLeftValueInLeftValue :: (TransformationPhase t) => t -> Downwards t -> ArrayElemReference (From t) -> (LeftValueData (To t), Upwards t)+    walkArrayElemReferenceLeftValueInLeftValue selfpointer fromAbove construction = (transformedArrayElemReference, toAbove)+        where+            toBelow = downwardsArrayElemReferenceLeftValueInLeftValue selfpointer fromAbove construction+            transformedArrayName = (walkLeftValue selfpointer toBelow) $ arrayName construction+            transformedArrayIndex = (walkExpression selfpointer toBelow) $ arrayIndex construction+            fromBelow = InfoFromArrayElemReferenceParts {+                recursivelyTransformedArrayName = fst transformedArrayName,+                upwardsInfoFromArrayName = snd transformedArrayName,+                recursivelyTransformedArrayIndex = fst transformedArrayIndex,+                upwardsInfoFromArrayIndex = snd transformedArrayIndex+            }+            transformedArrayElemReference = transformArrayElemReferenceLeftValueInLeftValue selfpointer fromAbove construction fromBelow+            toAbove = upwardsArrayElemReferenceLeftValueInLeftValue selfpointer fromAbove construction fromBelow transformedArrayElemReference+    -- ====================================================================================================+    --   == Walker for Instruction+    -- ====================================================================================================+    walkInstruction :: Walker t Instruction+    walkInstruction selfpointer fromAbove construction = (transformedInstruction, toAbove)+        where+            toBelow = downwardsInstruction selfpointer fromAbove construction+            transformedInstructionData = case instructionData construction of+                AssignmentInstruction construction -> (walkAssignmentInstructionInInstruction selfpointer toBelow) construction+                ProcedureCallInstruction construction -> (walkProcedureCallInstructionInInstruction selfpointer toBelow) construction+            fromBelow = InfoFromInstructionParts {+                recursivelyTransformedInstructionData = fst transformedInstructionData,+                upwardsInfoFromInstructionData = snd transformedInstructionData+            }+            transformedInstruction = transformInstruction selfpointer fromAbove construction fromBelow+            toAbove = upwardsInstruction selfpointer fromAbove construction fromBelow transformedInstruction+    -- ====================================================================================================+    --   == Walker for Assignment, current base type: InstructionData+    -- ====================================================================================================+    walkAssignmentInstructionInInstruction :: (TransformationPhase t) => t -> Downwards t -> Assignment (From t) -> (InstructionData (To t), Upwards t)+    walkAssignmentInstructionInInstruction selfpointer fromAbove construction = (transformedAssignment, toAbove)+        where+            toBelow = downwardsAssignmentInstructionInInstruction selfpointer fromAbove construction+            transformedAssignmentLhs = (walkLeftValue selfpointer toBelow) $ assignmentLhs construction+            transformedAssignmentRhs = (walkExpression selfpointer toBelow) $ assignmentRhs construction+            fromBelow = InfoFromAssignmentParts {+                recursivelyTransformedAssignmentLhs = fst transformedAssignmentLhs,+                upwardsInfoFromAssignmentLhs = snd transformedAssignmentLhs,+                recursivelyTransformedAssignmentRhs = fst transformedAssignmentRhs,+                upwardsInfoFromAssignmentRhs = snd transformedAssignmentRhs+            }+            transformedAssignment = transformAssignmentInstructionInInstruction selfpointer fromAbove construction fromBelow+            toAbove = upwardsAssignmentInstructionInInstruction selfpointer fromAbove construction fromBelow transformedAssignment+    -- ====================================================================================================+    --   == Walker for ProcedureCall, current base type: InstructionData+    -- ====================================================================================================+    walkProcedureCallInstructionInInstruction :: (TransformationPhase t) => t -> Downwards t -> ProcedureCall (From t) -> (InstructionData (To t), Upwards t)+    walkProcedureCallInstructionInInstruction selfpointer fromAbove construction = (transformedProcedureCall, toAbove)+        where+            toBelow = downwardsProcedureCallInstructionInInstruction selfpointer fromAbove construction+            transformedActualParametersOfProcedureToCall = map (walkActualParameter selfpointer toBelow) $ actualParametersOfProcedureToCall construction+            fromBelow = InfoFromProcedureCallParts {+                recursivelyTransformedActualParametersOfProcedureToCall = map fst transformedActualParametersOfProcedureToCall,+                upwardsInfoFromActualParametersOfProcedureToCall = map snd transformedActualParametersOfProcedureToCall+            }+            transformedProcedureCall = transformProcedureCallInstructionInInstruction selfpointer fromAbove construction fromBelow+            toAbove = upwardsProcedureCallInstructionInInstruction selfpointer fromAbove construction fromBelow transformedProcedureCall+    -- ====================================================================================================+    --   == Walker for ActualParameter+    -- ====================================================================================================+    walkActualParameter :: Walker t ActualParameter+    walkActualParameter selfpointer fromAbove construction = (transformedActualParameter, toAbove)+        where+            toBelow = downwardsActualParameter selfpointer fromAbove construction+            transformedActualParameterData = case actualParameterData construction of+                InputActualParameter construction -> (walkInputActualParameterInActualParameter selfpointer toBelow) construction+                OutputActualParameter construction -> (walkOutputActualParameterInActualParameter selfpointer toBelow) construction+            fromBelow = InfoFromActualParameterParts {+                recursivelyTransformedActualParameterData = fst transformedActualParameterData,+                upwardsInfoFromActualParameterData = snd transformedActualParameterData+            }+            transformedActualParameter = transformActualParameter selfpointer fromAbove construction fromBelow+            toAbove = upwardsActualParameter selfpointer fromAbove construction fromBelow transformedActualParameter+    -- ====================================================================================================+    --   == Walker for Expression, current base type: ActualParameterData+    -- ====================================================================================================+    walkInputActualParameterInActualParameter :: (TransformationPhase t) => t -> Downwards t -> Expression (From t) -> (ActualParameterData (To t), Upwards t)+    walkInputActualParameterInActualParameter selfpointer fromAbove construction = (transformedExpression, toAbove)+        where+            toBelow = downwardsInputActualParameterInActualParameter selfpointer fromAbove construction+            transformedExpressionData = case expressionData construction of+                LeftValueExpression construction -> (walkLeftValueExpressionInExpression selfpointer toBelow) construction+                ConstantExpression construction -> (walkConstantExpressionInExpression selfpointer toBelow) construction+                FunctionCallExpression construction -> (walkFunctionCallExpressionInExpression selfpointer toBelow) construction+            fromBelow = InfoFromExpressionParts {+                recursivelyTransformedExpressionData = fst transformedExpressionData,+                upwardsInfoFromExpressionData = snd transformedExpressionData+            }+            transformedExpression = transformInputActualParameterInActualParameter selfpointer fromAbove construction fromBelow+            toAbove = upwardsInputActualParameterInActualParameter selfpointer fromAbove construction fromBelow transformedExpression+    -- ====================================================================================================+    --   == Walker for LeftValue, current base type: ActualParameterData+    -- ====================================================================================================+    walkOutputActualParameterInActualParameter :: (TransformationPhase t) => t -> Downwards t -> LeftValue (From t) -> (ActualParameterData (To t), Upwards t)+    walkOutputActualParameterInActualParameter selfpointer fromAbove construction = (transformedLeftValue, toAbove)+        where+            toBelow = downwardsOutputActualParameterInActualParameter selfpointer fromAbove construction+            transformedLeftValueData = case leftValueData construction of+                VariableLeftValue construction -> (walkVariableLeftValueInLeftValue selfpointer toBelow) construction+                ArrayElemReferenceLeftValue construction -> (walkArrayElemReferenceLeftValueInLeftValue selfpointer toBelow) construction+            fromBelow = InfoFromLeftValueParts {+                recursivelyTransformedLeftValueData = fst transformedLeftValueData,+                upwardsInfoFromLeftValueData = snd transformedLeftValueData+            }+            transformedLeftValue = transformOutputActualParameterInActualParameter selfpointer fromAbove construction fromBelow+            toAbove = upwardsOutputActualParameterInActualParameter selfpointer fromAbove construction fromBelow transformedLeftValue+    -- ====================================================================================================+    --   == Walker for Variable+    -- ====================================================================================================+    walkVariable :: Walker t Variable+    walkVariable selfpointer fromAbove construction = (transformedVariable, toAbove)+        where+            transformedVariable = transformVariable selfpointer fromAbove construction+            toAbove = upwardsVariable selfpointer fromAbove construction transformedVariable+-- ====================================================================================================+--   == Upwards types+-- ====================================================================================================+data (TransformationPhase t) => InfoFromProcedureParts t = InfoFromProcedureParts {+    recursivelyTransformedInParameters                           :: [FormalParameter (To t)],+    upwardsInfoFromInParameters                                  :: [Upwards t],+    recursivelyTransformedOutParameters                          :: [FormalParameter (To t)],+    upwardsInfoFromOutParameters                                 :: [Upwards t],+    recursivelyTransformedProcedureBody                          :: Block (To t),+    upwardsInfoFromProcedureBody                                 :: Upwards t+}+data (TransformationPhase t) => InfoFromBlockParts t = InfoFromBlockParts {+    recursivelyTransformedBlockDeclarations                      :: [LocalDeclaration (To t)],+    upwardsInfoFromBlockDeclarations                             :: [Upwards t],+    recursivelyTransformedBlockInstructions                      :: Program (To t),+    upwardsInfoFromBlockInstructions                             :: Upwards t+}+data (TransformationPhase t) => InfoFromProgramParts t = InfoFromProgramParts {+    recursivelyTransformedProgramConstruction                    :: ProgramConstruction (To t),+    upwardsInfoFromProgramConstruction                           :: Upwards t+}+data (TransformationPhase t) => InfoFromPrimitiveParts t = InfoFromPrimitiveParts {+    recursivelyTransformedPrimitiveInstruction                   :: Instruction (To t),+    upwardsInfoFromPrimitiveInstruction                          :: Upwards t+}+data (TransformationPhase t) => InfoFromSequenceParts t = InfoFromSequenceParts {+    recursivelyTransformedSequenceProgramList                    :: [Program (To t)],+    upwardsInfoFromSequenceProgramList                           :: [Upwards t]+}+data (TransformationPhase t) => InfoFromBranchParts t = InfoFromBranchParts {+    recursivelyTransformedBranchConditionVariable                :: Variable (To t),+    upwardsInfoFromBranchConditionVariable                       :: Upwards t,+    recursivelyTransformedThenBlock                              :: Block (To t),+    upwardsInfoFromThenBlock                                     :: Upwards t,+    recursivelyTransformedElseBlock                              :: Block (To t),+    upwardsInfoFromElseBlock                                     :: Upwards t+}+data (TransformationPhase t) => InfoFromSequentialLoopParts t = InfoFromSequentialLoopParts {+    recursivelyTransformedSequentialLoopCondition                :: Expression (To t),+    upwardsInfoFromSequentialLoopCondition                       :: Upwards t,+    recursivelyTransformedConditionCalculation                   :: Block (To t),+    upwardsInfoFromConditionCalculation                          :: Upwards t,+    recursivelyTransformedSequentialLoopCore                     :: Block (To t),+    upwardsInfoFromSequentialLoopCore                            :: Upwards t+}+data (TransformationPhase t) => InfoFromParallelLoopParts t = InfoFromParallelLoopParts {+    recursivelyTransformedParallelLoopConditionVariable          :: Variable (To t),+    upwardsInfoFromParallelLoopConditionVariable                 :: Upwards t,+    recursivelyTransformedNumberOfIterations                     :: Expression (To t),+    upwardsInfoFromNumberOfIterations                            :: Upwards t,+    recursivelyTransformedParallelLoopCore                       :: Block (To t),+    upwardsInfoFromParallelLoopCore                              :: Upwards t+}+data (TransformationPhase t) => InfoFromFormalParameterParts t = InfoFromFormalParameterParts {+    recursivelyTransformedFormalParameterVariable                :: Variable (To t),+    upwardsInfoFromFormalParameterVariable                       :: Upwards t+}+data (TransformationPhase t) => InfoFromLocalDeclarationParts t = InfoFromLocalDeclarationParts {+    recursivelyTransformedLocalVariable                          :: Variable (To t),+    upwardsInfoFromLocalVariable                                 :: Upwards t,+    recursivelyTransformedLocalInitValue                         :: Maybe (Expression (To t)),+    upwardsInfoFromLocalInitValue                                :: Maybe (Upwards t)+}+data (TransformationPhase t) => InfoFromExpressionParts t = InfoFromExpressionParts {+    recursivelyTransformedExpressionData                         :: ExpressionData (To t),+    upwardsInfoFromExpressionData                                :: Upwards t+}+data (TransformationPhase t) => InfoFromConstantParts t = InfoFromConstantParts {+    recursivelyTransformedConstantData                           :: ConstantData (To t),+    upwardsInfoFromConstantData                                  :: Upwards t+}+data (TransformationPhase t) => InfoFromFunctionCallParts t = InfoFromFunctionCallParts {+    recursivelyTransformedActualParametersOfFunctionToCall       :: [Expression (To t)],+    upwardsInfoFromActualParametersOfFunctionToCall              :: [Upwards t]+}+data (TransformationPhase t) => InfoFromLeftValueParts t = InfoFromLeftValueParts {+    recursivelyTransformedLeftValueData                          :: LeftValueData (To t),+    upwardsInfoFromLeftValueData                                 :: Upwards t+}+data (TransformationPhase t) => InfoFromArrayElemReferenceParts t = InfoFromArrayElemReferenceParts {+    recursivelyTransformedArrayName                              :: LeftValue (To t),+    upwardsInfoFromArrayName                                     :: Upwards t,+    recursivelyTransformedArrayIndex                             :: Expression (To t),+    upwardsInfoFromArrayIndex                                    :: Upwards t+}+data (TransformationPhase t) => InfoFromInstructionParts t = InfoFromInstructionParts {+    recursivelyTransformedInstructionData                        :: InstructionData (To t),+    upwardsInfoFromInstructionData                               :: Upwards t+}+data (TransformationPhase t) => InfoFromAssignmentParts t = InfoFromAssignmentParts {+    recursivelyTransformedAssignmentLhs                          :: LeftValue (To t),+    upwardsInfoFromAssignmentLhs                                 :: Upwards t,+    recursivelyTransformedAssignmentRhs                          :: Expression (To t),+    upwardsInfoFromAssignmentRhs                                 :: Upwards t+}+data (TransformationPhase t) => InfoFromProcedureCallParts t = InfoFromProcedureCallParts {+    recursivelyTransformedActualParametersOfProcedureToCall      :: [ActualParameter (To t)],+    upwardsInfoFromActualParametersOfProcedureToCall             :: [Upwards t]+}+data (TransformationPhase t) => InfoFromActualParameterParts t = InfoFromActualParameterParts {+    recursivelyTransformedActualParameterData                    :: ActualParameterData (To t),+    upwardsInfoFromActualParameterData                           :: Upwards t+}+data (TransformationPhase t) => InfoFromArrayConstantParts t = InfoFromArrayConstantParts {+    recursivelyTransformedArrayConstantValue                     :: [Constant (To t)],+    upwardsInfoFromArrayConstantValue                            :: [Upwards t]+}
Feldspar/Compiler/PluginArchitecture/DefaultConvert.hs view
@@ -1,34 +1,30 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}
 
@@ -66,60 +62,64 @@ class Convert a b where
     convert :: a -> b
 
-{-instance Convert a a where
-    convert = id-}
-
 instance Default b => Convert a b where
     convert _ = defaultValue
-    
++-- ====================================================================================================+--   == ConvertAllInfos class & instance+-- ==================================================================================================== class (SemanticInfo from, SemanticInfo to
-    , Convert (ProcedureInfo from) (ProcedureInfo to)           
-    , Convert (BlockInfo from) (BlockInfo to)
-    , Default (ProgramInfo to)
-    , Convert (EmptyInfo from) (EmptyInfo to)
-    , Convert (PrimitiveInfo from) (PrimitiveInfo to)           
-    , Convert (SequenceInfo from) (SequenceInfo to)
-    , Convert (BranchInfo from)    (BranchInfo to)              
-    , Convert (FormalParameterInfo from) (FormalParameterInfo to)
-    , Convert (SequentialLoopInfo from) (SequentialLoopInfo to) 
-    , Convert (ParallelLoopInfo from) (ParallelLoopInfo to)
-    , Convert (LocalDeclarationInfo from) (LocalDeclarationInfo to)
-    , Convert (LeftValueExpressionInfo from) (LeftValueExpressionInfo to)
-    , Convert (InputActualParameterInfo from) (InputActualParameterInfo to)
-    , Convert (OutputActualParameterInfo from) (OutputActualParameterInfo to)
-    , Convert (VariableInLeftValueInfo from) (VariableInLeftValueInfo to)
-    , Convert (ArrayElemReferenceInfo from) (ArrayElemReferenceInfo to)
-    , Convert (ProcedureCallInfo from) (ProcedureCallInfo to)
-    , Convert (AssignmentInfo from) (AssignmentInfo to)
-    , Convert (FunctionCallInfo from) (FunctionCallInfo to)
-    , Convert (IntConstantInfo from) (IntConstantInfo to)
-    , Convert (FloatConstantInfo from) (FloatConstantInfo to)
-    , Convert (BoolConstantInfo from) (BoolConstantInfo to)
-    , Convert (ArrayConstantInfo from) (ArrayConstantInfo to)
-    , Convert (VariableInfo from) (VariableInfo to)) => ConvertAllInfos from to
-
-instance (SemanticInfo from, SemanticInfo to -- TODO general instance needs UndecidableInstances, check whether it is ok
-    , Convert (ProcedureInfo from) (ProcedureInfo to)           
-    , Convert (BlockInfo from) (BlockInfo to)
-    , Default (ProgramInfo to)
-    , Convert (EmptyInfo from) (EmptyInfo to)
-    , Convert (PrimitiveInfo from) (PrimitiveInfo to)           
-    , Convert (SequenceInfo from) (SequenceInfo to)
-    , Convert (BranchInfo from)    (BranchInfo to)              
-    , Convert (FormalParameterInfo from) (FormalParameterInfo to)
-    , Convert (SequentialLoopInfo from) (SequentialLoopInfo to) 
-    , Convert (ParallelLoopInfo from) (ParallelLoopInfo to)
-    , Convert (LocalDeclarationInfo from) (LocalDeclarationInfo to)
-    , Convert (LeftValueExpressionInfo from) (LeftValueExpressionInfo to)
-    , Convert (InputActualParameterInfo from) (InputActualParameterInfo to)
-    , Convert (OutputActualParameterInfo from) (OutputActualParameterInfo to)
-    , Convert (VariableInLeftValueInfo from) (VariableInLeftValueInfo to)
-    , Convert (ArrayElemReferenceInfo from) (ArrayElemReferenceInfo to)
-    , Convert (ProcedureCallInfo from) (ProcedureCallInfo to)
-    , Convert (AssignmentInfo from) (AssignmentInfo to)
-    , Convert (FunctionCallInfo from) (FunctionCallInfo to)
-    , Convert (IntConstantInfo from) (IntConstantInfo to)
-    , Convert (FloatConstantInfo from) (FloatConstantInfo to)
-    , Convert (BoolConstantInfo from) (BoolConstantInfo to)
-    , Convert (ArrayConstantInfo from) (ArrayConstantInfo to)
-    , Convert (VariableInfo from) (VariableInfo to)) => ConvertAllInfos from to
+      , Convert(ProcedureInfo from)           (ProcedureInfo to)+      , Convert(BlockInfo from)               (BlockInfo to)+      , Convert(ProgramInfo from)             (ProgramInfo to)+      , Convert(EmptyInfo from)               (EmptyInfo to)+      , Convert(PrimitiveInfo from)           (PrimitiveInfo to)+      , Convert(SequenceInfo from)            (SequenceInfo to)+      , Convert(BranchInfo from)              (BranchInfo to)+      , Convert(SequentialLoopInfo from)      (SequentialLoopInfo to)+      , Convert(ParallelLoopInfo from)        (ParallelLoopInfo to)+      , Convert(FormalParameterInfo from)     (FormalParameterInfo to)+      , Convert(LocalDeclarationInfo from)    (LocalDeclarationInfo to)+      , Convert(ExpressionInfo from)          (ExpressionInfo to)+      , Convert(ConstantInfo from)            (ConstantInfo to)+      , Convert(FunctionCallInfo from)        (FunctionCallInfo to)+      , Convert(LeftValueInfo from)           (LeftValueInfo to)+      , Convert(ArrayElemReferenceInfo from)  (ArrayElemReferenceInfo to)+      , Convert(InstructionInfo from)         (InstructionInfo to)+      , Convert(AssignmentInfo from)          (AssignmentInfo to)+      , Convert(ProcedureCallInfo from)       (ProcedureCallInfo to)+      , Convert(ActualParameterInfo from)     (ActualParameterInfo to)+      , Convert(IntConstantInfo from)         (IntConstantInfo to)+      , Convert(FloatConstantInfo from)       (FloatConstantInfo to)+      , Convert(BoolConstantInfo from)        (BoolConstantInfo to)+      , Convert(ArrayConstantInfo from)       (ArrayConstantInfo to)+      , Convert(VariableInfo from)            (VariableInfo to)+      ) => ConvertAllInfos from to++instance (SemanticInfo from, SemanticInfo to+         , Convert(ProcedureInfo from)           (ProcedureInfo to)+         , Convert(BlockInfo from)               (BlockInfo to)+         , Convert(ProgramInfo from)             (ProgramInfo to)+         , Convert(EmptyInfo from)               (EmptyInfo to)+         , Convert(PrimitiveInfo from)           (PrimitiveInfo to)+         , Convert(SequenceInfo from)            (SequenceInfo to)+         , Convert(BranchInfo from)              (BranchInfo to)+         , Convert(SequentialLoopInfo from)      (SequentialLoopInfo to)+         , Convert(ParallelLoopInfo from)        (ParallelLoopInfo to)+         , Convert(FormalParameterInfo from)     (FormalParameterInfo to)+         , Convert(LocalDeclarationInfo from)    (LocalDeclarationInfo to)+         , Convert(ExpressionInfo from)          (ExpressionInfo to)+         , Convert(ConstantInfo from)            (ConstantInfo to)+         , Convert(FunctionCallInfo from)        (FunctionCallInfo to)+         , Convert(LeftValueInfo from)           (LeftValueInfo to)+         , Convert(ArrayElemReferenceInfo from)  (ArrayElemReferenceInfo to)+         , Convert(InstructionInfo from)         (InstructionInfo to)+         , Convert(AssignmentInfo from)          (AssignmentInfo to)+         , Convert(ProcedureCallInfo from)       (ProcedureCallInfo to)+         , Convert(ActualParameterInfo from)     (ActualParameterInfo to)+         , Convert(IntConstantInfo from)         (IntConstantInfo to)+         , Convert(FloatConstantInfo from)       (FloatConstantInfo to)+         , Convert(BoolConstantInfo from)        (BoolConstantInfo to)+         , Convert(ArrayConstantInfo from)       (ArrayConstantInfo to)+         , Convert(VariableInfo from)            (VariableInfo to)+         ) => ConvertAllInfos from to
Feldspar/Compiler/Plugins/BackwardPropagation.hs view
@@ -1,38 +1,36 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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, FlexibleInstances #-} -module Feldspar.Compiler.Plugins.BackwardPropagation +module Feldspar.Compiler.Plugins.BackwardPropagation (+    BackwardPropagation(..)+    )     where  import Feldspar.Compiler.PluginArchitecture@@ -59,71 +57,70 @@ instance Plugin BackwardPropagation where     type ExternalInfo BackwardPropagation = DebugOption     executePlugin BackwardPropagation externalInfo procedure-		| externalInfo == NoSimplification = fst $ executeTransformationPhase BackwardPropagation () procedure-        | otherwise = fst $ executeTransformationPhase PropagationTransform [] $ fst $ executeTransformationPhase PropagationCollect (Occurrence_read,False) procedure+        | externalInfo == NoSimplification = fst $ executeTransformationPhase BackwardPropagation () procedure+        | otherwise = fst $ executeTransformationPhase PropagationTransform [] $ fst $ executeTransformationPhase BackwardPropagationCollect (Occurrence_read,False) procedure  -- ==================== --       Collect -- ==================== -instance Default [(VariableData, LeftValue ())] where+instance Default [(VariableData, LeftValueData ())] where     defaultValue = []  -- meaning (out,var,out written in a sequence before out=var)-instance Default [(VariableData, LeftValue (),Bool)] where+instance Default [(VariableData, LeftValueData (),Bool)] where     defaultValue = [] -instance Combine (VarStatBck, [(VariableData, LeftValue (),Bool)]) where+instance Combine (VarStatBck, [(VariableData, LeftValueData (),Bool)]) where     combine (m1,x1) (m2,x2) = (combine m1 m2, x1 ++ x2) -instance Default (Maybe (VariableData, LeftValue (),Bool)) where+instance Default (Maybe (VariableData, LeftValueData (),Bool)) where     defaultValue = Nothing -data PropagationSemInf+data BackwardPropagationSemInf -instance SemanticInfo PropagationSemInf where-    type ProcedureInfo PropagationSemInf = ()-    type BlockInfo PropagationSemInf = [(VariableData, LeftValue ())] --replacements inside block-    type ProgramInfo PropagationSemInf = ()-    type EmptyInfo PropagationSemInf = ()-    type PrimitiveInfo PropagationSemInf = Maybe (VariableData, LeftValue (), Bool) --if the primitive is a copy assignment the datas of the assigment, just because when we delete primitives at 2nd phase we need this -    type SequenceInfo PropagationSemInf = ()-    type BranchInfo PropagationSemInf = ()-    type SequentialLoopInfo PropagationSemInf = ()-    type ParallelLoopInfo PropagationSemInf = ()-    type FormalParameterInfo PropagationSemInf = ()-    type LocalDeclarationInfo PropagationSemInf = ()-    type LeftValueExpressionInfo PropagationSemInf = ()-    type VariableInLeftValueInfo PropagationSemInf = ()-    type ArrayElemReferenceInfo PropagationSemInf = ()-    type InputActualParameterInfo PropagationSemInf = ()-    type OutputActualParameterInfo PropagationSemInf = ()-    type AssignmentInfo PropagationSemInf = ()-    type ProcedureCallInfo PropagationSemInf = ()-    type FunctionCallInfo PropagationSemInf = ()-    type IntConstantInfo PropagationSemInf = ()-    type FloatConstantInfo PropagationSemInf = ()-    type BoolConstantInfo PropagationSemInf = ()-    type ArrayConstantInfo PropagationSemInf = ()-    type VariableInfo PropagationSemInf = ()+instance SemanticInfo BackwardPropagationSemInf where+    type ProcedureInfo             BackwardPropagationSemInf = ()+    type BlockInfo                 BackwardPropagationSemInf = [(VariableData, LeftValueData ())] --replacements inside block+    type ProgramInfo               BackwardPropagationSemInf = ()+    type EmptyInfo                 BackwardPropagationSemInf = ()+    type PrimitiveInfo             BackwardPropagationSemInf = Maybe (VariableData, LeftValueData (), Bool) --if the primitive is a copy assignment the datas of the assigment, just because when we delete primitives at 2nd phase we need this +    type SequenceInfo              BackwardPropagationSemInf = ()+    type BranchInfo                BackwardPropagationSemInf = ()+    type SequentialLoopInfo        BackwardPropagationSemInf = ()+    type ParallelLoopInfo          BackwardPropagationSemInf = ()+    type FormalParameterInfo       BackwardPropagationSemInf = ()+    type LocalDeclarationInfo      BackwardPropagationSemInf = ()+    type ExpressionInfo            BackwardPropagationSemInf = ()+    type ConstantInfo              BackwardPropagationSemInf = ()+    type FunctionCallInfo          BackwardPropagationSemInf = ()+    type LeftValueInfo             BackwardPropagationSemInf = ()+    type ArrayElemReferenceInfo    BackwardPropagationSemInf = ()+    type InstructionInfo           BackwardPropagationSemInf = ()+    type AssignmentInfo            BackwardPropagationSemInf = ()+    type ProcedureCallInfo         BackwardPropagationSemInf = ()+    type ActualParameterInfo       BackwardPropagationSemInf = ()+    type IntConstantInfo           BackwardPropagationSemInf = ()+    type FloatConstantInfo         BackwardPropagationSemInf = ()+    type BoolConstantInfo          BackwardPropagationSemInf = ()+    type ArrayConstantInfo         BackwardPropagationSemInf = ()+    type VariableInfo              BackwardPropagationSemInf = () -data PropagationCollect = PropagationCollect+data BackwardPropagationCollect = BackwardPropagationCollect -instance TransformationPhase PropagationCollect where-    type From PropagationCollect = InitSemInf-    type To PropagationCollect = PropagationSemInf-    type Downwards PropagationCollect = (Occurrence_place, Bool)-    type Upwards PropagationCollect = (VarStatBck, [(VariableData, LeftValue (),Bool)])-    downwardsBranch self d orig = (occurrenceDownwards orig, False)-    downwardsSequentialLoop self d orig = (occurrenceDownwards orig, False)-    downwardsParallelLoop self d orig = (occurrenceDownwards orig, False)+instance TransformationPhase BackwardPropagationCollect where+    type From BackwardPropagationCollect = InitSemInf+    type To BackwardPropagationCollect = BackwardPropagationSemInf+    type Downwards BackwardPropagationCollect = (Occurrence_place, Bool)+    type Upwards BackwardPropagationCollect = (VarStatBck, [(VariableData, LeftValueData (),Bool)])+    downwardsBranchProgramInProgram self d orig = (occurrenceDownwards orig, False)+    downwardsSequentialLoopProgramInProgram self d orig = (occurrenceDownwards orig, False)+    downwardsParallelLoopProgramInProgram self d orig = (occurrenceDownwards orig, False)     downwardsFormalParameter self d orig = (occurrenceDownwards orig, False)-    downwardsLocalDeclaration self d orig = (occurrenceDownwards orig, isJust $ localInitValue $ localDeclarationData orig)-    downwardsAssignment self d orig = (occurrenceDownwards orig, False)-    downwardsInputActualParameter self d orig = (occurrenceDownwards orig, False)-    downwardsOutputActualParameter self d orig = (occurrenceDownwards orig, False)-    downwardsLeftValueExpression self d orig = (occurrenceDownwards orig, False)-    downwardsFunctionCall self d orig = (occurrenceDownwards orig, False)+    downwardsLocalDeclaration self d orig = (occurrenceDownwards orig, isJust $ localInitValue orig)+    downwardsAssignmentInstructionInInstruction self d orig = (occurrenceDownwards orig, False)+    downwardsActualParameter self d orig = (occurrenceDownwards orig, False)+    downwardsExpression self d orig = (occurrenceDownwards orig, False)     upwardsVariable self (d,me) origVar newVar =  case d of         Occurrence_declare             | me -> (Map.singleton (variableData origVar) $ Occurrences (One Nothing) Zero, [])@@ -131,51 +128,53 @@         Occurrence_read -> (Map.singleton (variableData origVar) $ Occurrences Zero (One ()), [])         Occurrence_write -> (Map.singleton (variableData origVar) $ Occurrences (One Nothing) Zero, [])         Occurrence_notopt -> (Map.singleton (variableData origVar) $ Occurrences Multiple Multiple, [])-    upwardsPrimitive self d origPrimitive u newPrimitive = case newPrimitive of+    upwardsPrimitiveProgramInProgram self d origPrimitive u newPrimitive = case newPrimitive of         PrimitiveProgram newPr -> case primitiveSemInf newPr of              Just e -> (fst $ upwardsInfoFromPrimitiveInstruction u, [e])             Nothing -> upwardsInfoFromPrimitiveInstruction u         _ -> upwardsInfoFromPrimitiveInstruction u+     upwardsBlock self d origBlock u newBlock = (deleteFromVarStatistics (map (fst) $ blockSemInf newBlock) $ fst $ upwardsInfoFromBlockInstructions u,[])-    upwardsSequence self d origiSeq u transformedSequence = checkInSequence $ upwardsInfoFromSequenceProgramList u+    upwardsSequenceProgramInProgram self d origiSeq u transformedSequence = checkInSequence $ upwardsInfoFromSequenceProgramList u     transformBlock self d origBlock u = Block {-            blockData = recursivelyTransformedBlockData u,+            blockDeclarations = recursivelyTransformedBlockDeclarations u,+            blockInstructions = recursivelyTransformedBlockInstructions u,             blockSemInf = unChain $ checkInDeclatation origBlock $ upwardsInfoFromBlockInstructions u-        }-    transformPrimitive self d origPrimitive u = PrimitiveProgram $ Primitive {+        } +    transformPrimitiveProgramInProgram self d origPrimitive u = PrimitiveProgram $ Primitive {             primitiveInstruction = recursivelyTransformedPrimitiveInstruction u,             primitiveSemInf = getNames origPrimitive         } -getNames :: (SemanticInfo t) => Primitive t -> Maybe (VariableData, LeftValue (),Bool)-getNames pr = getNames' $ primitiveInstruction pr where+getNames :: (SemanticInfo t) => Primitive t -> Maybe (VariableData, LeftValueData (),Bool)+getNames pr = getNames' $ instructionData $ primitiveInstruction pr where     getNames' (AssignmentInstruction _) = Nothing     getNames' (ProcedureCallInstruction pc)-        | goodName pc = getParamNames $ actualParametersOfProcedureToCall $ procedureCallData pc+        | goodName pc = getParamNames $ map actualParameterData $ actualParametersOfProcedureToCall pc         | otherwise = Nothing-    goodName pc = "copy" == (nameOfProcedureToCall $ procedureCallData pc)+    goodName pc = "copy" == (nameOfProcedureToCall pc)     getParamNames [InputActualParameter i, OutputActualParameter o] = pairJust (getIName i) (getOName o)     getParamNames _ = Nothing     pairJust (Just a) (Just b) = Just (a,b,False)     pairJust _ _ = Nothing-    getIName i = getExpName $ inputActualParameterExpression i-    getOName o = Just $ deleteSemInf $ outputActualParameterLeftValue o-    getExpName (LeftValueExpression le) = getLvName_noarr $ leftValueExpressionContents le+    getIName i = getExpName $ expressionData i+    getOName o = Just $ deleteSemInf $ leftValueData o+    getExpName (LeftValueExpression lv) = getLvName_noarr $ leftValueData lv     getExpName _ = Nothing-    getLvName_noarr (VariableLeftValue vlv) = Just $ variableData $ variableLeftValueContents vlv+    getLvName_noarr (VariableLeftValue v) = Just $ variableData v     getLvName_noarr _ = Nothing -getLvName :: (SemanticInfo t) => LeftValue t -> VariableData-getLvName (VariableLeftValue vlv) = variableData $ variableLeftValueContents vlv-getLvName (ArrayElemReferenceLeftValue aer) = getLvName $ arrayName $ arrayElemReferenceData aer+getLvName :: (SemanticInfo t) => LeftValueData t -> VariableData+getLvName (VariableLeftValue v) = variableData v+getLvName (ArrayElemReferenceLeftValue aer) = getLvName $ leftValueData $ arrayName aer -checkInSequence :: [(VarStatBck, [(VariableData, LeftValue (), Bool)])]  -> (VarStatBck, [(VariableData, LeftValue (), Bool)])+checkInSequence :: [(VarStatBck, [(VariableData, LeftValueData (), Bool)])]  -> (VarStatBck, [(VariableData, LeftValueData (), Bool)]) checkInSequence [] = defaultValue checkInSequence xs = (varstat $ map fst xs, mapMaybe (checkSeq xs False False False) $ foldl (\ls (vs,s) -> s++ls) [] xs)     where         varstat :: [VarStatBck] -> VarStatBck         varstat = foldl combine defaultValue-        checkSeq :: [(VarStatBck, [(VariableData, LeftValue (), Bool)])] -> Bool{-usedVar-} -> Bool{-usedOut-} -> Bool{-after-} -> (VariableData {-var-}, LeftValue () {-out-}, Bool) -> Maybe (VariableData, LeftValue (), Bool)+        checkSeq :: [(VarStatBck, [(VariableData, LeftValueData (), Bool)])] -> Bool{-usedVar-} -> Bool{-usedOut-} -> Bool{-after-} -> (VariableData {-var-}, LeftValueData () {-out-}, Bool) -> Maybe (VariableData, LeftValueData (), Bool)         checkSeq [] _ usedOut _  (var,outD,outUsedLower) = Just (var,outD,usedOut)         checkSeq ((vs,s):ys) usedVar usedOut after sp@(var,outD,outUsedLower)             | after && (vs `notUse` var)  = checkSeq ys usedVar usedOut after sp@@ -190,7 +189,6 @@             | {-(not after) && (not usedVar) && (vs `notUse` var) && -} (vs `hasUse` out) = checkSeq ys usedVar True after sp             | {-(not after) && (not usedVar) && (vs `notUse` var) && (vs `notUse` out)-} otherwise = checkSeq ys usedVar usedOut after sp             where-                --var = variableName varD                 out = getLvName outD {- check the sequence format:@@ -208,13 +206,13 @@ | -} -checkInDeclatation :: Block InitSemInf -> (VarStatBck, [(VariableData, LeftValue (), Bool)]) -> [(VariableData, LeftValue ())]+checkInDeclatation :: Block InitSemInf -> (VarStatBck, [(VariableData, LeftValueData (), Bool)]) -> [(VariableData, LeftValueData ())] checkInDeclatation origBlock u = mapMaybe (checkDecl $ decl) (snd u) where-    decl = blockDeclarations $ blockData origBlock-    checkDecl :: [LocalDeclaration InitSemInf] -> (VariableData, LeftValue (), Bool) -> Maybe (VariableData, LeftValue ())+    decl = blockDeclarations origBlock+    checkDecl :: [LocalDeclaration InitSemInf] -> (VariableData, LeftValueData (), Bool) -> Maybe (VariableData, LeftValueData ())     checkDecl lds (var,outD,outUsedLower) = case List.find (\ld -> var == declaredVar ld) lds of         Nothing -> Nothing-        Just ld -> case localInitValue $ localDeclarationData ld of+        Just ld -> case localInitValue ld of             Nothing -> Just (var,outD)             Just exp -> case outUsedLower of                 True -> Nothing@@ -230,14 +228,14 @@ data PropagationTransform = PropagationTransform  instance TransformationPhase PropagationTransform where-    type From PropagationTransform = PropagationSemInf+    type From PropagationTransform = BackwardPropagationSemInf     type To PropagationTransform = ()-    type Downwards PropagationTransform = [(VariableData, LeftValue ())]+    type Downwards PropagationTransform = [(VariableData, LeftValueData ())]     type Upwards PropagationTransform = ()     downwardsBlock self d origBlock = foldl addChain (blockSemInf origBlock) d     downwardsLocalDeclaration self d origLocDecl = []-    transformBlock self d orig fromBelow = delUnusedDecl (map fst $ foldl addChain (blockSemInf orig) d) orig $ recursivelyTransformedBlockData fromBelow-    transformPrimitive self d origPrimitive u =+    transformBlock self d orig u = delUnusedDecl (map fst $ foldl addChain (blockSemInf orig) d) orig (recursivelyTransformedBlockDeclarations u) (recursivelyTransformedBlockInstructions u)+    transformPrimitiveProgramInProgram self d origPrimitive u =         case primitiveSemInf origPrimitive of             Nothing -> makedPrim             Just (var,outD,_)@@ -248,35 +246,30 @@                 primitiveInstruction = recursivelyTransformedPrimitiveInstruction u,                 primitiveSemInf =()             }-    transformVariableInLeftValue self d origVIL u = case List.find (\(a,b) -> a == newVar) d of-            Nothing -> VariableLeftValue $ VariableInLeftValue {-                    variableLeftValueContents = recursivelyTransformedVariableLeftValueContents u,-                    variableLeftValueSemInf = ()+    transformVariableLeftValueInLeftValue self d origVar = case List.find (\(a,b) -> a == {-newVar-} variableData origVar) d of+            Nothing -> VariableLeftValue $ origVar {+                    variableSemInf = ()                 }             Just (var,out) -> out-        where-            newVar = variableData $ recursivelyTransformedVariableLeftValueContents u+        --where+        --    newVar = variableData $ recursivelyTransformedVariableLeftValueContents u -unChain :: [(VariableData, LeftValue ())] -> [(VariableData, LeftValue ())]+unChain :: [(VariableData, LeftValueData ())] -> [(VariableData, LeftValueData ())] unChain s = foldl addChain [] s -addChain :: [(VariableData, LeftValue ())] -> (VariableData, LeftValue ()) -> [(VariableData, LeftValue ())]+addChain :: [(VariableData, LeftValueData ())] -> (VariableData, LeftValueData ()) -> [(VariableData, LeftValueData ())] addChain [] pair = [pair] addChain (x@(mibe1,mit1):xs) r@(mibe2,mit2)     | (getLvName mit1) == mibe2 = (mibe1,changeInnerArrayName mit1 mit2):r:xs     | (getLvName mit2) == mibe1 = (mibe2,changeInnerArrayName mit2 mit1):x:xs     | otherwise = x:(addChain xs r)     where-        changeInnerArrayName :: LeftValue () {-toChange-} -> LeftValue () {-newName-} -> LeftValue ()+        changeInnerArrayName :: LeftValueData () {-toChange-} -> LeftValueData () {-newName-} -> LeftValueData ()         changeInnerArrayName toChange (ArrayElemReferenceLeftValue aer) = ArrayElemReferenceLeftValue aer {-            arrayElemReferenceData = (arrayElemReferenceData aer) {-                arrayName = changeInnerArrayName toChange (arrayName $ arrayElemReferenceData aer)-            }+            arrayName = LeftValue (changeInnerArrayName toChange $ leftValueData $ arrayName aer) ()         }          changeInnerArrayName (ArrayElemReferenceLeftValue aer) newName@(VariableLeftValue _) = ArrayElemReferenceLeftValue aer {-            arrayElemReferenceData = (arrayElemReferenceData aer) {-                arrayName = changeInnerArrayName (arrayName $ arrayElemReferenceData aer) newName-            }+                arrayName = LeftValue (changeInnerArrayName (leftValueData $ arrayName aer) newName) ()         }         changeInnerArrayName (VariableLeftValue _) newName@(VariableLeftValue _) = newName
− Feldspar/Compiler/Plugins/ConstantFolding.hs 
@@ -1,72 +0,0 @@-{-- - Copyright (c) 2009-2010, 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.Plugins.ConstantFolding where
-
-import Feldspar.Compiler.PluginArchitecture
-
-data ConstantFolding = ConstantFolding
-
-instance Plugin ConstantFolding where
-  type ExternalInfo ConstantFolding = ()
-  executePlugin ConstantFolding _ procedure =
-    fst $ executeTransformationPhase ConstantFolding () procedure
-
-instance TransformationPhase ConstantFolding where
-  type From ConstantFolding = ()
-  type To ConstantFolding = ()
-  type Downwards ConstantFolding = ()
-  type Upwards ConstantFolding = ()
-
-  transformFunctionCall ConstantFolding _ _ (InfosFromFunctionCallParts funData _) =
-    case roleOfFunctionToCall $ funData of
-      InfixOp -> case nameOfFunctionToCall $ funData of
-        "+"     -> elimParamIf (isConstIntN 0) True funCall
-        "-"     -> elimParamIf (isConstIntN 0) False funCall
-        "*"     -> elimParamIf (isConstIntN 1) True funCall
-        _       -> FunctionCallExpression funCall
-      _       -> FunctionCallExpression funCall
-
-    where
-      funCall = FunctionCall (funData) ()
-
-      isConstIntN n (ConstantExpression (IntConstant (IntConstantType i _))) = n == i
-      isConstIntN _ _ = False
-
-      elimParamIf pred flippable funCall@(FunctionCall (FunctionCallData InfixOp _ _ (x:xs)) _)
-        | pred (head xs)      = x
-        | flippable && pred x = head xs
-        | otherwise           = FunctionCallExpression funCall
-      elimParamIf _ _ funCall = FunctionCallExpression funCall
-
Feldspar/Compiler/Plugins/ForwardPropagation.hs view
@@ -1,38 +1,37 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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, FlexibleInstances #-} -module Feldspar.Compiler.Plugins.ForwardPropagation where+module Feldspar.Compiler.Plugins.ForwardPropagation (+    ForwardPropagation(..)+    ) +    where  import Feldspar.Compiler.PluginArchitecture import qualified Data.Map as Map@@ -49,15 +48,15 @@ -- == Copy propagation plugin (forward) -- =========================================================================== -type VarStatFwd = VarStatistics (Expression ForwardPropagationpSemInf,[VariableData],Bool)-type OccurrencesFwd = Occurrences (Expression ForwardPropagationpSemInf,[VariableData],Bool)+type VarStatFwd = VarStatistics (ExpressionData ForwardPropagationSemInf, [VariableData], Bool)+type OccurrencesFwd = Occurrences (ExpressionData ForwardPropagationSemInf, [VariableData], Bool)  data ForwardPropagation = ForwardPropagation  instance Plugin ForwardPropagation where     type ExternalInfo ForwardPropagation = DebugOption     executePlugin ForwardPropagation externalInfo procedure -		| externalInfo == NoSimplification || externalInfo == NoPrimitiveInstructionHandling = procedure+        | externalInfo == NoSimplification || externalInfo == NoPrimitiveInstructionHandling = procedure         | otherwise = fst $ executeTransformationPhase ForwardPropagationTransform (fst globals1) procedureCollected1             where                  (procedureCollected1,globals1) = executeTransformationPhase ForwardPropagationCollect Occurrence_read procedure@@ -72,36 +71,34 @@ --       Collect -- ==================== -data ForwardPropagationpSemInf--instance SemanticInfo ForwardPropagationpSemInf where-    type ProcedureInfo ForwardPropagationpSemInf = ()-    type BlockInfo ForwardPropagationpSemInf = VarStatFwd-    type ProgramInfo ForwardPropagationpSemInf = ()-    type EmptyInfo ForwardPropagationpSemInf = ()-    type PrimitiveInfo ForwardPropagationpSemInf = ()-    type SequenceInfo ForwardPropagationpSemInf = ()-    type BranchInfo ForwardPropagationpSemInf = ()-    type SequentialLoopInfo ForwardPropagationpSemInf = VarStatFwd-    type ParallelLoopInfo ForwardPropagationpSemInf = ()-    type FormalParameterInfo ForwardPropagationpSemInf = ()-    type LocalDeclarationInfo ForwardPropagationpSemInf = ()-    type LeftValueExpressionInfo ForwardPropagationpSemInf = ()-    type VariableInLeftValueInfo ForwardPropagationpSemInf = ()-    type ArrayElemReferenceInfo ForwardPropagationpSemInf = Maybe VariableData --name of the indexed variable-    type InputActualParameterInfo ForwardPropagationpSemInf = ()-    type OutputActualParameterInfo ForwardPropagationpSemInf = ()-    type AssignmentInfo ForwardPropagationpSemInf = ()-    type ProcedureCallInfo ForwardPropagationpSemInf = ()-    type FunctionCallInfo ForwardPropagationpSemInf = ()-    type IntConstantInfo ForwardPropagationpSemInf = ()-    type FloatConstantInfo ForwardPropagationpSemInf = ()-    type BoolConstantInfo ForwardPropagationpSemInf = ()-    type ArrayConstantInfo ForwardPropagationpSemInf = ()-    type VariableInfo ForwardPropagationpSemInf = Occurrence_place+data ForwardPropagationSemInf -instance Default (Maybe VariableData) where-    defaultValue = Nothing+instance SemanticInfo ForwardPropagationSemInf where+    type ProcedureInfo             ForwardPropagationSemInf = ()+    type BlockInfo                 ForwardPropagationSemInf = VarStatFwd+    type ProgramInfo               ForwardPropagationSemInf = ()+    type EmptyInfo                 ForwardPropagationSemInf = ()+    type PrimitiveInfo             ForwardPropagationSemInf = ()+    type SequenceInfo              ForwardPropagationSemInf = ()+    type BranchInfo                ForwardPropagationSemInf = ()+    type SequentialLoopInfo        ForwardPropagationSemInf = VarStatFwd+    type ParallelLoopInfo          ForwardPropagationSemInf = ()+    type FormalParameterInfo       ForwardPropagationSemInf = ()+    type LocalDeclarationInfo      ForwardPropagationSemInf = ()+    type ExpressionInfo            ForwardPropagationSemInf = ()+    type ConstantInfo              ForwardPropagationSemInf = ()+    type FunctionCallInfo          ForwardPropagationSemInf = ()+    type LeftValueInfo             ForwardPropagationSemInf = ()+    type ArrayElemReferenceInfo    ForwardPropagationSemInf = Maybe VariableData --name of the indexed variable+    type InstructionInfo           ForwardPropagationSemInf = ()+    type AssignmentInfo            ForwardPropagationSemInf = ()+    type ProcedureCallInfo         ForwardPropagationSemInf = ()+    type ActualParameterInfo       ForwardPropagationSemInf = ()+    type IntConstantInfo           ForwardPropagationSemInf = ()+    type FloatConstantInfo         ForwardPropagationSemInf = ()+    type BoolConstantInfo          ForwardPropagationSemInf = ()+    type ArrayConstantInfo         ForwardPropagationSemInf = ()+    type VariableInfo              ForwardPropagationSemInf = Occurrence_place  instance Combine (VarStatFwd, Maybe VariableData) where     combine a b = (combine (fst a) $ fst b, Nothing)@@ -110,25 +107,24 @@  instance TransformationPhase ForwardPropagationCollect where     type From ForwardPropagationCollect = ()-    type To ForwardPropagationCollect = ForwardPropagationpSemInf+    type To ForwardPropagationCollect = ForwardPropagationSemInf     type Downwards ForwardPropagationCollect = Occurrence_place     type Upwards ForwardPropagationCollect = (VarStatFwd, Maybe VariableData)-    downwardsBranch self d orig = occurrenceDownwards orig-    downwardsSequentialLoop self d orig = occurrenceDownwards orig-    downwardsParallelLoop self d orig = occurrenceDownwards orig+    downwardsBranchProgramInProgram self d orig = occurrenceDownwards orig+    downwardsSequentialLoopProgramInProgram self d orig = occurrenceDownwards orig+    downwardsParallelLoopProgramInProgram self d orig = occurrenceDownwards orig     downwardsFormalParameter self d orig = occurrenceDownwards orig     downwardsLocalDeclaration self d orig = occurrenceDownwards orig-    downwardsAssignment self d orig = occurrenceDownwards orig-    downwardsInputActualParameter self d orig = occurrenceDownwards orig-    downwardsOutputActualParameter self d orig = occurrenceDownwards orig-    downwardsLeftValueExpression self d orig = occurrenceDownwards orig-    downwardsFunctionCall self d orig = occurrenceDownwards orig+    downwardsAssignmentInstructionInInstruction self d orig = occurrenceDownwards orig+    downwardsActualParameter self d orig = occurrenceDownwards orig+    downwardsInputActualParameterInActualParameter self d orig = occurrenceDownwards orig+    downwardsExpression self d orig = occurrenceDownwards orig     transformBlock self d origBlock u = Block {-        blockData = recursivelyTransformedBlockData u,+        blockDeclarations = recursivelyTransformedBlockDeclarations u,+        blockInstructions = recursivelyTransformedBlockInstructions u,         blockSemInf = selectFromVarStatistics ( declaredVars origBlock) belowStatistics     } where-		belowStatistics = checkFwdDeclaration (map fst $ upwardsInfoFromBlockDeclarations u) (fst $ upwardsInfoFromBlockInstructions u)-        --belowStatistics = foldl combine (fst $ upwardsInfoFromBlockInstructions u) $ map fst $ upwardsInfoFromBlockDeclarations u+        belowStatistics = checkFwdDeclaration (map fst $ upwardsInfoFromBlockDeclarations u) (fst $ upwardsInfoFromBlockInstructions u)     transformVariable self d origVar = origVar {         variableSemInf = d     }@@ -137,35 +133,36 @@         Occurrence_read -> (Map.singleton (variableData origVar) $ Occurrences Zero (One ()), Just $ variableData origVar)         Occurrence_write ->  (Map.singleton (variableData origVar) $ Occurrences (One Nothing) Zero, Just $ variableData origVar)         Occurrence_notopt -> (Map.singleton (variableData origVar) $ Occurrences Multiple Multiple, Just $ variableData origVar) --LIE to save variables-    upwardsSequence self d origSeq u transSeq = (checkFwdSequence $ map fst $ upwardsInfoFromSequenceProgramList u, Nothing)+    upwardsSequenceProgramInProgram self d origSeq u transSeq = (checkFwdSequence $ map fst $ upwardsInfoFromSequenceProgramList u, Nothing)     upwardsBlock self d origBlock u newBlock = (deleteFromVarStatistics (declaredVars origBlock) belowStatistics, Nothing) where         belowStatistics = foldl combine (fst $ upwardsInfoFromBlockInstructions u) $ map fst $ upwardsInfoFromBlockDeclarations u-    upwardsParallelLoop self d origParLoop u transParLoop = (multipleVarStatistics $+    upwardsParallelLoopProgramInProgram self d origParLoop u transParLoop = (multipleVarStatistics $         foldl combine (fst $ upwardsInfoFromParallelLoopConditionVariable u)                     [fst $ upwardsInfoFromNumberOfIterations u, fst $ upwardsInfoFromParallelLoopCore u], Nothing)-    upwardsAssignment self d origAssign u transAssig = case assignmentLhs $ assignmentData origAssign of+    upwardsAssignmentInstructionInInstruction self d origAssign u transAssig = case leftValueData $ assignmentLhs origAssign of         VariableLeftValue vlv -> (Map.insert var occ $ fst $ upwardsInfoFromAssignmentRhs u, Nothing)             where-                var = variableData $ variableLeftValueContents vlv+                var = variableData vlv                 occ = Occurrences (One $ Just (assRs, Map.keys $ fst $ upwardsInfoFromAssignmentRhs u, False)) Zero                 assRs = case transAssig of -                    AssignmentInstruction newAssign -> assignmentRhs $ assignmentData newAssign+                    AssignmentInstruction newAssign -> expressionData $ assignmentRhs newAssign                     _ -> fwdPropError $ "Internal error: ForwardPropagation/1!"         ArrayElemReferenceLeftValue aer -> (combine (fst $ upwardsInfoFromAssignmentLhs u) (fst $ upwardsInfoFromAssignmentRhs u), Nothing)-    upwardsLocalDeclaration self d origDecl u newDecl = case  localInitValue $ localDeclarationData newDecl of+    upwardsLocalDeclaration self d origDecl u newDecl = case  localInitValue newDecl of         Nothing -> defaultCase-        Just (ConstantExpression (ArrayConstant ac)) -> defaultCase-        Just initExp -> case upwardsInfoFromLocalInitValue u of-            Nothing -> defaultCase-            Just justUpFromLocalInitValue -> (Map.insert var (occ initExp $ fst justUpFromLocalInitValue) $ fst justUpFromLocalInitValue, Nothing)+        Just exp -> case expressionData exp of+            ConstantExpression (Constant (ArrayConstant ac) ()) -> defaultCase+            initExp -> case upwardsInfoFromLocalInitValue u of+                Nothing -> defaultCase+                Just justUpFromLocalInitValue -> (Map.insert var (occ initExp $ fst justUpFromLocalInitValue) $ fst justUpFromLocalInitValue, Nothing)         where-                    var = variableData $ localVariable $ localDeclarationData $ origDecl+                    var = variableData $ localVariable origDecl                     occ initExp justUpFromLocalInitValue = Occurrences (One $ Just (initExp, Map.keys justUpFromLocalInitValue, False)) Zero                     defaultCase = (fst $ upwardsInfoFromLocalVariable u, Nothing)-    upwardsProcedureCall self d origProcCall u transProcCall-        | List.isPrefixOf "copy" $ nameOfProcedureToCall $ procedureCallData origProcCall = case  actParams of -- TODO: eliminate string constant+    upwardsProcedureCallInstructionInInstruction self d origProcCall u transProcCall+        | List.isPrefixOf "copy" $ nameOfProcedureToCall origProcCall = case  map actualParameterData actParams of -- TODO: eliminate string constant             [InputActualParameter inArr, InputActualParameter arrSize, OutputActualParameter outArr] ->-                case outputActualParameterLeftValue outArr of+                case leftValueData outArr of                     VariableLeftValue vlv -> (Map.insert (var vlv) (occ inArr) $ fst $ head ul, Nothing)                     ArrayElemReferenceLeftValue aer -> defaultTr             _ -> defaultTr@@ -176,26 +173,33 @@                 otherwise -> foldl combine (head ul) (tail ul)             ul = upwardsInfoFromActualParametersOfProcedureToCall u             actParams = case transProcCall of-                ProcedureCallInstruction pc -> actualParametersOfProcedureToCall $ procedureCallData pc+                ProcedureCallInstruction pc -> actualParametersOfProcedureToCall pc                 _ -> fwdPropError $ "Internal error: ForwardPropagation/2!"-            var vlv = variableData $ variableLeftValueContents vlv-            occ inArr = Occurrences (One $ Just (inputActualParameterExpression inArr, Map.keys $ fst $ head ul, False)) Zero-    transformSequentialLoop self d origSeqLoop u = SequentialLoopProgram $ SequentialLoop {-        sequentialLoopData = (recursivelyTransformedSequentialLoopData u) {-            conditionCalculation = (conditionCalculation $ recursivelyTransformedSequentialLoopData u) {+            var vlv = variableData vlv+            occ inArr = Occurrences (One $ Just (expressionData inArr, Map.keys $ fst $ head ul, False)) Zero+    transformSequentialLoopProgramInProgram self d origSeqLoop u = SequentialLoopProgram $ origSeqLoop {+        sequentialLoopCondition = recursivelyTransformedSequentialLoopCondition u,+        conditionCalculation = (recursivelyTransformedConditionCalculation u) {                 blockSemInf = Map.empty -            }-        },-        sequentialLoopSemInf = blockSemInf $ conditionCalculation $ recursivelyTransformedSequentialLoopData u+            },+        sequentialLoopCore = recursivelyTransformedSequentialLoopCore u,+        sequentialLoopSemInf = blockSemInf $ recursivelyTransformedConditionCalculation u     }-    upwardsSequentialLoop self d origSeqLoop u newSeqLoop = (multipleVarStatistics $-        combine  (fst $ upwardsInfoFromSequentialLoopConditionCalculation u) $  fst $ upwardsInfoFromSequentialLoopCore u, Nothing)-    transformArrayElemReference self d origArrRef u = ArrayElemReferenceLeftValue $ ArrayElemReference {-        arrayElemReferenceData = recursivelyTransformedArrayElemReferenceData u,+    +    upwardsSequentialLoopProgramInProgram self d origSeqLoop u newSeqLoop = (multipleVarStatistics $+        combine  (deleteFromVarStatistics [condVar] $ fst $ upwardsInfoFromSequentialLoopCondition u) $  fst $ upwardsInfoFromSequentialLoopCore u, Nothing)+        where+            condVar = head $ Map.keys $ fst $ upwardsInfoFromSequentialLoopCondition u+    transformArrayElemReferenceLeftValueInLeftValue self d origArrRef u = ArrayElemReferenceLeftValue $ ArrayElemReference {+        arrayName = recursivelyTransformedArrayName u,+        arrayIndex = recursivelyTransformedArrayIndex u,         arrayElemReferenceSemInf = snd $ upwardsInfoFromArrayName u      }-    upwardsArrayElemReference self d origArrayRef u transArrayRefe =+    upwardsArrayElemReferenceLeftValueInLeftValue self d origArrayRef u transArrayRefe =         (combine (fst $ upwardsInfoFromArrayName u) (fst $ upwardsInfoFromArrayIndex u), snd $ upwardsInfoFromArrayName u)+    --upwardsLeftValue self d origLV u transLV = upwardsInfoFromLeftValueData u+    upwardsVariableLeftValueInLeftValue self d origVar transVar = upwardsVariable self d origVar $ transformVariable self d origVar+    transformVariableLeftValueInLeftValue self d origVar = VariableLeftValue $ transformVariable self d origVar  checkFwdSequence :: [VarStatFwd]  -> VarStatFwd checkFwdSequence [] = defaultValue@@ -207,7 +211,7 @@         updatePreSeq curr preSeqVar preSeqOcc = case writeVar preSeqOcc of             One (Just (preSeqExp,preSeqVars,preSeqVarsWritten))                 | preSeqVarsWritten && curr `hasRead` preSeqVar -> Occurrences (One Nothing) $ readVar preSeqOcc-                | any (hasWrite curr) preSeqVars -> case (curr `hasRead` preSeqVar)  && not ((simpleType $ variableType preSeqVar) && readVar preSeqOcc /= Multiple) of+                | any (hasWrite curr) preSeqVars -> case (curr `hasRead` preSeqVar)  && not ((simpleType $ variableDataType preSeqVar) && readVar preSeqOcc /= Multiple) of                     True -> Occurrences (One Nothing) $ readVar preSeqOcc                     False -> Occurrences (One (Just (preSeqExp,preSeqVars ++ (addDep curr preSeqVar),True))) $ readVar preSeqOcc                 | otherwise -> case curr `getWrite` preSeqVar of@@ -217,8 +221,8 @@                         | otherwise -> preSeqOcc             _ -> preSeqOcc         addDep curr preSeqVar = case curr `getWrite` preSeqVar of-			Nothing -> []-			Just (exp,vars,varsWritten) -> vars+            Nothing -> []+            Just (exp,vars,varsWritten) -> vars  checkFwdDeclaration :: [VarStatFwd] -> VarStatFwd -> VarStatFwd checkFwdDeclaration [] blockStat = blockStat@@ -228,100 +232,90 @@ --  ForwardPropagation -- ==================== -type VarWrite t = [(VariableData,Expression t)]+type VarWrite t = [(VariableData,ExpressionData t)] -toVarWrite :: VarStatFwd -> VarWrite ForwardPropagationpSemInf+toVarWrite :: VarStatFwd -> VarWrite ForwardPropagationSemInf toVarWrite vs = Map.foldWithKey (getExp) [] vs where-    getExp :: VariableData -> OccurrencesFwd -> VarWrite ForwardPropagationpSemInf -> VarWrite ForwardPropagationpSemInf+    getExp :: VariableData -> OccurrencesFwd -> VarWrite ForwardPropagationSemInf -> VarWrite ForwardPropagationSemInf     getExp name (Occurrences (One (Just (exp,_,_))) reads) vw          | reads /= Multiple && notConstArray exp = (name,exp):vw --used once and complex expr         | simpleExpr exp = (name,exp):vw --used several and simple expr         | otherwise = vw     getExp name _ vw = vw     notConstArray e = case e of-        ConstantExpression c -> simplConst c+        ConstantExpression (Constant c _) -> simplConst c         _ -> True     simpleExpr e = case e of-        ConstantExpression c -> simplConst c-        LeftValueExpression l -> case leftValueExpressionContents l of+        ConstantExpression (Constant c _) -> simplConst c+        LeftValueExpression l -> case leftValueData l of             VariableLeftValue v -> True-            ArrayElemReferenceLeftValue a -> simpleExpr $ arrayIndex $ arrayElemReferenceData a+            ArrayElemReferenceLeftValue a -> simpleExpr $ expressionData $ arrayIndex a         _ -> False     simplConst (ArrayConstant ac) = False     simplConst _ = True -instance Default (Set.Set VariableData) where-    defaultValue = Set.empty--instance Combine (Set.Set VariableData) where-    combine = Set.union- data ForwardPropagationTransform = ForwardPropagationTransform  instance TransformationPhase ForwardPropagationTransform where-    type From ForwardPropagationTransform = ForwardPropagationpSemInf+    type From ForwardPropagationTransform = ForwardPropagationSemInf     type To ForwardPropagationTransform = ()     type Downwards ForwardPropagationTransform = VarStatFwd     type Upwards ForwardPropagationTransform = Set.Set VariableData     downwardsBlock self d origBlock = combine d $ blockSemInf origBlock-    downwardsSequentialLoop self d origSeqLoop = combine d $ sequentialLoopSemInf origSeqLoop-    transformLeftValueExpression self d origLVE u = case leftValueExpressionContents origLVE of-            VariableLeftValue origVar -> case List.find (\(vn,e) -> (vn == var origVar)) varwrite of+    downwardsSequentialLoopProgramInProgram self d origSeqLoop = combine d $ sequentialLoopSemInf origSeqLoop+    transformLeftValueExpressionInExpression self d origLV u = case leftValueData origLV of+            VariableLeftValue origVar -> case List.find (\(vn,e) -> (vn == variableData origVar)) varwrite of                     Nothing -> defaultTr-                    Just repl -> fst $ walkExpression self d (snd repl)+                    Just repl -> expressionData $ fst $ walkExpression self d $ Expression (snd repl) ()             ArrayElemReferenceLeftValue origArr -> defaultTr         where-            var v = variableData $ variableLeftValueContents v             varwrite = toVarWrite d-            defaultTr = LeftValueExpression $ LeftValueInExpression {-                leftValueExpressionContents = recursivelyTransformedLeftValueExpressionContents u,-                leftValueExpressionSemInf = ()+            defaultTr = LeftValueExpression $ LeftValue {+                leftValueData = recursivelyTransformedLeftValueData u,+                leftValueSemInf = ()             }-    transformVariableInLeftValue self d origVarLV u = case List.find (\(vn,e) -> (vn == var)) varwrite of+    transformVariableLeftValueInLeftValue self d origVar = case List.find (\(vn,e) -> (vn == var)) varwrite of             Nothing -> defaultTr             Just repl  -> case repl of-                    (_,LeftValueExpression lve) -> fst $ walkLeftValue self d $ leftValueExpressionContents lve+                    (_,LeftValueExpression lv) -> leftValueData $ fst $ walkLeftValue self d lv                     _ -> defaultTr         where -            var = variableData $ variableLeftValueContents origVarLV+            var = variableData origVar             varwrite = toVarWrite d-            defaultTr = VariableLeftValue $ VariableInLeftValue {-                variableLeftValueContents = recursivelyTransformedVariableLeftValueContents u,-                variableLeftValueSemInf = ()+            defaultTr = VariableLeftValue $ origVar {+                variableSemInf = ()             }-    transformArrayElemReference self d origArrayRef u = case List.find (\(vn,e) -> (vn == var)) varwrite of+    transformArrayElemReferenceLeftValueInLeftValue self d origArrayRef u = case List.find (\(vn,e) -> (vn == var)) varwrite of             Nothing -> defaultTr             Just repl  -> case repl of-                    (_,LeftValueExpression lve) -> case leftValueExpressionContents lve of+                    (_,LeftValueExpression lv) -> case leftValueData lv of                         VariableLeftValue vlv -> defaultTr                         ArrayElemReferenceLeftValue aer -> ArrayElemReferenceLeftValue $ ArrayElemReference {-                            arrayElemReferenceData = ArrayElemReferenceData { -                                arrayName = fst $ walkLeftValue self (newD d var aer origArrayRef) $ arrayName $ arrayElemReferenceData origArrayRef-                                , arrayIndex = fst $ walkExpression self d $ arrayIndex $ arrayElemReferenceData aer-                            },+                            arrayName = fst $ walkLeftValue self (swapArrayIndex d var aer origArrayRef) $ arrayName origArrayRef,+                            arrayIndex = fst $ walkExpression self d $ arrayIndex aer,                             arrayElemReferenceSemInf = ()                         }                     _ -> defaultTr         where-            newD :: VarStatFwd -> VariableData -> ArrayElemReference ForwardPropagationpSemInf -> ArrayElemReference ForwardPropagationpSemInf -> VarStatFwd-            newD d var rep orig = Map.adjust (newDD var rep orig) var d-            newDD var rep orig x = x {-                writeVar = One $ Just ( LeftValueExpression $ LeftValueInExpression {-                    leftValueExpressionContents = ArrayElemReferenceLeftValue $ ArrayElemReference {-                        arrayElemReferenceData = ArrayElemReferenceData { -                            arrayName = arrayName $ arrayElemReferenceData rep-                            , arrayIndex = arrayIndex $ arrayElemReferenceData orig-                        },+            swapArrayIndex :: VarStatFwd -> VariableData -> ArrayElemReference ForwardPropagationSemInf -> ArrayElemReference ForwardPropagationSemInf -> VarStatFwd+            swapArrayIndex d var rep orig = Map.adjust (swapArrayIndex2 var rep orig) var d+            swapArrayIndex2 var rep orig x = x {+                writeVar = One $ Just ( LeftValueExpression $ LeftValue {+                    leftValueData = ArrayElemReferenceLeftValue $ ArrayElemReference {+                        arrayName = arrayName rep,+                        arrayIndex = arrayIndex orig,                         arrayElemReferenceSemInf = Just  var                     },  -                    leftValueExpressionSemInf = () +                    leftValueSemInf = ()                  },[],False)             }             var = getJust $ arrayElemReferenceSemInf origArrayRef             getJust (Just a) = a+            getJust _ = fwdPropError $ "Internal error: ForwardPropagation/3!"             varwrite = toVarWrite d             defaultTr = ArrayElemReferenceLeftValue $ ArrayElemReference {-                arrayElemReferenceData = recursivelyTransformedArrayElemReferenceData u,+                arrayName = recursivelyTransformedArrayName u,+                arrayIndex = recursivelyTransformedArrayIndex u,                 arrayElemReferenceSemInf = convert $ arrayElemReferenceSemInf origArrayRef             }     upwardsVariable self d origVar newVar = case variableSemInf origVar of@@ -330,14 +324,21 @@         Occurrence_write -> Set.singleton (variableData origVar)         Occurrence_notopt -> Set.empty     upwardsBlock self d origBlock u transformedBlock = foldl (\s e -> Set.delete e s) (upwardsInfoFromBlockInstructions u) (declaredVars origBlock) --Not need just optimalize compliler (not try delete locals outside block)-    transformBlock self d origBlock u = delUnusedDecl (map fst $ toVarWrite $ combine d $ blockSemInf origBlock) origBlock (recursivelyTransformedBlockData u)-    transformPrimitive self d originalPrimitive u = case canDelete of-            True -> EmptyProgram $ Empty ()-            False ->-                PrimitiveProgram $ Primitive {+    transformBlock self d origBlock u = delUnusedDecl (map fst $ toVarWrite $ combine d $ blockSemInf origBlock) origBlock (recursivelyTransformedBlockDeclarations u) (recursivelyTransformedBlockInstructions u)+    transformPrimitiveProgramInProgram self d originalPrimitive u+            | canDelete && deletablePrimitive  = EmptyProgram $ Empty ()+            | otherwise = PrimitiveProgram $ Primitive {                     primitiveInstruction = recursivelyTransformedPrimitiveInstruction u,                     primitiveSemInf = ()                 }         where             canDelete = Set.isSubsetOf (upwardsInfoFromPrimitiveInstruction u) (Set.fromList $ map fst $ toVarWrite d)+            deletablePrimitive = case instructionData $ primitiveInstruction originalPrimitive of+                ProcedureCallInstruction pc -> List.isPrefixOf "copy" $ nameOfProcedureToCall pc+                AssignmentInstruction ass -> True+    --need because of the new pluginarcitecture walk structure+    upwardsVariableLeftValueInLeftValue self d origVar transVar = upwardsVariable self d origVar $ transformVariable self d origVar+    transformLeftValue self d origLV u = case transformLeftValueExpressionInExpression self d origLV u of+		LeftValueExpression lv -> lv+		_  -> fwdPropError $ "Internal error: ForwardPropagation/4!"
Feldspar/Compiler/Plugins/HandlePrimitives.hs view
@@ -1,200 +1,229 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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.Plugins.HandlePrimitives     ( HandlePrimitives(..)     , makeAssignment-    , makePrimitive,+    , makePrimitive     ) where  +import Data.List (find)+ import Feldspar.Compiler.Imperative.Representation import Feldspar.Compiler.Imperative.Semantics (SemanticInfo)-import Feldspar.Compiler.Imperative.CodeGeneration (simpleType, typeof, listprint, compToC, toLeftValue)-import Feldspar.Compiler.PluginArchitecture (TransformationPhase(..), Plugin(..), InfosFromPrimitiveParts(..))+import Feldspar.Compiler.Imperative.CodeGeneration (simpleType, typeof, toLeftValue)+import Feldspar.Compiler.PluginArchitecture (TransformationPhase(..), Plugin(..), InfoFromPrimitiveParts(..), InfoFromProcedureParts(..))+import Feldspar.Compiler.PluginArchitecture.DefaultConvert (Combine(..)) import Feldspar.Compiler.Options import Feldspar.Compiler.Error  - handlePrimitivesError = handleError "PluginArch/HandlePrimitives" InternalError  +data HandleTraceFunctions = HandleTraceFunctions+++instance TransformationPhase HandleTraceFunctions where+    type From HandleTraceFunctions = ()+    type To HandleTraceFunctions = ()+    type Downwards HandleTraceFunctions = ()+    type Upwards HandleTraceFunctions = Bool+    upwardsPrimitiveProgramInProgram = upwardsPrimitiveProgramInProgram'+    transformProcedure = transformProcedure'++ data HandlePrimitives = HandlePrimitives   instance TransformationPhase HandlePrimitives where     type From HandlePrimitives = ()     type To HandlePrimitives = ()-    type Downwards HandlePrimitives = Int+    type Downwards HandlePrimitives = (Int,Platform)     type Upwards HandlePrimitives = ()-    transformPrimitive = transformPrimitive'+    transformPrimitiveProgramInProgram = transformPrimitive'   instance Plugin HandlePrimitives where-    type ExternalInfo HandlePrimitives = (Int,DebugOption)-    executePlugin _ (_,NoPrimitiveInstructionHandling) procedure = procedure-    executePlugin _ (defArrSize,_) procedure = fst $ executeTransformationPhase HandlePrimitives defArrSize procedure+    type ExternalInfo HandlePrimitives = (Int, DebugOption, Platform)+    executePlugin _ (_,NoPrimitiveInstructionHandling,_) procedure = procedure+    executePlugin _ (defArrSize,_,platform) procedure+        = fst $ executeTransformationPhase HandlePrimitives (defArrSize,platform)+        $ fst $ executeTransformationPhase HandleTraceFunctions () procedure   -transformPrimitive' :: HandlePrimitives -> Int -> Primitive () -> InfosFromPrimitiveParts HandlePrimitives -> ProgramConstruction ()-transformPrimitive' _ defArrSize old modified'-    = case (nameS,as) of-        ("(==)", [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive InfixOp 2 as "equal" "=="-        ("(/=)", [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive InfixOp 2 as "not_equal" "!="-        ("(<)",  [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive InfixOp 2 as "less" "<"-        ("(>)",  [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive InfixOp 2 as "greater" ">"-        ("(<=)", [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive InfixOp 2 as "less_equal" "<="-        ("(>=)", [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive InfixOp 2 as "greater_equal" ">="-        ("not",  [InputActualParameter _, OutputActualParameter _])                         -> mkPrg $ makePrimitive PrefixOp 1 as "not" "!"-        ("(&&)", [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive InfixOp 2 as "and" "&&"-        ("(||)", [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive InfixOp 2 as "or" "||"-        ("div",  [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive InfixOp 2 as "divide" "/"-        ("rem",  [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive InfixOp 2 as "remainder" "%"-        ("mod",  [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive SimpleFun 2 as "mod" ""-        ("(^)",  [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive SimpleFun 2 as "pow" ""+instance Combine Bool where+    combine x y = or [x,y]         -        ("(.&.)",   [InputActualParameter _, InputActualParameter _, OutputActualParameter _])  -> mkPrg $ makePrimitive InfixOp 2 as "bit_and" "&"-        ("(.|.)",   [InputActualParameter _, InputActualParameter _, OutputActualParameter _])  -> mkPrg $ makePrimitive InfixOp 2 as "bit_or" "|"-        ("xor",     [InputActualParameter _, InputActualParameter _, OutputActualParameter _])  -> mkPrg $ makePrimitive InfixOp 2 as "bit_xor" "^"-        ("complement", [InputActualParameter _, OutputActualParameter _])                       -> mkPrg $ makePrimitive PrefixOp 1 as "bit_not" "~"-        ("bit",     [InputActualParameter _, OutputActualParameter _])                          -> mkPrg $ makePrimitive SimpleFun 1 as "bit" ""-        ("setBit",  [InputActualParameter _, InputActualParameter _, OutputActualParameter _])  -> mkPrg $ makePrimitive SimpleFun 2 as "setBit" ""-        ("clearBit", [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive SimpleFun 2 as "clearBit" ""-        ("complementBit", [InputActualParameter _, InputActualParameter _, OutputActualParameter _])  -> mkPrg $ makePrimitive SimpleFun 2 as "complementBit" ""-        ("testBit", [InputActualParameter _, InputActualParameter _, OutputActualParameter _])  -> mkPrg $ makePrimitive SimpleFun 2 as "testBit" ""-        ("shiftL",  [InputActualParameter _, InputActualParameter _, OutputActualParameter _])  -> mkPrg $ makePrimitive InfixOp 2 as "shiftL" "<<"-        ("shiftR",  [InputActualParameter _, InputActualParameter _, OutputActualParameter _])  -> mkPrg $ makePrimitive InfixOp 2 as "shiftR" ">>"-        ("rotateL", [InputActualParameter _, InputActualParameter _, OutputActualParameter _])  -> mkPrg $ makePrimitive SimpleFun 2 as "rotateL" ""-        ("rotateR", [InputActualParameter _, InputActualParameter _, OutputActualParameter _])  -> mkPrg $ makePrimitive SimpleFun 2 as "rotateR" ""-        -- ("shift",   [InputActualParameter _, InputActualParameter _, OutputActualParameter _])  -> mkPrg $ makePrimitive SimpleFun 2 as "bit_shift" ""-        -- ("rotate",  [InputActualParameter _, InputActualParameter _, OutputActualParameter _])  -> mkPrg $ makePrimitive SimpleFun 2 as "bit_rotate" ""-        ("bitSize", [InputActualParameter _, OutputActualParameter _])                          -> mkPrg $ makePrimitive SimpleFun 1 as "bitSize" ""-        ("isSigned", [InputActualParameter _, OutputActualParameter _])                         -> mkPrg $ makePrimitive SimpleFun 1 as "isSigned" ""+         -        ("abs",    [InputActualParameter _, OutputActualParameter _])                         -> mkPrg $ makePrimitive SimpleFun 1 as "abs" ""-        ("signum", [InputActualParameter _, OutputActualParameter _])                         -> mkPrg $ makePrimitive SimpleFun 1 as "signum" ""-        ("(+)",    [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive InfixOp 2 as "add" "+"-        ("(-)",    [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive InfixOp 2 as "sub" "-"-        ("(*)",    [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive InfixOp 2 as "mult" "*"-        ("(/)",    [InputActualParameter _, InputActualParameter _, OutputActualParameter _]) -> mkPrg $ makePrimitive InfixOp 2 as "divide" "/"+upwardsPrimitiveProgramInProgram' :: HandleTraceFunctions -> () -> Primitive () -> InfoFromPrimitiveParts HandleTraceFunctions -> ProgramConstruction () -> Bool+upwardsPrimitiveProgramInProgram' _ _ old _ _ | nameS=="trace"  = True+                                              | otherwise       = False+  where+    nameS = nameOfProcedureToCall $ (\(ProcedureCallInstruction x) -> x) $ instructionData $ primitiveInstruction old++++transformProcedure' :: HandleTraceFunctions -> () -> Procedure () -> InfoFromProcedureParts HandleTraceFunctions -> Procedure ()+transformProcedure' _ _ old upwardInfos+    | containsTrace = old{ +                        procedureBody = (procedureBody old){ +                          blockInstructions = (blockInstructions $ procedureBody old){ +                            programConstruction = addTraceSE $ programConstruction $ blockInstructions $ procedureBody old } } }+    | otherwise = old+  where+    containsTrace = upwardsInfoFromProcedureBody upwardInfos+    addTraceSE (SequenceProgram sequ) = SequenceProgram sequ{ sequenceProgramList = [traceStart] ++ (sequenceProgramList sequ) ++ [traceEnd] }+    addTraceSE _                      = SequenceProgram (Sequence [traceStart, blockInstructions $ procedureBody old, traceEnd] ())+    traceStart = Program (PrimitiveProgram $ Primitive (Instruction (ProcedureCallInstruction $ ProcedureCall "traceStart" [] ()) ()) ()) ()+    traceEnd = Program (PrimitiveProgram $ Primitive (Instruction (ProcedureCallInstruction $ ProcedureCall "traceEnd" [] ()) ()) ()) ()++++transformPrimitive' :: HandlePrimitives -> (Int,Platform) -> Primitive () -> InfoFromPrimitiveParts HandlePrimitives -> ProgramConstruction ()+transformPrimitive' _ (defArrSize,pfm) old modified'+    = case (nameS, inps, outs) of         -        ("(!)", [arr@(InputActualParameter _), idx@(InputActualParameter _), out@(OutputActualParameter _)])-            -> mkPrg $ makeAssignment -                (LeftValueExpression $ LeftValueInExpression+        ("(!)", [arr, idx], [out])+            -> mkPrg $ makeAssignment pfm+                (lToe $ LeftValue                     (ArrayElemReferenceLeftValue $ ArrayElemReference-                        (ArrayElemReferenceData (toLeftValue $ aToE arr) $ aToE idx) ()+                        (toLeftValue arr) idx ()                     ) ()-                ) (aToL out) defArrSize--        ("setIx", [original@(InputActualParameter _), idx@(InputActualParameter _), val@(InputActualParameter _), result@(OutputActualParameter _)])+                ) out defArrSize+        +        ("setIx", [original, idx, val], [result])             -> SequenceProgram $ Sequence -                [ Program (PrimitiveProgram $ Primitive (makeAssignment (aToE original) (aToL result) defArrSize) ()) ()-                , Program (PrimitiveProgram $ Primitive -                    (makeAssignment-                        (aToE val)-                        (ArrayElemReferenceLeftValue $ ArrayElemReference (ArrayElemReferenceData (aToL result) $ aToE idx) ())+                [ Program (mkPrg $ makeAssignment pfm original result defArrSize) ()+                , Program (mkPrg $ makeAssignment pfm val+                        (LeftValue (ArrayElemReferenceLeftValue $ ArrayElemReference result  idx ()) ())                         defArrSize-                    ) ()) ()+                    ) ()                 ] ()         -        ("copy", [in1@(InputActualParameter _), out@(OutputActualParameter _)])                   -            -> mkPrg $ makeAssignment (aToE in1) (aToL out) defArrSize+        ("copy", [in1], [out]) -> mkPrg $ makeAssignment pfm in1 out defArrSize         -        _       -> mkPrg $ modified+        ("trace", [label, original], [result])+            -> SequenceProgram $ Sequence +                [ Program (mkPrg $ makeAssignment pfm original result defArrSize) ()+                , Program (mkPrg $ makePrimitive pfm (Proc "trace" firstInFP) [lToe result, label] [] 0) ()+                ] ()         +        _ -> case (find matchPrimitive $ primitives pfm) of+              Just (fd,Right tp) -> SequenceProgram (Sequence plist ())+                where+                  plist = map (\(cd',inps',outs') -> Program (mkPrg $ makePrimitive pfm cd' inps' outs' 0) ()) $ tp fd inps outs+              Just (fd,Left cd)  -> mkPrg $ makePrimitive pfm cd inps outs defArrSize+              Nothing            -> mkPrg $ modified+           where-    nameS = nameOfProcedureToCall $ procedureCallData $ (\(ProcedureCallInstruction x) -> x) $ primitiveInstruction old-    as = actualParametersOfProcedureToCall $ procedureCallData $ (\(ProcedureCallInstruction x) -> x) modified+    nameS = nameOfProcedureToCall $ (\(ProcedureCallInstruction x) -> x) $ instructionData $ primitiveInstruction old+    as = actualParametersOfProcedureToCall $ (\(ProcedureCallInstruction x) -> x) $ instructionData modified     modified = recursivelyTransformedPrimitiveInstruction modified'     mkPrg x = PrimitiveProgram (Primitive x ())+    +    inps = map aToE $ filter isInparam as+    outs = map aToL $ filter (not . isInparam) as+    +    matchPrimitive (fd,_) = (fName fd == nameS) && (matchTypes' (inputs fd) inps)+    +    matchTypes' :: [TypeDesc] -> [Expression ()] -> Bool+    matchTypes' [] []     = True+    matchTypes' [] (y:ys) = False+    matchTypes' (x:xs) [] = False+    matchTypes' (x:xs) (y:ys) = (machTypes x $ typeof y) && (matchTypes' xs ys)   -makeAssignment :: Expression () -> LeftValue () -> Int -> Instruction ()-makeAssignment in1 out defaultArraySize-    | simpleType (typeof in1) = AssignmentInstruction $ Assignment (AssignmentData out in1) ()-    | otherwise = case (typeof in1) of-        (ImpArrayType _ t) -> makePrimitive SimpleFun 2 [eToA in1, eToA $ arraySize (typeof in1) defaultArraySize, lToA out] "copy" ""-        _                  -> handlePrimitivesError $ "Unknown type in makeAssignment:\n" ++ show (typeof in1)+makeAssignment :: Platform -> Expression () -> LeftValue () -> Int -> Instruction ()+makeAssignment pfm in1 out defArrSize = makePrimitive pfm Assig [in1] [out] defArrSize   -makePrimitive :: FunctionRole -> Int -> [ActualParameter ()] -> String -> String -> Instruction ()-makePrimitive primType parNum as cFunName cOpName-    | simpleType (typeof out) = AssignmentInstruction $ Assignment (AssignmentData out (FunctionCallExpression funCall)) ()-    | otherwise               = ProcedureCallInstruction procCall+makePrimitive :: Platform -> CPrimDesc -> [Expression ()] -> [LeftValue ()] -> Int -> Instruction ()++makePrimitive pfm Assig [in1] [out] defArrSize+    | simpleType (typeof in1) = Instruction (AssignmentInstruction $ Assignment out in1 ()) ()+    | otherwise = case (typeof in1) of+        (ImpArrayType _ t) -> makePrimitive pfm (Proc "copy" firstInFP) [in1, intToCe $ arraySize (typeof in1) defArrSize] [out] 0+        _                  -> handlePrimitivesError $ "Unknown type in makePrimitive:\n" ++ show (typeof in1)++makePrimitive pfm Assig _ _ _ = handlePrimitivesError $ "Wrong number of parameters for an assignment. (Parallel assignment not allowed.)"++makePrimitive pfm desc inps outs _+    | isNotProc desc && simpleType (typeof $ head outs)+                = Instruction (AssignmentInstruction $ Assignment (head outs) (Expression (FunctionCallExpression funCall) ()) ()) ()+    | otherwise = Instruction (ProcedureCallInstruction procCall) ()   where-    funCall = case (primType, parNum) of-        (SimpleFun, 1)  -> FunctionCall (FunctionCallData SimpleFun (typeof out) completeFunName [in1]) ()-        (SimpleFun, 2)  -> FunctionCall (FunctionCallData SimpleFun (typeof out) completeFunName [in1, in2]) ()-        (PrefixOp, 1)   -> FunctionCall (FunctionCallData PrefixOp (typeof out) cOpName [in1]) ()-        (InfixOp, 2)    -> FunctionCall (FunctionCallData InfixOp (typeof out) cOpName [in1, in2]) ()-        _               -> handlePrimitivesError $ "Invalid arguments:\n" ++ show (primType, parNum)-    procCall = case (primType, parNum) of-        (SimpleFun, 1)  -> ProcedureCall (ProcedureCallData completeProcName [in1', out']) ()-        (SimpleFun, 2)  -> ProcedureCall (ProcedureCallData completeProcName [in1', in2', out']) ()-        (PrefixOp, 1)   -> ProcedureCall (ProcedureCallData completeProcName [in1', out']) ()-        (InfixOp, 2)    -> ProcedureCall (ProcedureCallData completeProcName [in1', in2', out']) ()-        _               -> handlePrimitivesError $ "Invalid arguments:\n" ++ show (primType, parNum)-    completeFunName = cFunName ++ "_fun_" ++ toFunName (typeof in1)-    completeProcName = cFunName ++ "_" ++ toFunName (typeof in1)-    (in1,in1') = case (filter isInparam as) of-        x:_ -> (aToE x,x)-        _ -> handlePrimitivesError $ "There is not any Input parameter:\n" ++ show as-    (in2,in2') = case (filter isInparam as) of-        _:x:_ -> (aToE x,x)-        _  -> handlePrimitivesError $ "There is not enough Input parameter:\n" ++ show as-    (out,out') = case (filter (not . isInparam) as) of-        x:_ -> (aToL x,x)-        _     -> handlePrimitivesError $ "There is not any Output parameter:\n" ++ show as+    +    funCall = case (desc, length inps, length outs) of+        (Op1 op, 1, 1) -> FunctionCall PrefixOp (typeof $ head outs) op inps ()+        (Op2 op, 2, 1) -> FunctionCall InfixOp (typeof $ head outs) op inps ()+        (Fun _ _, _, 1)   -> FunctionCall SimpleFun (typeof $ head outs) completeFunName inps ()+        _                 -> errorMessage+    +    procCall = case (desc, length inps, length outs) of+        (Fun _ _, _, 1)   -> procCall'+        (Proc _ _, _, _)  -> procCall'+        _                 -> errorMessage+    +    procCall' = ProcedureCall completeProcName (inps' ++ outs') ()+    inps' = map eToA inps+    outs' = map lToA outs+    completeFunName | funPf desc == noneFP  = cName desc+                    | otherwise             = cName desc ++ "_fun" ++ apsToName+    completeProcName  | funPf desc == noneFP  = cName desc+                      | otherwise             = cName desc ++ apsToName+    apsToName = concatMap (("_"++) . (toFunName pfm) . typeof) apsToNameList+    apsToNameList = (take (useInputs $ funPf desc) inps') ++ (take (useOutputs $ funPf desc) outs')+    isNotProc (Proc _ _)  = False+    isNotProc _           = True+    errorMessage = handlePrimitivesError $ "Wrong C pirmitive description or different number of parameter:\n"+                                                  ++ show desc ++ "\n" ++ concatMap ((", "++) . show . typeof) inps   -toFunName :: Type -> String-toFunName BoolType = "bool"-toFunName FloatType = "float"-toFunName (Numeric sig siz) = listprint id "_" [compToC sig, compToC siz]-toFunName (ImpArrayType _ t@(ImpArrayType _ _)) = toFunName t -toFunName (ImpArrayType _ t)                    = "arrayOf_" ++ toFunName t +toFunName :: Platform -> Type -> String+toFunName pfm (ImpArrayType _ t@(ImpArrayType _ _)) = toFunName pfm t+toFunName pfm (ImpArrayType _ t)                    = "arrayOf_" ++ toFunName pfm t+toFunName pfm t = case (find (\(t',_,_) -> t == t') $ types pfm) of+    Just (_,_,s)  -> map (\c -> if c == ' ' then '_' else c) $ s+    Nothing       -> handlePrimitivesError $ "Unhandled type in platform " ++ name pfm   -arraySize :: Type -> Int -> Expression ()-arraySize a@(ImpArrayType _ t) defaultArraySize-    = ConstantExpression $ IntConstant $ IntConstantType (arraySize' a) ()+arraySize :: Type -> Int -> Int+arraySize a@(ImpArrayType _ t) defaultArraySize = arraySize' a   where     arraySize' (ImpArrayType (Norm n) t) = n * arraySize' t     arraySize' (ImpArrayType (Defined n) t) = n * arraySize' t@@ -203,16 +232,24 @@   -isInparam (InputActualParameter _)  = True-isInparam (OutputActualParameter _) = False+isInparam (ActualParameter (InputActualParameter _) _)  = True+isInparam (ActualParameter (OutputActualParameter _) _) = False   -aToE (InputActualParameter x) = inputActualParameterExpression x-aToL (OutputActualParameter x) = outputActualParameterLeftValue x--- TODO create a simple wrapper interface based on these functions+aToE (ActualParameter (InputActualParameter x) ())  = x+aToL (ActualParameter (OutputActualParameter x) ()) = x -eToA x = InputActualParameter $ InputActualParameterType x ()-lToA x = OutputActualParameter $ OutputActualParameterType x ()+-- adToE (InputActualParameter x)  = x+-- adToL (OutputActualParameter x) = x +eToA x = ActualParameter (InputActualParameter x) ()+lToA x = ActualParameter (OutputActualParameter x) ()++-- adToA x = ActualParameter x ()++-- ceToInt (Expression (ConstantExpression (Constant (IntConstant (IntConstantType x _)) _)) _) = x+intToCe x = Expression (ConstantExpression $ Constant (IntConstant $ IntConstantType x ()) ()) ()++lToe x = Expression (LeftValueExpression x) ()
Feldspar/Compiler/Plugins/Precompilation.hs view
@@ -1,34 +1,30 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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 #-} @@ -63,30 +59,31 @@ data PrecompilationSemanticInfo  instance SemanticInfo PrecompilationSemanticInfo where-    type ProcedureInfo PrecompilationSemanticInfo = SignatureInformation-    type BlockInfo PrecompilationSemanticInfo = ()-    type ProgramInfo PrecompilationSemanticInfo = ()-    type EmptyInfo PrecompilationSemanticInfo = ()-    type PrimitiveInfo PrecompilationSemanticInfo = ()-    type SequenceInfo PrecompilationSemanticInfo = ()-    type BranchInfo PrecompilationSemanticInfo = ()-    type SequentialLoopInfo PrecompilationSemanticInfo = ()-    type ParallelLoopInfo PrecompilationSemanticInfo = ()-    type FormalParameterInfo PrecompilationSemanticInfo = ()-    type LocalDeclarationInfo PrecompilationSemanticInfo = ()-    type LeftValueExpressionInfo PrecompilationSemanticInfo = ()-    type VariableInLeftValueInfo PrecompilationSemanticInfo = ()-    type ArrayElemReferenceInfo PrecompilationSemanticInfo = ()-    type InputActualParameterInfo PrecompilationSemanticInfo = ()-    type OutputActualParameterInfo PrecompilationSemanticInfo = ()-    type AssignmentInfo PrecompilationSemanticInfo = ()-    type ProcedureCallInfo PrecompilationSemanticInfo = ()-    type FunctionCallInfo PrecompilationSemanticInfo = ()-    type IntConstantInfo PrecompilationSemanticInfo = ()-    type FloatConstantInfo PrecompilationSemanticInfo = ()-    type BoolConstantInfo PrecompilationSemanticInfo = ()-    type ArrayConstantInfo PrecompilationSemanticInfo = ()-    type VariableInfo PrecompilationSemanticInfo = SignatureInformation+    type ProcedureInfo             PrecompilationSemanticInfo = SignatureInformation+    type BlockInfo                 PrecompilationSemanticInfo = ()+    type ProgramInfo               PrecompilationSemanticInfo = ()+    type EmptyInfo                 PrecompilationSemanticInfo = ()+    type PrimitiveInfo             PrecompilationSemanticInfo = ()+    type SequenceInfo              PrecompilationSemanticInfo = ()+    type BranchInfo                PrecompilationSemanticInfo = ()+    type SequentialLoopInfo        PrecompilationSemanticInfo = ()+    type ParallelLoopInfo          PrecompilationSemanticInfo = ()+    type FormalParameterInfo       PrecompilationSemanticInfo = ()+    type LocalDeclarationInfo      PrecompilationSemanticInfo = ()+    type ExpressionInfo            PrecompilationSemanticInfo = ()+    type ConstantInfo              PrecompilationSemanticInfo = ()+    type FunctionCallInfo          PrecompilationSemanticInfo = ()+    type LeftValueInfo             PrecompilationSemanticInfo = ()+    type ArrayElemReferenceInfo    PrecompilationSemanticInfo = ()+    type InstructionInfo           PrecompilationSemanticInfo = ()+    type AssignmentInfo            PrecompilationSemanticInfo = ()+    type ProcedureCallInfo         PrecompilationSemanticInfo = ()+    type ActualParameterInfo       PrecompilationSemanticInfo = ()+    type IntConstantInfo           PrecompilationSemanticInfo = ()+    type FloatConstantInfo         PrecompilationSemanticInfo = ()+    type BoolConstantInfo          PrecompilationSemanticInfo = ()+    type ArrayConstantInfo         PrecompilationSemanticInfo = ()+    type VariableInfo              PrecompilationSemanticInfo = SignatureInformation  data Precompilation = Precompilation @@ -97,7 +94,7 @@     type Upwards Precompilation = ()     downwardsProcedure Precompilation fromAbove procedure = fromAbove {         generatedImperativeParameterNames =-            map (variableName . variableData . formalParameterVariable) (inParameters procedure)+            map (variableName . formalParameterVariable) (inParameters procedure)     }     transformProcedure Precompilation fromAbove originalProcedure fromBelow =         Procedure { -- NOTE: fromAbove won't have the generated imperative parameter names right here@@ -108,6 +105,7 @@             procedureSemInf = ()         }     transformVariable = myTransformVariable+    transformVariableLeftValueInLeftValue = myTransformVariableLeftValueInLeftValue  getVariableName :: SignatureInformation -> String -> String getVariableName signatureInformation origname = case (originalFeldsparParameterNames signatureInformation) of@@ -127,11 +125,12 @@  myTransformVariable :: Precompilation -> SignatureInformation -> Variable () -> Variable () myTransformVariable Precompilation fromAbove v = v {-    variableData = (variableData v) {-        variableName = getVariableName fromAbove (variableName $ variableData v)-    },+    variableName = getVariableName fromAbove (variableName v),     variableSemInf = () }++myTransformVariableLeftValueInLeftValue :: Precompilation -> SignatureInformation -> Variable () -> LeftValueData ()+myTransformVariableLeftValueInLeftValue Precompilation fromAbove v = VariableLeftValue $ myTransformVariable Precompilation fromAbove v  data PrecompilationExternalInfo = PrecompilationExternalInfo {     originalFeldsparFunctionSignature :: Precompiler.OriginalFeldsparFunctionSignature,
Feldspar/Compiler/Plugins/PrettyPrint.hs view
@@ -1,34 +1,30 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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 #-} @@ -68,28 +64,24 @@          transformLocalDeclaration _ (_,defArrSize) _ up =         LocalDeclaration {-            localDeclarationData = ldd{localVariable = addDefaultArraySizes v defArrSize},+            localVariable = addDefaultArraySizes v defArrSize,+            localInitValue = recursivelyTransformedLocalInitValue up,             localDeclarationSemInf = ()          }       where-        ldd = recursivelyTransformedLocalDeclarationData up-        v = localVariable ldd+        v = recursivelyTransformedLocalVariable up   instance Plugin PrettyPrint where     type ExternalInfo PrettyPrint = (Platform,Int)     executePlugin PrettyPrint (platform,defArrSize) procedure = fst-        $ executeTransformationPhase PrettyPrint (isRestrict,defArrSize) procedure where-            isRestrict = case platform of-                C99    -> Restrict-                _     -> NoRestrict+        $ executeTransformationPhase PrettyPrint (isRestrict platform,defArrSize) procedure where   addDefaultArraySizes :: (SemanticInfo t) => Variable t -> Int -> Variable t-addDefaultArraySizes v defArrSize = v{variableData = vd{variableType = addDefaultArraySizes' t}}+addDefaultArraySizes v defArrSize = v{variableType = addDefaultArraySizes' t}   where-    vd = variableData v-    t = variableType vd+    t = variableType v     addDefaultArraySizes' (ImpArrayType (Norm n) t) = ImpArrayType (Norm n) $ addDefaultArraySizes' t     addDefaultArraySizes' (ImpArrayType Undefined t)  = ImpArrayType (Defined defArrSize) $ addDefaultArraySizes' t     addDefaultArraySizes' t                         = t
Feldspar/Compiler/Plugins/PropagationUtils.hs view
@@ -1,34 +1,30 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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, FlexibleInstances #-} @@ -36,21 +32,48 @@  import Feldspar.Compiler.PluginArchitecture import qualified Data.Map as Map---import qualified Data.Set as Set+import qualified Data.Set as Set import qualified Data.List as List  -- ========================---       VarStatistics+--       VariableData -- ========================+ +data VariableData = VariableData {+    variableDataType   :: Type+    , variableDataName   :: String+} deriving (Eq,Show) +variableData :: (SemanticInfo t) => Variable t -> VariableData+variableData var = VariableData {+    variableDataName = variableName var+    , variableDataType = variableType var+}+ instance Ord VariableData where-	compare v1 v2 = compare (variableName v1) $ variableName v2+    compare v1 v2 = compare (variableDataName v1) $ variableDataName v2 +instance Default (Maybe VariableData) where+    defaultValue = Nothing++instance Default [VariableData] where+    defaultValue = []++instance Default (Set.Set VariableData) where+    defaultValue = Set.empty++instance Combine (Set.Set VariableData) where+    combine = Set.union++-- ========================+--       VarStatistics+-- ========================+ type VarStatistics t = Map.Map VariableData (Occurrences t)  data Occurrences t     = Occurrences-    { writeVar  :: Occurrence (Maybe t) --(Maybe (Expression t,[String],Bool))+    { writeVar  :: Occurrence (Maybe t)     , readVar   :: Occurrence ()     }     deriving (Eq,Show)@@ -66,54 +89,54 @@  hasRead :: VarStatistics t -> VariableData -> Bool hasRead vs var = case Map.lookup var vs of-	Nothing -> False-	Just occ -> case readVar occ of-		Zero -> False-		_ -> True+    Nothing -> False+    Just occ -> case readVar occ of+        Zero -> False+        _ -> True  notRead :: VarStatistics t -> VariableData -> Bool notRead vs var = not $ hasRead vs var  hasWrite :: VarStatistics t -> VariableData -> Bool hasWrite vs var = case Map.lookup var vs of-	Nothing -> False-	Just occ -> case writeVar occ of-		Zero -> False-		_ -> True+    Nothing -> False+    Just occ -> case writeVar occ of+        Zero -> False+        _ -> True  notWrite :: VarStatistics t -> VariableData -> Bool notWrite  vs var = not $ hasWrite  vs var  getWrite :: VarStatistics t -> VariableData -> Maybe t getWrite vs var = case Map.lookup var vs of-	Nothing -> Nothing-	Just occ -> case writeVar occ of-		One val -> val-		_ -> Nothing+    Nothing -> Nothing+    Just occ -> case writeVar occ of+        One val -> val+        _ -> Nothing  instance Default (VarStatistics t) where     defaultValue = Map.empty  instance Combine (VarStatistics t) where-	combine fst snd = Map.unionWith combine fst snd +    combine fst snd = Map.unionWith combine fst snd   instance Combine (Occurrences t) where-	combine o1 o2 = Occurrences-		(combine (writeVar o1) (writeVar o2) )-		(combine (readVar o1) (readVar o2) ) +    combine o1 o2 = Occurrences+        (combine (writeVar o1) (writeVar o2) )+        (combine (readVar o1) (readVar o2) )   instance Combine (Occurrence t) where-	combine Zero x = x-	combine Multiple x = Multiple-	combine e@(One _) Zero = e-	combine (One _) _ = Multiple+    combine Zero x = x+    combine Multiple x = Multiple+    combine e@(One _) Zero = e+    combine (One _) _ = Multiple  multipleVarStatistics :: VarStatistics t -> VarStatistics t multipleVarStatistics vs = Map.map multipleOccurrences vs where-	multipleOccurrences (Occurrences write read) = Occurrences (multipleOccurrence write) (multipleOccurrence read)-	multipleOccurrence Zero = Zero-	multipleOccurrence (One _) = Multiple-	multipleOccurrence Multiple = Multiple+    multipleOccurrences (Occurrences write read) = Occurrences (multipleOccurrence write) (multipleOccurrence read)+    multipleOccurrence Zero = Zero+    multipleOccurrence (One _) = Multiple+    multipleOccurrence Multiple = Multiple  variablesInVarStatistics :: VarStatistics t -> [VariableData] variablesInVarStatistics vs = Map.keys vs@@ -136,114 +159,128 @@     defaultValue = Occurrence_read  class OccurrenceDownwards node where-	occurrenceDownwards :: node -> Occurrence_place+    occurrenceDownwards :: node -> Occurrence_place  instance OccurrenceDownwards (Branch t) where-	occurrenceDownwards _ = Occurrence_notopt --condition variable OK+    occurrenceDownwards _ = Occurrence_notopt --condition variable OK instance OccurrenceDownwards (SequentialLoop t) where-	occurrenceDownwards _ = Occurrence_read --condition variable OK+    occurrenceDownwards _ = Occurrence_read --condition variable OK instance OccurrenceDownwards (ParallelLoop t) where-	occurrenceDownwards _ = Occurrence_notopt --condition variable OK+    occurrenceDownwards _ = Occurrence_notopt --condition variable OK instance OccurrenceDownwards (FormalParameter t) where-	occurrenceDownwards _ = Occurrence_notopt+    occurrenceDownwards _ = Occurrence_notopt instance OccurrenceDownwards (LocalDeclaration t) where-	occurrenceDownwards _ = Occurrence_declare+    occurrenceDownwards _ = Occurrence_declare instance OccurrenceDownwards (Assignment t) where-	occurrenceDownwards _ = Occurrence_write --left OK, right is expression-instance OccurrenceDownwards (InputActualParameterType t) where-	occurrenceDownwards _ = Occurrence_read-instance OccurrenceDownwards (OutputActualParameterType t) where-	occurrenceDownwards _ = Occurrence_write-instance OccurrenceDownwards (LeftValueInExpression t) where-	occurrenceDownwards _ = Occurrence_read -- OK-instance OccurrenceDownwards (FunctionCall t) where-	occurrenceDownwards _ = Occurrence_read -- OK--+    occurrenceDownwards _ = Occurrence_write --left OK, right is expression+instance OccurrenceDownwards (ActualParameter t) where+    occurrenceDownwards _ = Occurrence_write+instance OccurrenceDownwards (Expression t) where+    occurrenceDownwards _ = Occurrence_read -- OK  -- ======================== --       Other utils -- ======================== -instance Default [VariableData] where-	defaultValue = []-- declaredVar :: (SemanticInfo t) => LocalDeclaration t -> VariableData-declaredVar = variableData.localVariable.localDeclarationData+declaredVar = variableData.localVariable  declaredVars :: (SemanticInfo t) => Block t -> [VariableData]-declaredVars block = map declaredVar $ blockDeclarations $ blockData block+declaredVars block = map declaredVar $ blockDeclarations block -delUnusedDecl :: (ConvertAllInfos via to) =>  [VariableData] -> Block via -> BlockData to -> Block to-delUnusedDecl unusedList origblock partiallyTransformedBlock =-				Block {-					blockData = BlockData {-						blockDeclarations = filter (\d -> not $ List.elem (declaredVar d) unusedList) $ blockDeclarations partiallyTransformedBlock,-						blockInstructions = blockInstructions partiallyTransformedBlock-					},-					blockSemInf = convert $ blockSemInf origblock-				}+delUnusedDecl :: (ConvertAllInfos via to) =>  [VariableData] -> Block via -> [LocalDeclaration to] -> Program to -> Block to+delUnusedDecl unusedList origblock partiallyTransformedDecl partiallyTransformedInstr =+                Block {+                    blockDeclarations = filter (\d -> not $ List.elem (declaredVar d) unusedList) $ partiallyTransformedDecl,+                    blockInstructions = partiallyTransformedInstr,+                    blockSemInf = convert $ blockSemInf origblock+                }  -- ======================== --       SemInfUtils -- ========================  class SemInfUtils node where-	deleteSemInf :: (SemanticInfo t) => node t -> node ()+    deleteSemInf :: (SemanticInfo t) => node t -> node ()  instance SemInfUtils Expression where-	deleteSemInf (LeftValueExpression lve) = LeftValueExpression $ lve {-		leftValueExpressionContents = deleteSemInf $ leftValueExpressionContents lve,-		leftValueExpressionSemInf = ()-	}-	deleteSemInf (ConstantExpression ce) = (ConstantExpression $ deleteSemInf ce)-	deleteSemInf (FunctionCallExpression fce) = FunctionCallExpression $ fce {-		functionCallData = (functionCallData fce) {-			actualParametersOfFunctionToCall = map deleteSemInf $ actualParametersOfFunctionToCall $ functionCallData fce-		},-		functionCallSemInf = ()-	}+    deleteSemInf exp = exp {+        expressionData = deleteSemInf $ expressionData exp,+        expressionSemInf = ()+    } +instance SemInfUtils ExpressionData where+    deleteSemInf (LeftValueExpression lve) = LeftValueExpression $ deleteSemInf  lve+    deleteSemInf (ConstantExpression ce) = ConstantExpression $ deleteSemInf ce+    deleteSemInf (FunctionCallExpression fce) = FunctionCallExpression $ deleteSemInf fce + instance SemInfUtils LeftValue where-	deleteSemInf (VariableLeftValue vlv) = VariableLeftValue vlv {-		variableLeftValueContents = deleteSemInf $ variableLeftValueContents vlv,-		variableLeftValueSemInf = ()-	}-	deleteSemInf (ArrayElemReferenceLeftValue aer) = ArrayElemReferenceLeftValue aer {-		arrayElemReferenceData = (arrayElemReferenceData aer){-			arrayName = deleteSemInf $ arrayName $ arrayElemReferenceData aer,-			arrayIndex = deleteSemInf $ arrayIndex $ arrayElemReferenceData aer-		},-		arrayElemReferenceSemInf = ()-	}+    deleteSemInf lv = lv {+        leftValueData = deleteSemInf $ leftValueData lv,+        leftValueSemInf = ()+    } +instance SemInfUtils LeftValueData where+    deleteSemInf (VariableLeftValue vlv) = VariableLeftValue $ deleteSemInf vlv+    deleteSemInf (ArrayElemReferenceLeftValue aer) = ArrayElemReferenceLeftValue $ deleteSemInf aer++instance SemInfUtils ArrayElemReference where+    deleteSemInf aer = aer {+        arrayName = deleteSemInf $ arrayName aer,+        arrayIndex = deleteSemInf $ arrayIndex aer,+        arrayElemReferenceSemInf = ()+    }+ instance SemInfUtils Variable where-	deleteSemInf var = var {-		variableSemInf = ()-	}+    deleteSemInf var = var {+        variableSemInf = ()+    }  instance SemInfUtils ActualParameter where-	deleteSemInf (InputActualParameter iap) = InputActualParameter iap {-		inputActualParameterExpression = deleteSemInf $ inputActualParameterExpression iap,-		inputActualParameterSemInf = ()-	}-	deleteSemInf (OutputActualParameter oap) = OutputActualParameter oap {-		outputActualParameterLeftValue = deleteSemInf $ outputActualParameterLeftValue oap,-		outputActualParameterSemInf = ()-	}+    deleteSemInf ap = ap {+        actualParameterData = deleteSemInf $ actualParameterData ap,+        actualParameterSemInf = ()+    } +instance SemInfUtils ActualParameterData where+    deleteSemInf (InputActualParameter iap) = InputActualParameter $ deleteSemInf iap+    deleteSemInf (OutputActualParameter oap) = OutputActualParameter $ deleteSemInf oap+ instance SemInfUtils Constant where-	deleteSemInf (IntConstant ic) = IntConstant ic {-		intConstantSemInf = ()-	}-	deleteSemInf (FloatConstant fc) = FloatConstant fc {-		floatConstantSemInf = ()-	}-	deleteSemInf (BoolConstant bc) = BoolConstant bc {-		boolConstantSemInf = ()-	}-	deleteSemInf (ArrayConstant ac) = ArrayConstant ac {-		arrayConstantValue = map deleteSemInf $ arrayConstantValue ac,-		arrayConstantSemInf = ()-	}+    deleteSemInf c = c {+        constantData = deleteSemInf $ constantData c,+        constantSemInf = ()+    }++instance SemInfUtils ConstantData where+    deleteSemInf (IntConstant ic) = IntConstant $ deleteSemInf ic+    deleteSemInf (FloatConstant fc) = FloatConstant $ deleteSemInf fc+    deleteSemInf (BoolConstant bc) = BoolConstant  $ deleteSemInf bc+    deleteSemInf (ArrayConstant ac) = ArrayConstant  $ deleteSemInf ac++instance SemInfUtils IntConstantType where+    deleteSemInf c = c {+        intConstantSemInf = ()+    }++instance SemInfUtils FloatConstantType where+    deleteSemInf c = c {+        floatConstantSemInf = ()+    }++instance SemInfUtils BoolConstantType where+    deleteSemInf c = c {+        boolConstantSemInf = ()+    }++instance SemInfUtils ArrayConstantType where+    deleteSemInf c = c {+        arrayConstantValue = map deleteSemInf $ arrayConstantValue c,+        arrayConstantSemInf = ()+    }++instance SemInfUtils FunctionCall where+    deleteSemInf fc = fc {+        actualParametersOfFunctionToCall = map deleteSemInf $ actualParametersOfFunctionToCall fc,+        functionCallSemInf = ()+    }
Feldspar/Compiler/Plugins/Unroll.hs view
@@ -1,34 +1,30 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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 #-} @@ -60,8 +56,8 @@     type To Unroll_1 = UnrollSemInf     type Downwards Unroll_1 = Int     type Upwards Unroll_1 = Bool-    upwardsParallelLoop _ _ _ _ _ = True-    transformParallelLoop Unroll_1 d pl u = trParLoop1 d pl u+    upwardsParallelLoopProgramInProgram _ _ _ _ _ = True+    transformParallelLoopProgramInProgram Unroll_1 d pl u = trParLoop1 d pl u  data Unroll_2 = Unroll_2     instance TransformationPhase Unroll_2     where@@ -73,34 +69,36 @@         | programSemInf p == Nothing = d         | otherwise = programSemInf p     transformVariable Unroll_2 d v = trVariable d v-    transformLeftValueExpression Unroll_2 d lvie u = trLVIE d lvie u+    transformVariableLeftValueInLeftValue Unroll_2 d v = VariableLeftValue $ trVariable d $ v+    transformLeftValueExpressionInExpression Unroll_2 d lvie u = trLVIE d lvie u  data UnrollSemInf = UnrollSemInf instance SemanticInfo UnrollSemInf where-    type ProcedureInfo UnrollSemInf = ()-    type BlockInfo UnrollSemInf = ()-    type ProgramInfo UnrollSemInf = Maybe SemInfPrg-    type EmptyInfo UnrollSemInf = Maybe SemInfPrg-    type PrimitiveInfo UnrollSemInf = Maybe SemInfPrg-    type SequenceInfo UnrollSemInf = Maybe SemInfPrg-    type BranchInfo UnrollSemInf = ()-    type SequentialLoopInfo UnrollSemInf = ()-    type ParallelLoopInfo UnrollSemInf = ()-    type FormalParameterInfo UnrollSemInf = ()-    type LocalDeclarationInfo UnrollSemInf = ()-    type LeftValueExpressionInfo UnrollSemInf = ()-    type VariableInLeftValueInfo UnrollSemInf = ()-    type ArrayElemReferenceInfo UnrollSemInf = ()-    type InputActualParameterInfo UnrollSemInf = ()-    type OutputActualParameterInfo UnrollSemInf = ()-    type AssignmentInfo UnrollSemInf = ()-    type ProcedureCallInfo UnrollSemInf = ()-    type FunctionCallInfo UnrollSemInf = ()-    type IntConstantInfo UnrollSemInf = ()-    type FloatConstantInfo UnrollSemInf = ()-    type BoolConstantInfo UnrollSemInf = ()-    type ArrayConstantInfo UnrollSemInf = ()-    type VariableInfo UnrollSemInf = ()+    type ProcedureInfo             UnrollSemInf = ()+    type BlockInfo                 UnrollSemInf = ()+    type ProgramInfo               UnrollSemInf = Maybe SemInfPrg+    type EmptyInfo                 UnrollSemInf = Maybe SemInfPrg+    type PrimitiveInfo             UnrollSemInf = Maybe SemInfPrg+    type SequenceInfo              UnrollSemInf = Maybe SemInfPrg+    type BranchInfo                UnrollSemInf = ()+    type SequentialLoopInfo        UnrollSemInf = ()+    type ParallelLoopInfo          UnrollSemInf = ()+    type FormalParameterInfo       UnrollSemInf = ()+    type LocalDeclarationInfo      UnrollSemInf = ()+    type ExpressionInfo            UnrollSemInf = ()+    type ConstantInfo              UnrollSemInf = ()+    type FunctionCallInfo          UnrollSemInf = ()+    type LeftValueInfo             UnrollSemInf = ()+    type ArrayElemReferenceInfo    UnrollSemInf = ()+    type InstructionInfo           UnrollSemInf = ()+    type AssignmentInfo            UnrollSemInf = ()+    type ProcedureCallInfo         UnrollSemInf = ()+    type ActualParameterInfo       UnrollSemInf = ()+    type IntConstantInfo           UnrollSemInf = ()+    type FloatConstantInfo         UnrollSemInf = ()+    type BoolConstantInfo          UnrollSemInf = ()+    type ArrayConstantInfo         UnrollSemInf = ()+    type VariableInfo              UnrollSemInf = ()  instance Combine Bool where     combine = (||)    @@ -112,57 +110,56 @@     } deriving (Eq, Show) instance Default (Maybe SemInfPrg) where defaultValue = Nothing     -trLVIE d lvie u = case d of+trLVIE :: Downwards Unroll_2 -> LeftValue UnrollSemInf -> InfoFromLeftValueParts Unroll_2 -> ExpressionData ()+trLVIE d (LeftValue leftValue _) u = case d of     Just x -> result x     otherwise -> orig     where-        leftValue = leftValueExpressionContents $ lvie         name = case leftValue of-            VariableLeftValue (VariableInLeftValue d _) -> Just $ getVarName d+            VariableLeftValue d -> Just $ getVarName d             otherwise    ->    Nothing         result x = case name of             Just n-                | n == loopVar x -> FunctionCallExpression $ FunctionCall (FunctionCallData (InfixOp) (Numeric ImpSigned S32) ("+") ([loopVarPar, plusPar])) ()+                | n == loopVar x -> FunctionCallExpression $ FunctionCall InfixOp (Numeric ImpSigned S32) ("+") ([loopVarPar, plusPar]) ()                 | otherwise -> orig             otherwise -> orig             where-                loopVarPar = orig+                loopVarPar = Expression orig ()                 num = position x-                plusPar = ConstantExpression $ IntConstant $ IntConstantType num ()-        orig = LeftValueExpression $ LeftValueInExpression (recursivelyTransformedLeftValueExpressionContents u ) ()        +                plusPar =  Expression (ConstantExpression $ Constant (IntConstant $ IntConstantType num ()) ()) ()+        orig = LeftValueExpression $ LeftValue (recursivelyTransformedLeftValueData u ) ()        trVariable d v-    | d /= Nothing && elementOf (varNames (valueFromJust d)) (getVarName v) = v { variableData = (variableData v){ variableName = (variableName $ variableData v) ++ "_u" ++ (show $ position $ valueFromJust d) },variableSemInf = ()}+    | d /= Nothing && elementOf (varNames (valueFromJust d)) (getVarName v) = v { variableName = (variableName v) ++ "_u" ++ (show $ position $ valueFromJust d), variableSemInf = ()}     | otherwise = v {variableSemInf = ()}-    ++trParLoop1 :: Downwards Unroll_1 -> ParallelLoop () -> InfoFromParallelLoopParts Unroll_1 -> ProgramConstruction UnrollSemInf trParLoop1 d pl u     | ( upwardsInfoFromParallelLoopCore u ) == False && (unrollPossible || varInExpr ) = ParallelLoopProgram newParLoop-    | otherwise = ParallelLoopProgram (ParallelLoop trPL ())+    | otherwise = ParallelLoopProgram trPl     where-        newParLoop = pl { parallelLoopData = ( trPL ) -            {    parallelLoopStep = unrollNum-            ,    parallelLoopCore = newLoopCore}-        ,    parallelLoopSemInf = ()}+        newParLoop = trPl {    parallelLoopStep = unrollNum+                        ,    parallelLoopCore = newLoopCore+                        ,    parallelLoopSemInf = ()}         newLoopCore = origLoopCore -                        {    blockData = (blockData origLoopCore)-                            {    blockDeclarations = unrollDecls-                            ,    blockInstructions = unrollPrg-                            }+                        {    blockDeclarations = unrollDecls+                        ,    blockInstructions = unrollPrg                         ,    blockSemInf = ()}         unrollPrg = Program (SequenceProgram $ Sequence prgs (Nothing)) (Nothing)         prgs = map (\(i,p) -> writeSemInfToPrg p (Just $ SemInfPrg i varNames loopCounter)) $ zip [0,1..] replPrg         writeSemInfToPrg prg semInf = prg { programSemInf = semInf }                 replPrg = replicate unrollNum origPrg-        origPrg = blockInstructions $ blockData origLoopCore+        origPrg = blockInstructions $ origLoopCore         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 unrollNum origDecls-        origDecls = blockDeclarations $ blockData origLoopCore-        origLoopCore = parallelLoopCore $ trPL-        iterExpr = numberOfIterations $ trPL-        trPL = recursivelyTransformedParallelLoopData u+        origDecls = blockDeclarations $ origLoopCore+        origLoopCore = recursivelyTransformedParallelLoopCore u+        iterExpr = recursivelyTransformedNumberOfIterations u+        loopCounter' = recursivelyTransformedParallelLoopConditionVariable u+        trPl = ParallelLoop loopCounter' iterExpr (parallelLoopStep pl) origLoopCore ()         unrollNum = d-        loopCounter = getVarName $ parallelLoopConditionVariable trPL+        loopCounter = getVarName $ recursivelyTransformedParallelLoopConditionVariable u         varNames = map (\d -> getVarNameDecl d) origDecls         iterTemp = iterNumFromExpr iterExpr         origIterNum = valueFromJust iterTemp@@ -171,14 +168,14 @@         varInExpr = not $ isJust iterTemp  -- helper functions : -iterNumFromExpr (ConstantExpression (IntConstant (IntConstantType i _))) = Just i+iterNumFromExpr (Expression (ConstantExpression (Constant (IntConstant (IntConstantType i _)) _)) _) = Just i iterNumFromExpr _ = Nothing isJust (Just x) = True isJust _ = False-getVarNameDecl d = getVarName $ localVariable $ localDeclarationData $ d-getVarName v = variableName $ variableData v+getVarNameDecl d = getVarName $ localVariable d+getVarName v = variableName v valueFromJust (Just v) = v valueFromJust Nothing = error "This was Nothing"-renameDeclaration d n = d { localDeclarationData = (localDeclarationData d) { localVariable = renameVariable (localVariable $ localDeclarationData d) n } }-renameVariable v n = v { variableData = (variableData v) { variableName = n    } }+renameDeclaration d n = d { localVariable = renameVariable (localVariable d) n }+renameVariable v n = v { variableName = n    } elementOf ss s = (length $ filter (\s' -> s' == s) ss) > 0
Feldspar/Compiler/Precompiler/Precompiler.hs view
@@ -1,34 +1,30 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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.Precompiler.Precompiler where
+ Feldspar/Compiler/Standalone/Constants.hs view
@@ -0,0 +1,42 @@+--+-- Copyright (c) 2009-2010, 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.Standalone.Constants where++globalImportList = ["Feldspar.Fs2dot", "Feldspar.Compiler.Compiler", +                    "Feldspar.Compiler.Precompiler.Precompiler", "Feldspar.Compiler.Options",+                    "Feldspar.Compiler.Platforms"]++warningPrefix = "[WARNING]: "+errorPrefix   = "[ERROR  ]: "++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"
+ Feldspar/Compiler/Standalone/Library.hs view
@@ -0,0 +1,71 @@+--+-- Copyright (c) 2009-2010, 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.Standalone.Library where++import qualified Feldspar.Compiler.Options as CoreOptions+import Feldspar.Compiler.Platforms++import Data.Char+import System.Console.ANSI+import Language.Haskell.Interpreter++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])+    +withColor :: Color -> IO () -> IO ()+withColor color action = do+    setSGR [SetColor Foreground Dull color, SetConsoleIntensity BoldIntensity]+    action+    setSGR [Reset]+    +iPutStrLn :: String -> Interpreter ()+iPutStrLn = liftIO . putStrLn++iPutStr :: String -> Interpreter ()+iPutStr = liftIO . putStr
+ Feldspar/Compiler/Standalone/Options.hs view
@@ -0,0 +1,151 @@+--+-- Copyright (c) 2009-2010, 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.Standalone.Options where++import qualified Feldspar.Compiler.Options as CompilerCoreOptions+import qualified Feldspar.Compiler.Compiler as CompilerCore+import qualified Feldspar.Compiler.Standalone.Library as StandaloneLib+import Feldspar.Compiler.Standalone.Constants+import Feldspar.Compiler.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 FunctionMode = SingleFunction String | MultiFunction++data Options = Options  { optSingleFunction     :: FunctionMode+                        , optOutputFileName     :: Maybe String+                        , optDotGeneration      :: Bool+                        , optDotFileName        :: Maybe String+                        , optCompilerMode       :: CompilerCoreOptions.Options+                        }++-- | Default options+startOptions :: Options+startOptions = Options  { optSingleFunction = MultiFunction+                        , optOutputFileName = Nothing+                        , optDotGeneration  = False+                        , optDotFileName    = Nothing+                        , optCompilerMode   = CompilerCore.defaultOptions+                        }++-- | Option descriptions for getOpt+optionDescriptors :: [ OptDescr (Options -> IO Options) ]+optionDescriptors =+    [ Option "f" ["singlefunction"]+        (ReqArg+            (\arg opt -> return opt { optSingleFunction = SingleFunction arg })+            "FUNCTION")+        "Enables single-function compilation"++    , Option "o" ["output"]+        (ReqArg+            (\arg opt -> return opt { optOutputFileName = Just arg })+            "outputfile.c")+        "Overrides the file name for the generated output code"++    , Option "d" ["todot"]+        (OptArg+            (\arg opt -> return opt { optDotFileName = arg, optDotGeneration = True })+            "dotfile.dot")+        "Enables dot generation (outputs to stdout if no filename is specified)"++    , 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 (NoSimplification | NoPrimitiveInstructionHandling)"+     , Option "a" ["defaultArraySize"]+        (ReqArg+            (\arg opt -> return opt {+                optCompilerMode = (optCompilerMode opt) {+                    CompilerCoreOptions.defaultArraySize = parseInt arg "Invalid default array size"+                }+            })+            "<size>")+        "Overrides default array size"++    , 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 "NoSimplification" = CompilerCoreOptions.NoSimplification+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/Transformation/GraphToImperative.hs view
@@ -1,34 +1,30 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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 #-} @@ -103,17 +99,15 @@         inParameters  = inputDecls,         outParameters = outputDecls,         procedureBody = Block {-            blockData = BlockData {-                blockDeclarations = localDecls,-                blockInstructions = Program {-                                        programConstruction = SequenceProgram $ Sequence {-                                            sequenceProgramList = ( map transformNodeToProgram pairs-                                                                   ++ copyToOutput (interfaceOutput ifc) (interfaceOutputType ifc) True ),-                                            sequenceSemInf = ()-                                        },-                                        programSemInf = ()-                                    }-            },+            blockDeclarations = localDecls,+            blockInstructions = Program {+                                    programConstruction = SequenceProgram $ Sequence {+                                        sequenceProgramList = ( map transformNodeToProgram pairs+                                                               ++ copyToOutput (interfaceOutput ifc) (interfaceOutputType ifc) True ),+                                        sequenceSemInf = ()+                                    },+                                    programSemInf = ()+                                },             blockSemInf = ()         },         procedureSemInf = ()@@ -126,7 +120,7 @@         outputDecls = tupleWalk transformSourceToFormalParameter $ interfaceOutputType ifc         transformSourceToFormalParameter :: [Int] -> StorableType -> FormalParameter InitSemInf         transformSourceToFormalParameter path typ = FormalParameter {-            formalParameterVariable = Representation.Variable (VariableData FunOut ctyp (outName path)) (),+            formalParameterVariable = Representation.Variable FunOut ctyp (outName path) (),             formalParameterSemInf = ()         } where              ctyp = compileStorableType typ@@ -141,7 +135,7 @@ transformNodeToFormalParameter n = tupleWalk genDecl $ tupleZip (outTyps,initVals) where     genDecl path (typ,ini)         = FormalParameter {-              formalParameterVariable = Representation.Variable (VariableData Value ctyp (varPrefix (nodeId n) ++ varPath path)) (),+              formalParameterVariable = Representation.Variable Value ctyp (varPrefix (nodeId n) ++ varPath path) (),               formalParameterSemInf = ()           } where               ctyp = compileStorableType typ@@ -157,17 +151,13 @@ transformNodeToLocalDeclaration :: Node -> [LocalDeclaration InitSemInf] transformNodeToLocalDeclaration n = tupleWalk genDecl $ tupleZip (outTyps,initVals) where     genDecl path (typ,ini) = LocalDeclaration {-        localDeclarationData = LocalDeclarationData {-            localVariable     = Representation.Variable {-                variableData = VariableData {-                    variableRole = Value,-                    variableType = ctyp,-                    variableName = (varPrefix (nodeId n) ++ varPath path)-                },-                variableSemInf = ()-            },-            localInitValue = ini+        localVariable     = Representation.Variable {+            variableRole = Value,+            variableType = ctyp,+            variableName = (varPrefix (nodeId n) ++ varPath path),+            variableSemInf = ()         },+        localInitValue = ini,         localDeclarationSemInf  = ()     } where         ctyp = compileStorableType typ@@ -193,14 +183,15 @@     Array _         -> Program (EmptyProgram $ Empty ()) ()     Function s      -> Program {                             programConstruction = PrimitiveProgram $ Primitive {-                                primitiveInstruction = (ProcedureCallInstruction $ ProcedureCall {-                                                            procedureCallData = ProcedureCallData {-                                                                nameOfProcedureToCall = s,-                                                                actualParametersOfProcedureToCall = passInArgs (input n) (inputType n) ++-                                                                                                    passOutArgs (nodeId n) (outputType n)-                                                            },-                                                            procedureCallSemInf = ()-                                                        }),+                                primitiveInstruction = Instruction {+                                                           instructionData = (ProcedureCallInstruction $ ProcedureCall {+                                                               nameOfProcedureToCall = s,+                                                               actualParametersOfProcedureToCall = passInArgs (input n) (inputType n) +++                                                                                                   passOutArgs (nodeId n) (outputType n),+                                                               procedureCallSemInf = ()+                                                           }),+                                                           instructionSemInf = ()+                                                       },                                 primitiveSemInf = False                            },                            programSemInf = ()@@ -210,14 +201,15 @@         -- actual arguments come from the node input and the node id     NoInline s ifc  -> Program {                             programConstruction = PrimitiveProgram $ Primitive {-                                primitiveInstruction = (ProcedureCallInstruction $ ProcedureCall {-                                                        procedureCallData = ProcedureCallData {-                                                            nameOfProcedureToCall = s,-                                                            actualParametersOfProcedureToCall = passInArgs  (input n) (inputType n) ++-                                                                                                passOutArgs (nodeId n) (outputType n)-                                                        },-                                                        procedureCallSemInf = ()-                                                    }),+                                primitiveInstruction = Instruction {+                                                           instructionData = (ProcedureCallInstruction $ ProcedureCall {+                                                               nameOfProcedureToCall = s,+                                                               actualParametersOfProcedureToCall = passInArgs  (input n) (inputType n) +++                                                                                                   passOutArgs (nodeId n) (outputType n),+                                                               procedureCallSemInf = ()+                                                           }),+                                                           instructionSemInf = ()+                                                       },                                 primitiveSemInf = False                             },                             programSemInf = ()@@ -235,11 +227,9 @@                     -> error "Error in 'ifThenElse' node: node output is expected to be 'Bool'."                 | otherwise -> Program {                       programConstruction = BranchProgram $ Branch {-                          branchData = BranchData {-                              branchConditionVariable = condVar,-                              thenBlock               = mkBranch n thenIfc thenH,-                              elseBlock               = mkBranch n elseIfc elseH-                          },+                          branchConditionVariable = condVar,+                          thenBlock               = mkBranch n thenIfc thenH,+                          elseBlock               = mkBranch n elseIfc elseH,                           branchSemInf            = ()                       },                       programSemInf = ()@@ -247,23 +237,21 @@                         where                             mkBranch :: Node -> Interface -> Hierarchy -> Block InitSemInf                             mkBranch n ifc h@(Hierarchy pairs) = Block {-                                blockData = BlockData {-                                    blockDeclarations = (transformNodeListToLocalDeclarations $ map fst pairs),-                                    blockInstructions = Program {-                                        programConstruction = SequenceProgram $ Sequence { -                                            sequenceProgramList = (copyResult inp (interfaceInput ifc) inTyp False-                                                           ++ transformNodeListToPrograms  pairs-                                                           ++ copyResult (interfaceOutput ifc) (nodeId n) (outputType n) True),-                                            sequenceSemInf = ()-                                        },-                                        programSemInf = ()-                                    }+                                blockDeclarations = (transformNodeListToLocalDeclarations $ map fst pairs),+                                blockInstructions = Program {+                                    programConstruction = SequenceProgram $ Sequence { +                                        sequenceProgramList = (copyResult inp (interfaceInput ifc) inTyp False+                                                       ++ transformNodeListToPrograms  pairs+                                                       ++ copyResult (interfaceOutput ifc) (nodeId n) (outputType n) True),+                                        sequenceSemInf = ()+                                    },+                                    programSemInf = ()                                 },                                 blockSemInf = ()                             }                             condVar = case cond of                                 One (Graph.Variable (id,path)) ->-                                    Representation.Variable (VariableData Value Representation.BoolType (varName id path)) ()+                                    Representation.Variable Value Representation.BoolType (varName id path) ()                                 _ -> error "Error in 'ifThenElse' node: condition is not a variable."                                     -- TODO: it seems that in case of constant condition the program is already simplified on the graph level             otherwise -> error $ "Error in 'ifThenElse' node: incorrect node input or node input type"@@ -282,33 +270,34 @@                 (copyResult (input n) (nodeId n) (outputType n) True ++                     [Program {                     programConstruction = SequentialLoopProgram $ SequentialLoop {-                        sequentialLoopData = SequentialLoopData { -                            sequentialLoopCondition = (case interfaceOutput condIfc of-                                One (Graph.Variable (id,path)) -> varToExpr $ Representation.Variable (VariableData Value Representation.BoolType (varName id path)) ()-                                _ -> error "Error in a while loop: Malformed interface output of condition calculation." -                                    -- TODO: should this hold?-                            ),-                            conditionCalculation = Block {-                                blockData = BlockData {-                                    blockDeclarations = (transformNodeListToLocalDeclarations condNodes),-                                    blockInstructions = Program {-                                        programConstruction = (SequenceProgram (Sequence (copyStateToCond ++ calculationCond) ())),-                                        programSemInf = ()-                                    }-                                },-                                blockSemInf = ()-                            },-                            sequentialLoopCore = Block {-                                blockData = BlockData { -                                    blockDeclarations = (transformNodeListToLocalDeclarations bodyNodes),-                                    blockInstructions = Program {-                                        programConstruction = (SequenceProgram (Sequence (copyStateToBody ++ calculationBody ++ copyResultToState) ())),-                                        programSemInf = ()-                                    }+                        sequentialLoopCondition = (case interfaceOutput condIfc of+                            One (Graph.Variable (id,path)) -> varToExpr $ Representation.Variable Value Representation.BoolType (varName id path) ()+                            One (Graph.Constant (BoolData x)) -> Expression {+                                expressionData = ConstantExpression $ Representation.Constant {+                                    constantData = BoolConstant $ BoolConstantType x (),+                                    constantSemInf = ()                                 },-                                blockSemInf       = ()+                                expressionSemInf = ()                             }+                            unknown -> error $ "Error in a while loop: Malformed interface output of condition calculation: " ++ (show unknown) +                                -- TODO: should this hold?+                        ),+                        conditionCalculation = Block {+                            blockDeclarations = (transformNodeListToLocalDeclarations condNodes),+                            blockInstructions = Program {+                                programConstruction = (SequenceProgram (Sequence (copyStateToCond ++ calculationCond) ())),+                                programSemInf = ()+                            },+                            blockSemInf = ()                         },+                        sequentialLoopCore = Block {+                            blockDeclarations = (transformNodeListToLocalDeclarations bodyNodes),+                            blockInstructions = Program {+                                programConstruction = (SequenceProgram (Sequence (copyStateToBody ++ calculationBody ++ copyResultToState) ())),+                                programSemInf = ()+                            },+                            blockSemInf       = ()+                        },                         sequentialLoopSemInf = ()                    },                    programSemInf = ()@@ -336,9 +325,9 @@         -- body: embedded graph and its interface     Parallel ifc  ->         Program {-            programConstruction = ParallelLoopProgram (ParallelLoop (ParallelLoopData-                    (Representation.Variable (VariableData Value (Numeric ImpSigned S32) (varName inpId [])) ()) num 1 prg-                    ) ()),+            programConstruction = ParallelLoopProgram $ ParallelLoop +                    (Representation.Variable Value (Numeric ImpSigned S32) (varName inpId []) ()) num 1 prg+                    (),             programSemInf = ()         } where             num = case (input n, inputType n) of@@ -368,43 +357,40 @@             outTypArrayImp = compileStorableType outTypArray             outTypElemImp =  compileStorableType outTypElem             prg = Block {-                blockData = BlockData {-                    blockDeclarations = declarations,-                    blockInstructions = Program {-                        programConstruction = SequenceProgram $ Sequence {-                            sequenceProgramList = map transformNodeToProgram notInps ++-                              [ Program {-                                    programConstruction = PrimitiveProgram $ Primitive {-                                        primitiveInstruction = makeCopyFromExprs-                                            (transformSourceToExpr outSrc outTypElem)-                                            (LeftValueExpression $ LeftValueInExpression {-                                                leftValueExpressionContents = ArrayElemReferenceLeftValue $ ArrayElemReference {-                                                    arrayElemReferenceData = ArrayElemReferenceData {-                                                        arrayName = VariableLeftValue $ VariableInLeftValue {-                                                            variableLeftValueContents = Representation.Variable {-                                                                variableData = VariableData {-                                                                    variableRole = Value,                   -                                                                    variableType = outTypArrayImp,-                                                                    variableName = (varName (nodeId n) [])-                                                                },-                                                                variableSemInf = ()-                                                            },-                                                            variableLeftValueSemInf = ()+                blockDeclarations = declarations,+                blockInstructions = Program {+                    programConstruction = SequenceProgram $ Sequence {+                        sequenceProgramList = map transformNodeToProgram notInps +++                          [ Program {+                                programConstruction = PrimitiveProgram $ Primitive {+                                    primitiveInstruction = makeCopyFromExprs+                                        (transformSourceToExpr outSrc outTypElem)+                                        (Expression {+                                            expressionData = LeftValueExpression $ LeftValue {+                                                leftValueData = (ArrayElemReferenceLeftValue $ ArrayElemReference {+                                                    arrayName = LeftValue {+                                                        leftValueData = VariableLeftValue $ Representation.Variable {+                                                            variableRole = Value,                   +                                                            variableType = outTypArrayImp,+                                                            variableName = (varName (nodeId n) []),+                                                            variableSemInf = ()                                                         },-                                                        arrayIndex = (genVar inpId [] intType)+                                                        leftValueSemInf = ()                                                     },+                                                    arrayIndex = (genVar inpId [] intType),                                                     arrayElemReferenceSemInf = ()-                                                },-                                                leftValueExpressionSemInf = ()-                                            }),-                                        primitiveSemInf = True-                                    },-                                    programSemInf = ()-                                } ],-                            sequenceSemInf = ()-                        },-                        programSemInf = ()-                    }+                                                }),+                                                leftValueSemInf = ()+                                            },+                                            expressionSemInf = ()+                                        }),+                                    primitiveSemInf = True+                                },+                                programSemInf = ()+                            } ],+                        sequenceSemInf = ()+                    },+                    programSemInf = ()                 },                 blockSemInf = ()             }@@ -428,15 +414,17 @@  -- Generates a variable genVar :: NodeId -> [Int] -> Type -> Expression InitSemInf-genVar id path typ = LeftValueExpression $ LeftValueInExpression {-    leftValueExpressionContents = VariableLeftValue $ VariableInLeftValue {-        variableLeftValueContents = Representation.Variable {-            variableData = VariableData { variableRole = Value, variableType = typ, variableName = (varName id path) },+genVar id path typ = Expression {+    expressionData = LeftValueExpression $ LeftValue {+        leftValueData = VariableLeftValue $ Representation.Variable {+            variableRole = Value,+            variableType = typ,+            variableName = (varName id path),             variableSemInf = ()         },-        variableLeftValueSemInf = ()+        leftValueSemInf = ()     },-    leftValueExpressionSemInf = ()+    expressionSemInf = () }  -- Prefix of output parameters@@ -449,35 +437,37 @@  -- Generates an output variable genOut :: [Int] -> Type -> Expression InitSemInf-genOut path typ =LeftValueExpression $ LeftValueInExpression {-    leftValueExpressionContents = VariableLeftValue $ VariableInLeftValue {-        variableLeftValueContents = Representation.Variable {-            variableData = VariableData { variableRole = FunOut, variableType = typ, variableName = (outName path) },+genOut path typ = Expression {+    expressionData = LeftValueExpression $ LeftValue {+        leftValueData = VariableLeftValue $ Representation.Variable {+            variableRole = FunOut,+            variableType = typ,+            variableName = (outName path),             variableSemInf = ()         },-        variableLeftValueSemInf = ()+        leftValueSemInf = ()     },-    leftValueExpressionSemInf = ()-} +    expressionSemInf = ()+}  -- Generates input parameters of a function call from the node input. passInArgs :: Tuple Source -> Tuple StorableType -> [ActualParameter InitSemInf] passInArgs tup typs = tupleWalk genArg $ tupleZip (tup,typs) where-    genArg _ (Constant primData, StorableType _ typ) = InputActualParameter $ InputActualParameterType {-        inputActualParameterExpression = compilePrimData primData typ,-        inputActualParameterSemInf = ()+    genArg _ (Graph.Constant primData, StorableType _ typ) = ActualParameter {+        actualParameterData = InputActualParameter $ compilePrimData primData typ,+        actualParameterSemInf = ()     }-    genArg _ (Graph.Variable (id, path), typ) = InputActualParameter $ InputActualParameterType {-        inputActualParameterExpression = genVar id path (compileStorableType typ),-        inputActualParameterSemInf = ()+    genArg _ (Graph.Variable (id, path), typ) = ActualParameter {+        actualParameterData = InputActualParameter $ genVar id path (compileStorableType typ),+        actualParameterSemInf = ()     }  -- Generates output parameters of a function call from the node id and output type. passOutArgs :: NodeId -> Tuple StorableType -> [ActualParameter InitSemInf] passOutArgs id typs = tupleWalk genArg typs where-    genArg path t = OutputActualParameter $ OutputActualParameterType {-        outputActualParameterLeftValue = toLeftValue $ genVar id path (compileStorableType t),-        outputActualParameterSemInf = ()+    genArg path t = ActualParameter {+        actualParameterData = OutputActualParameter $ toLeftValue $ genVar id path (compileStorableType t),+        actualParameterSemInf = ()     }  -------------------------------------------------@@ -508,34 +498,50 @@     IntType False 64 _  -> Numeric ImpUnsigned S64     IntType sig size _  -> handleError "GraphToImperative" InvariantViolation $ "unknown integer type: IntType" ++ (show sig) ++ " " ++ (show size)     CoreTypes.FloatType x -> Representation.FloatType    -- TODO: think about the imperative typesystem!+    CoreTypes.UserType userTypeName -> Representation.UserType userTypeName  -- Transforms an array or primitive data to an imperative constant. compileStorableDataToConst :: StorableData -> Constant InitSemInf compileStorableDataToConst (CoreTypes.PrimitiveData pd) = compilePrimDataToConst pd-compileStorableDataToConst (StorableData ds) = ArrayConstant $ ArrayConstantType (map compileStorableDataToConst ds) ()+compileStorableDataToConst (StorableData ds) = Representation.Constant {+    constantData = ArrayConstant $ ArrayConstantType (map compileStorableDataToConst ds) (),+    constantSemInf = ()+}  -- Transforms a primitive data to an imperative constant. compilePrimDataToConst :: CoreTypes.PrimitiveData -> Constant InitSemInf-compilePrimDataToConst (UnitData ()) = BoolConstant $ BoolConstantType False ()-compilePrimDataToConst (BoolData x) = BoolConstant $ BoolConstantType x ()-compilePrimDataToConst (IntData x) = IntConstant $ IntConstantType (fromInteger x) ()-compilePrimDataToConst (FloatData x) = FloatConstant $ FloatConstantType x () -- TODO+compilePrimDataToConst (UnitData ()) = Representation.Constant {+    constantData = BoolConstant $ BoolConstantType False (),+    constantSemInf = ()+}+compilePrimDataToConst (BoolData x) = Representation.Constant {+    constantData = BoolConstant $ BoolConstantType x (),+    constantSemInf = ()+}+compilePrimDataToConst (IntData x) = Representation.Constant {+    constantData = IntConstant $ IntConstantType (fromInteger x) (),+    constantSemInf = ()+}+compilePrimDataToConst (FloatData x) = Representation.Constant {+    constantData = FloatConstant $ FloatConstantType x (), -- TODO+    constantSemInf = ()+}  -- Transforms an array or primitive data to an imperative typed expression. compileStorableData :: StorableData -> StorableType -> Expression InitSemInf compileStorableData (CoreTypes.PrimitiveData pd) (StorableType _ elemTyp) = compilePrimData pd elemTyp-compileStorableData a@(StorableData ds) typ = (ConstantExpression $ compileStorableDataToConst a)+compileStorableData a@(StorableData ds) typ = Expression (ConstantExpression $ compileStorableDataToConst a) ()  -- Transforms a primitive data to an imperative typed expression. compilePrimData :: CoreTypes.PrimitiveData -> PrimitiveType -> Expression InitSemInf-compilePrimData d t = ConstantExpression $ compilePrimDataToConst d+compilePrimData d t = Expression (ConstantExpression $ compilePrimDataToConst d) ()  charType = Numeric ImpSigned S8 intType = Numeric ImpSigned S32  -- Transforms a Source to an imperative expression. transformSourceToExpr :: Source -> StorableType -> Expression InitSemInf-transformSourceToExpr (Constant primData) (StorableType _ typ) = compilePrimData primData typ+transformSourceToExpr (Graph.Constant primData) (StorableType _ typ) = compilePrimData primData typ transformSourceToExpr (Graph.Variable (id,path)) typ = genVar id path ctyp     where         ctyp = compileStorableType typ@@ -552,18 +558,22 @@  -- Generates a copy call from two expressions. makeCopyFromExprs :: Expression InitSemInf -> Expression InitSemInf -> Instruction InitSemInf-makeCopyFromExprs from to = ProcedureCallInstruction $-    ProcedureCall {-        procedureCallData = ProcedureCallData "copy" [InputActualParameter $ InputActualParameterType {-                                                         inputActualParameterExpression = from,-                                                         inputActualParameterSemInf = ()-                                                      },-                                                      OutputActualParameter $ OutputActualParameterType {-                                                         outputActualParameterLeftValue = (toLeftValue to),-                                                         outputActualParameterSemInf = ()-                                                      }],+makeCopyFromExprs from to = Instruction {+    instructionData = ProcedureCallInstruction $ ProcedureCall {+        nameOfProcedureToCall = "copy",+        actualParametersOfProcedureToCall = [ActualParameter {+                                                actualParameterData = InputActualParameter from,+                                                actualParameterSemInf = ()+                                            },+                                            ActualParameter {+                                                actualParameterData = OutputActualParameter $ toLeftValue to,+                                                actualParameterSemInf = ()+                                            }],         procedureCallSemInf = ()-    }+    },+    instructionSemInf = ()+}+      -- Generates copies for all variables of a node to all variables of another node. copyNode :: NodeId -> NodeId -> Tuple StorableType -> Bool -> [Program InitSemInf]@@ -601,10 +611,10 @@     tupleWalk         (\path (out,typ) ->             Program {-                programConstruction = PrimitiveProgram (Primitive {+                programConstruction = PrimitiveProgram $ Primitive {                     primitiveInstruction = (makeCopyFromExprs (transformSourceToExpr out typ) (genOut path $ compileStorableType typ)),                     primitiveSemInf = isOutputCopying-                }),+                },                 programSemInf = ()             }         )@@ -612,10 +622,10 @@           varToExpr :: Representation.Variable InitSemInf -> Expression InitSemInf-varToExpr v =-  LeftValueExpression -    (LeftValueInExpression -         (VariableLeftValue $-              VariableInLeftValue v() ) -         ()-    )+varToExpr v = Expression {+  expressionData = LeftValueExpression $ LeftValue { +    leftValueData = VariableLeftValue v, +    leftValueSemInf = ()+  },+  expressionSemInf = ()+}
Feldspar/Compiler/Transformation/GraphUtils.hs view
@@ -1,34 +1,30 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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, TypeSynonymInstances #-}
Feldspar/Compiler/Transformation/Lifting.hs view
@@ -1,34 +1,30 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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 #-}
Feldspar/Fs2dot.hs view
@@ -1,270 +1,266 @@-{-- - Copyright (c) 2009-2010, 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.- -}+--+-- Copyright (c) 2009-2010, 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.+-- --- |Fs2dot is to help us create a visualisation of an algorithm written in
--- Feldspar by converting its graph into dot format -- which can be further
--- processed by the Graphviz suite.
-module Feldspar.Fs2dot
-  ( fs2dot
-  , writeDot
-  , DOTSource
-  )
-    where
-
-import Feldspar.Core.Types
-import Feldspar.Core.Graph
-import Feldspar.Core.Reify (reify, Program)
-import Prelude hiding (id)
-
-{- frontend -}
-
--- |'fs2dot' takes a Feldspar function as its argument and produces DOT language
--- source.
-fs2dot :: (Program prg)
-       => prg       -- ^Feldspar function
-       -> DOTSource -- ^DOT language source
-fs2dot = toDot . fromGraph . makeHierarchical . reify
-
--- |'writeDot' creates a DOT language format source file. Expected arguments
--- are the desired filename and the Feldspar function to be output in DOT
--- language.
-writeDot :: (Program prg)
-         => FilePath  -- ^output filename
-         -> prg       -- ^Feldspar function
-         -> IO ()
-writeDot filename prg = writeFile filename $ fs2dot prg
-
--- |This is for clarity.
-type DOTSource = String
-
-{- data types -}
-
-data DGraph =
-  DGraph
-  { inputs  :: [NodeId]
-  , outputs :: [NodeId]
-  , nodes   :: [DNode]
-  , edges   :: [DEdge]
-  }
-    deriving (Eq, Show)
-
-data DNode =
-  DNode
-  { id        :: Int
-  , role      :: Function
-  , subgraphs :: [DGraph]
-  , label     :: String
-  }
-    deriving (Eq, Show)
-
-data DEdge =
-  DEdge
-  { start :: DConnector
-  , end   :: DConnector
-  }
-    deriving (Eq, Show)
-
-data DConnector =
-    DNodeConn (NodeId, Int)
-  | DConstConn PrimitiveData
-    deriving (Eq, Show)
-
-{- core -}
-
-fromGraph :: HierarchicalGraph
-          -> DGraph
-fromGraph graph =
-    DGraph
-    { inputs = enumerateInputs graph
-    , outputs = enumerateOutputs graph
-    , nodes = (\(Hierarchy h) -> enumerateNodes h) $ graphHierarchy graph
-    , edges = (\(Hierarchy h) -> enumerateEdges h) $ graphHierarchy graph
-    }
-
-  where
-    enumerateInputs graph = [interfaceInput $ hierGraphInterface graph]
-    enumerateOutputs graph = graph
-      |> tuple2list . interfaceOutput . hierGraphInterface
-      |> map (\(Variable (n, _)) -> n) . filter isVariable
-
-    enumerateNodes = map
-      (\(node, hiers) ->
-        DNode
-        { id = nodeId node
-        , role = function node
-        , subgraphs = hiers |> map
-          (\hier -> DGraph
-            { inputs = []
-            , outputs = []
-            , nodes = (\(Hierarchy h) -> enumerateNodes h) hier
-            , edges = []
-            }
-          )
-        , label = (fun2label (function node)
-            ++ " (" ++ show (nodeId node) ++ ")") |> subst '"' '\''
-        }
-      )
-
-    enumerateEdges :: [(Node, [Hierarchy])] -> [DEdge]
-    enumerateEdges = concatMap
-      (\(node, hiers) ->
-        [ DEdge
-          { start = DNodeConn (inputnode, 0)
-          , end = DNodeConn (nodeId node, 0)
-          }
-        | inputnode <-
-          (tuple2list $ input node)
-            |> filter isVariable |> map (\(Variable (n, _)) -> n)
-        ] ++
-        [ DEdge
-          { start = DConstConn (constval)
-          , end = DNodeConn (nodeId node, 0)
-          }
-        | constval <-
-          (tuple2list $ input node)
-            |> filter (not.isVariable) |> map (\(Constant val) -> val)
-        ] ++
-        concatMap (\(Hierarchy h) -> enumerateEdges h) hiers
-      )
-
-    isVariable src = case src of
-      Variable _ -> True
-      _          -> False
-
-toDot :: DGraph
-      -> DOTSource
-toDot graph =
-  [ dGraphHead
-  , dGraphOptions
-  , dGraphNodes graph
-  , dGraphEdges graph
-  , dGraphOutputs graph
-  , dGraphTail
-  ] |> unlines
-    |> unlines . filter (not.null) . lines
-
-  where
-    dGraphHead = "digraph G {"
-    dGraphOptions =
-      [ "node [shape=box]"
-      , "compound=true bgcolor=\"lightgray\""
-      , "node [style=filled color=\"black\" fillcolor=\"steelblue\"]"
-      , "edge []"
-      ] |> unlines
-
-    dGraphNodes graph =
-      nodes graph
-        |> map
-          (\node -> 
-            if compound node
-            then
-              [ "subgraph cluster" ++ show (id node) ++ " {"
-              , "label =\"" ++ label node ++ "\""
-              , subgraphs node |> map
-                  (\subgraph ->
-                    [ dGraphNodes subgraph
-                    , dGraphEdges subgraph
-                    ] |> unlines
-                  ) |> unlines
-              , "}"
-              ] |> unlines
-            else
-              [ "node" ++ show (id node)
-              , "[label=\"" ++ label node ++ "\""
-              , "href=\"#node" ++ show (id node) ++ "\"]"
-              ] |> unwords
-          )
-        |> unlines
-
-    dGraphEdges graph =
-      zip [1..] (edges graph)
-        |> map
-          (\(n, edge) ->
-            if constEdge edge
-            then   "const" ++ show ((\(DNodeConn (i, _)) -> i) $ end edge)
-                  ++ "_" ++ show n
-                ++ " [label=\""
-                  ++ show ((\(DEdge (DConstConn val) _) -> val) edge)
-                ++ "\"]\n"
-                ++ "const" ++ show ((\(DNodeConn (i, _)) -> i) $ end edge)
-                  ++ "_" ++ show n
-                ++ " -> "
-                ++ "node" ++ show ((\(DNodeConn (i, _)) -> i) $ end edge)
-            else   "node" ++ show ((\(DNodeConn (i, _)) -> i) $ start edge)
-                ++ " -> "
-                ++ "node" ++ show ((\(DNodeConn (i, _)) -> i) $ end edge)
-          )
-        |> unlines
-
-      where
-        label edge = ""
-        constEdge edge = case edge of
-          DEdge (DConstConn _) _ -> True
-          _                      -> False
-
-    dGraphOutputs graph = zip [0 ..] (outputs graph) |> map
-      (\(n, opid) ->
-        [ "node" ++ show opid ++ " -> output" ++ show n
-        , "output" ++ show n ++ " [label=\"Output " ++ show n ++ "\"]"
-        ] |> unlines
-      ) |> unlines
-    dGraphTail = "}"
-    compound = \n -> (not.null) $ subgraphs n
-
-fun2label :: Function
-          -> String
-fun2label (Input)                = "Input"
-fun2label (Array sd)             = "Array " ++ (show sd)
-fun2label (Function str)         = "Function " ++ (show str)
-fun2label (NoInline str ifc)     = "NoInLine " ++ (show str)
-fun2label (IfThenElse ifc1 ifc2) = "IfThenElse"
-fun2label (While ifc1 ifc2)      = "While"
-fun2label (Parallel ifc)       = "Parallel" -- ++ (show i)
-
-{- utility functions -}
-
-tupleCount :: Tuple a -> Int
-tupleCount (One a) = 1
-tupleCount (Tup as) = sum $ map tupleCount as
-
-tuple2list :: Tuple a -> [a]
-tuple2list (One a) = [a]
-tuple2list (Tup as) = concatMap tuple2list as
-
-subst :: (Eq a) => a -> a -> [a] -> [a]
-subst _ _ [] = []
-subst a b (x:xs) = (if a == x then b else x) : subst a b xs
-
-infixl 1 |>
-(|>) :: a -> (a -> b) -> b
-(|>) x f = f x
-
+-- |Fs2dot is to help us create a visualisation of an algorithm written in+-- Feldspar by converting its graph into dot format -- which can be further+-- processed by the Graphviz suite.+module Feldspar.Fs2dot+  ( fs2dot+  , writeDot+  , DOTSource+  )+    where++import Feldspar.Core.Types+import Feldspar.Core.Graph+import Feldspar.Core.Reify (reify, Program)+import Prelude hiding (id)++{- frontend -}++-- |'fs2dot' takes a Feldspar function as its argument and produces DOT language+-- source.+fs2dot :: (Program prg)+       => prg       -- ^Feldspar function+       -> DOTSource -- ^DOT language source+fs2dot = toDot . fromGraph . makeHierarchical . reify++-- |'writeDot' creates a DOT language format source file. Expected arguments+-- are the desired filename and the Feldspar function to be output in DOT+-- language.+writeDot :: (Program prg)+         => FilePath  -- ^output filename+         -> prg       -- ^Feldspar function+         -> IO ()+writeDot filename prg = writeFile filename $ fs2dot prg++-- |This is for clarity.+type DOTSource = String++{- data types -}++data DGraph =+  DGraph+  { inputs  :: [NodeId]+  , outputs :: [NodeId]+  , nodes   :: [DNode]+  , edges   :: [DEdge]+  }+    deriving (Eq, Show)++data DNode =+  DNode+  { id        :: Int+  , role      :: Function+  , subgraphs :: [DGraph]+  , label     :: String+  }+    deriving (Eq, Show)++data DEdge =+  DEdge+  { start :: DConnector+  , end   :: DConnector+  }+    deriving (Eq, Show)++data DConnector =+    DNodeConn (NodeId, Int)+  | DConstConn PrimitiveData+    deriving (Eq, Show)++{- core -}++fromGraph :: HierarchicalGraph+          -> DGraph+fromGraph graph =+    DGraph+    { inputs = enumerateInputs graph+    , outputs = enumerateOutputs graph+    , nodes = (\(Hierarchy h) -> enumerateNodes h) $ graphHierarchy graph+    , edges = (\(Hierarchy h) -> enumerateEdges h) $ graphHierarchy graph+    }++  where+    enumerateInputs graph = [interfaceInput $ hierGraphInterface graph]+    enumerateOutputs graph = graph+      |> tuple2list . interfaceOutput . hierGraphInterface+      |> map (\(Variable (n, _)) -> n) . filter isVariable++    enumerateNodes = map+      (\(node, hiers) ->+        DNode+        { id = nodeId node+        , role = function node+        , subgraphs = hiers |> map+          (\hier -> DGraph+            { inputs = []+            , outputs = []+            , nodes = (\(Hierarchy h) -> enumerateNodes h) hier+            , edges = []+            }+          )+        , label = (fun2label (function node)+            ++ " (" ++ show (nodeId node) ++ ")") |> subst '"' '\''+        }+      )++    enumerateEdges :: [(Node, [Hierarchy])] -> [DEdge]+    enumerateEdges = concatMap+      (\(node, hiers) ->+        [ DEdge+          { start = DNodeConn (inputnode, 0)+          , end = DNodeConn (nodeId node, 0)+          }+        | inputnode <-+          (tuple2list $ input node)+            |> filter isVariable |> map (\(Variable (n, _)) -> n)+        ] +++        [ DEdge+          { start = DConstConn (constval)+          , end = DNodeConn (nodeId node, 0)+          }+        | constval <-+          (tuple2list $ input node)+            |> filter (not.isVariable) |> map (\(Constant val) -> val)+        ] +++        concatMap (\(Hierarchy h) -> enumerateEdges h) hiers+      )++    isVariable src = case src of+      Variable _ -> True+      _          -> False++toDot :: DGraph+      -> DOTSource+toDot graph =+  [ dGraphHead+  , dGraphOptions+  , dGraphNodes graph+  , dGraphEdges graph+  , dGraphOutputs graph+  , dGraphTail+  ] |> unlines+    |> unlines . filter (not.null) . lines++  where+    dGraphHead = "digraph G {"+    dGraphOptions =+      [ "node [shape=box]"+      , "compound=true bgcolor=\"lightgray\""+      , "node [style=filled color=\"black\" fillcolor=\"steelblue\"]"+      , "edge []"+      ] |> unlines++    dGraphNodes graph =+      nodes graph+        |> map+          (\node -> +            if compound node+            then+              [ "subgraph cluster" ++ show (id node) ++ " {"+              , "label =\"" ++ label node ++ "\""+              , subgraphs node |> map+                  (\subgraph ->+                    [ dGraphNodes subgraph+                    , dGraphEdges subgraph+                    ] |> unlines+                  ) |> unlines+              , "}"+              ] |> unlines+            else+              [ "node" ++ show (id node)+              , "[label=\"" ++ label node ++ "\""+              , "href=\"#node" ++ show (id node) ++ "\"]"+              ] |> unwords+          )+        |> unlines++    dGraphEdges graph =+      zip [1..] (edges graph)+        |> map+          (\(n, edge) ->+            if constEdge edge+            then   "const" ++ show ((\(DNodeConn (i, _)) -> i) $ end edge)+                  ++ "_" ++ show n+                ++ " [label=\""+                  ++ show ((\(DEdge (DConstConn val) _) -> val) edge)+                ++ "\"]\n"+                ++ "const" ++ show ((\(DNodeConn (i, _)) -> i) $ end edge)+                  ++ "_" ++ show n+                ++ " -> "+                ++ "node" ++ show ((\(DNodeConn (i, _)) -> i) $ end edge)+            else   "node" ++ show ((\(DNodeConn (i, _)) -> i) $ start edge)+                ++ " -> "+                ++ "node" ++ show ((\(DNodeConn (i, _)) -> i) $ end edge)+          )+        |> unlines++      where+        label edge = ""+        constEdge edge = case edge of+          DEdge (DConstConn _) _ -> True+          _                      -> False++    dGraphOutputs graph = zip [0 ..] (outputs graph) |> map+      (\(n, opid) ->+        [ "node" ++ show opid ++ " -> output" ++ show n+        , "output" ++ show n ++ " [label=\"Output " ++ show n ++ "\"]"+        ] |> unlines+      ) |> unlines+    dGraphTail = "}"+    compound = \n -> (not.null) $ subgraphs n++fun2label :: Function+          -> String+fun2label (Input)                = "Input"+fun2label (Array sd)             = "Array " ++ (show sd)+fun2label (Function str)         = "Function " ++ (show str)+fun2label (NoInline str ifc)     = "NoInLine " ++ (show str)+fun2label (IfThenElse ifc1 ifc2) = "IfThenElse"+fun2label (While ifc1 ifc2)      = "While"+fun2label (Parallel ifc)       = "Parallel" -- ++ (show i)++{- utility functions -}++tupleCount :: Tuple a -> Int+tupleCount (One a) = 1+tupleCount (Tup as) = sum $ map tupleCount as++tuple2list :: Tuple a -> [a]+tuple2list (One a) = [a]+tuple2list (Tup as) = concatMap tuple2list as++subst :: (Eq a) => a -> a -> [a] -> [a]+subst _ _ [] = []+subst a b (x:xs) = (if a == x then b else x) : subst a b xs++infixl 1 |>+(|>) :: a -> (a -> b) -> b+(|>) x f = f x+
Setup.hs view
@@ -1,6 +1,31 @@-module Main (main) where+--+-- Copyright (c) 2009-2010, 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.+--  import Distribution.Simple -main :: IO () main = defaultMain
feldspar-compiler.cabal view
@@ -1,6 +1,6 @@ name:           feldspar-compiler-version:        0.2.1-cabal-version:  >= 1.2.3+version:        0.3+cabal-version:  >= 1.6 build-type:     Simple license:        BSD3 license-file:   LICENSE@@ -9,7 +9,7 @@                 Eotvos Lorand University Faculty of Informatics maintainer:     deva@inf.elte.hu stability:      experimental-homepage:       http://feldspar.sourceforge.net/+homepage:       http://feldspar.inf.elte.hu/feldspar/ 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@@ -28,7 +28,6 @@     Feldspar.Compiler.Imperative.Semantics     Feldspar.Compiler.PluginArchitecture.DefaultConvert     Feldspar.Compiler.Plugins.BackwardPropagation-    Feldspar.Compiler.Plugins.ConstantFolding     Feldspar.Compiler.Plugins.ForwardPropagation     Feldspar.Compiler.Plugins.HandlePrimitives     Feldspar.Compiler.Plugins.Precompilation@@ -42,13 +41,14 @@     Feldspar.Compiler.Compiler     Feldspar.Compiler.Error     Feldspar.Compiler.Options+    Feldspar.Compiler.Platforms     Feldspar.Compiler.PluginArchitecture     Feldspar.Compiler     Feldspar.Fs2dot    build-depends:-    feldspar-language == 0.2,-    base >= 4.0 && < 4.2,+    feldspar-language == 0.3,+    base >= 4 && < 4.3,     containers,     haskell-src-exts,     directory,@@ -72,11 +72,21 @@     ./Feldspar/C    install-includes:-    feldspar.h-    feldspar.c+    feldspar_c99.h+    feldspar_c99.c+    feldspar_tic64x.h+    feldspar_tic64x.c  executable feldspar   main-is : ./Feldspar/Compiler/CompilerMain.hs++  other-modules:+    Feldspar.Compiler.Standalone.Constants+    Feldspar.Compiler.Standalone.Library+    Feldspar.Compiler.Standalone.Options++  build-depends:+    ansi-terminal    extensions:     CPP