7508b64 · Idris-dev · git.iko.soy

lib/Builtins.idr+3

compare with master

unifiedsplit

@@ -22,6 +22,9 @@ sym refl = refl

22lazy : a -> a

23lazy x = x -- compiled specially

24

25+par : |(thunk:a) -> a

26+par x = x -- compiled specially

27+

25malloc : Int -> a -> a

28malloc : Int -> a -> a

26malloc size x = x -- compiled specially

29malloc size x = x -- compiled specially

27

30

rts/idris_main.c+1−1

@@ -1,5 +1,5 @@

1int main(int argc, char* argv[]) {

2− VM* vm = init_vm(4096000, 2048000, argc, argv); // 1024000);

2+ VM* vm = init_vm(4096000, 2048000, 1, argc, argv); // 1024000);

3 _idris__123_runMain0_125_(vm, NULL);

4 //_idris_main(vm, NULL);

5#ifdef IDRIS_TRACE

rts/idris_rts.c+8−3

@@ -9,7 +9,9 @@

9#include "idris_rts.h"

10#include "idris_gc.h"

11

12−VM* init_vm(int stack_size, size_t heap_size, int argc, char* argv[]) {

12+VM* init_vm(int stack_size, size_t heap_size,

13+ int max_threads, // not implemented yet

14+ int argc, char* argv[]) {

13 VAL* valstack = malloc(stack_size*sizeof(VAL));

15 VAL* valstack = malloc(stack_size*sizeof(VAL));

14 int* intstack = malloc(stack_size*sizeof(int));

16 int* intstack = malloc(stack_size*sizeof(int));

15 double* floatstack = malloc(stack_size*sizeof(double));

17 double* floatstack = malloc(stack_size*sizeof(double));

@@ -43,8 +45,9 @@ VM* init_vm(int stack_size, size_t heap_size, int argc, char* argv[]) {

43 pthread_mutex_init(&(vm->inbox_block), NULL);

45 pthread_mutex_init(&(vm->inbox_block), NULL);

44 pthread_cond_init(&(vm->inbox_waiting), NULL);

46 pthread_cond_init(&(vm->inbox_waiting), NULL);

45

47

48+ vm->max_threads = max_threads;

49+

46 int i;

50 int i;

47−

48 // Assumption: there's enough space for this in the initial heap.

51 // Assumption: there's enough space for this in the initial heap.

49 vm->argv = malloc(argc*sizeof(VAL));

52 vm->argv = malloc(argc*sizeof(VAL));

50 vm->argc = argc;

53 vm->argc = argc;

@@ -364,7 +367,9 @@ void* runThread(void* arg) {

364}

367}

365

368

366void* vmThread(VM* callvm, func f, VAL arg) {

369void* vmThread(VM* callvm, func f, VAL arg) {

367− VM* vm = init_vm(callvm->stack_max - callvm->valstack, callvm->heap_size, 0, NULL);

370+ VM* vm = init_vm(callvm->stack_max - callvm->valstack, callvm->heap_size,

371+ callvm->max_threads,

372+ 0, NULL);

368 pthread_t t;

373 pthread_t t;

369 pthread_attr_t attr;

374 pthread_attr_t attr;

370// size_t stacksize;

375// size_t stacksize;

rts/idris_rts.h+5−1

@@ -59,6 +59,8 @@ typedef struct {

59 VAL* inbox_ptr; // Next message to read

60 VAL* inbox_write; // Location of next message to write

61

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

63+

62 int argc;

64 int argc;

63 VAL* argv; // command line arguments

65 VAL* argv; // command line arguments

64

66

@@ -71,7 +73,9 @@ typedef struct {

71} VM;

73} VM;

72

74

73// Create a new VM

75// Create a new VM

74−VM* init_vm(int stack_size, size_t heap_size, int argc, char* argv[]);

76+VM* init_vm(int stack_size, size_t heap_size,

77+ int max_threads,

78+ int argc, char* argv[]);

75// Clean up a VM once it's no longer needed

79// Clean up a VM once it's no longer needed

76void terminate(VM* vm);

80void terminate(VM* vm);

77

81

src/Core/Evaluate.hs+2−1

@@ -109,7 +109,8 @@ specialise ctxt env limits t

109

110simplify :: Context -> Env -> TT Name -> TT Name

111simplify ctxt env t

112− = evalState (do val <- eval False ctxt threshold [(UN "lazy", 0)]

112+ = evalState (do val <- eval False ctxt threshold [(UN "lazy", 0),

113+ (UN "par", 0)]

113 (map finalEntry env) (finalise t) [Simplify]

114 (map finalEntry env) (finalise t) [Simplify]

114 quote 0 val) initEval

115 quote 0 val) initEval

115

116

src/IRTS/CodegenC.hs+1

@@ -245,6 +245,7 @@ doOp v LStdOut [] = v ++ "MKPTR(vm, stdout)"

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

246

247doOp v LFork [x] = v ++ "MKPTR(vm, vmThread(vm, " ++ cname (MN 0 "EVAL") ++ ", " ++ creg x ++ "))"

248+doOp v LPar [x] = v ++ creg x -- "MKPTR(vm, vmThread(vm, " ++ cname (MN 0 "EVAL") ++ ", " ++ creg x ++ "))"

248doOp v LVMPtr [] = v ++ "MKPTR(vm, vm)"

249doOp v LVMPtr [] = v ++ "MKPTR(vm, vm)"

249doOp v LNoOp args = ""

250doOp v LNoOp args = ""

250doOp _ _ _ = "FAIL"

251doOp _ _ _ = "FAIL"

src/IRTS/Compiler.hs+3

@@ -145,6 +145,9 @@ instance ToIR (TT Name) where

145 | (P _ (UN "lazy") _, [_, arg]) <- unApply tm

146 = do arg' <- ir' env arg

147 return $ LLazyExp arg'

148+ | (P _ (UN "par") _, [_, arg]) <- unApply tm

149+ = do arg' <- ir' env arg

150+ return $ LOp LPar [LLazyExp arg']

148 | (P _ (UN "fork") _, [arg]) <- unApply tm

151 | (P _ (UN "fork") _, [arg]) <- unApply tm

149 = do arg' <- ir' env arg

152 = do arg' <- ir' env arg

150 return $ LOp LFork [LLazyExp arg']

153 return $ LOp LFork [LLazyExp arg']

src/IRTS/Lang.hs+9−1

@@ -25,6 +25,9 @@ data LExp = LV LVar

25 | LError String

26 deriving Eq

27

28+-- Primitive operators. Backends are not *required* to implement all

29+-- of these, but should report an error if they are unable

30+

28data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe

31data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe

@@ -38,7 +41,12 @@ data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe

38

41

40 | LStdIn | LStdOut | LStdErr

43 | LStdIn | LStdOut | LStdErr

44+

45+ | LFork

46+ | LPar -- evaluate argument anywhere, possibly on another

47+ -- core or another machine. 'id' is a valid implementation

41− | LFork | LVMPtr | LNoOp

48+ | LVMPtr

49+ | LNoOp

42 deriving (Show, Eq)

50 deriving (Show, Eq)

43

51

44-- Supported target languages for foreign calls

52-- Supported target languages for foreign calls