Simple example of lambda calculus 'partial' application in C

partial.c

//partial.c
/*
	Author: Frank V. Castellucci
	Simple example to demonstrate 'partial' application (lambda calculus)
	of function.

	Brief Intro:
	I've created a compiled function language 'CFL' which supports curry/partial
	application of functions, lambdas and closures. CFL:
		Is typeless, everything is an OBJ* (see below for simplified)
		All functions have an implict OBJ* return type

		A function can take up to 16 args (OBJ*), for example
			func foo[]
			func foo[a]
			func foo[a, b]
			etc.

		Calling a function is identified by function name with ':' suffix
			foo:
			foo: 1
			foo: 1 2

		Partials and evaluations require parens to demarcate, for example:
		func add2[a,b]
			+: a b
		func main[]
			(+: 1) ;	Produces a partial

			-or-
		var constAdd1 (+: 1)

		func main[]
			(constAdd1: 1) ;	Produces result of partial (e.g. 1+1)

		Functions may evaluate arguments as functions, for example:
		func indirect[fn]
			(fn: 2)

	At compile time I generate machinery (in LLVM-IR) that, when
	encountering parens, produces partials and/or evaluation of
	partials. The following exemplifies the fundementals of my 
	'partials' implmenetation. 

	Lambdas and closures have a similar setup and are omitted in
	the example.

*/

#include <stdio.h> 		// 	For printf
#include <stdlib.h> 	//	For malloc 

/*
	Emulating a typeless system
*/

typedef int OBJTYPE;
const OBJTYPE NILOBJ 	= 0;
const OBJTYPE INTOBJ 	= 1;
const OBJTYPE STROBJ 	= 2;
const OBJTYPE FUNCREF 	= 20;

typedef struct OBJ {
	OBJTYPE type;
	void 	*value;
} *POBJ;

struct OBJ _nil = {NILOBJ,0};
POBJ nil = &_nil;

//
// Some convenience stuff for demo
// 

POBJ 	newSimpleType(OBJTYPE type, void *val) {
	POBJ 	res = malloc(sizeof(struct OBJ));
	res->type = type;
	res->value = val;
	return res;
}

/*
	FUNCWRAP type represents a partial function until the threshold of 
	the true functions argument count is reached, in which point
	the function is invoked.
	This, in effect, reflects the behavior of currying in languages
	like Haskell
*/

typedef struct FUNCWRAP {
	OBJTYPE 	type;
	void* 		fn; 		//	Placeholder for function address
	int 		mcount; 	//	Total argument count for fn
	int 		acount; 	//	Current arguments collected
	POBJ 		*args; 		//	Array of arguments stored
} *PFUNCWRAP;


/*
	Helper routines implemented in run-time library 
	to invoke (evaluate) a function taking 0 to n arguments indirectly
	
	These are only examples which work for 0-3 argument functions	
	demonstrations only
*/

//	Zero arg
POBJ 	invoke0(PFUNCWRAP pfw) {
	return ((POBJ (*) ()) pfw->fn)();
}

//	One arg
POBJ 	invoke1(PFUNCWRAP pfw) {
	return ((POBJ (*) (POBJ)) pfw->fn) 
	(pfw->args[0]);
}

//	Two args
POBJ 	invoke2(PFUNCWRAP pfw) {
	return ((POBJ (*) (POBJ,POBJ)) pfw->fn) 
		(pfw->args[0],pfw->args[1]);
}

//	Three args
POBJ 	invoke3(PFUNCWRAP pfw) {
	return ((POBJ (*) (POBJ,POBJ,POBJ)) pfw->fn) 
		(pfw->args[0],pfw->args[1],pfw->args[2]);
}

// Invocation lookup convenience

typedef POBJ (*invoke_ptr_t)( PFUNCWRAP );

static invoke_ptr_t invoke_ptrs[4] = {invoke0,invoke1,invoke2,invoke3};

/*
	Basic example function that simply adds two numbers
	partial would be something like 'add2(obj1)' which would
	return a PFUNCWRAP object that can take 1 more argument
	before hiting max arg threshold and invoking the underlying
	function itself.

	CFL source function: func add2 [a,b] +: a b
	CFL source to call: add2: 1 6
	CFL partial: (add2: 1)	
*/	

POBJ add2(POBJ a, POBJ b) {
	POBJ res = nil;
	if(a->type == INTOBJ && b->type == INTOBJ) {
		res = newSimpleType(INTOBJ,0);
		res->value = (void *) (size_t) ((int) a->value + (int) b->value);
	}
	else {
		//	Exception, can't added non-integer numbers
	}
	return res;
}

/*
	Basic example function that simply adds three numbers
	partial would be something like 'add3(obj1)' which would
	return a PFUNCWRAP object that can take 2 more arguments
	before hiting max arg threshold and invoking the underlying
	function itself.

	CFL source example: func add3 [a,b,c] +: a +: b c
	CFL source to call: add3: 1 6 7
	CFL partials: (add3: 1) or (add3: 1 6)	
*/	

POBJ add3(POBJ a, POBJ b, POBJ c) {
	POBJ res2 = nil;
	POBJ res = add2(a,b);
	if(res != nil && c->type == INTOBJ) {
		res2 = add2(res,c);
		free(res);
	}
	return res2;
}

//
// 	Machinery
//

/*
	In essence, the following is emitted during
	compilation when author is using partials. 
	The compiler knows the address and number of args 
	from signature of all functions	
	e.g.: (foo: n) first produces PFUNCWRAP as shown
	See 'storeArgument' below for completing the expansion from
	source
*/

PFUNCWRAP makePartial(void *fn, int expected_args) {
	PFUNCWRAP 	ret = (PFUNCWRAP) malloc(sizeof(struct FUNCWRAP));
	ret->type   = FUNCREF;
	ret->fn 	= fn;
	ret->mcount = expected_args;
	ret->acount = 0;
	ret->args 	= malloc(expected_args * sizeof(void *));
	return ret;
}

/*
	To emulate persistance (function programing) we want to
	avoid fouling original partial's argument list with
	derivatives (see example below);	
*/

POBJ partialFrom(POBJ origFw) {
	PFUNCWRAP 	orig = (PFUNCWRAP) origFw;
	PFUNCWRAP 	ret = (PFUNCWRAP) malloc(sizeof(struct FUNCWRAP));
	ret->type   = FUNCREF;
	ret->fn = orig->fn;
	ret->mcount = orig->mcount;
	ret->acount = orig->acount;
	ret->args 	= malloc(orig->mcount * sizeof(void *));
	for(int i=0;i<orig->mcount;i++)
		ret->args[i] = orig->args[i];
	return (POBJ) ret;
}

/*
	Capture argument to partial function wrapper arg
	collection
	This completes the (foo: n) example unless the
	new arg hits the max threshold. In this case
	we invoke the underlying function
*/

POBJ storeArgument(POBJ obj,POBJ arg) {
	if(obj->type == FUNCREF) {
		PFUNCWRAP pfw = (PFUNCWRAP) obj;
		if(pfw->acount < pfw->mcount) {
			pfw->args[pfw->acount] = arg;
			++pfw->acount;
		}
		if(pfw->acount == pfw->mcount) {
			invoke_ptr_t fnp = invoke_ptrs[pfw->mcount];
			return fnp(pfw);
		}
		else 
			return obj;
	}
	else {
		return obj;
	}
}

//	Emulate CFL 'print: n'

POBJ printResult(POBJ obj) {
	printf("Result of partial application = %i\n", (int) obj->value);
	return nil;
}

/*
 Emulate function generated with source with compiler inserted
 partial copying to preserve original, in CFL the source would look 
 like:
 ; p2 is a function that takes function that accepts one argument
 func p2[fn]
 	print: (fn: 6) ; => 1+6 = 7

 func main[]
 	p2: (+: 1) 		; Partial of add function with 1 arg
*/

POBJ passedPartialForSecond(POBJ obj) {
	POBJ 	six = newSimpleType(INTOBJ,(void *) 6);
	POBJ 	pfunc = partialFrom(obj);
	return printResult(storeArgument(pfunc,six));	
}

/*
 Emulate function generated with source with compiler inserted
 partial copying to preserve original, in CFL the source would look 
 like:

 ; p3 is function that takes function that accepts two arguments
 func p3[fn]
 	print: ((fn: 6) 7) ; => 1+6+7 = 14

 func main[]
 	p2: (+: 1) 		; Partial of add function with 1 arg
*/

POBJ passedPartialForSecondAndThird(POBJ obj) {
	POBJ 	six = newSimpleType(INTOBJ,(void *) 6);
	POBJ 	seven = newSimpleType(INTOBJ,(void *) 7);
	POBJ 	pfunc = partialFrom(obj);
	return printResult(storeArgument (storeArgument(pfunc,six),seven));
}

/*
	Main wraps the machinery for setting up partial
	application. This would be something like what you
	would 'emit' as part of your source code compilation
	In CFL the source for this would look like:

	func main[]
		let: [p1 (add2: 1)]
		@( 					; For blocks
			p2: p1
			print: (p1: 1)
			p3: (add3: 1)
		)
*/

int main() {
	POBJ 	one = newSimpleType(INTOBJ,(void *) 1);	

	//	Demonstrate setting up and imbuing one 
	//	of our two arguments for the 'add2' function.
	// 	Because a partial wrapper is mutative, to achieve
	//	persistence we need to make copies (partialFrom) to preserve.

	POBJ padd = storeArgument((POBJ) makePartial(add2,2),one);
	
	// Demonstrate passing the partial
	passedPartialForSecond(padd);

	//	This is more direct that will exhaust the first partial
	printResult(storeArgument(padd,one));

	// Demonstrate 3 args
	passedPartialForSecondAndThird(storeArgument((POBJ) makePartial(add3,3),one));

	return 0;
}

To compile to executable:

clang partial.c -o partial

To generate LLVM-IR (more closely approximates what my CFL compiler emits):

clang -S -emit-llvm partial.c