Finished TidBit 3.
Added some things extra.
This commit is contained in:
@@ -0,0 +1,14 @@
|
||||
---
|
||||
AlignConsecutiveShortCaseStatements:
|
||||
Enabled: true
|
||||
AcrossEmptyLines: true
|
||||
AcrossComments: true
|
||||
IndentCaseLabels: true
|
||||
AllowShortBlocksOnASingleLine: Always
|
||||
AllowShortCaseLabelsOnASingleLine: true
|
||||
AllowShortEnumsOnASingleLine: true
|
||||
AllowShortIfStatementsOnASingleLine: AllIfsAndElse
|
||||
AllowShortLoopsOnASingleLine: true
|
||||
IndentWidth: 4
|
||||
PointerAlignment: Left
|
||||
AlignAfterOpenBracket: BlockIndent
|
||||
@@ -8,6 +8,7 @@ The grammar:
|
||||
| { * <TIDBIT> <TIDBIT> }
|
||||
| { / <TIDBIT> <TIDBIT> }
|
||||
| { with { <id> <TIDBIT> } <TIDBIT> }
|
||||
| { recur { <id> <TIDBIT> } <TIDBIT> }
|
||||
| <id>
|
||||
| { fun <id> <TIDBIT> }
|
||||
| { call <TIDBIT> <TIDBIT> }
|
||||
@@ -20,31 +21,32 @@ The grammar:
|
||||
|#
|
||||
|
||||
(define-type TIDBIT
|
||||
[Num Number]
|
||||
[Add TIDBIT TIDBIT]
|
||||
[Sub TIDBIT TIDBIT]
|
||||
[Mul TIDBIT TIDBIT]
|
||||
[Div TIDBIT TIDBIT]
|
||||
[Id Symbol]
|
||||
[With Symbol TIDBIT TIDBIT]
|
||||
[Fun (Listof Symbol) TIDBIT]
|
||||
[Call TIDBIT (Listof TIDBIT)]
|
||||
[Bind (Listof Symbol) (Listof TIDBIT) TIDBIT]
|
||||
[Bind* (Listof Symbol) (Listof TIDBIT) TIDBIT]
|
||||
[If0 TIDBIT TIDBIT TIDBIT])
|
||||
[Num Number]
|
||||
[Add TIDBIT TIDBIT]
|
||||
[Sub TIDBIT TIDBIT]
|
||||
[Mul TIDBIT TIDBIT]
|
||||
[Div TIDBIT TIDBIT]
|
||||
[Id Symbol]
|
||||
[With Symbol TIDBIT TIDBIT]
|
||||
[Recur Symbol TIDBIT TIDBIT]
|
||||
[Fun (Listof Symbol) TIDBIT]
|
||||
[Call TIDBIT (Listof TIDBIT)]
|
||||
[Bind (Listof Symbol) (Listof TIDBIT) TIDBIT]
|
||||
[Bind* (Listof Symbol) (Listof TIDBIT) TIDBIT]
|
||||
[If0 TIDBIT TIDBIT TIDBIT])
|
||||
|
||||
(define-type Idx = Integer)
|
||||
|
||||
(define-type CORE
|
||||
[CNum Number]
|
||||
[CAdd CORE CORE]
|
||||
[CSub CORE CORE]
|
||||
[CMul CORE CORE]
|
||||
[CDiv CORE CORE]
|
||||
[CIdx Idx]
|
||||
[CFun CORE]
|
||||
[CCall CORE CORE]
|
||||
[CIf0 CORE CORE CORE]) ; No way to implement equality check with only arithmetic and functions.
|
||||
[CNum Number]
|
||||
[CAdd CORE CORE]
|
||||
[CSub CORE CORE]
|
||||
[CMul CORE CORE]
|
||||
[CDiv CORE CORE]
|
||||
[CIdx Idx]
|
||||
[CFun CORE]
|
||||
[CCall CORE CORE]
|
||||
[CIf0 CORE CORE CORE]) ; No way to implement equality check with only arithmetic and functions.
|
||||
|
||||
(define-type BINDING-DEPTH = (Symbol -> Idx))
|
||||
|
||||
@@ -58,8 +60,8 @@ The grammar:
|
||||
(: currycall : CORE (Listof TIDBIT) BINDING-DEPTH -> CORE)
|
||||
(define (currycall body args bd)
|
||||
(match args
|
||||
['() body]
|
||||
[(cons f r) (currycall (CCall body (preprocess f bd)) r bd)]))
|
||||
['() body]
|
||||
[(cons f r) (currycall (CCall body (preprocess f bd)) r bd)]))
|
||||
|
||||
(: curryfn : (Listof Symbol) TIDBIT BINDING-DEPTH -> CORE)
|
||||
(define (curryfn params body bd)
|
||||
@@ -78,23 +80,43 @@ The grammar:
|
||||
['() body]
|
||||
[else (With (first names) (first vals) (binds* (rest names) (rest vals) body))]))
|
||||
|
||||
(: Z : -> TIDBIT)
|
||||
; Z combinator!
|
||||
(define (Z)
|
||||
(Fun (list 'f)
|
||||
(Call
|
||||
(Fun (list 'x)
|
||||
(Call (Id 'f)
|
||||
(list (Fun (list 'v)
|
||||
(Call (Call (Id 'x) (list (Id 'x))) (list (Id 'v)))))))
|
||||
(list (Fun (list 'x)
|
||||
(Call (Id 'f)
|
||||
(list (Fun (list 'v)
|
||||
(Call (Call (Id 'x) (list (Id 'x))) (list (Id 'v)))))))))))
|
||||
|
||||
(: preprocess : TIDBIT BINDING-DEPTH -> CORE)
|
||||
(define (preprocess tb bd)
|
||||
(cases tb
|
||||
[(Num n) (CNum n)]
|
||||
[(Add l r) (CAdd (preprocess l bd) (preprocess r bd))]
|
||||
[(Sub l r) (CSub (preprocess l bd) (preprocess r bd))]
|
||||
[(Mul l r) (CMul (preprocess l bd) (preprocess r bd))]
|
||||
[(Div l r) (CDiv (preprocess l bd) (preprocess r bd))]
|
||||
[(Id s) (CIdx (bd s))]
|
||||
[(With name value body) (CCall (CFun (preprocess body (binding-encountered bd name)))
|
||||
(preprocess value bd))]
|
||||
[(Fun params body) (curryfn params body bd)]
|
||||
[(Call body args) (currycall (preprocess body bd) args bd)]
|
||||
[(Num n) (CNum n)]
|
||||
[(Add l r) (CAdd (preprocess l bd) (preprocess r bd))]
|
||||
[(Sub l r) (CSub (preprocess l bd) (preprocess r bd))]
|
||||
[(Mul l r) (CMul (preprocess l bd) (preprocess r bd))]
|
||||
[(Div l r) (CDiv (preprocess l bd) (preprocess r bd))]
|
||||
[(Id s) (CIdx (bd s))]
|
||||
[(With name value body) (CCall (CFun (preprocess body (binding-encountered bd name)))
|
||||
(preprocess value bd))]
|
||||
[(Recur name value body)
|
||||
(preprocess
|
||||
(With name
|
||||
(Call (Z) (list (Fun (list name) value)))
|
||||
body)
|
||||
bd)]
|
||||
[(Fun params body) (curryfn params body bd)]
|
||||
[(Call body args) (currycall (preprocess body bd) args bd)]
|
||||
|
||||
[(Bind names vals body) (preprocess (binds names vals body) bd)]
|
||||
[(Bind* names vals body) (preprocess (binds* names vals body) bd)]
|
||||
[(If0 n body alt) (CIf0 (preprocess n bd) (preprocess body bd) (preprocess alt bd))]))
|
||||
[(Bind names vals body) (preprocess (binds names vals body) bd)]
|
||||
[(Bind* names vals body) (preprocess (binds* names vals body) bd)]
|
||||
[(If0 n body alt) (CIf0 (preprocess n bd) (preprocess body bd) (preprocess alt bd))]))
|
||||
|
||||
(: parse-bind : (Listof Sexpr) (Listof Sexpr) TIDBIT -> TIDBIT)
|
||||
(define (parse-bind names vals body)
|
||||
@@ -118,6 +140,11 @@ The grammar:
|
||||
[(list 'with (list (symbol: name) named) body)
|
||||
(With name (parse-sexpr named) (parse-sexpr body))]
|
||||
[else (error 'parse-sexpr "bad `with' syntax in ~s" sexpr)])]
|
||||
[(cons 'recur more)
|
||||
(match sexpr
|
||||
[(list 'recur (list (symbol: name) named) body)
|
||||
(Recur name (parse-sexpr named) (parse-sexpr body))]
|
||||
[else (error 'parse-sexpr "bad `recur' syntax in ~s" sexpr)])]
|
||||
|
||||
; Function declaration.
|
||||
[(cons 'fun more)
|
||||
@@ -184,19 +211,19 @@ The grammar:
|
||||
;; evaluates CORE expressions by reducing them to values
|
||||
(define (eval expr env)
|
||||
(cases expr
|
||||
[(CNum n) (NumV n)]
|
||||
[(CAdd l r) (arith-op + (eval l env) (eval r env))]
|
||||
[(CSub l r) (arith-op - (eval l env) (eval r env))]
|
||||
[(CMul l r) (arith-op * (eval l env) (eval r env))]
|
||||
[(CDiv l r) (arith-op / (eval l env) (eval r env))]
|
||||
[(CIdx n) (list-ref env (sub1 n))]
|
||||
[(CFun body) (FunV body env)]
|
||||
[(CCall fun-expr arg-expr)
|
||||
(let ([fval (eval fun-expr env)])
|
||||
(cases fval
|
||||
[(FunV body f-env) (eval body (cons (eval arg-expr env) f-env))]
|
||||
[else (error 'eval "`call' expects a function, got: ~s" fval)]))]
|
||||
[(CIf0 n body alt) (if (zero? (NumV->number (eval n env))) (eval body env) (eval alt env))]))
|
||||
[(CNum n) (NumV n)]
|
||||
[(CAdd l r) (arith-op + (eval l env) (eval r env))]
|
||||
[(CSub l r) (arith-op - (eval l env) (eval r env))]
|
||||
[(CMul l r) (arith-op * (eval l env) (eval r env))]
|
||||
[(CDiv l r) (arith-op / (eval l env) (eval r env))]
|
||||
[(CIdx n) (list-ref env (sub1 n))]
|
||||
[(CFun body) (FunV body env)]
|
||||
[(CCall fun-expr arg-expr)
|
||||
(let ([fval (eval fun-expr env)])
|
||||
(cases fval
|
||||
[(FunV body f-env) (eval body (cons (eval arg-expr env) f-env))]
|
||||
[else (error 'eval "`call' expects a function, got: ~s" fval)]))]
|
||||
[(CIf0 n body alt) (if (zero? (NumV->number (eval n env))) (eval body env) (eval alt env))]))
|
||||
|
||||
(: run : String -> Number)
|
||||
;; evaluate a TIDBIT program contained in a string
|
||||
@@ -207,6 +234,38 @@ The grammar:
|
||||
[else (error 'run "evaluation returned a non-number: ~s"
|
||||
result)])))
|
||||
|
||||
; Factorial implemented with the Z combinator implemented in SKI-logic generated
|
||||
; with C to be interpreted by TIDBIT which is built on CORE.
|
||||
(test (run "{with {I {fun {x} x}} {with {K {fun {x} {fun {y} x}}} {with {S {fun
|
||||
{f} {fun {g} {fun {x} {call {call f x} {call g x}}}}}} {with {Z {call {call S
|
||||
{call {call S {call {call S {call K S}} {call {call S {call K K}} I}}} {call
|
||||
{call S {call {call S {call K S}} {call {call S {call {call S {call K S}} {call
|
||||
{call S {call K K}} {call K S}}}} {call {call S {call {call S {call K S}} {call
|
||||
{call S {call {call S {call K S}} {call {call S {call K K}} {call K S}}}} {call
|
||||
{call S {call {call S {call K S}} {call {call S {call K K}} {call K K}}}} {call
|
||||
K I}}}}} {call {call S {call {call S {call K S}} {call {call S {call K K}} {call
|
||||
K K}}}} {call K I}}}}}} {call {call S {call K K}} {call K I}}}}} {call {call S
|
||||
{call {call S {call K S}} {call {call S {call K K}} I}}} {call {call S {call
|
||||
{call S {call K S}} {call {call S {call {call S {call K S}} {call {call S {call
|
||||
K K}} {call K S}}}} {call {call S {call {call S {call K S}} {call {call S {call
|
||||
{call S {call K S}} {call {call S {call K K}} {call K S}}}} {call {call S {call
|
||||
{call S {call K S}} {call {call S {call K K}} {call K K}}}} {call K I}}}}} {call
|
||||
{call S {call {call S {call K S}} {call {call S {call K K}} {call K K}}}} {call
|
||||
K I}}}}}} {call {call S {call K K}} {call K I}}}}}} {with {fact {call Z {fun {f}
|
||||
{fun {n} {if0 n 1 {* n {call f {- n 1}}}}}}}} {call fact 5}}}}}} ") => 120)
|
||||
; C program for generating SKI/TIDBIT code at the bottom of this file.
|
||||
|
||||
(test (run
|
||||
"{recur {Y {fun {n} {if0 n 1 {* n {call Y {- n 1}}}}}} {call Y 5}}")
|
||||
|
||||
=> 120)
|
||||
(test (run
|
||||
"{recur {fact {fun {Y} {if0 Y 1 {* Y {call fact {- Y 1}}}}}} {call fact 5}}")
|
||||
|
||||
=> 120)
|
||||
|
||||
(test (run "{recur {fact {fun {n} {if0 n 1 {* n {call fact {- n 1}}}}}} {call fact 5}}") => 120)
|
||||
|
||||
(test (run "{if0 0 1 2}") => 1)
|
||||
(test (run "{if0 1 1 2}") => 2)
|
||||
|
||||
@@ -236,7 +295,7 @@ The grammar:
|
||||
(test (run "{{fun {x} {+ x 1}} of 4}")
|
||||
=> 5)
|
||||
(test (run "{with {add3 {fun {x} {+ x 3}}}
|
||||
{add3 of 1}}")
|
||||
{add3 of 1}}")
|
||||
=> 4)
|
||||
(test (run "{with {x 1} {with {y 2} {+ x y}}}") => 3)
|
||||
(test (run "{call {call {fun {x} {fun {y} {+ x y}}} 1} 2}") => 3)
|
||||
@@ -250,28 +309,163 @@ The grammar:
|
||||
(test (run "{fun {x} x}") =error> "run: evaluation returned a non-number: (FunV (CIdx 1) ())")
|
||||
|
||||
(test (run "{with {identity {fun {x} x}}
|
||||
{with {foo {fun {x} {+ x 1}}}
|
||||
{{identity of foo} of 123}}}")
|
||||
{with {foo {fun {x} {+ x 1}}}
|
||||
{{identity of foo} of 123}}}")
|
||||
=> 124)
|
||||
(test (run "{with {add3 {fun {x} {+ x 3}}}
|
||||
{with {add1 {fun {x} {+ x 1}}}
|
||||
{with {x 3}
|
||||
{add1 of {add3 of x}}}}}")
|
||||
{with {add1 {fun {x} {+ x 1}}}
|
||||
{with {x 3}
|
||||
{add1 of {add3 of x}}}}}")
|
||||
=> 7)
|
||||
(test (run "{with {x 3}
|
||||
{with {f {fun {y} {+ x y}}}
|
||||
{with {x 5}
|
||||
{f of 4}}}}")
|
||||
{with {f {fun {y} {+ x y}}}
|
||||
{with {x 5}
|
||||
{f of 4}}}}")
|
||||
=> 7)
|
||||
(test (run "{call {with {x 3}
|
||||
{fun {y} {+ x y}}}
|
||||
{fun {y} {+ x y}}}
|
||||
4}")
|
||||
=> 7)
|
||||
(test (run "{with {f {with {x 3} {fun {y} {+ x y}}}}
|
||||
{with {x 100}
|
||||
{f of 4}}}")
|
||||
{with {x 100}
|
||||
{f of 4}}}")
|
||||
=> 7)
|
||||
(test (run "{call {call {fun {x} {x of 1}}
|
||||
{fun {x} {fun {y} {+ x y}}}}
|
||||
123}")
|
||||
=> 124)
|
||||
|
||||
#|
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
// AST; variable, application, lambda.
|
||||
typedef enum { VAR, APP, LAM } Tag;
|
||||
|
||||
typedef struct Term {
|
||||
Tag tag;
|
||||
const char* name; // For VAR.
|
||||
struct Term *f, *a; // For APP: function and argument.
|
||||
const char* param; // For LAM: bound variable name.
|
||||
struct Term* body; // For LAM: body expression.
|
||||
} Term;
|
||||
|
||||
static Term* var(const char* n) {
|
||||
Term* t = malloc(sizeof *t);
|
||||
t->tag = VAR;
|
||||
t->name = n;
|
||||
return t;
|
||||
}
|
||||
|
||||
static Term* app(Term* f, Term* a) {
|
||||
Term* t = malloc(sizeof *t);
|
||||
t->tag = APP;
|
||||
t->f = f;
|
||||
t->a = a;
|
||||
return t;
|
||||
}
|
||||
|
||||
static Term* lam(const char* p, Term* b) {
|
||||
Term* t = malloc(sizeof *t);
|
||||
t->tag = LAM;
|
||||
t->param = p;
|
||||
t->body = b;
|
||||
return t;
|
||||
}
|
||||
|
||||
static Term* elim(Term* t);
|
||||
|
||||
// [v]t → SKI
|
||||
static Term* bracket(const char* v, Term* t) {
|
||||
if (t->tag == VAR)
|
||||
return strcmp(v, t->name) == 0
|
||||
? var("I")
|
||||
: app(var("K"), t); // [v]v = I, [v]x = K x
|
||||
if (t->tag == APP)
|
||||
return app(
|
||||
app(var("S"), bracket(v, t->f)), bracket(v, t->a)
|
||||
); // [v](p q) = S ([v]p) ([v]q)
|
||||
fprintf(stderr, "tf did you just do\n");
|
||||
exit(1);
|
||||
}
|
||||
|
||||
// Eliminate the λs.
|
||||
static Term* elim(Term* t) {
|
||||
switch (t->tag) {
|
||||
case VAR: return t;
|
||||
case APP: return app(elim(t->f), elim(t->a));
|
||||
case LAM: return bracket(t->param, elim(t->body));
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
// Man I love how C provides such a rich standard library for strings.
|
||||
typedef struct {
|
||||
char* buf;
|
||||
size_t len, cap;
|
||||
} Str;
|
||||
|
||||
static void sb_init(Str* s) {
|
||||
s->buf = NULL;
|
||||
s->len = s->cap = 0;
|
||||
}
|
||||
|
||||
static void sb_putc(Str* s, char c) {
|
||||
if (s->len + 1 >= s->cap) {
|
||||
s->cap = s->cap ? s->cap * 2 : 256;
|
||||
s->buf = realloc(s->buf, s->cap);
|
||||
}
|
||||
s->buf[s->len++] = c;
|
||||
s->buf[s->len] = 0;
|
||||
}
|
||||
|
||||
static void sb_puts(Str* s, const char* p) {
|
||||
while (*p) sb_putc(s, *p++);
|
||||
}
|
||||
|
||||
static void spit_out(Str* s, Term* t) {
|
||||
switch (t->tag) {
|
||||
case VAR: sb_puts(s, t->name); return;
|
||||
case APP:
|
||||
sb_puts(s, "{call ");
|
||||
spit_out(s, t->f);
|
||||
sb_putc(s, ' ');
|
||||
spit_out(s, t->a);
|
||||
sb_putc(s, '}');
|
||||
return;
|
||||
default: fprintf(stderr, "Tried to spit out a lambda D:\n"); exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
int main(void) {
|
||||
// First we construct the z combinator in SKI...
|
||||
Term* z =
|
||||
lam("f",
|
||||
app(lam("x", app(var("f"),
|
||||
lam("v", app(app(var("x"), var("x")), var("v"))))),
|
||||
lam("x", app(var("f"), lam("v", app(app(var("x"), var("x")),
|
||||
var("v")))))));
|
||||
Term* z_ski = elim(z);
|
||||
Str z_txt;
|
||||
sb_init(&z_txt);
|
||||
spit_out(&z_txt, z_ski);
|
||||
|
||||
// Then print the factorial function using it.
|
||||
printf(
|
||||
"{with {I {fun {x} x}} "
|
||||
"{with {K {fun {x} {fun {y} x}}} "
|
||||
"{with {S {fun {f} {fun {g} {fun {x} {call {call f x} {call g x}}}}}} "
|
||||
"{with {Z %s} " // <<<< Z combinator goes here.
|
||||
"{with {fact {call Z {fun {f} {fun {n} {if0 n 1 {* n {call f {- n "
|
||||
"1}}}}}}}} "
|
||||
"{call fact 5}}}}}}\n",
|
||||
z_txt.buf
|
||||
);
|
||||
|
||||
free(z_txt.buf);
|
||||
return 0;
|
||||
}
|
||||
|
||||
|#
|
||||
|
||||
@@ -0,0 +1,130 @@
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
// AST; variable, application, lambda.
|
||||
typedef enum { VAR, APP, LAM } Tag;
|
||||
|
||||
typedef struct Term {
|
||||
Tag tag;
|
||||
const char* name; // For VAR.
|
||||
struct Term *f, *a; // For APP: function and argument.
|
||||
const char* param; // For LAM: bound variable name.
|
||||
struct Term* body; // For LAM: body expression.
|
||||
} Term;
|
||||
|
||||
static Term* var(const char* n) {
|
||||
Term* t = malloc(sizeof *t);
|
||||
t->tag = VAR;
|
||||
t->name = n;
|
||||
return t;
|
||||
}
|
||||
|
||||
static Term* app(Term* f, Term* a) {
|
||||
Term* t = malloc(sizeof *t);
|
||||
t->tag = APP;
|
||||
t->f = f;
|
||||
t->a = a;
|
||||
return t;
|
||||
}
|
||||
|
||||
static Term* lam(const char* p, Term* b) {
|
||||
Term* t = malloc(sizeof *t);
|
||||
t->tag = LAM;
|
||||
t->param = p;
|
||||
t->body = b;
|
||||
return t;
|
||||
}
|
||||
|
||||
static Term* elim(Term* t);
|
||||
|
||||
// [v]t → SKI
|
||||
static Term* bracket(const char* v, Term* t) {
|
||||
if (t->tag == VAR)
|
||||
return strcmp(v, t->name) == 0
|
||||
? var("I")
|
||||
: app(var("K"), t); // [v]v = I, [v]x = K x
|
||||
if (t->tag == APP)
|
||||
return app(
|
||||
app(var("S"), bracket(v, t->f)), bracket(v, t->a)
|
||||
); // [v](p q) = S ([v]p) ([v]q)
|
||||
fprintf(stderr, "tf did you just do\n");
|
||||
exit(1);
|
||||
}
|
||||
|
||||
// Eliminate the λs.
|
||||
static Term* elim(Term* t) {
|
||||
switch (t->tag) {
|
||||
case VAR: return t;
|
||||
case APP: return app(elim(t->f), elim(t->a));
|
||||
case LAM: return bracket(t->param, elim(t->body));
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
// Man I love how C provides such a rich standard library for strings.
|
||||
typedef struct {
|
||||
char* buf;
|
||||
size_t len, cap;
|
||||
} Str;
|
||||
|
||||
static void sb_init(Str* s) {
|
||||
s->buf = NULL;
|
||||
s->len = s->cap = 0;
|
||||
}
|
||||
|
||||
static void sb_putc(Str* s, char c) {
|
||||
if (s->len + 1 >= s->cap) {
|
||||
s->cap = s->cap ? s->cap * 2 : 256;
|
||||
s->buf = realloc(s->buf, s->cap);
|
||||
}
|
||||
s->buf[s->len++] = c;
|
||||
s->buf[s->len] = 0;
|
||||
}
|
||||
|
||||
static void sb_puts(Str* s, const char* p) {
|
||||
while (*p) sb_putc(s, *p++);
|
||||
}
|
||||
|
||||
static void spit_out(Str* s, Term* t) {
|
||||
switch (t->tag) {
|
||||
case VAR: sb_puts(s, t->name); return;
|
||||
case APP:
|
||||
sb_puts(s, "{call ");
|
||||
spit_out(s, t->f);
|
||||
sb_putc(s, ' ');
|
||||
spit_out(s, t->a);
|
||||
sb_putc(s, '}');
|
||||
return;
|
||||
default: fprintf(stderr, "Tried to spit out a lambda D:\n"); exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
int main(void) {
|
||||
// First we construct the z combinator in SKI...
|
||||
Term* z =
|
||||
lam("f",
|
||||
app(lam("x", app(var("f"),
|
||||
lam("v", app(app(var("x"), var("x")), var("v"))))),
|
||||
lam("x", app(var("f"), lam("v", app(app(var("x"), var("x")),
|
||||
var("v")))))));
|
||||
Term* z_ski = elim(z);
|
||||
Str z_txt;
|
||||
sb_init(&z_txt);
|
||||
spit_out(&z_txt, z_ski);
|
||||
|
||||
// Then print the factorial function using it.
|
||||
printf(
|
||||
"{with {I {fun {x} x}} "
|
||||
"{with {K {fun {x} {fun {y} x}}} "
|
||||
"{with {S {fun {f} {fun {g} {fun {x} {call {call f x} {call g x}}}}}} "
|
||||
"{with {Z %s} " // <<<< Z combinator goes here.
|
||||
"{with {fact {call Z {fun {f} {fun {n} {if0 n 1 {* n {call f {- n "
|
||||
"1}}}}}}}} "
|
||||
"{call fact 5}}}}}}\n",
|
||||
z_txt.buf
|
||||
);
|
||||
|
||||
free(z_txt.buf);
|
||||
return 0;
|
||||
}
|
||||
Reference in New Issue
Block a user