So here's a big HTML file with an SK-combinator graph reduction engine
in it. It's 3:00 now, and I started on it around 21:00, so it's taken
about 6 hours; this lends some credence to the remark I wrote on FoRK
the other day:
[SK-combinators] look like the simplest way to implement a functional
language with reasonable efficiency, although anyone who reads
kragen-hacks knows that I've implemented several functional languages
without reasonable efficiency.
I'd go ahead and implement compilation of lambda-expressions into
SK-combinators, but I'm too tired now.
I'll stick this at http://pobox.com/~kragen/sw/sk.html when I get a
chance.
I find SK-combinators incredibly hard to program in directly, and
nearly impossible to debug. I think I spent 45 minutes trying to
debug 'max' --- you know, (lambda (a b) (if (> a b) a b)) in Scheme.
On the other hand, I believe this implementation is fully lazy without
ever duplicating a reduction, supports currying, does general
tail-call elimination, logs all the reduction steps to a log that you
can view with "MochiKit.Logging.logger.debuggingBookmarklet()", and
even produces a sort of stack trace for any errors. So I think there
may be something to be said for this implementation approach.
<html><head><title>SK-combinator evaluation by graph reduction</title>
<!-- Tested on Firefox 1.5.0.6 with MochiKit 1.3.1. Might work in
other browsers. You NEED MochiKit for this. I'm using the following
bits of it: $(), map, repr, ifilter, forEach, operator, focusOnLoad,
MochiKit.DOM (specifically toHTML, A, and DIV, but it's not very
separable), and logging (with log and logDebug - the MochiKit
debugging bookmarklet shows reduction steps, very helpful for
debugging). In short, this code would be a lot longer without it.
Point the next line at MochiKit: -->
<script src="Desktop/MochiKit-1.3.1/lib/MochiKit/MochiKit.js"></script>
<script>
// SK-combinator evaluation by graph reduction
// CONSTRUCTORS
// Constructor makes an ML-like or Haskell-like constructor (which has
// very little in common with an OO constructor, or a JavaScript
// constructor). Once you say
// App = Constructor("App", ["Fun", "Val"])
// then you can construct an object with {Fun: 3, Val: 4} with App(3,
// 4) and you can also set things on App.prototype. You can't new
// App(...) though, which you could (and would have to) if App were a
// JavaScript constructor.
function ConstructorObject(name, argnames, argvals) {
this.tagname = name
for (var ii = 0; ii < argnames.length; ii++) {
this[argnames[ii]] = argvals[ii]
}
this.argnames = argnames
}
ConstructorObject.prototype = {
toString: function() {
var rv = this.tagname
for (var ii = 0; ii < this.argnames.length; ii++) {
rv = rv + ' ' + this[this.argnames[ii]]
}
return rv
},
repr: function() {
var inside = map(repr, this.argvals()).join(', ')
return this.tagname + '(' + inside + ')'
},
argvals: function() {
var self = this
return map(function(name) { return self[name] }, self.argnames)
}
}
function ArgumentsMismatch(argvals, argnames) {
this.argvals = argvals
this.argnames = argnames
this.toString = function () {
return ('ArgumentsMismatch: got: ' + repr(this.argvals) +
' expected: ' + repr(this.argnames))
}
}
function Constructor(name, argnames) {
var newclass = function() { ConstructorObject.apply(this, arguments) }
newclass.prototype = new ConstructorObject(name, argnames, argnames)
var rv = function() {
if (arguments.length != argnames.length) {
throw new ArgumentsMismatch(arguments, argnames)
}
return new newclass(name, argnames, arguments)
}
rv.prototype = newclass.prototype // for convenience
return rv
}
// GRAPH NODES
// There are three types of graph nodes: applications (App), variables
// (Var), and indirection nodes (Ind). An application is a function
// being applied to an argument, and a variable is an atom like 'S' or
// 'K' or '1' or '+'. An indirection node is merely an alias for some
// other node; they exist because we sometimes need to actually mutate
// graph nodes into other graph nodes, specifically for K and I.
// Originally I had separate constructors for App and Var, but
// sometimes in graph-reduction, you need to mutate an App into a Var,
// or at least an Ind to a Var. I want different behavior (e.g. for
// rendering) in the different kinds of graph nodes, but I don't know
// how to change the constructor of a JavaScript object at run-time.
// In Python, I would just set the __class__ to change the behavior;
// in Perl I would rebless. (The obvious approach, object.constructor
// = something_else, doesn't work in my Firefox.)
// So now I use a single Node constructor for all three of App, Var,
// and Ind, and put the per-type code into strategy objects App_type
// etc., and wrote corresponding functions for creation of each node
// type.
Node = Constructor("Node", ["Type", "Args"])
function delegate(name) {
var method = name + '_of'
return function() {
return this.Type[method].apply(this.Type, this.Args)
}
}
Node.prototype.repr = delegate('repr')
Node.prototype.unparenthesized = delegate('unparenthesized')
Node.prototype.parenthesized = delegate('parenthesized')
Node.prototype.become = function(other) {
this.Type = other.Type
this.Args = other.Args
}
Var_type = {
tagname: 'Var',
repr_of: function(name) { return "Var(" + repr(name) + ")" },
unparenthesized_of: function(name) { return name },
parenthesized_of: function(name) { return name },
}
App_type = {
tagname: 'App',
repr_of: function(fun, arg) {
return "App(" + repr(fun) + ", " + repr(arg) + ")"
},
unparenthesized_of: function(fun, arg) {
return fun.unparenthesized() + ' ' + arg.parenthesized()
},
parenthesized_of: function(fun, arg) {
return '(' + this.unparenthesized_of(fun, arg) + ')'
},
}
Ind_type = {
tagname: 'Ind',
repr_of: function(target) { return "Ind(" + repr(target) + ")" },
unparenthesized_of: function(target) { return target.unparenthesized() },
parenthesized_of: function(target) { return target.parenthesized() },
}
function Var(name) { return Node(Var_type, [name]) }
function App(fun, arg) { return Node(App_type, [fun, arg]) }
function Ind(target) {
// no need to create an Ind node for an Ind node
if (target.Type == Ind_type) return target
else return Node(Ind_type, [target])
}
function pretty_print(expr) { return expr.unparenthesized() }
// TOKENIZING AND PARSING
function tokenize(expr) {
// Hooray for regexps!
var tokens = expr.match(/\s+|[^\s\(\)]+|\(|\)/g)
var wsp_re = /\s/
return ifilter(function(token) { return !token.match(wsp_re) }, tokens)
}
// parsing exceptions
EmptyParens = Constructor("EmptyParens", ["Where"])
ExtraRightParen = Constructor("ExtraRightParen", ["Where"])
MissingRightParen = Constructor("MissingRightParen", [])
// wow, this grammar is really easy to shift-reduce by hand :)
function sk_parse(expr) {
var stack = [null]
var tokens_so_far = [] // for error reporting
forEach(tokenize(expr), function(token) {
tokens_so_far.push(token)
var val
if (token == '(') {
stack.unshift(null)
return // do not construct an App
} else if (token == ')') {
if (stack.length == 1)
throw ExtraRightParen(tokens_so_far.join(' '))
val = stack.shift()
if (!val) throw EmptyParens(tokens_so_far.join(' '))
} else {
val = Var(token)
}
if (stack[0]) stack[0] = App(stack[0], val)
else stack[0] = val
})
if (stack.length != 1) throw MissingRightParen()
return stack[0]
}
UnevaluableArgument = Constructor("UnevaluableArgument", ["Fun", "Arg"])
NonNumericArgument = Constructor("NonNumericArgument", ["Fun", "Arg"])
function strict_value(context, expr) {
if (expr.Type == Ind_type) expr = expr.Args[0]
if (expr.Type != Var_type) expr = sk_reduce(expr)
if (expr.Type != Var_type)
throw UnevaluableArgument(context, expr.parenthesized())
return expr.Args[0]
}
function isnan(n) { return n.toString() == 'NaN' }
function numeric_value(context, expr) {
var string_value = strict_value(context, expr)
var value = parseFloat(string_value)
if (isnan(value)) throw NonNumericArgument(context, string_value)
return value
}
function binary_arithmetic(name, fun) {
return [2, function(a, b) {
return Var(fun(numeric_value(name + ' (left)', a),
numeric_value(name + ' (right)', b)))
}]
}
InvalidPredicateValue = Constructor("InvalidPredicateValue", ['Value'])
built_ins = {
// This is the set of combinators from Simon Peyton Jones' 1987
// "The Implementation of Functional Programming Languages",
// chapter 16; he says that the B, C, S', and C' combinators were
// originated by David Turner in order to implement SASL in the
// late 1970s, and the B* combinator by Mark Sheevel of Burroughs
// Corp. as an alternative to the B' combinator
// B' c f g x -> c f (g x).
// S and K are sufficient to build all the others.
S: [3, function(f, g, x) { return App(App(f, x), App(g, x)) }],
K: [2, function(k, _) { return Ind(k) }],
I: [1, function(x) { return Ind(x) }],
B: [3, function(f, g, x) { return App(f, App(g, x)) }],
C: [3, function(f, g, x) { return App(App(f, x), g) }],
"S'": [4, function(c, f, g, x) {return App(App(c, App(f, x)), App(g, x))}],
"B*": [4, function(c, f, g, x) {return App(c, App(f, App(g, x)))}],
"C'": [4, function(c, f, g, x) {return App(App(c, App(f, x)), g)}],
// Again, this can be done with S and K, but it's simpler to:
Y: [1, function(f) { return App(f, App(Var("Y"), f)) }],
// And here are some arithmetic operators.
'+': binary_arithmetic('+', operator.add),
'*': binary_arithmetic('*', operator.mul),
'/': binary_arithmetic('/', operator.div),
'-': binary_arithmetic('-', operator.sub),
'%': binary_arithmetic('%', operator.mod),
'&': binary_arithmetic('&', operator.and),
'|': binary_arithmetic('|', operator.or),
'^': binary_arithmetic('^', operator.xor),
'<<': binary_arithmetic('<<', operator.lshift),
'>>': binary_arithmetic('>>', operator.rshift),
'>>>': binary_arithmetic('>>>', operator.zrshift),
'==': binary_arithmetic('==', operator.eq),
'!=': binary_arithmetic('!=', operator.ne),
'>': binary_arithmetic('>', operator.gt),
'<': binary_arithmetic('<', operator.lt),
'>=': binary_arithmetic('>=', operator.ge),
'<=': binary_arithmetic('<=', operator.le),
// and a conditional
'if': [3, function(pred, conseq, alt) {
var pred_rv = strict_value('if', pred)
if (pred_rv == true) return Ind(conseq)
else if (pred_rv == false) return Ind(alt)
else throw InvalidPredicateValue(pred_rv)
}],
}
// Suppose you want a 'cons' whose result takes two arguments and
// applies the first to its contents. That's
// \car.\cdr.\f.\g.f car cdr
// but translating that by hand into combinators is beyond my ability
// at the moment.
// Suppose instead we just want 'car'. That's easy --- it's K. How about cdr?
// \car.\cdr.cdr
// \car.I
// K I
// Suppose we just want a 'cons' that doesn't afford a nil test:
// \car.\cdr.\f.f car cdr
// \car.\cdr.C(\f.f car) cdr
// \car.\cdr.C (C I car) cdr
// \car.B (C (C I car)) I
// C (\car.B (C (C I car))) I
// C (B B (\car. C (C I car))) I
// C (B B (B C (\car. C I car))) I
// C (B B (B C (B (C I) I))) I
// cons = 'C (B B (B C (B (C I) I))) I'
// and that works --- if you apply it to 1 and 2, you get
// C (B (C I) I 1) (I 2)
// and then applying that to K gives you 1, or applying to (K I) gives you 2.
// the 'square' function:
// \a.* a a -> S(\a.* a) I -> S(B * I) I
// 'max':
// \a.\b.if (> a b) a b
// \a.S(\b.if (> a b) a) I
// \a.S(C (\b.if (> a b)) a) I
// \a.S(C (B if (\b. > a b)) a) I
// \a.S(C (B if (> a)) a) I
// C (\a.S(C (B if (> a)) a)) I
// C (B S (\a. C (B if (> a)) a)) I
// C (B S (S (\a. C (B if (> a))) I)) I
// C (B S (S (B C (\a. B if (> a))) I)) I
// C (B S (S (B C (B (B if) >)) I)) I
samples = {
cons: 'C (B B (B C (B (C I) I))) I',
square: 'S (B * I) I',
max3: 'S (C (B if (> 3)) 3) I',
max: 'C (B S (S (B C (B (B if) >)) I)) I',
}
function samples_div(input_name) {
var rv = []
var inp_code = '$(' + repr(input_name) + ')'
for (var name in samples) {
var code = inp_code + '.value = ' + repr(samples[name]) +
"+ ' '; " + inp_code + '.focus()'
rv.push(A({href: 'javascript:' + code + '; void 0'}, name))
rv.push(' ')
}
return DIV(null, 'Samples: ', rv)
}
function last(list) { return list[list.length - 1] }
ReductionError = Constructor("ReductionError", ["State", "Error"])
ReductionError.prototype.toString = function() {
return "ReductionError in " + this.State + " because:\n" + this.Error
}
function sk_reduce(expr) {
var spine = [expr]
for (;;) {
var expr = spine[spine.length - 1]
log("examining " + expr.parenthesized() +
" in " + spine[0].parenthesized())
logDebug(' (' + repr(expr) + ')')
if (expr.Type == App_type) {
spine.push(expr.Args[0])
} else if (expr.Type == Var_type) {
var name = expr.Args[0]
var defn = built_ins[name]
if (!defn) return spine[0]
var nargs = defn[0]
var fun = defn[1]
if (spine.length <= nargs) return spine[0]
var args = []
for (var ii = 0; ii < nargs; ii++) {
spine.pop()
args.push(last(spine).Args[1]) // it's an App, so Args[1] is arg
}
try {
last(spine).become(fun.apply(this, args))
} catch (e) {
throw ReductionError(spine[0].parenthesized(), e.toString())
}
} else if (expr.Type == Ind_type) {
spine.pop()
spine.push(expr.Args[0])
} else { throw "up" }
}
}
function eval_sk(expr) {
try {
return pretty_print(sk_reduce(sk_parse(expr)))
} catch (e) {
return "Error: " + e
}
}
</script>
<script type="text/javascript">
focusOnLoad('input')
</script>
</head><body>
<h1>SK combinators</h1>
<form
onsubmit="$('results').value += eval_sk($('input').value) + '\n'; return false"
>
<textarea id="results" cols="80" rows="20"></textarea> <br />
<input id="input" value="S (B * I) I 9" size="80">
</form>
<script type="text/javascript">
document.write(toHTML(samples_div('input')))
</script>
</body></html>
