Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: c38b6071df
Fetching contributors…

Cannot retrieve contributors at this time

181 lines (138 sloc) 4.287 kB
#ifndef _CLOSURE_H
#define _CLOSURE_H
# ifndef WIN32
# include <pthread.h>
# define GC_THREADS
# else
# define GC_WIN32_THREADS
# endif
#include <gc/gc.h>
#include <gmp.h>
#include <stdio.h>
#include <stdlib.h>
#define EMALLOC GC_MALLOC
#define EREALLOC GC_REALLOC
#define EFREE GC_FREE
//#define EMALLOC malloc
//#define EREALLOC realloc
//#define EFREE free
#define MKCON (con*)EMALLOC(sizeof(con))
#define MKFUN (fun*)EMALLOC(sizeof(fun))
#define MKTHUNK (thunk*)EMALLOC(sizeof(thunk))
#define MKCLOSURE (Closure*)EMALLOC(sizeof(Closure))
#define MKUNIT (void*)0
#define INTOP(op,x,y) MKINT((((int)x)>>1) op (((int)y)>>1))
#define CHECKEVALUATED(x) if(ISFUN(x) || ISTHUNK(x) \
|| ISFV(x)) return 0;
#define MKARGS(x) (void**)EMALLOC(sizeof(VAL)*(x));
#define MOREARGS(args,x) (void**)EREALLOC(args,sizeof(VAL)*(x));
typedef enum {
FUN,
THUNK,
CON,
INT,
BIGINT,
FLOAT,
BIGFLOAT,
STRING,
UNIT,
PTR,
FREEVAR
} ClosureType;
typedef struct {
int ty;
void* info;
} Closure;
void dumpClosure(Closure* c);
void assertConR(Closure* c);
void assertInt(Closure* c);
#define assertCon(x) assertConR(x)
typedef Closure* VAL;
#define GETTY(x) (ISINT(x) ? INT : ((ClosureType)(((x)->ty) >> 24)))
#define QGETTY(x) ((ClosureType)(((x)->ty) >> 24))
#define SETTY(x,t) (x)->ty = (((int)t) << 24)
#define REF(x) x
#define DEREF(x)
typedef void*(*func)(void**);
typedef struct {
func fn;
void** args;
void** arg_end;
int arity;
} fun;
typedef struct {
void* fn;
void** args;
int numargs;
} thunk;
typedef struct {
int tag;
void** args;
} con;
#define UPDATE(x,res) if (ISINT(res)) { x = MKINT(GETINT(res)); } else { \
SETTY(x, GETTY(res)); x->info=res->info; }
#define TAG(x) (((con*)((Closure*)x)->info)->tag & 65535)
#define ARITY(x) (((con*)((Closure*)x)->info)->tag >> 16)
#define ISCON(x) GETTY(((Closure*)(x)))==CON
#define ISINT(x) ((((int)x)&1) == 1)
#define ISTHUNK(x) GETTY(((Closure*)(x)))==THUNK
#define ISFUN(x) GETTY(((Closure*)(x)))==FUN
#define ISFV(x) GETTY(((Closure*)(x)))==FREEVAR
#ifdef TRACEON
#define TRACE if(1)
#else
#define TRACE if(0)
#endif
// Evaluate x to head normal form
VAL DO_EVAL(VAL x);
//#define EVAL(x) DO_EVAL(x)
#define EVAL(x) ((x && (ISTHUNK(x) || ISFUN(x))) ? DO_EVAL(x) : x)
#define CONSTRUCTOR(t,a,b) ((a)==0 && t<255 ? zcon[t] : CONSTRUCTORn(t,a,b))
// Return a new constructor
VAL CONSTRUCTORn(int tag, int arity, void** block);
VAL CONSTRUCTOR1(int tag, VAL a1);
VAL CONSTRUCTOR2(int tag, VAL a1, VAL a2);
VAL CONSTRUCTOR3(int tag, VAL a1, VAL a2, VAL a3);
VAL CONSTRUCTOR4(int tag, VAL a1, VAL a2, VAL a3, VAL a4);
VAL CONSTRUCTOR5(int tag, VAL a1, VAL a2, VAL a3, VAL a4, VAL a5);
// Return a new function node
VAL CLOSURE(func x, int arity, int args, void** block);
// Add arguments to an already existing thunk
VAL CLOSURE_ADDN(VAL x, int args, void** block);
VAL CLOSURE_ADD1(VAL xin, VAL a1);
VAL CLOSURE_ADD2(VAL xin, VAL a1, VAL a2);
VAL CLOSURE_ADD3(VAL xin, VAL a1, VAL a2, VAL a3);
VAL CLOSURE_ADD4(VAL xin, VAL a1, VAL a2, VAL a3, VAL a4);
VAL CLOSURE_ADD5(VAL xin, VAL a1, VAL a2, VAL a3, VAL a4, VAL a5);
// Apply a closure to some arguments
VAL CLOSURE_APPLY(VAL x, int args, void** block);
VAL CLOSURE_APPLY1(VAL x, VAL a1);
VAL CLOSURE_APPLY2(VAL x, VAL a1, VAL a2);
VAL CLOSURE_APPLY3(VAL x, VAL a1, VAL a2, VAL a3);
VAL CLOSURE_APPLY4(VAL x, VAL a1, VAL a2, VAL a3, VAL a4);
VAL CLOSURE_APPLY5(VAL x, VAL a1, VAL a2, VAL a3, VAL a4, VAL a5);
// Project an argument from a constructor
#define PROJECT(x,arg) (((con*)((x)->info))->args[arg])
//void* DO_PROJECT(VAL x, int arg);
#define ASSIGNINT(t, x) t=MKINT(x);
//extern VAL one;
// array of zero arity constructors. We don't need more than one of each...
extern VAL* zcon;
#define MKINT(x) ((void*)((x)<<1)+1)
#define GETINT(x) ((int)(x)>>1)
//void* MKINT(int x);
void* NEWBIGINT(char* bigint);
void* MKBIGINT(mpz_t* bigint);
void* MKSTR(char* str);
void* MKPTR(void* ptr);
// Get values from a closure
//int GETINT(void* x);
mpz_t* GETBIGINT(void* x);
char* GETSTR(void* x);
void* GETPTR(void* x);
void* MKFREE(int x);
// Exit with fatal error
void ERROR(char* msg);
// Initialise everything
void init_evm();
#endif
Jump to Line
Something went wrong with that request. Please try again.