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

Line counts:

• Scheme: 14
• Python: 12
• Oyster transliteration: 13
• more idiomatic Oyster: 11
• Oyster OO: 10

The gussied-up OO oyster version including the class function still only adds up to 25 lines: there would be a total space savings after only a few short class definitions. Metaprogramming is terse. Cool.

Of course class is foolishly simplistic; it would be good to allow methods of no arguments, accessors, setters, and so on.

Edit 2: Finally fixed formatting, but had to write <- as ←

There are a couple things that didn't look right I had questions about. I forked and made some
changes, but it you may have to actually clone that gist (shown under Forks, above) to see
the diff. I couldn't find a way online.

Could you write the while loop in the definition of class as

map (\m:
        return.(really first m) ← \(really second m):
            *(rest: rest m))
    members

or

foreach members: \m:
    return.(really first m) ← \(really second m):
        *(rest: rest m))

(guessing that you both have or I could write map and/or foreach and that they look like that)

Also, I don't follow what really really means.

Absolutely you could do both of those, though I would write foreach without the lambda (and
those really's need colons. I forgot them in the example above):

foreach m members:
    return.(really: first m) ← \(really: second m):
        *(rest: rest m))

I just tossed out a class definition to see if I could, and I was in the midst of writing bad C,
so I wrote it like bad C. I've corrected to the map version :)

[I'll be wordy for the sake of other readers] So, as you suggested some time ago, an argument
in a lambda-list can be wrapped with a function. To make a fexpr, that function is quote:

my-if <- \(test 'then 'else): if test ,then ,else (where , is eval)

But that function doesn't have to be quote; it can be anything:

my-typed-function <- \((x <<of-type>> fizzbin)): print "X is a fizzbin!"

However, when an argument is wrapped in really and a lamda-list-element is wrapped
in a function, that function is ignored --- and the argument value is 'really' used, not some
proxy value. So leak with a single argument has the signature:

\('symbol)

by passing it really name I am telling it to actually use the value bound to name, and don't
worry about quoting.

Note that I have NOT settled on the symbol really yet --- but it's what it is right now.

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