SICP make-account in Tainted Oyster

1-make-account.scm

;; 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)

2-make-account.py

## 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);

3-make-account.oy

# 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

See, I'm hoping to reserve that notation for slices:

xs ← '(a b c d e f g)
xs-slice ← xs[2 4]

would return an object that behaved like a list (c d), but would still be a reference to the original list; first xs-slice == 2, and rest xs-slice would be another slice, like what would have been returned by xs[3 4]. rest rest xs-slice would be nil.

I suppose one could make the same syntax do both, depending on the type of the argument...

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.

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