|
@ -4,6 +4,7 @@ |
|
|
#include "error.h" |
|
|
#include "error.h" |
|
|
#include "RTS.h" |
|
|
#include "RTS.h" |
|
|
|
|
|
|
|
|
|
|
|
/* Test case stuff */ |
|
|
#ifndef LIB |
|
|
#ifndef LIB |
|
|
static svalue_t* |
|
|
static svalue_t* |
|
|
make_doubleadder_inner_inner(svalue_t *, svalue_t **); |
|
|
make_doubleadder_inner_inner(svalue_t *, svalue_t **); |
|
@ -18,6 +19,15 @@ make_doubleadder(svalue_t *, svalue_t **); |
|
|
inline svalue_t |
|
|
inline svalue_t |
|
|
box_value(svalue_variants_t value, |
|
|
box_value(svalue_variants_t value, |
|
|
stype_t type) { |
|
|
stype_t type) { |
|
|
|
|
|
/*
|
|
|
|
|
|
* Creates a boxed value which is just |
|
|
|
|
|
* a tagged union where the value is the unboxed |
|
|
|
|
|
* value and the tag is an enum value describing |
|
|
|
|
|
* what the unboxed value represents |
|
|
|
|
|
* We do this so that all values are of the same "type" |
|
|
|
|
|
* and this makes it a lot simpler to pass around parameters, |
|
|
|
|
|
* environments, closures, etc... |
|
|
|
|
|
*/ |
|
|
|
|
|
|
|
|
svalue_t val; |
|
|
svalue_t val; |
|
|
switch (type) { |
|
|
switch (type) { |
|
@ -35,6 +45,9 @@ box_value(svalue_variants_t value, |
|
|
case STRING: |
|
|
case STRING: |
|
|
val.value.string = value.string; |
|
|
val.value.string = value.string; |
|
|
val.type_tag = type; |
|
|
val.type_tag = type; |
|
|
|
|
|
case PAIR: |
|
|
|
|
|
val.value.pair = value.pair; |
|
|
|
|
|
val.type_tag = type; |
|
|
case CLOSURE: |
|
|
case CLOSURE: |
|
|
val.value.closure = value.closure; |
|
|
val.value.closure = value.closure; |
|
|
val.type_tag = type; |
|
|
val.type_tag = type; |
|
@ -88,8 +101,8 @@ box_string(char *chars, size_t n) { |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
inline svalue_t * |
|
|
inline svalue_t * |
|
|
box_closure(closure_t *closure) { |
|
|
box_closure(sc_closure_t *closure) { |
|
|
svalue_t *val = calloc(sizeof (svalue_t), 1); |
|
|
svalue_t *val = malloc(sizeof (svalue_t)); |
|
|
CHECK(val); |
|
|
CHECK(val); |
|
|
svalue_variants_t value_val; |
|
|
svalue_variants_t value_val; |
|
|
value_val.closure = closure; |
|
|
value_val.closure = closure; |
|
@ -97,6 +110,20 @@ box_closure(closure_t *closure) { |
|
|
return val; |
|
|
return val; |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
inline svalue_t * |
|
|
|
|
|
box_pair(svalue_t *left, svalue_t *right) { |
|
|
|
|
|
sc_pair_t pair; |
|
|
|
|
|
pair.left = left; |
|
|
|
|
|
pair.right = right; |
|
|
|
|
|
|
|
|
|
|
|
svalue_t *val = malloc(sizeof (svalue_t)); |
|
|
|
|
|
CHECK(val); |
|
|
|
|
|
|
|
|
|
|
|
svalue_variants_t value_val; |
|
|
|
|
|
value_val.pair = pair; |
|
|
|
|
|
*val = box_value(value_val, PAIR); |
|
|
|
|
|
return val; |
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
inline svalue_t* |
|
|
inline svalue_t* |
|
|
make_closure(svalue_t *(*func)(svalue_t*, svalue_t**), |
|
|
make_closure(svalue_t *(*func)(svalue_t*, svalue_t**), |
|
@ -107,7 +134,7 @@ make_closure(svalue_t *(*func)(svalue_t*, svalue_t**), |
|
|
* closure or else it is undefined behavior when it is invoked |
|
|
* closure or else it is undefined behavior when it is invoked |
|
|
* since it would get deallocated when this function returns |
|
|
* since it would get deallocated when this function returns |
|
|
*/ |
|
|
*/ |
|
|
closure_t *closure = malloc(sizeof (closure_t)); |
|
|
sc_closure_t *closure = malloc(sizeof (sc_closure_t)); |
|
|
closure->func = func; |
|
|
closure->func = func; |
|
|
closure->fvars = fvars; |
|
|
closure->fvars = fvars; |
|
|
return box_closure(closure); |
|
|
return box_closure(closure); |
|
@ -118,7 +145,16 @@ invoke(svalue_t *closure, svalue_t *val) { |
|
|
return closure->value.closure->func(val, closure->value.closure->fvars); |
|
|
return closure->value.closure->func(val, closure->value.closure->fvars); |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
|
* The process for closure conversion basically involves finding all of the free variables |
|
|
|
|
|
* This will give the number of variables the environment must hold in total |
|
|
|
|
|
* Hence we can figure out how much memory to allocate for them! |
|
|
|
|
|
* Then the process of creating a closure simply involves assigning the bound variables to the environment |
|
|
|
|
|
* before returning the closure (created with make_closure) |
|
|
|
|
|
* Problem: how do we handle escaping functions? C can't do this afaik. |
|
|
|
|
|
*/ |
|
|
|
|
|
|
|
|
|
|
|
/* More testing stuff */ |
|
|
#ifndef LIB |
|
|
#ifndef LIB |
|
|
static inline svalue_t* |
|
|
static inline svalue_t* |
|
|
make_doubleadder_inner_inner(svalue_t *z, svalue_t **env) { |
|
|
make_doubleadder_inner_inner(svalue_t *z, svalue_t **env) { |
|
@ -141,19 +177,28 @@ make_doubleadder(svalue_t *x, svalue_t **env) { |
|
|
return make_closure(make_doubleadder_inner, env); |
|
|
return make_closure(make_doubleadder_inner, env); |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
/*svalue_t **env extend(uint32_t n, svalue_t *v*/ |
|
|
|
|
|
|
|
|
|
|
|
int |
|
|
int |
|
|
main(void) { |
|
|
main(void) { |
|
|
(void)box_float; |
|
|
(void)box_float; |
|
|
(void)box_double; |
|
|
(void)box_double; |
|
|
(void)box_string; |
|
|
(void)box_string; |
|
|
|
|
|
/*Allocate an environment
|
|
|
|
|
|
* The environment size depends on how many nested functions there are ? |
|
|
|
|
|
*/ |
|
|
svalue_t **env = calloc(sizeof (svalue_t *), 2); |
|
|
svalue_t **env = calloc(sizeof (svalue_t *), 2); |
|
|
|
|
|
/* Get the final closure */ |
|
|
svalue_t *closure1 = make_closure(make_doubleadder, env); |
|
|
svalue_t *closure1 = make_closure(make_doubleadder, env); |
|
|
|
|
|
/* Invoke the closure that the closure returns */ |
|
|
svalue_t *c1 = invoke(closure1, box_int(23)); |
|
|
svalue_t *c1 = invoke(closure1, box_int(23)); |
|
|
svalue_t *c2 = invoke(c1, box_int(5)); |
|
|
svalue_t *c2 = invoke(c1, box_int(5)); |
|
|
svalue_t *result = invoke(c2, box_int(334)); |
|
|
svalue_t *result = invoke(c2, box_int(334)); |
|
|
|
|
|
/* The final result */ |
|
|
printf("print 23 + 5 + 334 == %d\n", result->value.integer); |
|
|
printf("print 23 + 5 + 334 == %d\n", result->value.integer); |
|
|
|
|
|
svalue_t *a = box_int(123); |
|
|
|
|
|
svalue_t *b = box_int(455); |
|
|
|
|
|
svalue_t *improper = box_pair(a, b); |
|
|
|
|
|
improper->value.pair.right = improper; |
|
|
|
|
|
printf("(%d, %d)\n", improper->value.pair.left->value.integer, improper->value.pair.right->value.pair.left->value.integer); |
|
|
return 0; |
|
|
return 0; |
|
|
} |
|
|
} |
|
|
#endif |
|
|
#endif |