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

I've finally got enough of the interpreter assembled to actually try my wild claims --- and it turns out that this class definition does NOT work, for exactly the sort of unexpected scoping reason I designed oyster to avoid.

class ← λ('name 'args ... 'members):
    leak: really name
    really name ← λ(really args):
        return ← name
        return.type ← name
        map:
            λm:
                return.(really: car m) ← λ(really: car: cdr m): 
                        *(cdr: cdr m)   # This code is not in the same scope as balance
                                             # even though it appears to be
            members
        return

When the individual methods of the class are created, the code inside belongs in the method is scoped to match the global scope --- the scope where it was written. So even though the methods appear to have been written in a scope where balanced is defined, and the functions are built in a scope where balance is defined, the code executes in the scope where it was created --- and fails to find the variable balance --- or worse, could find the wrong one.

The class definition can be fixed, but not without some loss of clarity. I'll post the correct version when I decide what it should be.

That reminds me of something I forgot to mention re:

return.(really: car m) ← λ(really: car: cdr m): 

This line is a example of why M-expressions are sometimes nice:

return[car m] ← λ(really: car: cdr m):

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