# This file is a halfway house for code that's almost, but not quite, # ready to go into bicicleta_lib.ml, largely due to things like # missing functionality and things being renamed. # Bicicleta language interpreter # Copyright (C) 2007 Kragen Javier Sitaker # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor # Boston, MA 02110-1301, USA numvector = {numvector: # Absurdly inefficient auto-mapping container. nonempty = prog.sys.normal_commutative_number {self: head = 37 tail = numvector.empty new = {op: arg1 = 37, arg2 = numvector.empty '()' = op.arg2.if_ok(op.arg1.if_ok( self { head = op.arg1, tail = op.arg2 })) } cyclic = {op: arg1 = 37 '()' = op.arg1.if_ok(self { x: head = op.arg1, tail = x }) } as_numvector = self show = "[{show_contents}" % self show_contents = "{mine} {tail}" % {mine = self.head.show, tail = self.tail.show} coerce = {op: arg1 = 2 test = (self.head + op.arg1) '()' = arg1.as_numvector !! test.if_ok(self.cyclic(op.arg1)) } add = {op: arg1 = self '()' = self.new(self.head + op.arg1.head, self.tail + op.arg1.tail) } negated = self.new(self.head.negated, self.tail.negated) multiply = self.add {op: '()' = self.new(self.head * op.arg1.head, self.tail * op.arg1.tail) } reciprocal = self.new(self.head.reciprocal, self.tail.reciprocal) # Note that this returns a numvector of, say, booleans, not a # boolean; so we've put them over in the boolvector class to # keep things tidy. less_than = self.add {op: '()' = numvector.boolvector.new(self.head < op.arg1.head, self.tail < op.arg1.tail) } foldr = {op: arg1 = self.new, arg2 = numvector.empty '()' = op.arg1(self.head, self.tail.foldr(op.arg1, op.arg2))} where = {op: arg1 = self index = op.arg1.as_numvector tail = self.tail.where(op.index.tail) '()' = op.index.if_ok(op.index.head.if_true( then = self.new(self.head, op.tail) else = op.tail )) } map = {op: arg1 = 1.'+' '()' = self.new(op.arg1(self.head), self.tail.map(op.arg1)) } } empty = numvector.nonempty {self: show_contents = "]" as_empty_numvector = self add = {op: arg1 = self, '()' = op.arg1.as_empty_numvector.if_ok(self)} multiply = self.add less_than = self.add negated = self reciprocal = self foldr = numvector.nonempty.foldr {op: '()' = op.arg2} where = self.add some = prog.sys.false all = prog.sys.true map = self } boolvector = numvector.nonempty {self: # We have a few methods here to support a boolean protocol # elementwise: not = self.new(self.head.not, self.tail.not) '&&' = self.binop {op: arg1 = self '()' = self.new(self.head && op.other.head, self.tail && op.other.tail) } if_true = {op: then = self, else = self a = self.coerce(op.then) b = self.coerce(op.else) '()' = self.new(self.head.if_true(then=op.a.head, else=op.b.head), self.tail.if_true(then=op.a.tail, else=op.b.tail)) } some = self.head || self.tail.some all = self.head && self.tail.all } new = numvector.nonempty.new } {numfuncwrapper: # Give functions of numbers the operations expected of numbers. coerce = {op: arg1 = 3 '()' = op.arg1.as_numfunc || prog.if( op.arg1(1).is_ok -> numfuncwrapper.lifted { f = op.arg1 }, (op.arg1 + 1).is_ok -> numfuncwrapper.constant { k = op.arg1 }, op.arg1.'&&'.is_ok -> numfuncwrapper.constant { k = op.arg1 }, else = prog.error("can't make {arg1} a numfunc" % op) ) } base = prog.sys.normal_commutative_number {self: arg1 = 3 as_numfunc = self coerce = numfuncwrapper.coerce add = {op: arg1 = self, '()' = numfuncwrapper.sum { f = self, g = op.arg1 } } negated = numfuncwrapper.negated { f = self } multiply = self.add {op: '()' = numfuncwrapper.product { f = self, g = op.arg1 } } reciprocal = numfuncwrapper.reciprocal { f = self } less_than = self.add {op: '()' = numfuncwrapper.less_than { f = self, g = op.arg1 } } map = {op: arg1 = 1.'+' '()' = numfuncwrapper.compose { f = op.arg1, g = self } } } lifted = numfuncwrapper.base {self: f = 2.'*' show = "({f})" % self '()' = f(self.arg1) } negated = numfuncwrapper.base {self: f = numfuncwrapper.lifted fat = self.f(self.arg1) show = "{f}.negated" % self '()' = self.fat.negated } sum = numfuncwrapper.negated {self: g = numfuncwrapper.lifted show = "({f} + {g})" % self gat = self.g(self.arg1) '()' = self.fat + self.gat } product = numfuncwrapper.sum {self: show = "({f} * {g})" % self '()' = self.fat + self.gat } reciprocal = numfuncwrapper.negated {self: show = "{f}.reciprocal" % self '()' = self.fat.negated } with_booleans = {op: arg1 = numfuncwrapper._less_than, '()' = op.arg1 {self: not = numfuncwrapper.not { f = self } '&&' = self.binop {op: arg1 = self, '()' = numfuncwrapper.conjunction { f = self, g = op.arg1 } } # XXX copied and pasted... :( ) if_true = {op: then = self, else = self a = self.coerce(op.then) b = self.coerce(op.else) '()' = numfuncwrapper.case { f = self, g = a, h = b) } } } _less_than = numfuncwrapper.sum {self: show = "{f} < {g}" % self '()' = self.fat < self.gat } less_than = numfuncwrapper.with_booleans(numfuncwrapper._less_than) not = numfuncwrapper.with_booleans(numfuncwrapper.negated {self: show = "{f}.not" % self '()' = self.fat.not }) conjunction = numfuncwrapper.with_booleans(numfuncwrapper.sum {self: show = "{f} && {g}" % self '()' = self.fat && self.gat }) case = numfuncwrapper.conjunction {self: h = numfuncwrapper.coerce(37.'/') hat = self.h(self.arg1) show = "{g} where {f}, otherwise {h}" % self '()' = self.fat.if_true(then=self.gat, else=self.hat) } constant = numfuncwrapper.base {self: k = 22 show = "always({k})" % self '()' = k } compose = numfuncwrapper.sum {self: show = "{f} . {g}" % self '()' = self.f(self.gat) } } # Here's the code from # http://lists.canonical.org/pipermail/kragen-hacks/2005-October/000417.html # using the older, perhaps prettier, but more verbose syntax. # object = { # booleans = { # booleans.true = { # negated = booleans.false # ifTrue = { # then = 1 # else = 0 # x.'()' = x.then # } # self.ifFalse = self.negated.ifTrue # } # booleans.false = booleans.true { # negated = booleans.true # ifTrue = booleans.true.ifTrue { # x.'()' = x.else # } # } # } # object.nil = { # isNil = object.booleans.true # self.'++' = object.unary_function { # arg1 = self # '++'.'()' = '++'.arg1 # } # self.qsort = { # '()' = self # } # } # object.'>=' = object.'<'.negated_function # object.'<=' = object.'>'.negated_function # object.'!=' = object.'=='.negated_function # object.'>' = object.unary_function { # my.'()' = my.arg1.'<' ( # arg1 = object # ) # } # object.unary_function = { # arg1 = "Uninitialized unary function argument" # '()' = "Undefined function result" # function.filter = object.unary_function { # filter.'()' = filter.arg1.isNil.ifTrue ( # then = filter.arg1 # else = function ( # arg1 = filter.arg1.head # ).ifTrue ( # then = filter.arg1.':' ( # arg1 = filter { # arg1 = filter.arg1.tail # } # ) # else = filter ( # arg1 = filter.arg1.tail # ) # ) # ) # } # function.negated_function = object.unary_function { # my.'()' = function ( # arg1 = my.arg1 # ).negated # } # } # self.':' = self.unary_function { # ':'.'()' = self.nil { # isNil = self.booleans.false # head = self # tail = ':'.arg1 # cons.'++' = self.nil.'++' { # '++'.'()' = cons.head.':' ( # arg1 = cons.tail.'++' ( # arg1 = '++'.arg1 # ) # ) # } # self.qsort = { # low = self.head.'<'.filter ( # arg1 = self.tail # ) # high = self.head.'>='.filter ( # arg1 = self.tail # ) # my.'()' = my.low.qsort ( # ).'++' ( # arg1 = self.head.':' ( # arg1 = my.high.qsort ( # ) # ) # ) # } # } # } # } # Here it is, converted to modern syntax, reformatted, with a bug or # two fixed. I can't use ':' any more as an infix operator character, # since now the grammar uses it to declare self-names. So I'm using # '@', which is much inferior. # Note that there are two nested infix expressions here, # head @ (tail ++ arg1) and qsort() ++ (head @ qsort()). Both of # these would benefit from infix operations associating to the right # rather than the left. Probably too early to make the change just # for that, though. object = {object: booleans = {booleans: true = {self: negated = booleans.false ifTrue = {x: then = 1, else = 0, '()' = x.then} ifFalse = self.negated.ifTrue } false = booleans.true { negated = booleans.true ifTrue = booleans.true.ifTrue {x: '()' = x.else} } } nil = {self: isNil = object.booleans.true '++' = object.unary_function {'++': self, '()' = '++'.arg1} qsort = {'()' = self} } '@' = object.unary_function {'@': object.nil '()' = object.nil {cons: isNil = object.booleans.false head = object tail = '@'.arg1 '++' = object.nil.'++' {'++': '()' = cons.head @ (cons.tail ++ '++'.arg1)} qsort = {my: low = cons.head.'<'.filter(cons.tail) high = cons.head.'>='.filter(cons.tail) '()' = my.low.qsort() ++ (cons.head @ my.high.qsort()) } } } '>=' = object.'<'.negated_function '<=' = object.'>'.negated_function '!=' = object.'=='.negated_function '>' = object.unary_function {my: '()' = my.arg1.'<' (object)} unary_function = {function: arg1 = "Uninitialized unary function argument" '()' = "Undefined function result" filter = object.unary_function {filter: '()' = filter.arg1.isNil.ifTrue ( then = filter.arg1 else = function(filter.arg1.head).ifTrue ( then = filter.arg1 @ filter(filter.arg1.tail) else = filter(filter.arg1.tail) ) ) } negated_function = object.unary_function {my: '()' = function(my.arg1).negated } } } # I'm inclined to write a mergesort just for fun. # Note that in this case we have an expression with three infix operators, # and no precedence would make it happy. merge = {m: list(1, 2, 3), list(4, 5, 6) '()' = prog.if( m.arg1.is_nil -> m.arg2, m.arg2.is_nil -> m.arg1, (m.arg1.head > m.arg2.head) -> (m.arg2.head @ m(m.arg1, m.arg2.tail)) else = m.arg1.head @ m(m.arg1.tail, m.arg2), ) } mergesort = {s: list(6, 5, 4, 2, 1, 3), cutpoint = s.arg1.length // 2 # XXX define this // thing first = s.arg1.take(cutpoint) last = s.arg1.drop(cutpoint) '()' = prog.if( s.arg1.is_nil -> s.arg1, else = merge(mergesort(first), mergesort(last)) } # The big loose ends here are: # - strings (and symbols?) # - string.'%' needs slot-value # - some kind of built-in sequence type # - actually implementing the native integer and floating-point # - prog.error; needs DoesNotUnderstand or equivalent # - in a couple of places, we expect if_ok, is_ok, and -> to be # defined on all objects; I think this means that object literal # expressions {} need to be rewritten internally to derive from # prog.sys.object; the smallest bootstrap that would allow this # would be to stick the really empty object in some fixed place, so # things like prog.sys.object could inherit from it.