Skip to content

Instantly share code, notes, and snippets.

@FrankC01
Created September 10, 2017 13:43
Show Gist options
  • Save FrankC01/2935885f7ee6d2d25d85c049cf8922e3 to your computer and use it in GitHub Desktop.
Save FrankC01/2935885f7ee6d2d25d85c049cf8922e3 to your computer and use it in GitHub Desktop.
Simple example of lambda calculus 'partial' application in 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;
}
@FrankC01
Copy link
Author

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment