8472966 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Remove Buffer/BitVectors from compiler/C rts

commit847296659b21c1362801247f292d2e353b036b30 authorEdwin Brady <ecb10@st-andrews.ac.uk> dateSat 28 Mar 2015, 18:29 (12 years ago) parent73ea02b

15 files changed+2−757

compare with master

unifiedsplit

rts/idris_bitstring.c−68 rts/idris_bitstring.h−10 rts/idris_gc.c−15 rts/idris_rts.c−338 rts/idris_rts.h+1−30 src/IRTS/CodegenC.hs−19 src/IRTS/Lang.hs−11 src/Idris/Core/Binary.hs−10 src/Idris/Core/CaseTree.hs−4 src/Idris/Core/DeepSeq.hs−5 src/Idris/Core/TT.hs+1−19 src/Idris/Core/Typecheck.hs−4 src/Idris/ElabTerm.hs−5 src/Idris/IdeMode.hs−4 src/Idris/Primitives.hs−215

rts/idris_bitstring.c−68

@@ -822,71 +822,3 @@ VAL idris_b64T32(VM *vm, VAL a) {

822822 return cl;

823823}

824824

825−// SSE vectors

826−VAL idris_IDXB8x16(VM* vm, VAL vec, VAL idx) {

827− __m128i sse = *vec->info.bits128p;

828− uint8_t data[16];

829− _mm_storeu_si128((__m128i*)&data, sse);

830− return MKB8(vm, data[idx->info.bits32]);

831−}

832−

833−VAL idris_IDXB16x8(VM* vm, VAL vec, VAL idx) {

834− __m128i sse = *vec->info.bits128p;

835− uint16_t data[8];

836− _mm_storeu_si128((__m128i*)&data, sse);

837− return MKB16(vm, data[idx->info.bits32]);

838−}

839−

840−VAL idris_IDXB32x4(VM* vm, VAL vec, VAL idx) {

841− __m128i sse = *vec->info.bits128p;

842− uint32_t data[4];

843− _mm_storeu_si128((__m128i*)&data, sse);

844− return MKB32(vm, data[idx->info.bits32]);

845−}

846−

847−VAL idris_IDXB64x2(VM* vm, VAL vec, VAL idx) {

848− __m128i sse = *vec->info.bits128p;

849− uint64_t data[2];

850− _mm_storeu_si128((__m128i*)&data, sse);

851− return MKB64(vm, data[idx->info.bits32]);

852−}

853−

854−VAL idris_b8x16CopyForGC(VM *vm, VAL vec) {

855− __m128i sse = *vec->info.bits128p;

856− VAL cl = allocate(sizeof(Closure) + 16 + sizeof(__m128i), 1);

857− SETTY(cl, BITS8X16);

858− cl->info.bits128p = (__m128i*)ALIGN((uintptr_t)cl + sizeof(Closure), 16);

859− assert ((uintptr_t)cl->info.bits128p % 16 == 0);

860− *cl->info.bits128p = sse;

861− return cl;

862−}

863−

864−VAL idris_b16x8CopyForGC(VM *vm, VAL vec) {

865− __m128i sse = *vec->info.bits128p;

866− VAL cl = allocate(sizeof(Closure) + 16 + sizeof(__m128i), 1);

867− SETTY(cl, BITS16X8);

868− cl->info.bits128p = (__m128i*)ALIGN((uintptr_t)cl + sizeof(Closure), 16);

869− assert ((uintptr_t)cl->info.bits128p % 16 == 0);

870− *cl->info.bits128p = sse;

871− return cl;

872−}

873−

874−VAL idris_b32x4CopyForGC(VM *vm, VAL vec) {

875− __m128i sse = *vec->info.bits128p;

876− VAL cl = allocate(sizeof(Closure) + 16 + sizeof(__m128i), 1);

877− SETTY(cl, BITS32X4);

878− cl->info.bits128p = (__m128i*)ALIGN((uintptr_t)cl + sizeof(Closure), 16);

879− assert ((uintptr_t)cl->info.bits128p % 16 == 0);

880− *cl->info.bits128p = sse;

881− return cl;

882−}

883−

884−VAL idris_b64x2CopyForGC(VM *vm, VAL vec) {

885− __m128i sse = *vec->info.bits128p;

886− VAL cl = allocate(sizeof(Closure) + 16 + sizeof(__m128i), 1);

887− SETTY(cl, BITS64X2);

888− cl->info.bits128p = (__m128i*)ALIGN((uintptr_t)cl + sizeof(Closure), 16);

889− assert ((uintptr_t)cl->info.bits128p % 16 == 0);

890− *cl->info.bits128p = sse;

891− return cl;

892−}

rts/idris_bitstring.h−10

@@ -126,14 +126,4 @@ VAL idris_b64T8(VM *vm, VAL a);

126126VAL idris_b64T16(VM *vm, VAL a);

127127VAL idris_b64T32(VM *vm, VAL a);

128128

129−VAL idris_IDXB8x16(VM* vm, VAL vec, VAL idx);

130−VAL idris_IDXB16x8(VM* vm, VAL vec, VAL idx);

131−VAL idris_IDXB32x4(VM* vm, VAL vec, VAL idx);

132−VAL idris_IDXB64x2(VM* vm, VAL vec, VAL idx);

133−

134−VAL idris_b8x16CopyForGC(VM *vm, VAL a);

135−VAL idris_b16x8CopyForGC(VM *vm, VAL a);

136−VAL idris_b32x4CopyForGC(VM *vm, VAL a);

137−VAL idris_b64x2CopyForGC(VM *vm, VAL a);

138−

139129#endif

rts/idris_gc.c−15

@@ -30,9 +30,6 @@ VAL copy(VM* vm, VAL x) {

3030 case STROFFSET:

3131 cl = MKSTROFFc(vm, x->info.str_offset);

3232 break;

33− case BUFFER:

34− cl = MKBUFFERc(vm, x->info.buf);

35− break;

3633 case BIGINT:

3734 cl = MKBIGMc(vm, x->info.ptr);

3835 break;

@@ -54,18 +51,6 @@ VAL copy(VM* vm, VAL x) {

5451 case BITS64:

5552 cl = idris_b64CopyForGC(vm, x);

5653 break;

57− case BITS8X16:

58− cl = idris_b8x16CopyForGC(vm, x);

59− break;

60− case BITS16X8:

61− cl = idris_b16x8CopyForGC(vm, x);

62− break;

63− case BITS32X4:

64− cl = idris_b32x4CopyForGC(vm, x);

65− break;

66− case BITS64X2:

67− cl = idris_b64x2CopyForGC(vm, x);

68− break;

6954 case FWD:

7055 return x->info.ptr;

7156 default:

rts/idris_rts.c−338

@@ -327,107 +327,6 @@ VAL MKB64(VM* vm, uint64_t bits64) {

327327 return cl;

328328}

329329

330−VAL MKB8x16const(VM* vm,

331− uint8_t v0, uint8_t v1, uint8_t v2, uint8_t v3,

332− uint8_t v4, uint8_t v5, uint8_t v6, uint8_t v7,

333− uint8_t v8, uint8_t v9, uint8_t v10, uint8_t v11,

334− uint8_t v12, uint8_t v13, uint8_t v14, uint8_t v15) {

335− Closure* cl = allocate(sizeof(Closure) + sizeof(__m128i), 1);

336− SETTY(cl, BITS8X16);

337−

338− cl->info.bits128p = (__m128i*)ALIGN((uintptr_t)cl + sizeof(Closure), 16);

339− assert ((uintptr_t)cl->info.bits128p % 16 == 0);

340−

341− uint8_t data[16];

342− data[0]=v0; data[1]=v1; data[2]=v2; data[3]=v3;

343− data[4]=v4; data[5]=v5; data[6]=v6; data[7]=v7;

344− data[8]=v8; data[9]=v9; data[10]=v10; data[11]=v11;

345− data[12]=v12; data[13]=v13; data[14]=v14; data[15]=v15;

346−

347− *cl->info.bits128p = _mm_loadu_si128((__m128i*)&data);

348−

349− return cl;

350−}

351−

352−VAL MKB8x16(VM* vm,

353− VAL v0, VAL v1, VAL v2, VAL v3,

354− VAL v4, VAL v5, VAL v6, VAL v7,

355− VAL v8, VAL v9, VAL v10, VAL v11,

356− VAL v12, VAL v13, VAL v14, VAL v15) {

357− return MKB8x16const(vm,

358− v0->info.bits8, v1->info.bits8, v2->info.bits8, v3->info.bits8,

359− v4->info.bits8, v5->info.bits8, v6->info.bits8, v7->info.bits8,

360− v8->info.bits8, v9->info.bits8, v10->info.bits8, v11->info.bits8,

361− v12->info.bits8, v13->info.bits8, v14->info.bits8, v15->info.bits8);

362−}

363−

364−VAL MKB16x8const(VM* vm,

365− uint16_t v0, uint16_t v1, uint16_t v2, uint16_t v3,

366− uint16_t v4, uint16_t v5, uint16_t v6, uint16_t v7) {

367− Closure* cl = allocate(sizeof(Closure) + sizeof(__m128i), 1);

368− SETTY(cl, BITS16X8);

369−

370− cl->info.bits128p = (__m128i*)ALIGN((uintptr_t)cl + sizeof(Closure), 16);

371− assert ((uintptr_t)cl->info.bits128p % 16 == 0);

372−

373− uint16_t data[8];

374− data[0]=v0; data[1]=v1; data[2]=v2; data[3]=v3;

375− data[4]=v4; data[5]=v5; data[6]=v6; data[7]=v7;

376−

377− *cl->info.bits128p = _mm_loadu_si128((__m128i*)&data);

378− return cl;

379−

380−}

381−

382−VAL MKB16x8(VM* vm,

383− VAL v0, VAL v1, VAL v2, VAL v3,

384− VAL v4, VAL v5, VAL v6, VAL v7) {

385− return MKB16x8const(vm,

386− v0->info.bits16, v1->info.bits16, v2->info.bits16, v3->info.bits16,

387− v4->info.bits16, v5->info.bits16, v6->info.bits16, v7->info.bits16);

388−}

389−

390−VAL MKB32x4const(VM* vm,

391− uint32_t v0, uint32_t v1, uint32_t v2, uint32_t v3) {

392− Closure* cl = allocate(sizeof(Closure) + 16 + sizeof(__m128i), 1);

393− SETTY(cl, BITS64X2);

394−

395− cl->info.bits128p = (__m128i*)ALIGN((uintptr_t)cl + sizeof(Closure), 16);

396− assert ((uintptr_t)cl->info.bits128p % 16 == 0);

397−

398− uint32_t data[4];

399− data[0]=v0; data[1]=v1; data[2]=v2; data[3]=v3;

400−

401− *cl->info.bits128p = _mm_loadu_si128((__m128i*)&data);

402− return cl;

403−}

404−

405−VAL MKB32x4(VM* vm,

406− VAL v0, VAL v1, VAL v2, VAL v3) {

407− return MKB32x4const(vm,

408− v0->info.bits32, v1->info.bits32, v2->info.bits32, v3->info.bits32);

409−}

410−

411−VAL MKB64x2const(VM* vm, uint64_t v0, uint64_t v1) {

412− Closure* cl = allocate(sizeof(Closure) + 16 + sizeof(__m128i), 1);

413− SETTY(cl, BITS64X2);

414−

415− cl->info.bits128p = (__m128i*)ALIGN((uintptr_t)cl + sizeof(Closure), 16);

416− assert ((uintptr_t)cl->info.bits128p % 16 == 0);

417−

418− uint64_t data[2];

419− data[0]=v0; data[1]=v1;

420−

421− *cl->info.bits128p = _mm_loadu_si128((__m128i*)&data);

422− return cl;

423−}

424−

425−VAL MKB64x2(VM* vm, VAL v0, VAL v1) {

426− return MKB64x2const(vm,

427− v0->info.bits64,

428− v1->info.bits64);

429−}

430−

431330void PROJECT(VM* vm, VAL r, int loc, int arity) {

432331 int i;

433332 for(i = 0; i < arity; ++i) {

@@ -740,240 +639,6 @@ VAL idris_systemInfo(VM* vm, VAL index) {

740639 return MKSTR(vm, "");

741640}

742641

743−VAL MKBUFFERc(VM* vm, Buffer* buf) {

744− Closure* cl = allocate(sizeof(Closure) + sizeof *buf + buf->cap, 1);

745− SETTY(cl, BUFFER);

746− cl->info.buf = (Buffer*)((void*)cl + sizeof(Closure));

747− memmove(cl->info.buf, buf, sizeof *buf + buf->fill);

748− return cl;

749−}

750−

751−static VAL internal_allocate(VM *vm, size_t hint) {

752− size_t size = hint + sizeof(Closure) + sizeof(Buffer);

753−

754− // Round up to a power of 2

755− --size;

756− size_t i;

757− for (i = 0; i <= sizeof size; ++i)

758− size |= size >> (1 << i);

759− ++size;

760−

761− Closure* cl = allocate(size, 0);

762− SETTY(cl, BUFFER);

763− cl->info.buf = (Buffer*)((void*)cl + sizeof(Closure));

764− cl->info.buf->cap = size - (sizeof(Closure) + sizeof(Buffer));

765− return cl;

766−}

767−

768−// Following functions cast uint64_t to size_t, which may narrow!

769−VAL idris_buffer_allocate(VM* vm, VAL hint) {

770− Closure* cl = internal_allocate(vm, hint->info.bits64);

771− cl->info.buf->fill = 0;

772− return cl;

773−}

774−

775−static void internal_memset(void *dest, const void *src, size_t size, size_t num) {

776− while (num--) {

777− memmove(dest, src, size);

778− dest += size;

779− }

780−}

781−

782−static VAL internal_prepare_append(VM* vm, VAL buf, size_t bufLen, size_t appLen) {

783− size_t totalLen = bufLen + appLen;

784− Closure* cl;

785− if (bufLen != buf->info.buf->fill ||

786− totalLen > buf->info.buf->cap) {

787− // We're not at the fill or are over cap, so need a new buffer

788− cl = internal_allocate(vm, totalLen);

789− memmove(cl->info.buf->store,

790− buf->info.buf->store,

791− bufLen);

792− cl->info.buf->fill = totalLen;

793− } else {

794− // Hooray, can just bump the fill

795− cl = buf;

796− cl->info.buf->fill += appLen;

797− }

798− return cl;

799−}

800−

801−VAL idris_appendBuffer(VM* vm, VAL fst, VAL fstLen, VAL cnt, VAL sndLen, VAL sndOff, VAL snd) {

802− size_t firstLength = fstLen->info.bits64;

803− size_t secondLength = sndLen->info.bits64;

804− size_t count = cnt->info.bits64;

805− size_t offset = sndOff->info.bits64;

806− Closure* cl = internal_prepare_append(vm, fst, firstLength, count * secondLength);

807− internal_memset(cl->info.buf->store + firstLength, snd->info.buf->store + offset, secondLength, count);

808− return cl;

809−}

810−

811−// Special cased because we can use memset

812−VAL idris_appendB8Native(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {

813− size_t bufLen = len->info.bits64;

814− size_t count = cnt->info.bits64;

815− Closure* cl = internal_prepare_append(vm, buf, bufLen, count);

816− memset(cl->info.buf->store + bufLen, val->info.bits8, count);

817− return cl;

818−}

819−

820−static VAL internal_append_bits(VM* vm, VAL buf, VAL bufLen, VAL cnt, const void* val, size_t val_len) {

821− size_t len = bufLen->info.bits64;

822− size_t count = cnt->info.bits64;

823− Closure* cl = internal_prepare_append(vm, buf, len, count * val_len);

824− internal_memset(cl->info.buf->store + len, val, val_len, count);

825− return cl;

826−}

827−

828−VAL idris_appendB16Native(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {

829− return internal_append_bits(vm, buf, len, cnt, &val->info.bits16, sizeof val->info.bits16);

830−}

831−

832−VAL idris_appendB16LE(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {

833− // On gcc 4.8 -O3 compiling for x86_64, using leVal like this is

834− // optimized away. Presumably the same holds for other sizes and

835− // conversly on BE systems

836− unsigned char leVal[sizeof val] = { val->info.bits16

837− , (val->info.bits16 >> 8)

838− };

839− return internal_append_bits(vm, buf, len, cnt, leVal, sizeof leVal);

840−}

841−

842−VAL idris_appendB16BE(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {

843− unsigned char beVal[sizeof val] = { (val->info.bits16 >> 8)

844− , val->info.bits16

845− };

846− return internal_append_bits(vm, buf, len, cnt, beVal, sizeof beVal);

847−}

848−

849−VAL idris_appendB32Native(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {

850− return internal_append_bits(vm, buf, len, cnt, &val->info.bits32, sizeof val->info.bits32);

851−}

852−

853−VAL idris_appendB32LE(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {

854− unsigned char leVal[sizeof val] = { val->info.bits32

855− , (val->info.bits32 >> 8)

856− , (val->info.bits32 >> 16)

857− , (val->info.bits32 >> 24)

858− };

859− return internal_append_bits(vm, buf, len, cnt, leVal, sizeof leVal);

860−}

861−

862−VAL idris_appendB32BE(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {

863− unsigned char beVal[sizeof val] = { (val->info.bits32 >> 24)

864− , (val->info.bits32 >> 16)

865− , (val->info.bits32 >> 8)

866− , val->info.bits32

867− };

868− return internal_append_bits(vm, buf, len, cnt, beVal, sizeof beVal);

869−}

870−

871−VAL idris_appendB64Native(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {

872− return internal_append_bits(vm, buf, len, cnt, &val->info.bits64, sizeof val->info.bits64);

873−}

874−

875−VAL idris_appendB64LE(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {

876− unsigned char leVal[sizeof val] = { val->info.bits64

877− , (val->info.bits64 >> 8)

878− , (val->info.bits64 >> 16)

879− , (val->info.bits64 >> 24)

880− , (val->info.bits64 >> 32)

881− , (val->info.bits64 >> 40)

882− , (val->info.bits64 >> 48)

883− , (val->info.bits64 >> 56)

884− };

885− return internal_append_bits(vm, buf, len, cnt, leVal, sizeof leVal);

886−}

887−

888−VAL idris_appendB64BE(VM* vm, VAL buf, VAL len, VAL cnt, VAL val) {

889− unsigned char beVal[sizeof val] = { (val->info.bits64 >> 56)

890− , (val->info.bits64 >> 48)

891− , (val->info.bits64 >> 40)

892− , (val->info.bits64 >> 32)

893− , (val->info.bits64 >> 24)

894− , (val->info.bits64 >> 16)

895− , (val->info.bits64 >> 8)

896− , val->info.bits64

897− };

898− return internal_append_bits(vm, buf, len, cnt, beVal, sizeof beVal);

899−}

900−

901−VAL idris_peekB8Native(VM* vm, VAL buf, VAL off) {

902− size_t offset = off->info.bits64;

903− uint8_t *val = buf->info.buf->store + offset;

904− return MKB8(vm, *val);

905−}

906−

907−VAL idris_peekB16Native(VM* vm, VAL buf, VAL off) {

908− size_t offset = off->info.bits64;

909− uint16_t *val = (uint16_t *) (buf->info.buf->store + offset);

910− return MKB16(vm, *val);

911−}

912−

913−VAL idris_peekB16LE(VM* vm, VAL buf, VAL off) {

914− size_t offset = off->info.bits64;

915− return MKB16(vm, ((uint16_t) buf->info.buf->store[offset]) +

916− (((uint16_t) buf->info.buf->store[offset + 1]) << 8));

917−}

918−

919−VAL idris_peekB16BE(VM* vm, VAL buf, VAL off) {

920− size_t offset = off->info.bits64;

921− return MKB16(vm, ((uint16_t) buf->info.buf->store[offset + 1]) +

922− (((uint16_t) buf->info.buf->store[offset]) << 8));

923−}

924−

925−VAL idris_peekB32Native(VM* vm, VAL buf, VAL off) {

926− size_t offset = off->info.bits64;

927− uint32_t *val = (uint32_t *) (buf->info.buf->store + offset);

928− return MKB32(vm, *val);

929−}

930−

931−VAL idris_peekB32LE(VM* vm, VAL buf, VAL off) {

932− size_t offset = off->info.bits64;

933− return MKB32(vm, ((uint32_t) buf->info.buf->store[offset]) +

934− (((uint32_t) buf->info.buf->store[offset + 1]) << 8) +

935− (((uint32_t) buf->info.buf->store[offset + 2]) << 16) +

936− (((uint32_t) buf->info.buf->store[offset + 3]) << 24));

937−}

938−

939−VAL idris_peekB32BE(VM* vm, VAL buf, VAL off) {

940− size_t offset = off->info.bits64;

941− return MKB32(vm, ((uint32_t) buf->info.buf->store[offset + 3]) +

942− (((uint32_t) buf->info.buf->store[offset + 2]) << 8) +

943− (((uint32_t) buf->info.buf->store[offset + 1]) << 16) +

944− (((uint32_t) buf->info.buf->store[offset]) << 24));

945−}

946−

947−VAL idris_peekB64Native(VM* vm, VAL buf, VAL off) {

948− size_t offset = off->info.bits64;

949− uint64_t *val = (uint64_t *) (buf->info.buf->store + offset);

950− return MKB64(vm, *val);

951−}

952−

953−VAL idris_peekB64LE(VM* vm, VAL buf, VAL off) {

954− size_t offset = off->info.bits64;

955− return MKB64(vm, ((uint64_t) buf->info.buf->store[offset]) +

956− (((uint64_t) buf->info.buf->store[offset + 1]) << 8) +

957− (((uint64_t) buf->info.buf->store[offset + 2]) << 16) +

958− (((uint64_t) buf->info.buf->store[offset + 3]) << 24) +

959− (((uint64_t) buf->info.buf->store[offset + 4]) << 32) +

960− (((uint64_t) buf->info.buf->store[offset + 5]) << 40) +

961− (((uint64_t) buf->info.buf->store[offset + 6]) << 48) +

962− (((uint64_t) buf->info.buf->store[offset + 7]) << 56));

963−}

964−

965−VAL idris_peekB64BE(VM* vm, VAL buf, VAL off) {

966− size_t offset = off->info.bits64;

967− return MKB64(vm, ((uint64_t) buf->info.buf->store[offset + 7]) +

968− (((uint64_t) buf->info.buf->store[offset + 6]) << 8) +

969− (((uint64_t) buf->info.buf->store[offset + 5]) << 16) +

970− (((uint64_t) buf->info.buf->store[offset + 4]) << 24) +

971− (((uint64_t) buf->info.buf->store[offset + 3]) << 32) +

972− (((uint64_t) buf->info.buf->store[offset + 2]) << 40) +

973− (((uint64_t) buf->info.buf->store[offset + 1]) << 48) +

974− (((uint64_t) buf->info.buf->store[offset]) << 56));

975−}

976−

977642typedef struct {

978643 VM* vm; // thread's VM

979644 VM* callvm; // calling thread's VM

@@ -1058,9 +723,6 @@ VAL doCopyTo(VM* vm, VAL x) {

1058723 case STRING:

1059724 cl = MKSTRc(vm, x->info.str);

1060725 break;

1061− case BUFFER:

1062− cl = MKBUFFERc(vm, x->info.buf);

1063− break;

1064726 case BIGINT:

1065727 cl = MKBIGMc(vm, x->info.ptr);

1066728 break;

rts/idris_rts.h+1−30

@@ -26,8 +26,7 @@

2626typedef enum {

2727 CON, INT, BIGINT, FLOAT, STRING, STROFFSET,

2828 BITS8, BITS16, BITS32, BITS64, UNIT, PTR, FWD,

29− MANAGEDPTR, BUFFER, BITS8X16, BITS16X8, BITS32X4,

30− BITS64X2

29+ MANAGEDPTR

3130} ClosureType;

3231

3332typedef struct Closure *VAL;

@@ -208,37 +207,12 @@ VAL MKB16(VM* vm, uint16_t b);

208207VAL MKB32(VM* vm, uint32_t b);

209208VAL MKB64(VM* vm, uint64_t b);

210209

211−// SSE Vectors

212−VAL MKB8x16(VM* vm,

213− VAL v0, VAL v1, VAL v2, VAL v3,

214− VAL v4, VAL v5, VAL v6, VAL v7,

215− VAL v8, VAL v9, VAL v10, VAL v11,

216− VAL v12, VAL v13, VAL v14, VAL v15);

217−VAL MKB8x16const(VM* vm,

218− uint8_t v0, uint8_t v1, uint8_t v2, uint8_t v3,

219− uint8_t v4, uint8_t v5, uint8_t v6, uint8_t v7,

220− uint8_t v8, uint8_t v9, uint8_t v10, uint8_t v11,

221− uint8_t v12, uint8_t v13, uint8_t v14, uint8_t v15);

222−VAL MKB16x8(VM* vm,

223− VAL v0, VAL v1, VAL v2, VAL v3,

224− VAL v4, VAL v5, VAL v6, VAL v7);

225−VAL MKB16x8const(VM* vm,

226− uint16_t v0, uint16_t v1, uint16_t v2, uint16_t v3,

227− uint16_t v4, uint16_t v5, uint16_t v6, uint16_t v7);

228−VAL MKB32x4(VM* vm,

229− VAL v0, VAL v1, VAL v2, VAL v3);

230−VAL MKB32x4const(VM* vm,

231− uint32_t v0, uint32_t v1, uint32_t v2, uint32_t v3);

232−VAL MKB64x2(VM* vm, VAL v0, VAL v1);

233−VAL MKB64x2const(VM* vm, uint64_t v0, uint64_t v1);

234−

235210// following versions don't take a lock when allocating

236211VAL MKFLOATc(VM* vm, double val);

237212VAL MKSTROFFc(VM* vm, StrOffset* off);

238213VAL MKSTRc(VM* vm, char* str);

239214VAL MKPTRc(VM* vm, void* ptr);

240215VAL MKMPTRc(VM* vm, void* ptr, size_t size);

241−VAL MKBUFFERc(VM* vm, Buffer* buf);

242216

243217char* GETSTROFF(VAL stroff);

244218

@@ -341,9 +315,6 @@ VAL idris_strCons(VM* vm, VAL x, VAL xs);

341315VAL idris_strIndex(VM* vm, VAL str, VAL i);

342316VAL idris_strRev(VM* vm, VAL str);

343317

344−// Buffer primitives

345−VAL idris_buffer_allocate(VM* vm, VAL hint);

346−VAL idris_appendBuffer(VM* vm, VAL fst, VAL fstLen, VAL cnt, VAL sndLen, VAL sndOff, VAL snd);

347318VAL idris_appendB8Native(VM* vm, VAL buf, VAL len, VAL cnt, VAL val);

348319VAL idris_appendB16Native(VM* vm, VAL buf, VAL len, VAL cnt, VAL val);

349320VAL idris_appendB16LE(VM* vm, VAL buf, VAL len, VAL cnt, VAL val);

src/IRTS/CodegenC.hs−19

@@ -182,10 +182,6 @@ bcc i (ASSIGNCONST l c)

182182 mkConst (B16 x) = "idris_b16const(vm, " ++ show x ++ "U)"

183183 mkConst (B32 x) = "idris_b32const(vm, " ++ show x ++ "UL)"

184184 mkConst (B64 x) = "idris_b64const(vm, " ++ show x ++ "ULL)"

185− mkConst (B8V x) = let x' = V.toList x in "MKB8x16const(vm, " ++ intercalate ", " (map (\elem -> show elem ++ "U") x') ++ ")"

186− mkConst (B16V x) = let x' = V.toList x in "MKB16x8const(vm, " ++ intercalate ", " (map (\elem -> show elem ++ "U") x') ++ ")"

187− mkConst (B32V x) = let x' = V.toList x in "MKB32x4const(vm, " ++ intercalate ", " (map (\elem -> show elem ++ "UL") x') ++ ")"

188− mkConst (B64V x) = let x' = V.toList x in "MKB64x2const(vm, " ++ intercalate ", " (map (\elem -> show elem ++ "ULL") x') ++ ")"

189185 -- if it's a type constant, we won't use it, but equally it shouldn't

190186 -- report an error. These might creep into generated for various reasons

191187 -- (especially if erasure is disabled).

@@ -556,11 +552,6 @@ doOp v LStrIndex [x, y] = v ++ "idris_strIndex(vm, " ++ creg x ++ "," ++ creg y

556552doOp v LStrRev [x] = v ++ "idris_strRev(vm, " ++ creg x ++ ")"

557553doOp v LStrLen [x] = v ++ "idris_strlen(vm, " ++ creg x ++ ")"

558554

559−doOp v LAllocate [x] = v ++ "idris_buffer_allocate(vm, " ++ creg x ++ ")"

560−doOp v LAppendBuffer [a, b, c, d, e, f] = v ++ "idris_appendBuffer(vm, " ++ creg a ++ "," ++ creg b ++ "," ++ creg c ++ "," ++ creg d ++ "," ++ creg e ++ "," ++ creg f ++ ")"

561−doOp v (LAppend ity en) [a, b, c, d] = v ++ "idris_append" ++ intTyName ity ++ show en ++ "(vm, " ++ creg a ++ "," ++ creg b ++ "," ++ creg c ++ "," ++ creg d ++ ")"

562−doOp v (LPeek ity en) [x, y] = v ++ "idris_peek" ++ intTyName ity ++ show en ++ "(vm, " ++ creg x ++ "," ++ creg y ++ ")"

563−

564555doOp v LStdIn [] = v ++ "MKPTR(vm, stdin)"

565556doOp v LStdOut [] = v ++ "MKPTR(vm, stdout)"

566557doOp v LStdErr [] = v ++ "MKPTR(vm, stderr)"

@@ -576,16 +567,6 @@ doOp v (LChInt ITChar) args = doOp v (LChInt ITNative) args

576567doOp v (LIntCh ITNative) args = v ++ creg (last args)

577568doOp v (LIntCh ITChar) args = doOp v (LIntCh ITNative) args

578569

579−doOp v c@(LMkVec IT8 _) args = v ++ "MKB8x16(vm, " ++ (intercalate ", " (map creg args)) ++ ")"

580−doOp v c@(LMkVec IT16 _) args = v ++ "MKB16x8(vm, " ++ (intercalate ", " (map creg args)) ++ ")"

581−doOp v c@(LMkVec IT32 _) args = v ++ "MKB32x4(vm, " ++ (intercalate ", " (map creg args)) ++ ")"

582−doOp v c@(LMkVec IT64 _) args = v ++ "MKB64x2(vm, " ++ (intercalate ", " (map creg args)) ++ ")"

583−

584−doOp v c@(LIdxVec IT8 _) [p, i] = v ++ "idris_IDXB8x16(vm, " ++ creg p ++ ", " ++ creg i ++ ")"

585−doOp v c@(LIdxVec IT16 _) [p, i] = v ++ "idris_IDXB16x8(vm, " ++ creg p ++ ", " ++ creg i ++ ")"

586−doOp v c@(LIdxVec IT32 _) [p, i] = v ++ "idris_IDXB32x4(vm, " ++ creg p ++ ", " ++ creg i ++ ")"

587−doOp v c@(LIdxVec IT64 _) [p, i] = v ++ "idris_IDXB64x2(vm, " ++ creg p ++ ", " ++ creg i ++ ")"

588−

589570doOp v LSystemInfo [x] = v ++ "idris_systemInfo(vm, " ++ creg x ++ ")"

590571doOp v LNoOp args = v ++ creg (last args)

591572doOp _ op args = error "doOp of (" ++ show op ++ ") not implemented, arguments (" ++ show args ++ ")"

src/IRTS/Lang.hs−11

@@ -75,22 +75,11 @@ data PrimFn = LPlus ArithTy | LMinus ArithTy | LTimes ArithTy

7676 | LFSqrt | LFFloor | LFCeil | LFNegate

7777

78− -- construction element extraction element insertion

79− | LMkVec NativeTy Int | LIdxVec NativeTy Int | LUpdateVec NativeTy Int

80−

8279 | LStdIn | LStdOut | LStdErr

8380

84− -- Buffers

85− | LAllocate

86− | LAppendBuffer

8781 -- system info

8882 | LSystemInfo

89− -- Note that for Bits8 only Native endianness is actually used

90− -- and the user-exposed interface for Bits8 doesn't mention

91− -- endianness

92− | LAppend IntTy Endianness

93− | LPeek IntTy Endianness

9483

9584 | LFork

9685 | LPar -- evaluate argument anywhere, possibly on another

src/Idris/Core/Binary.hs−10

@@ -350,11 +350,6 @@ instance Binary Const where

350350 putWord8 (fromIntegral . fromEnum $ ity)

351351 putWord8 (fromIntegral count)

352352

353− B8V x1 -> putWord8 21 >> put x1

354− B16V x1 -> putWord8 22 >> put x1

355− B32V x1 -> putWord8 23 >> put x1

356− B64V x1 -> putWord8 24 >> put x1

357− BufferType -> putWord8 25

358353 ManagedPtrType -> putWord8 26

359354 VoidType -> putWord8 27

360355 WorldType -> putWord8 28

@@ -395,11 +390,6 @@ instance Binary Const where

395390 c <- getWord8

396391 return (AType (ATInt (ITVec (toEnum . fromIntegral $ e) (fromIntegral c))))

397392

398− 21 -> fmap B8V get

399− 22 -> fmap B16V get

400− 23 -> fmap B32V get

401− 24 -> fmap B64V get

402− 25 -> return BufferType

403393 26 -> return ManagedPtrType

404394 27 -> return VoidType

405395 28 -> return WorldType

src/Idris/Core/CaseTree.hs−4

@@ -321,10 +321,6 @@ isConstType (B8 _) (AType (ATInt _)) = True

321321isConstType (B16 _) (AType (ATInt _)) = True

322322isConstType (B32 _) (AType (ATInt _)) = True

323323isConstType (B64 _) (AType (ATInt _)) = True

324−isConstType (B8V _) (AType (ATInt _)) = True

325−isConstType (B16V _) (AType (ATInt _)) = True

326−isConstType (B32V _) (AType (ATInt _)) = True

327−isConstType (B64V _) (AType (ATInt _)) = True

328324isConstType _ _ = False

329325

330326data Pat = PCon Bool Name Int [Pat]

src/Idris/Core/DeepSeq.hs−5

@@ -150,17 +150,12 @@ instance NFData Const where

150150 rnf (B16 x1) = rnf x1 `seq` ()

151151 rnf (B32 x1) = rnf x1 `seq` ()

152152 rnf (B64 x1) = rnf x1 `seq` ()

153− rnf (B8V x1) = rnf x1 `seq` ()

154− rnf (B16V x1) = rnf x1 `seq` ()

155− rnf (B32V x1) = rnf x1 `seq` ()

156− rnf (B64V x1) = rnf x1 `seq` ()

157153 rnf (AType x1) = rnf x1 `seq` ()

158154 rnf WorldType = ()

159155 rnf TheWorld = ()

160156 rnf StrType = ()

161157 rnf PtrType = ()

162158 rnf ManagedPtrType = ()

163− rnf BufferType = ()

164159 rnf VoidType = ()

165160 rnf Forgot = ()

166161

src/Idris/Core/TT.hs+1−19

@@ -565,11 +565,9 @@ intTyWidth ITBig = error "IRTS.Lang.intTyWidth: Big integers have variable width

565565

566566data Const = I Int | BI Integer | Fl Double | Ch Char | Str String

567567 | B8 Word8 | B16 Word16 | B32 Word32 | B64 Word64

568− | B8V (Vector Word8) | B16V (Vector Word16)

569− | B32V (Vector Word32) | B64V (Vector Word64)

570568 | AType ArithTy | StrType

571569 | WorldType | TheWorld

570+ | PtrType | ManagedPtrType | VoidType | Forgot

573571 deriving (Eq, Ord, Data, Typeable)

574572{-!

575573deriving instance Binary Const

@@ -580,7 +578,6 @@ isTypeConst :: Const -> Bool

580578isTypeConst (AType _) = True

581579isTypeConst StrType = True

582580isTypeConst ManagedPtrType = True

583−isTypeConst BufferType = True

584581isTypeConst WorldType = True

585582isTypeConst PtrType = True

586583isTypeConst VoidType = True

@@ -599,7 +596,6 @@ instance Pretty Const OutputAnnotation where

599596 pretty StrType = text "String"

600597 pretty TheWorld = text "%theWorld"

601598 pretty WorldType = text "prim__World"

602− pretty BufferType = text "prim__UnsafeBuffer"

603599 pretty PtrType = text "Ptr"

604600 pretty ManagedPtrType = text "Ptr"

605601 pretty VoidType = text "Void"

@@ -620,10 +616,6 @@ constIsType (B8 _) = False

620616constIsType (B16 _) = False

621617constIsType (B32 _) = False

622618constIsType (B64 _) = False

623−constIsType (B8V _) = False

624−constIsType (B16V _) = False

625−constIsType (B32V _) = False

626−constIsType (B64V _) = False

627619constIsType _ = True

628620

629621-- | Get the docstring for a Const

@@ -635,7 +627,6 @@ constDocs c@(AType ATFloat) = "Double-precision floating-point nu

635627constDocs StrType = "Strings in some unspecified encoding"

636628constDocs PtrType = "Foreign pointers"

637629constDocs ManagedPtrType = "Managed pointers"

638−constDocs BufferType = "Copy-on-write buffers"

639630constDocs c@(AType (ATInt (ITFixed IT8))) = "Eight bits (unsigned)"

640631constDocs c@(AType (ATInt (ITFixed IT16))) = "Sixteen bits (unsigned)"

641632constDocs c@(AType (ATInt (ITFixed IT32))) = "Thirty-two bits (unsigned)"

@@ -657,10 +648,6 @@ constDocs (B32 w) = "The thirty-two-bit value 0x" ++

657648 showIntAtBase 16 intToDigit w ""

658649constDocs (B64 w) = "The sixty-four-bit value 0x" ++

659650 showIntAtBase 16 intToDigit w ""

660−constDocs (B8V v) = "A vector of eight-bit values"

661−constDocs (B16V v) = "A vector of sixteen-bit values"

662−constDocs (B32V v) = "A vector of thirty-two-bit values"

663−constDocs (B64V v) = "A vector of sixty-four-bit values"

664651constDocs prim = "Undocumented"

665652

666653data Universe = NullType | UniqueType | AllTypes

@@ -1303,10 +1290,6 @@ instance Show Const where

13031290 show (B16 x) = show x

13041291 show (B32 x) = show x

13051292 show (B64 x) = show x

1306− show (B8V x) = "<" ++ intercalate "," (map show (V.toList x)) ++ ">"

1307− show (B16V x) = "<" ++ intercalate "," (map show (V.toList x)) ++ ">"

1308− show (B32V x) = "<" ++ intercalate "," (map show (V.toList x)) ++ ">"

1309− show (B64V x) = "<" ++ intercalate "," (map show (V.toList x)) ++ ">"

13101293 show (AType ATFloat) = "Float"

13111294 show (AType (ATInt ITBig)) = "Integer"

13121295 show (AType (ATInt ITNative)) = "Int"

@@ -1316,7 +1299,6 @@ instance Show Const where

13161299 show TheWorld = "prim__TheWorld"

13171300 show WorldType = "prim__WorldType"

13181301 show StrType = "String"

1319− show BufferType = "prim__UnsafeBuffer"

13201302 show PtrType = "Ptr"

13211303 show ManagedPtrType = "ManagedPtr"

13221304 show VoidType = "Void"

src/Idris/Core/Typecheck.hs−4

@@ -151,10 +151,6 @@ check' holes ctxt env top = chk (TType (UVar (-5))) env top where

151151 constType (B16 _) = Constant (AType (ATInt (ITFixed IT16)))

152152 constType (B32 _) = Constant (AType (ATInt (ITFixed IT32)))

153153 constType (B64 _) = Constant (AType (ATInt (ITFixed IT64)))

154− constType (B8V a) = Constant (AType (ATInt (ITVec IT8 (V.length a))))

155− constType (B16V a) = Constant (AType (ATInt (ITVec IT16 (V.length a))))

156− constType (B32V a) = Constant (AType (ATInt (ITVec IT32 (V.length a))))

157− constType (B64V a) = Constant (AType (ATInt (ITVec IT64 (V.length a))))

158154 constType TheWorld = Constant WorldType

159155 constType Forgot = Erased

160156 constType _ = TType (UVal 0)

src/Idris/ElabTerm.hs−5

@@ -2586,10 +2586,6 @@ reflectConstant c@(B8 _) = reflCall "B8" [RConstant c]

25862586reflectConstant c@(B16 _) = reflCall "B16" [RConstant c]

25872587reflectConstant c@(B32 _) = reflCall "B32" [RConstant c]

25882588reflectConstant c@(B64 _) = reflCall "B64" [RConstant c]

2589−reflectConstant (B8V ws) = reflCall "B8V" [mkList (Var (sUN "Bits8")) . map (RConstant . B8) . V.toList $ ws]

2590−reflectConstant (B16V ws) = reflCall "B8V" [mkList (Var (sUN "Bits16")) . map (RConstant . B16) . V.toList $ ws]

2591−reflectConstant (B32V ws) = reflCall "B8V" [mkList (Var (sUN "Bits32")) . map (RConstant . B32) . V.toList $ ws]

2592−reflectConstant (B64V ws) = reflCall "B8V" [mkList (Var (sUN "Bits64")) . map (RConstant . B64) . V.toList $ ws]

25932589reflectConstant (AType (ATInt ITNative)) = reflCall "AType" [reflCall "ATInt" [Var (reflm "ITNative")]]

25942590reflectConstant (AType (ATInt ITBig)) = reflCall "AType" [reflCall "ATInt" [Var (reflm "ITBig")]]

25952591reflectConstant (AType ATFloat) = reflCall "AType" [Var (reflm "ATFloat")]

@@ -2605,7 +2601,6 @@ reflectConstant (AType (ATInt (ITVec IT32 c))) = reflCall "AType" [reflCall "ATI

26052601reflectConstant (AType (ATInt (ITVec IT64 c))) = reflCall "AType" [reflCall "ATInt" [reflCall "ITVec" [Var (reflm "IT64"), RConstant (I c)]]]

26062602reflectConstant PtrType = Var (reflm "PtrType")

26072603reflectConstant ManagedPtrType = Var (reflm "ManagedPtrType")

2608−reflectConstant BufferType = Var (reflm "BufferType")

26092604reflectConstant VoidType = Var (reflm "VoidType")

26102605reflectConstant Forgot = Var (reflm "Forgot")

26112606reflectConstant WorldType = Var (reflm "WorldType")

src/Idris/IdeMode.hs−4

@@ -113,10 +113,6 @@ constTy (B8 _) = "Bits8"

113113constTy (B16 _) = "Bits16"

114114constTy (B32 _) = "Bits32"

115115constTy (B64 _) = "Bits64"

116−constTy (B8V _) = "Bits8x16"

117−constTy (B16V _) = "Bits16x8"

118−constTy (B32V _) = "Bits32x4"

119−constTy (B64V _) = "Bits64x2"

120116constTy _ = "Type"

121117

122118instance SExpable OutputAnnotation where

src/Idris/Primitives.hs−215

@@ -190,17 +190,9 @@ primitives =

190190 -- Managed pointer registration

191191 Prim (sUN "prim__registerPtr") (ty [PtrType, AType (ATInt ITNative)] ManagedPtrType) 2 (p_cantreduce)

192192 (2, LRegisterPtr) total,

193− -- Buffers

194− Prim (sUN "prim__allocate") (ty [AType (ATInt (ITFixed IT64))] BufferType) 1 (p_allocate)

195− (1, LAllocate) total,

196− Prim (sUN "prim__appendBuffer") (ty [BufferType, AType (ATInt (ITFixed IT64)), AType (ATInt (ITFixed IT64)), AType (ATInt (ITFixed IT64)), AType (ATInt (ITFixed IT64)), BufferType] BufferType) 6 (p_appendBuffer)

197− (6, LAppendBuffer) partial,

198193 Prim (sUN "prim__systemInfo") (ty [AType (ATInt ITNative)] StrType) 1 (p_cantreduce)

199194 (1, LSystemInfo) total

200195 ] ++ concatMap intOps [ITFixed IT8, ITFixed IT16, ITFixed IT32, ITFixed IT64, ITBig, ITNative, ITChar]

201− ++ concatMap vecOps vecTypes

202− ++ concatMap fixedOps [ITFixed IT8, ITFixed IT16, ITFixed IT32, ITFixed IT64] -- ITNative, ITChar, ATFloat ] ++ vecTypes

203− ++ vecBitcasts vecTypes

204196

205197vecTypes :: [IntTy]

206198vecTypes = [ITVec IT8 16, ITVec IT16 8, ITVec IT32 4, ITVec IT64 2]

@@ -270,48 +262,11 @@ vecCmps ity =

270262 , iCmp ity "gt" True (bCmp ity (>)) LGt total

271263 ]

272264

273−-- The TODOs in this function are documented as Issue #1617 on the issue tracker.

274−--

275−-- https://github.com/idris-lang/Idris-dev/issues/1617

276−vecOps :: IntTy -> [Prim]

277−vecOps ity@(ITVec elem count) =

278− [ Prim (sUN $ "prim__mk" ++ intTyName ity)

279− (ty (replicate count . AType . ATInt . ITFixed $ elem) (AType . ATInt $ ity))

280− count (mkVecCon elem count) (count, LMkVec elem count) total

281− , Prim (sUN $ "prim__index" ++ intTyName ity)

282− (ty [AType . ATInt $ ity, AType (ATInt (ITFixed IT32))] (AType . ATInt . ITFixed $ elem))

283− 2 (mkVecIndex count) (2, LIdxVec elem count) partial -- TODO: Ensure this reduces

284− , Prim (sUN $ "prim__update" ++ intTyName ity)

285− (ty [AType . ATInt $ ity, AType (ATInt (ITFixed IT32)), AType . ATInt . ITFixed $ elem]

286− (AType . ATInt $ ity))

287− 3 (mkVecUpdate elem count) (3, LUpdateVec elem count) partial -- TODO: Ensure this reduces

288− ] ++ intArith ity ++ vecCmps ity

289−

290265bitcastPrim :: ArithTy -> ArithTy -> (ArithTy -> [Const] -> Maybe Const) -> PrimFn -> Prim

291266bitcastPrim from to impl prim =

292267 Prim (sUN $ "prim__bitcast" ++ aTyName from ++ "_" ++ aTyName to) (ty [AType from] (AType to)) 1 (impl to)

293268 (1, prim) total

294269

295−vecBitcasts :: [IntTy] -> [Prim]

296−vecBitcasts tys = [bitcastPrim from to bitcastVec (LBitCast from to)

297− | from <- map ATInt vecTypes, to <- map ATInt vecTypes, from /= to]

298−

299−fixedOps :: IntTy -> [Prim]

300−fixedOps ity@(ITFixed _) =

301− map appendFun endiannesses ++

302− map peekFun endiannesses

303− where

304− endiannesses = [ Native, LE, BE ]

305− tyName = intTyName ity

306− b64 = AType (ATInt (ITFixed IT64))

307− thisTy = AType $ ATInt ity

308− appendFun en = Prim (sUN $ "prim__append" ++ tyName ++ show en)

309− (ty [BufferType, b64, b64, thisTy] BufferType)

310− 4 (p_append en) (4, LAppend ity en) partial

311− peekFun en = Prim (sUN $ "prim__peek" ++ tyName ++ show en)

312− (ty [BufferType, b64] thisTy)

313− 2 (p_peek ity en) (2, LPeek ity en) partial

314−

315270mapHalf :: (V.Unbox a, V.Unbox b) => ((a, a) -> b) -> Vector a -> Vector b

316271mapHalf f xs = V.generate (V.length xs `div` 2) (\i -> f (xs V.! (i*2), xs V.! (i*2+1)))

317272

@@ -339,76 +294,6 @@ truncWord64 :: Bool -> Word64 -> Word32

339294truncWord64 True x = fromIntegral (x `shiftR` 32)

340295truncWord64 False x = fromIntegral x

341296

342−bitcastVec :: ArithTy -> [Const] -> Maybe Const

343−bitcastVec (ATInt (ITVec IT8 n)) [x@(B8V v)]

344− | V.length v == n = Just x

345−bitcastVec (ATInt (ITVec IT16 n)) [B8V v]

346− | V.length v == n*2 = Just . B16V . mapHalf concatWord8 $ v

347−bitcastVec (ATInt (ITVec IT32 n)) [B8V v]

348− | V.length v == n*4 = Just . B32V . mapHalf concatWord16 . mapHalf concatWord8 $ v

349−bitcastVec (ATInt (ITVec IT64 n)) [B8V v]

350− | V.length v == n*8 = Just . B64V . mapHalf concatWord32 . mapHalf concatWord16 . mapHalf concatWord8 $ v

351−

352−bitcastVec (ATInt (ITVec IT8 n)) [B16V v]

353− | V.length v * 2 == n = Just . B8V . mapDouble truncWord16 $ v

354−bitcastVec (ATInt (ITVec IT16 n)) [x@(B16V v)]

355− | V.length v == n = Just x

356−bitcastVec (ATInt (ITVec IT32 n)) [B16V v]

357− | V.length v == n*2 = Just . B32V . mapHalf concatWord16 $ v

358−bitcastVec (ATInt (ITVec IT64 n)) [B16V v]

359− | V.length v == n*4 = Just . B64V . mapHalf concatWord32 . mapHalf concatWord16 $ v

360−

361−bitcastVec (ATInt (ITVec IT8 n)) [B32V v]

362− | V.length v * 4 == n = Just . B8V . mapDouble truncWord16 . mapDouble truncWord32 $ v

363−bitcastVec (ATInt (ITVec IT16 n)) [B32V v]

364− | V.length v * 2 == n = Just . B16V . mapDouble truncWord32 $ v

365−bitcastVec (ATInt (ITVec IT32 n)) [x@(B32V v)]

366− | V.length v == n = Just x

367−bitcastVec (ATInt (ITVec IT64 n)) [B32V v]

368− | V.length v == n*2 = Just . B64V . mapHalf concatWord32 $ v

369−

370−bitcastVec (ATInt (ITVec IT8 n)) [B64V v]

371− | V.length v * 8 == n = Just . B8V . mapDouble truncWord16 . mapDouble truncWord32 . mapDouble truncWord64 $ v

372−bitcastVec (ATInt (ITVec IT16 n)) [B64V v]

373− | V.length v * 4 == n = Just . B16V . mapDouble truncWord32 . mapDouble truncWord64 $ v

374−bitcastVec (ATInt (ITVec IT32 n)) [B64V v]

375− | V.length v == n*2 = Just . B32V . mapDouble truncWord64 $ v

376−bitcastVec (ATInt (ITVec IT64 n)) [x@(B64V v)]

377− | V.length v == n = Just x

378−

379−bitcastVec _ _ = Nothing

380−

381−mkVecCon :: NativeTy -> Int -> [Const] -> Maybe Const

382−mkVecCon ity count args

383− | length ints == count = Just (mkVec ity count ints)

384− | otherwise = Nothing

385− where

386− ints = getInt args

387− mkVec :: NativeTy -> Int -> [Integer] -> Const

388− mkVec IT8 len values = B8V $ V.generate len (fromInteger . (values !!))

389− mkVec IT16 len values = B16V $ V.generate len (fromInteger . (values !!))

390− mkVec IT32 len values = B32V $ V.generate len (fromInteger . (values !!))

391− mkVec IT64 len values = B64V $ V.generate len (fromInteger . (values !!))

392−

393−mkVecIndex count [vec, B32 i] = Just (idxVec vec)

394− where

395− idxVec :: Const -> Const

396− idxVec (B8V v) = B8 $ V.unsafeIndex v (fromIntegral i)

397− idxVec (B16V v) = B16 $ V.unsafeIndex v (fromIntegral i)

398− idxVec (B32V v) = B32 $ V.unsafeIndex v (fromIntegral i)

399− idxVec (B64V v) = B64 $ V.unsafeIndex v (fromIntegral i)

400−mkVecIndex _ _ = Nothing

401−

402−mkVecUpdate ity count [vec, B32 i, newElem] = updateVec vec newElem

403− where

404− updateVec :: Const -> Const -> Maybe Const

405− updateVec (B8V v) (B8 e) = Just . B8V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))

406− updateVec (B16V v) (B16 e) = Just . B16V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))

407− updateVec (B32V v) (B32 e) = Just . B32V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))

408− updateVec (B64V v) (B64 e) = Just . B64V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))

409− updateVec _ _ = Nothing

410−mkVecUpdate _ _ _ = Nothing

411−

412297aTyName :: ArithTy -> String

413298aTyName (ATInt t) = intTyName t

414299aTyName ATFloat = "Float"

@@ -470,18 +355,6 @@ bsrem (ITFixed IT64) [B64 x, B64 y]

470355 = Just $ B64 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int64))

471356bsrem ITNative [I x, I y] = Just $ I (x `rem` y)

472357bsrem ITChar [Ch x, Ch y] = Just $ Ch (chr $ (ord x) `rem` (ord y))

473−bsrem (ITVec IT8 _) [B8V x, B8V y]

474− = Just . B8V $

475− V.zipWith (\n d -> (fromIntegral (fromIntegral n `rem` fromIntegral d :: Int8))) x y

476−bsrem (ITVec IT16 _) [B16V x, B16V y]

477− = Just . B16V $

478− V.zipWith (\n d -> (fromIntegral (fromIntegral n `rem` fromIntegral d :: Int16))) x y

479−bsrem (ITVec IT32 _) [B32V x, B32V y]

480− = Just . B32V $

481− V.zipWith (\n d -> (fromIntegral (fromIntegral n `rem` fromIntegral d :: Int64))) x y

482−bsrem (ITVec IT64 _) [B64V x, B64V y]

483− = Just . B64V $

484− V.zipWith (\n d -> (fromIntegral (fromIntegral n `rem` fromIntegral d :: Int64))) x y

485358bsrem _ _ = Nothing

486359

487360bsdiv :: IntTy -> [Const] -> Maybe Const

@@ -496,18 +369,6 @@ bsdiv (ITFixed IT64) [B64 x, B64 y]

496369 = Just $ B64 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int64))

497370bsdiv ITNative [I x, I y] = Just $ I (x `div` y)

498371bsdiv ITChar [Ch x, Ch y] = Just $ Ch (chr $ (ord x) `div` (ord y))

499−bsdiv (ITVec IT8 _) [B8V x, B8V y]

500− = Just . B8V $

501− V.zipWith (\n d -> (fromIntegral (fromIntegral n `div` fromIntegral d :: Int8))) x y

502−bsdiv (ITVec IT16 _) [B16V x, B16V y]

503− = Just . B16V $

504− V.zipWith (\n d -> (fromIntegral (fromIntegral n `div` fromIntegral d :: Int16))) x y

505−bsdiv (ITVec IT32 _) [B32V x, B32V y]

506− = Just . B32V $

507− V.zipWith (\n d -> (fromIntegral (fromIntegral n `div` fromIntegral d :: Int64))) x y

508−bsdiv (ITVec IT64 _) [B64V x, B64V y]

509− = Just . B64V $

510− V.zipWith (\n d -> (fromIntegral (fromIntegral n `div` fromIntegral d :: Int64))) x y

511372bsdiv _ _ = Nothing

512373

513374bashr :: IntTy -> [Const] -> Maybe Const

@@ -522,18 +383,6 @@ bashr (ITFixed IT64) [B64 x, B64 y]

522383 = Just $ B64 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int64))

523384bashr ITNative [I x, I y] = Just $ I (x `shiftR` y)

524385bashr ITChar [Ch x, Ch y] = Just $ Ch (chr $ (ord x) `shiftR` (ord y))

525−bashr (ITVec IT8 _) [B8V x, B8V y]

526− = Just . B8V $

527− V.zipWith (\n d -> (fromIntegral (fromIntegral n `shiftR` fromIntegral d :: Int8))) x y

528−bashr (ITVec IT16 _) [B16V x, B16V y]

529− = Just . B16V $

530− V.zipWith (\n d -> (fromIntegral (fromIntegral n `shiftR` fromIntegral d :: Int16))) x y

531−bashr (ITVec IT32 _) [B32V x, B32V y]

532− = Just . B32V $

533− V.zipWith (\n d -> (fromIntegral (fromIntegral n `shiftR` fromIntegral d :: Int64))) x y

534−bashr (ITVec IT64 _) [B64V x, B64V y]

535− = Just . B64V $

536− V.zipWith (\n d -> (fromIntegral (fromIntegral n `shiftR` fromIntegral d :: Int64))) x y

537386bashr _ _ = Nothing

538387

539388bUn :: IntTy -> (forall a. Bits a => a -> a) -> [Const] -> Maybe Const

@@ -544,10 +393,6 @@ bUn (ITFixed IT64) op [B64 x] = Just $ B64 (op x)

544393bUn ITBig op [BI x] = Just $ BI (op x)

545394bUn ITNative op [I x] = Just $ I (op x)

546395bUn ITChar op [Ch x] = Just $ Ch (chr $ op (ord x))

547−bUn (ITVec IT8 _) op [B8V x] = Just . B8V $ V.map op x

548−bUn (ITVec IT16 _) op [B16V x] = Just . B16V $ V.map op x

549−bUn (ITVec IT32 _) op [B32V x] = Just . B32V $ V.map op x

550−bUn (ITVec IT64 _) op [B64V x] = Just . B64V $ V.map op x

551396bUn _ _ _ = Nothing

552397

553398bitBin :: IntTy -> (forall a. (Bits a, Integral a) => a -> a -> a) -> [Const] -> Maybe Const

@@ -558,10 +403,6 @@ bitBin (ITFixed IT64) op [B64 x, B64 y] = Just $ B64 (op x y)

558403bitBin ITBig op [BI x, BI y] = Just $ BI (op x y)

559404bitBin ITNative op [I x, I y] = Just $ I (op x y)

560405bitBin ITChar op [Ch x, Ch y] = Just $ Ch (chr $ op (ord x) (ord y))

561−bitBin (ITVec IT8 _) op [B8V x, B8V y] = Just . B8V $ V.zipWith op x y

562−bitBin (ITVec IT16 _) op [B16V x, B16V y] = Just . B16V $ V.zipWith op x y

563−bitBin (ITVec IT32 _) op [B32V x, B32V y] = Just . B32V $ V.zipWith op x y

564−bitBin (ITVec IT64 _) op [B64V x, B64V y] = Just . B64V $ V.zipWith op x y

565406bitBin _ _ _ = Nothing

566407

567408bCmp :: IntTy -> (forall a. (Integral a, Ord a) => a -> a -> Bool) -> [Const] -> Maybe Const

@@ -572,14 +413,6 @@ bCmp (ITFixed IT64) op [B64 x, B64 y] = Just $ I (if (op x y) then 1 else 0)

572413bCmp ITBig op [BI x, BI y] = Just $ I (if (op x y) then 1 else 0)

573414bCmp ITNative op [I x, I y] = Just $ I (if (op x y) then 1 else 0)

574415bCmp ITChar op [Ch x, Ch y] = Just $ I (if (op (ord x) (ord y)) then 1 else 0)

575−bCmp (ITVec IT8 _) op [B8V x, B8V y]

576− = Just . B8V . V.map (\b -> if b then -1 else 0) $ V.zipWith op x y

577−bCmp (ITVec IT16 _) op [B16V x, B16V y]

578− = Just . B16V . V.map (\b -> if b then -1 else 0) $ V.zipWith op x y

579−bCmp (ITVec IT32 _) op [B32V x, B32V y]

580− = Just . B32V . V.map (\b -> if b then -1 else 0) $ V.zipWith op x y

581−bCmp (ITVec IT64 _) op [B64V x, B64V y]

582− = Just . B64V . V.map (\b -> if b then -1 else 0) $ V.zipWith op x y

583416bCmp _ _ _ = Nothing

584417

585418

@@ -717,53 +550,5 @@ p_strCons _ = Nothing

717550p_strRev [Str xs] = Just $ Str (reverse xs)

718551p_strRev _ = Nothing

719552

720−p_allocate, p_appendBuffer :: [Const] -> Maybe Const

721−p_allocate [B64 _] = Just $ B8V V.empty

722−p_allocate n = Nothing

723−p_appendBuffer [B8V vect1, B64 size1, B64 count, B64 size2, B64 off, B8V vect2] =

724− Just $ B8V (foldl (V.++)

725− (V.slice 0 (fromIntegral size1) vect1)

726− (replicate (fromIntegral count) (V.slice (fromIntegral off) (fromIntegral size2) vect2)))

727−p_appendBuffer n = Nothing

728−p_append :: Endianness -> [Const] -> Maybe Const

729−p_append en [B8V vect, B64 size, B64 count, val] =

730− let bytes = case val of

731− B8 x -> [x]

732− B16 x -> [fromIntegral x, fromIntegral (shiftR x 8)]

733− B32 x -> map (fromIntegral . shiftR x) [0,8..24]

734− B64 x -> map (fromIntegral . shiftR x) [0,8..56]

735− in Just $ B8V (foldl V.snoc

736− (V.slice 0 (fromIntegral size) vect)

737− (concat (replicate (fromIntegral count)

738− (case en of

739− BE -> reverse bytes

740− _ -> bytes))))

741−p_append _ _ = Nothing

742−

743−p_peek :: IntTy -> Endianness -> [Const] -> Maybe Const

744−p_peek (ITFixed IT8) _ [B8V vect, B64 offset] = Just $ B8 (vect V.! fromIntegral offset)

745−p_peek (ITFixed IT16) en [B8V vect, B64 offset] =

746− let bytes = [0..1]

747− in Just $ B16 (foldl (\full byte -> shiftL full 8 .|. fromIntegral (vect V.! (fromIntegral offset+byte)))

748− 0

749− (case en of

750− BE -> bytes

751− _ -> reverse bytes))

752−p_peek (ITFixed IT32) en [B8V vect, B64 offset] =

753− let bytes = [0..1]

754− in Just $ B32 (foldl (\full byte -> shiftL full 8 .|. fromIntegral (vect V.! (fromIntegral offset+byte)))

755− 0

756− (case en of

757− BE -> bytes

758− _ -> reverse bytes))

759−p_peek (ITFixed IT64) en [B8V vect, B64 offset] =

760− let bytes = [0..1]

761− in Just $ B64 (foldl (\full byte -> shiftL full 8 .|. fromIntegral (vect V.! (fromIntegral offset+byte)))

762− 0

763− (case en of

764− BE -> bytes

765− _ -> reverse bytes))

766−p_peek _ _ _ = Nothing

767−

768553p_cantreduce :: a -> Maybe b

769554p_cantreduce _ = Nothing