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

git.iko.soy/Idris-dev

'par' primitive in builtins (not yet implemented)

commit7508b646a0bb3cff04578e1994bc61fb70d98a62 authorEdwin Brady <ecb10@st-andrews.ac.uk> dateWed 31 Oct 2012, 10:51 (14 years ago) parentaf66f25

8 files changed+32−7

compare with master

unifiedsplit

lib/Builtins.idr+3 rts/idris_main.c+1−1 rts/idris_rts.c+8−3 rts/idris_rts.h+5−1 src/Core/Evaluate.hs+2−1 src/IRTS/CodegenC.hs+1 src/IRTS/Compiler.hs+3 src/IRTS/Lang.hs+9−1

lib/Builtins.idr+3

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

2222lazy : a -> a

2323lazy x = x -- compiled specially

2424

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

26+par x = x -- compiled specially

27+

2528malloc : Int -> a -> a

2629malloc size x = x -- compiled specially

2730

rts/idris_main.c+1−1

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

11int 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);

33 _idris__123_runMain0_125_(vm, NULL);

44 //_idris_main(vm, NULL);

55#ifdef IDRIS_TRACE

rts/idris_rts.c+8−3

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

99#include "idris_rts.h"

1010#include "idris_gc.h"

1111

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[]) {

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

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

1517 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[]) {

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

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

4547

48+ vm->max_threads = max_threads;

49+

4650 int i;

47−

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

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

5053 vm->argc = argc;

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

364367}

365368

366369void* 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);

368373 pthread_t t;

369374 pthread_attr_t attr;

370375// size_t stacksize;

rts/idris_rts.h+5−1

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

5959 VAL* inbox_ptr; // Next message to read

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

6161

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

63+

6264 int argc;

6365 VAL* argv; // command line arguments

6466

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

7173} VM;

7274

7375// 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[]);

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

7680void terminate(VM* vm);

7781

src/Core/Evaluate.hs+2−1

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

109109

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

111111simplify 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)]

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

114115 quote 0 val) initEval

115116

src/IRTS/CodegenC.hs+1

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

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

246246

247247doOp 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 ++ "))"

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

249250doOp v LNoOp args = ""

250251doOp _ _ _ = "FAIL"

src/IRTS/Compiler.hs+3

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

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

146146 = do arg' <- ir' env arg

147147 return $ LLazyExp arg'

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

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

150+ return $ LOp LPar [LLazyExp arg']

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

149152 = do arg' <- ir' env arg

150153 return $ LOp LFork [LLazyExp arg']

src/IRTS/Lang.hs+9−1

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

2525 | LError String

2626 deriving Eq

2727

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

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

30+

2831data 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

3841

4043 | LStdIn | LStdOut | LStdErr

41− | LFork | LVMPtr | LNoOp

44+

45+ | LFork

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

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

48+ | LVMPtr

49+ | LNoOp

4250 deriving (Show, Eq)

4351

4452-- Supported target languages for foreign calls