590140a · Idris-dev · git.iko.soy

CONTRIBUTORS+1

compare with master

unifiedsplit

@@ -3,6 +3,7 @@ Thanks to the following for their help and contributions:

3Ozgur Akgun

4Ahmad Salim Al-Sibahi

5Edward Chadwick Amsden

6+Jan Bessai

6Nicola Botta

7Nicola Botta

7Edwin Brady

8Edwin Brady

8David Raymond Christiansen

9David Raymond Christiansen

config.mk+1−2

@@ -1,6 +1,6 @@

1CC ?=cc

2CABAL :=cabal

3−CFLAGS :=-O2 -Wall $(CFLAGS)

3+CFLAGS :=-O2 -Wall -DHAS_PTHREAD $(CFLAGS)

4#CABALFLAGS :=

5## Disable building of Effects

6#CABALFLAGS :=-f NoEffects

@@ -35,4 +35,3 @@ else

35 SHLIB_SUFFIX :=.so

36endif

37endif

38−

libs/prelude/Prelude/List.idr+3

@@ -579,6 +579,9 @@ isSuffixOfBy p left right = isPrefixOfBy p (reverse left) (reverse right)

579isSuffixOf : Eq a => List a -> List a -> Bool

580isSuffixOf = isSuffixOfBy (==)

581

582+isInfixOf : Eq a => List a -> List a -> Bool

583+isInfixOf n h = any (isPrefixOf n) (tails h)

584+

582--------------------------------------------------------------------------------

585--------------------------------------------------------------------------------

583-- Sorting

586-- Sorting

584--------------------------------------------------------------------------------

587--------------------------------------------------------------------------------

rts/idris_gc.c+11−2

@@ -103,7 +103,14 @@ void idris_gc(VM* vm) {

103 free(vm->heap.old);

104

105 vm->heap.heap = newheap;

106+#ifdef FORCE_ALIGNMENT

107+ if (((i_int)(vm->heap.heap)&1) == 1) {

106− vm->heap.next = newheap;

108+ vm->heap.next = newheap + 1;

109+ } else

110+#endif

111+ {

112+ vm->heap.next = newheap;

113+ }

107 vm->heap.end = newheap + vm->heap.size;

114 vm->heap.end = newheap + vm->heap.size;

108

115

109 VAL* root;

116 VAL* root;

@@ -111,10 +118,12 @@ void idris_gc(VM* vm) {

111 for(root = vm->valstack; root < vm->valstack_top; ++root) {

118 for(root = vm->valstack; root < vm->valstack_top; ++root) {

112 *root = copy(vm, *root);

119 *root = copy(vm, *root);

113 }

120 }

121+

122+#ifdef HAS_PTHREAD

114 for(root = vm->inbox_ptr; root < vm->inbox_write; ++root) {

123 for(root = vm->inbox_ptr; root < vm->inbox_write; ++root) {

115 *root = copy(vm, *root);

124 *root = copy(vm, *root);

116 }

125 }

117−

126+#endif

118 vm->ret = copy(vm, vm->ret);

127 vm->ret = copy(vm, vm->ret);

119 vm->reg1 = copy(vm, vm->reg1);

128 vm->reg1 = copy(vm, vm->reg1);

120

129

rts/idris_heap.c+8−1

@@ -16,7 +16,14 @@ void alloc_heap(Heap * h, size_t heap_size)

16 }

17

18 h->heap = mem;

19+#ifdef FORCE_ALIGNMENT

20+ if (((i_int)(h->heap)&1) == 1) {

19− h->next = h->heap;

21+ h->next = h->heap + 1;

22+ } else

23+#endif

24+ {

25+ h->next = h->heap;

26+ }

20 h->end = h->heap + heap_size;

27 h->end = h->heap + heap_size;

21

28

22 h->size = heap_size;

29 h->size = heap_size;

rts/idris_rts.c+23−11

@@ -1,10 +1,11 @@

1#include <stdlib.h>

2#include <stdio.h>

3#include <string.h>

4−#include <unistd.h>

5#include <stdarg.h>

4#include <stdarg.h>

6#include <assert.h>

5#include <assert.h>

6+#ifdef HAS_PTHREAD

7#include <pthread.h>

8+#endif

8

9

9#include "idris_rts.h"

10#include "idris_rts.h"

10#include "idris_gc.h"

11#include "idris_gc.h"

@@ -30,7 +31,7 @@ VM* init_vm(int stack_size, size_t heap_size,

30

31

31 vm->ret = NULL;

32 vm->ret = NULL;

32 vm->reg1 = NULL;

33 vm->reg1 = NULL;

33−

34+#ifdef HAS_PTHREAD

34 vm->inbox = malloc(1024*sizeof(VAL));

35 vm->inbox = malloc(1024*sizeof(VAL));

35 memset(vm->inbox, 0, 1024*sizeof(VAL));

36 memset(vm->inbox, 0, 1024*sizeof(VAL));

36 vm->inbox_end = vm->inbox + 1024;

37 vm->inbox_end = vm->inbox + 1024;

@@ -53,7 +54,7 @@ VM* init_vm(int stack_size, size_t heap_size,

53

54

54 vm->max_threads = max_threads;

55 vm->max_threads = max_threads;

55 vm->processes = 0;

56 vm->processes = 0;

56−

57+#endif

57 STATS_LEAVE_INIT(vm->stats)

58 STATS_LEAVE_INIT(vm->stats)

58 return vm;

59 return vm;

59}

60}

@@ -61,14 +62,16 @@ VM* init_vm(int stack_size, size_t heap_size,

61Stats terminate(VM* vm) {

62Stats terminate(VM* vm) {

62 Stats stats = vm->stats;

63 Stats stats = vm->stats;

63 STATS_ENTER_EXIT(stats)

64 STATS_ENTER_EXIT(stats)

64−

65+#ifdef HAS_PTHREAD

65 free(vm->inbox);

66 free(vm->inbox);

67+#endif

66 free(vm->valstack);

68 free(vm->valstack);

67 free_heap(&(vm->heap));

69 free_heap(&(vm->heap));

68−

70+#ifdef HAS_PTHREAD

69 pthread_mutex_destroy(&(vm -> inbox_lock));

71 pthread_mutex_destroy(&(vm -> inbox_lock));

70 pthread_mutex_destroy(&(vm -> inbox_block));

72 pthread_mutex_destroy(&(vm -> inbox_block));

71 pthread_cond_destroy(&(vm -> inbox_waiting));

73 pthread_cond_destroy(&(vm -> inbox_waiting));

74+#endif

72 free(vm);

75 free(vm);

73

76

74 STATS_LEAVE_EXIT(stats)

77 STATS_LEAVE_EXIT(stats)

@@ -79,18 +82,21 @@ void idris_requireAlloc(VM* vm, size_t size) {

79 if (!(vm->heap.next + size < vm->heap.end)) {

82 if (!(vm->heap.next + size < vm->heap.end)) {

80 idris_gc(vm);

83 idris_gc(vm);

81 }

84 }

82−

85+#ifdef HAS_PTHREAD

83 int lock = vm->processes > 0;

86 int lock = vm->processes > 0;

84 if (lock) { // We only need to lock if we're in concurrent mode

87 if (lock) { // We only need to lock if we're in concurrent mode

85 pthread_mutex_lock(&vm->alloc_lock);

88 pthread_mutex_lock(&vm->alloc_lock);

86 }

89 }

90+#endif

87}

91}

88

92

89void idris_doneAlloc(VM* vm) {

93void idris_doneAlloc(VM* vm) {

94+#ifdef HAS_PTHREAD

90 int lock = vm->processes > 0;

95 int lock = vm->processes > 0;

91 if (lock) { // We only need to lock if we're in concurrent mode

96 if (lock) { // We only need to lock if we're in concurrent mode

92 pthread_mutex_unlock(&vm->alloc_lock);

97 pthread_mutex_unlock(&vm->alloc_lock);

93 }

98 }

99+#endif

94}

100}

95

101

96int space(VM* vm, size_t size) {

102int space(VM* vm, size_t size) {

@@ -99,16 +105,18 @@ int space(VM* vm, size_t size) {

99

105

100void* allocate(VM* vm, size_t size, int outerlock) {

106void* allocate(VM* vm, size_t size, int outerlock) {

101// return malloc(size);

107// return malloc(size);

108+#ifdef HAS_PTHREAD

102 int lock = vm->processes > 0 && !outerlock;

109 int lock = vm->processes > 0 && !outerlock;

103

110

104 if (lock) { // not message passing

111 if (lock) { // not message passing

105 pthread_mutex_lock(&vm->alloc_lock);

112 pthread_mutex_lock(&vm->alloc_lock);

106 }

113 }

114+#endif

107

115

108 if ((size & 7)!=0) {

116 if ((size & 7)!=0) {

109 size = 8 + ((size >> 3) << 3);

117 size = 8 + ((size >> 3) << 3);

110 }

118 }

111−

119+

112 size_t chunk_size = size + sizeof(size_t);

120 size_t chunk_size = size + sizeof(size_t);

113

121

114 if (vm->heap.next + chunk_size < vm->heap.end) {

122 if (vm->heap.next + chunk_size < vm->heap.end) {

@@ -120,16 +128,19 @@ void* allocate(VM* vm, size_t size, int outerlock) {

120 assert(vm->heap.next <= vm->heap.end);

128 assert(vm->heap.next <= vm->heap.end);

121

129

122 memset(ptr, 0, size);

130 memset(ptr, 0, size);

123−

131+#ifdef HAS_PTHREAD

124 if (lock) { // not message passing

132 if (lock) { // not message passing

125 pthread_mutex_unlock(&vm->alloc_lock);

133 pthread_mutex_unlock(&vm->alloc_lock);

126 }

134 }

135+#endif

127 return ptr;

136 return ptr;

128 } else {

137 } else {

129 idris_gc(vm);

138 idris_gc(vm);

139+#ifdef HAS_PTHREAD

130 if (lock) { // not message passing

140 if (lock) { // not message passing

131 pthread_mutex_unlock(&vm->alloc_lock);

141 pthread_mutex_unlock(&vm->alloc_lock);

132 }

142 }

143+#endif

133 return allocate(vm, size, 0);

144 return allocate(vm, size, 0);

134 }

145 }

135

146

@@ -187,7 +198,7 @@ VAL MKPTR(VM* vm, void* ptr) {

187 return cl;

198 return cl;

188}

199}

189

200

190−VAL MKMPTR(VM* vm, void* ptr, int size) {

201+VAL MKMPTR(VM* vm, void* ptr, size_t size) {

191 Closure* cl = allocate(vm, sizeof(Closure) +

202 Closure* cl = allocate(vm, sizeof(Closure) +

192 sizeof(ManagedPtr) + size, 0);

203 sizeof(ManagedPtr) + size, 0);

193 SETTY(cl, MANAGEDPTR);

204 SETTY(cl, MANAGEDPTR);

@@ -222,7 +233,7 @@ VAL MKPTRc(VM* vm, void* ptr) {

222 return cl;

233 return cl;

223}

234}

224

235

225−VAL MKMPTRc(VM* vm, void* ptr, int size) {

236+VAL MKMPTRc(VM* vm, void* ptr, size_t size) {

226 Closure* cl = allocate(vm, sizeof(Closure) +

237 Closure* cl = allocate(vm, sizeof(Closure) +

227 sizeof(ManagedPtr) + size, 1);

238 sizeof(ManagedPtr) + size, 1);

228 SETTY(cl, MANAGEDPTR);

239 SETTY(cl, MANAGEDPTR);

@@ -760,6 +771,7 @@ typedef struct {

760 VAL arg;

771 VAL arg;

761} ThreadData;

772} ThreadData;

762

773

774+#ifdef HAS_PTHREAD

763void* runThread(void* arg) {

775void* runThread(void* arg) {

764 ThreadData* td = (ThreadData*)arg;

776 ThreadData* td = (ThreadData*)arg;

765 VM* vm = td->vm;

777 VM* vm = td->vm;

@@ -949,7 +961,7 @@ VAL idris_recvMessage(VM* vm) {

949

961

950 return msg;

962 return msg;

951}

963}

952−

964+#endif

953int __idris_argc;

965int __idris_argc;

954char **__idris_argv;

966char **__idris_argv;

955

967

rts/idris_rts.h+13−9

@@ -4,9 +4,10 @@

4#include <stdlib.h>

5#include <stdio.h>

6#include <string.h>

7−#include <unistd.h>

8#include <stdarg.h>

7#include <stdarg.h>

8+#ifdef HAS_PTHREAD

9#include <pthread.h>

10+#endif

10#include <stdint.h>

11#include <stdint.h>

11

12

12#include "idris_heap.h"

13#include "idris_heap.h"

@@ -23,13 +24,13 @@ typedef enum {

23typedef struct Closure *VAL;

24typedef struct Closure *VAL;

24

25

25typedef struct {

26typedef struct {

26− int tag_arity;

27+ uint32_t tag_arity;

27 VAL args[];

28 VAL args[];

28} con;

29} con;

29

30

30typedef struct {

31typedef struct {

31 VAL str;

32 VAL str;

32− int offset;

33+ size_t offset;

33} StrOffset;

34} StrOffset;

34

35

35typedef struct {

36typedef struct {

@@ -49,7 +50,10 @@ typedef struct {

49typedef struct Closure {

50typedef struct Closure {

50// Use top 16 bits of ty for saying which heap value is in

51// Use top 16 bits of ty for saying which heap value is in

51// Bottom 16 bits for closure type

52// Bottom 16 bits for closure type

52− ClosureType ty;

53+//

54+// NOTE: ty can not have type ClosureType because ty must be a

55+// uint32_t but enum is platform dependent

56+ uint32_t ty;

53 union {

57 union {

54 con c;

58 con c;

55 int i;

59 int i;

@@ -73,7 +77,7 @@ typedef struct {

73 VAL* stack_max;

77 VAL* stack_max;

74

78

75 Heap heap;

79 Heap heap;

76−

80+#ifdef HAS_PTHREAD

77 pthread_mutex_t inbox_lock;

81 pthread_mutex_t inbox_lock;

78 pthread_mutex_t inbox_block;

82 pthread_mutex_t inbox_block;

79 pthread_mutex_t alloc_lock;

83 pthread_mutex_t alloc_lock;

@@ -87,7 +91,7 @@ typedef struct {

87

91

88 int processes; // Number of child processes

92 int processes; // Number of child processes

89 int max_threads; // maximum number of threads to run in parallel

93 int max_threads; // maximum number of threads to run in parallel

90−

94+#endif

91 Stats stats;

95 Stats stats;

92

96

93 VAL ret;

97 VAL ret;

@@ -170,7 +174,7 @@ typedef intptr_t i_int;

170VAL MKFLOAT(VM* vm, double val);

174VAL MKFLOAT(VM* vm, double val);

171VAL MKSTR(VM* vm, const char* str);

175VAL MKSTR(VM* vm, const char* str);

172VAL MKPTR(VM* vm, void* ptr);

176VAL MKPTR(VM* vm, void* ptr);

173−VAL MKMPTR(VM* vm, void* ptr, int size);

177+VAL MKMPTR(VM* vm, void* ptr, size_t size);

174VAL MKB8(VM* vm, uint8_t b);

178VAL MKB8(VM* vm, uint8_t b);

175VAL MKB16(VM* vm, uint16_t b);

179VAL MKB16(VM* vm, uint16_t b);

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

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

@@ -181,7 +185,7 @@ VAL MKFLOATc(VM* vm, double val);

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

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

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

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

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

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

184−VAL MKMPTRc(VM* vm, void* ptr, int size);

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

185VAL MKBUFFERc(VM* vm, Buffer* buf);

189VAL MKBUFFERc(VM* vm, Buffer* buf);

186

190

187char* GETSTROFF(VAL stroff);

191char* GETSTROFF(VAL stroff);

@@ -208,7 +212,7 @@ void idris_doneAlloc(VM* vm);

208#define allocCon(cl, vm, t, a, o) \

212#define allocCon(cl, vm, t, a, o) \

209 cl = allocate(vm, sizeof(Closure) + sizeof(VAL)*a, o); \

213 cl = allocate(vm, sizeof(Closure) + sizeof(VAL)*a, o); \

210 SETTY(cl, CON); \

214 SETTY(cl, CON); \

211− cl->info.c.tag_arity = ((t) << 8) + (a);

215+ cl->info.c.tag_arity = ((t) << 8) | (a);

212

216

213void* vmThread(VM* callvm, func f, VAL arg);

217void* vmThread(VM* callvm, func f, VAL arg);

214

218

src/IRTS/CodegenJava.hs+8−5

@@ -169,7 +169,7 @@ jarHeader =

169 ++ "if test -n \"$JAVA_HOME\"; then\n"

170 ++ " java=\"$JAVA_HOME/bin/java\"\n"

171 ++ "fi\n"

172− ++ "exec \"$java\" $java_args -jar $MYSELF \"$@\""

172+ ++ "exec \"$java\" $java_args -jar $MYSELF \"$@\"\n"

173 ++ "exit 1\n"

174

175-----------------------------------------------------------------------

@@ -312,6 +312,7 @@ mkCompilationUnit globalInit defs hdrs out = do

312 , ImportDecl True idrisPrelude True

313 , ImportDecl False bigInteger False

314 , ImportDecl False runtimeException False

315+ , ImportDecl False byteBuffer False

315 ] ++ otherHdrs

316 ] ++ otherHdrs

316 )

317 )

317 <$> mkTypeDecl clsName globalInit defs

318 <$> mkTypeDecl clsName globalInit defs

@@ -320,6 +321,7 @@ mkCompilationUnit globalInit defs hdrs out = do

320 idrisPrelude = J.Name $ map Ident ["org", "idris", "rts", "Prelude"]

321 idrisPrelude = J.Name $ map Ident ["org", "idris", "rts", "Prelude"]

321 bigInteger = J.Name $ map Ident ["java", "math", "BigInteger"]

322 bigInteger = J.Name $ map Ident ["java", "math", "BigInteger"]

322 runtimeException = J.Name $ map Ident ["java", "lang", "RuntimeException"]

323 runtimeException = J.Name $ map Ident ["java", "lang", "RuntimeException"]

324+ byteBuffer = J.Name $ map Ident ["java", "nio", "ByteBuffer"]

323 otherHdrs = map ( (\ name -> ImportDecl False name False)

325 otherHdrs = map ( (\ name -> ImportDecl False name False)

324 . J.Name

326 . J.Name

325 . map (Ident . T.unpack)

327 . map (Ident . T.unpack)

@@ -386,9 +388,7 @@ mkMainMethod =

386 "main"

388 "main"

387 [FormalParam [] (array stringType) False (VarId $ Ident "args")]

389 [FormalParam [] (array stringType) False (VarId $ Ident "args")]

388 $ Block [ BlockStmt . ExpStmt

390 $ Block [ BlockStmt . ExpStmt

389− $ call "idris_initArgs" [ (threadType ~> "currentThread") []

391+ $ call "idris_initArgs" [ jConst "args" ]

390− , jConst "args"

391− ]

392 , BlockStmt . ExpStmt $ call (mangle' (sMN 0 "runMain")) []

393 ]

394

@@ -484,6 +484,8 @@ mkExp pp (SOp LFork [arg]) =

484 (mkThread arg) >>= ppExp pp

485mkExp pp (SOp LPar [arg]) =

486 (Nothing <>@! arg) >>= ppExp pp

487+mkExp pp (SOp LRegisterPtr [ptr, i]) =

488+ (Nothing <>@! ptr) >>= ppExp pp

487mkExp pp (SOp LNoOp args) =

489mkExp pp (SOp LNoOp args) =

488 (Nothing <>@! (last args)) >>= ppExp pp

490 (Nothing <>@! (last args)) >>= ppExp pp

489mkExp pp (SOp LNullPtr args) =

491mkExp pp (SOp LNullPtr args) =

@@ -707,6 +709,7 @@ mkConstant c@(AType x) = ClassLit (Just $ box (constType c))

707mkConstant c@(StrType ) = ClassLit (Just $ stringType)

709mkConstant c@(StrType ) = ClassLit (Just $ stringType)

708mkConstant c@(PtrType ) = ClassLit (Just $ objectType)

710mkConstant c@(PtrType ) = ClassLit (Just $ objectType)

709mkConstant c@(ManagedPtrType) = ClassLit (Just $ objectType)

711mkConstant c@(ManagedPtrType) = ClassLit (Just $ objectType)

712+mkConstant c@(BufferType) = ClassLit (Just $ bufferType)

710mkConstant c@(VoidType ) = ClassLit (Just $ voidType)

713mkConstant c@(VoidType ) = ClassLit (Just $ voidType)

711mkConstant c@(Forgot ) = ClassLit (Just $ objectType)

714mkConstant c@(Forgot ) = ClassLit (Just $ objectType)

712

715

@@ -744,7 +747,7 @@ mkForeign pp (LANG_JAVA callType) resTy text params

744

747

745mkPrimitiveFunction :: PrimFn -> [LVar] -> CodeGeneration Exp

748mkPrimitiveFunction :: PrimFn -> [LVar] -> CodeGeneration Exp

746mkPrimitiveFunction op args =

749mkPrimitiveFunction op args =

747− (\ args -> (primFnType ~> opName op) args)

750+ (\ args -> (primFnType ~> opName op) (endiannessArguments op ++ args))

748 <$> sequence (zipWith (\ a t -> (Just t) <>@! a) args (sourceTypes op))

751 <$> sequence (zipWith (\ a t -> (Just t) <>@! a) args (sourceTypes op))

749

752

750mkThread :: LVar -> CodeGeneration Exp

753mkThread :: LVar -> CodeGeneration Exp

src/IRTS/Java/JTypes.hs+31

@@ -33,6 +33,9 @@ doubleType = PrimType DoubleT

33array :: J.Type -> J.Type

34array t = RefType . ArrayType $ t

35

36+addressType :: J.Type

37+addressType = longType

38+

36-----------------------------------------------------------------------

39-----------------------------------------------------------------------

37-- Boxed types

40-- Boxed types

38

41

@@ -48,6 +51,10 @@ stringType :: J.Type

48stringType =

51stringType =

49 RefType . ClassRefType $ ClassType [(Ident "String", [])]

52 RefType . ClassRefType $ ClassType [(Ident "String", [])]

50

53

54+bufferType :: J.Type

55+bufferType =

56+ RefType . ClassRefType $ ClassType [(Ident "ByteBuffer", [])]

57+

51threadType :: J.Type

58threadType :: J.Type

52threadType =

59threadType =

53 RefType . ClassRefType $ ClassType [(Ident "Thread", [])]

60 RefType . ClassRefType $ ClassType [(Ident "Thread", [])]

@@ -132,6 +139,9 @@ runtimeExceptionType :: J.Type

132runtimeExceptionType =

139runtimeExceptionType =

133 RefType . ClassRefType $ ClassType [(Ident "RuntimeException", [])]

140 RefType . ClassRefType $ ClassType [(Ident "RuntimeException", [])]

134

141

142+-----------------------------------------------------------------------

143+-- Integer types

144+

135nativeTyToJType :: NativeTy -> J.Type

145nativeTyToJType :: NativeTy -> J.Type

136nativeTyToJType IT8 = byteType

146nativeTyToJType IT8 = byteType

137nativeTyToJType IT16 = shortType

147nativeTyToJType IT16 = shortType

@@ -219,6 +229,7 @@ opName x

219 | (LFloatInt to) <- x = "LFloatInt" ++ (suffixFor to)

229 | (LFloatInt to) <- x = "LFloatInt" ++ (suffixFor to)

220 | (LStrInt to) <- x = "LStrInt" ++ (suffixFor to)

230 | (LStrInt to) <- x = "LStrInt" ++ (suffixFor to)

221 | (LChInt to) <- x = "LChInt" ++ (suffixFor to)

231 | (LChInt to) <- x = "LChInt" ++ (suffixFor to)

232+ | (LPeek to _) <- x = "LPeek" ++ (suffixFor to)

222 | otherwise = takeWhile ((/=) ' ') $ show x

233 | otherwise = takeWhile ((/=) ' ') $ show x

223 where

234 where

224 suffixFor (ITFixed nt) = show nt

235 suffixFor (ITFixed nt) = show nt

@@ -291,10 +302,30 @@ sourceTypes (LStrRev) = [stringType]

291sourceTypes (LStdIn) = []

302sourceTypes (LStdIn) = []

292sourceTypes (LStdOut) = []

303sourceTypes (LStdOut) = []

293sourceTypes (LStdErr) = []

304sourceTypes (LStdErr) = []

305+sourceTypes (LAllocate) = [addressType]

306+sourceTypes (LAppendBuffer) =

307+ [bufferType, addressType, addressType, addressType, addressType, bufferType]

308+sourceTypes (LSystemInfo) = [integerType]

309+sourceTypes (LAppend nt _) = [bufferType, addressType, addressType, intTyToJType nt]

310+sourceTypes (LPeek _ _) = [bufferType, addressType]

294sourceTypes (LFork) = [objectType]

311sourceTypes (LFork) = [objectType]

295sourceTypes (LPar) = [objectType]

312sourceTypes (LPar) = [objectType]

296sourceTypes (LVMPtr) = []

313sourceTypes (LVMPtr) = []

297sourceTypes (LNullPtr) = [objectType]

314sourceTypes (LNullPtr) = [objectType]

298sourceTypes (LNoOp) = repeat objectType

315sourceTypes (LNoOp) = repeat objectType

299

316

317+-----------------------------------------------------------------------

318+-- Endianess markers

300

319

320+endiannessConstant :: Endianness -> Exp

321+endiannessConstant c =

322+ ExpName . Name . map Ident $ ["java", "nio", "ByteOrder", endiannessConstant' c]

323+ where

324+ endiannessConstant' BE = "BIG_ENDIAN"

325+ endiannessConstant' LE = "LITTLE_ENDIAN"

326+ endiannessConstant' (IRTS.Lang.Native) = endiannessConstant' BE

327+

328+endiannessArguments :: PrimFn -> [Exp]

329+endiannessArguments (LAppend _ end) = [endiannessConstant end]

330+endiannessArguments (LPeek _ end) = [endiannessConstant end]

331+endiannessArguments _ = []

src/IRTS/Java/Pom.hs+7−1

@@ -3,6 +3,9 @@ module IRTS.Java.Pom (pomString) where

3import Data.List (unfoldr)

4import Text.XML.Light

5

6+-----------------------------------------------------------------------

7+-- String <-> XML processing

8+

6uattr :: String -> String -> Attr

9uattr :: String -> String -> Attr

7uattr k v = Attr (QName k Nothing Nothing) v

10uattr k v = Attr (QName k Nothing Nothing) v

8

11

@@ -31,6 +34,9 @@ groupArtifactVersion g a v = [

31pomString :: String -> String -> [String] -> String

34pomString :: String -> String -> [String] -> String

32pomString c a d = ppElement $ pom c a d

35pomString c a d = ppElement $ pom c a d

33

36

37+-----------------------------------------------------------------------

38+-- The pom template for idris projects

39+

34pom :: String -> String -> [String] -> Element

40pom :: String -> String -> [String] -> Element

35pom clsName artifactName dependencies = unode "project" ([

41pom clsName artifactName dependencies = unode "project" ([

36 uattr "xmlns" "http://maven.apache.org/POM/4.0.0",

42 uattr "xmlns" "http://maven.apache.org/POM/4.0.0",

@@ -49,7 +55,7 @@ pom clsName artifactName dependencies = unode "project" ([

49 unode "skipTest" "true"

55 unode "skipTest" "true"

50 ],

56 ],

51 unode "dependencies" (

57 unode "dependencies" (

52− dependency "org.idris-lang" "idris" "0.9.10-alpha-2" :

58+ dependency "org.idris-lang" "idris" "0.9.14" :

53 map parseToDep dependencies

59 map parseToDep dependencies

54 ),

60 ),

55 unode "build" [

61 unode "build" [

test/Makefile+1−1

@@ -8,7 +8,7 @@ test: $(TESTS)

8 @perl ./runtest.pl $(patsubst %.test,%,$@)

9

10test_java:

11− perl ./runtest.pl without sugar004 buffer001 --codegen Java

11+ @perl ./runtest.pl without --codegen Java

12

13test_js:

14 @perl ./runtest.pl without sugar004 reg029 io001 dsl002 io003 effects001 effects002 buffer001 --codegen node

test/reg029/Reg029Wrapper.javanew file+17

@@ -0,0 +1,17 @@

1+import java.util.Map;

2+

3+/**

4+ * The Java back end uses properties

5+ * instead of environment variables.

6+ * This wrapper loads the env variables

7+ * into the standard set of properties.

8+ */

9+public class Reg029Wrapper {

10+ public static void main(String args[]) {

11+ Map<String, String> env = System.getenv();

12+ for (String key : env.keySet()) {

13+ System.setProperty(key, env.get(key));

14+ }

15+ reg029.main(args);

16+ }

17+}

test/reg029/reg029.idr+1

@@ -2,6 +2,7 @@ module Main

2

3import System

4

5+-- necessary to find the getenv symbol

5%dynamic "libm"

6%dynamic "libm"

6

7

7main : IO ()

8main : IO ()

test/reg029/run+12−2

@@ -1,7 +1,17 @@

1#!/usr/bin/env bash

2+

2idris $@ reg029.idr -o reg029

3idris $@ reg029.idr -o reg029

3unset IDRIS_REG029_NONEXISTENT_VAR

4unset IDRIS_REG029_NONEXISTENT_VAR

4export IDRIS_REG029_EXISTENT_VAR='exists!'

5export IDRIS_REG029_EXISTENT_VAR='exists!'

6+

7+IsJava=`echo "$@" | grep -E "\-\-codegen([[:space:]]+)Java\>"`

8+if [ -z "$IsJava" ]

9+then

5−./reg029

10+ ./reg029

11+else

12+ javac -cp reg029:. Reg029Wrapper.java

13+ java -cp reg029:. Reg029Wrapper

14+fi

6idris $@ reg029.idr --execute

15idris $@ reg029.idr --execute

7−rm -f reg029 *.ibc

16+rm -f reg029 *.ibc *.class

17+