Skip to content

Instantly share code, notes, and snippets.

@diiq
Created July 31, 2011 01:01
Show Gist options
  • Save diiq/1116216 to your computer and use it in GitHub Desktop.
Save diiq/1116216 to your computer and use it in GitHub Desktop.
SICP make-account in Tainted Oyster
;; This is some code from chapter 3 of SICP. I chose it by going to
;; http://mitpress.mit.edu/sicp/code/index.html , clicking at random
;; and picking the first good, meaty function that caught my eye. It
;; is a demonstration of object orientation by way of functional
;; closures.
(define (make-account balance)
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
(define (dispatch m)
(cond ((eq? m 'withdraw) withdraw)
((eq? m 'deposit) deposit)
(else (error "Unknown request -- MAKE-ACCOUNT"
m))))
dispatch)
(define acc (make-account 100))
((acc 'withdraw) 50)
((acc 'deposit) 50)
## Scheme is not a specifically object oriented language, so here is the same
## function as it would be defined in Python. Note that Python does not
## close functions over integers, so in addition to being idiomatic, a class
## is also easiest.
class Account():
def __init__(balance):
self.balance = balance
def withdraw(self, amount):
if selfbalance >= amount:
self.balance -= amount
return self.balance
else:
return "Insufficient funds"
def deposit(self, amount):
self.balance += amount
return self.balance
acc = Account(100)
acc.withdraw(50);
acc.deposit(50);
# Here is a direct transliteration of the scheme into Tainted Oyster:
make-account <- \balance:
withdraw <- \amount:
if (balance >= amount):
balance <- balance - amount
else:
"Insufficient funds"
deposit <- \amount:
balance <- balance + amount
dispatch <- \m:
cond:
(m == 'withdraw): withdraw
(m == 'deposit): withdraw
t: signal: list "Unknown request -- MAKE-ACCOUNT" m
acc <- make-account 100
(acc 'withdraw) 50
(acc 'deposit) 50
# Here is a more idiomatically Oyster-ish solution:
make-account <- \balance:
account <- 'account
account.type <- 'account
account.withdraw <- \amount:
if (balance >= amount):
balance <- balance - amount
else:
"Insufficient funds"
account.deposit <- \amount:
balance <- balance + amount
account
acc <- make-account 100
acc.withdraw 50
acc.deposit 50
# But Tainted Oyster is designed for metaprogramming, so here is what it might
# look like if someone chose to write an an object orientation framework:
class account:
init balance:
self.balance ← balance
withdraw amount:
if (self.balance >= amount):
self.balance ← self.balance - amount
else:
"Insufficient funds"
deposit amount:
self.balance ← self.balance + amount
acc ← account 100
acc.withdraw 50
acc.deposit 50
# But "object orientation framework"? That sound like a lot of work,
# bulky an gross and hard to wri--- oh wait, here it is:
class ← λ('name 'init ... 'members):
leak: really name
really name ← λ(really: second init):
self ← '(really name)
members ← init :: members
map:
λm: set self.(really: car m):
leak:
self
λ(really: second m): *(rest: rest m)
self
members
self.init *(leak-all: second init)
self
@diiq
Copy link
Author

diiq commented Aug 3, 2011

OK, I fixed the class definition, but now it doesn't do the neat variable-capture trick. It is possible to write a version which does do variable capture --- I'll post that one later --- but the definition of class, already somewhat strained, becomes further convoluted.

Grrr.

@diiq
Copy link
Author

diiq commented Aug 4, 2011

And with 5 more lines, I can add multiple inheritance:

class ← λ('name 'inheritance ... 'members):
    leak: really name
    init ← find-if (λx: first x «is» 'init) members
    init-args ← if init (second init) ()

    it ← really name ← λ(really init-args):
        self ← '(really name)
        it.subclass self
        if init: self.init *(leak-all: init-args)
        self

    it.subclass ← λself:
        map (λ(,class): class.subclass self) inheritance
        map:
            λm: set self.(really: first m): 
                leak: 
                    self
                    λ(really: second m): *(rest: rest m)
                    self
            members
        self

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