source: doc/theses/mike_brooks_MMath/content/array/features/array.hfa@ 729df21

// a type whose size is n
#define Z(n) char[n]

// the inverse of Z(-)
#define z(Zn) sizeof(Zn)

// if you're expecting a Z(n), say so, by asking for a ztype, instead of dtype or otype
#define ztype(Zn) Zn & | sized(Zn)

forall( T & ) struct tag {};
#define ttag(T) ((tag(T)){})
#define ztag(n) ttag(Z(n))


//
// Single-dim array sruct (with explicit packing and atom)
//

forall( ztype(Zn), ztype(S), Timmed &, Tbase & ) {
    struct arpk {
        S strides[z(Zn)];
    };

    Timmed & ?[?]( arpk(Zn, S, Timmed, Tbase) & a, ptrdiff_t i ) {
        return (Timmed &) a.strides[i];
    }

    // workaround #226 (and array relevance thereof demonstrated in mike102/otype-slow-ndims.cfa)
    void ?{}( arpk(Zn, S, Timmed, Tbase) & this ) {
        void ?{}( S (&inner)[z(Zn)] ) {}
        ?{}(this.strides);
    }
    void ^?{}( arpk(Zn, S, Timmed, Tbase) & this ) {
        void ^?{}( S (&inner)[z(Zn)] ) {}
        ^?{}(this.strides);
    }
}

//
// Sugar for declaring array structure instances
//

forall( Te )
Te mkar_( tag(Te) ) {}

forall( ztype(Zn), ZTags ... , Trslt &, Tatom & | { Trslt mkar_( tag(Tatom), ZTags ); } )
arpk(Zn, Trslt, Trslt, Tatom) mkar_( tag(Tatom), tag(Zn), ZTags ) {}

// stolen from https://stackoverflow.com/questions/1872220/is-it-possible-to-iterate-over-arguments-in-variadic-macros

    // Make a FOREACH macro
    #define FE_0(WHAT)
    #define FE_1(WHAT, X) WHAT(X) 
    #define FE_2(WHAT, X, ...) WHAT(X)FE_1(WHAT, __VA_ARGS__)
    #define FE_3(WHAT, X, ...) WHAT(X)FE_2(WHAT, __VA_ARGS__)
    #define FE_4(WHAT, X, ...) WHAT(X)FE_3(WHAT, __VA_ARGS__)
    #define FE_5(WHAT, X, ...) WHAT(X)FE_4(WHAT, __VA_ARGS__)
    //... repeat as needed

    #define GET_MACRO(_0,_1,_2,_3,_4,_5,NAME,...) NAME 
    #define FOR_EACH(action,...) \
    GET_MACRO(_0,__VA_ARGS__,FE_5,FE_4,FE_3,FE_2,FE_1,FE_0)(action,__VA_ARGS__)

#define COMMA_ttag(X) , ttag(X)
#define array( TE, ...) typeof( mkar_( ttag(TE)  FOR_EACH( COMMA_ttag, __VA_ARGS__ ) ) )

#define COMMA_ztag(X) , ztag(X)
#define zarray( TE, ...) typeof( mkar_( ttag(TE)  FOR_EACH( COMMA_ztag, __VA_ARGS__ ) ) )

//
// Sugar for multidimensional indexing
//

// Core -[[-,-,-]] operator

// Desired form, one definition with recursion on IxBC (worked until Jan 2021, see trac #__TODO__)
// forall( TA &, TB &, TC &, IxAB, IxBC ... | { TB & ?[?]( TA &, IxAB ); TC & ?[?]( TB &, IxBC ); } )
// TC & ?[?]( TA & this, IxAB ab, IxBC bc ) {
//     return this[ab][bc];
// }

// Workaround form.  Listing all possibilities up to 4 dims.
forall( TA &, TB &, IxAB | { TB & ?[?]( TA &, IxAB ); }
            , TC &, IxBC | { TC & ?[?]( TB &, IxBC ); } )
TC & ?[?]( TA & this, IxAB ab, IxBC bc ) {
    return this[ab][bc];
}
// forall( TA &, TB &, TC &, IxAB, IxBC ... | { TB & ?[?]( TA &, IxAB ); TC & ?[?]( TB &, IxBC ); } )
// TC & ?[?]( TA & this, IxAB ab, IxBC bc ) {
//     return this[ab][bc];
// }

// Adapters for "indexed by ptrdiff_t" implies "indexed by [this other integral type]"
// Work around restriction that assertions underlying -[[-,-,-]] must match excatly
forall( C &, E & | { E & ?[?]( C &, ptrdiff_t ); } ) {

    // Targeted to support:  for( i; z(N) ) ... a[[ ..., i, ... ]]
    E & ?[?]( C & this, size_t i ) {
        return this[ (ptrdiff_t) i ];
    }

    // Targeted to support:  for( i; 5 ) ... a[[ ..., i, ... ]]
    E & ?[?]( C & this, int i ) {
        return this[ (ptrdiff_t) i ];
    }
}

//
// Rotation
//

// Base
forall( ztype(Zq), ztype(Sq), Tbase & )
tag(arpk(Zq, Sq, Tbase, Tbase)) enq_( tag(Tbase), tag(Zq), tag(Sq), tag(Tbase) ) {}

// Rec
forall( ztype(Zq), ztype(Sq), ztype(Z), ztype(S), recq &, recr &, Tbase & | { tag(recr) enq_( tag(Tbase), tag(Zq), tag(Sq), tag(recq) ); } )
tag(arpk(Z, S, recr, Tbase)) enq_( tag(Tbase), tag(Zq), tag(Sq), tag(arpk(Z, S, recq, Tbase)) ) {}

// Wrapper
struct all_t {} all;
forall( ztype(Z), ztype(S), Te &, result &, Tbase & | { tag(result) enq_( tag(Tbase), tag(Z), tag(S), tag(Te) ); } )
result & ?[?]( arpk(Z, S, Te, Tbase) & this, all_t ) {
    return (result&) this;
}