go-fringe.go: Language change: `closed' function on channels has gone.

[fringe] / smalltalk-fringe.st

"-*-smalltalk-*-

Smalltalk implementation of a `same-fringe' solver.

Use GNU Smalltalk syntax -- it seems more Emacs-friendly.
"

Object subclass: BasicNode [
    <comment: 'I am provide common behaviour for my subclasses Node and
LeafNode.  Otherwise, I''m not particularly interesting.'>

    iterator [
        "Return a new iterator to walk this node."

        <category: 'iteration'>
        ^NodeIterator for: self
    ]
]

BasicNode subclass: Node [
    | left right data |

    <comment: 'I represent simple binary tree nodes.  My instances consist of
a data object, and left and right subtrees.  The leaves of a tree are
instances of LeafNode.'>
    <category: 'Toys-SameFringe'>

    Node class >> left: aNode data: anObject right: anotherNode [
        "Answer a newly tree Node with the given subtrees and data."

        <category: 'instance creation'>
        ^self new left: aNode data: anObject right: anotherNode
    ]

    Node class >> parse: aString [
        "Answer a newly constructed tree, parsed from aString."

        <category: 'parsing'>
        | stream tree |
        stream := ReadStream on: aString.
        tree := stream parseTree.
        stream atEnd ifFalse: [self error: 'trailing junk'].
        ^tree
    ]

    left: aNode data: anObject right: anotherNode [
        "Initialize a (presumably) new instance."

        <category: 'initialization'>
        left := aNode.
        right := anotherNode.
        data := anObject.
        ^self
    ]

    left [
        "Answer the receiver's left subtree."

        <category: 'accessing'>
        ^left
    ]

    right [
        "Answer the receiver's right subtree."

        <category: 'accessing'>
        ^right
    ]

    data [
        "Answer the receiver's data."

        <category: 'accessing'>
        ^data
    ]

    isLeaf [
        "Answer false, becase the receiver is not a leaf."

        <category: 'testing'>
        ^false
    ]

    inorderTell: aBlock tell: aNodeIterator [
        "This is the hairy part of the iteration protocol.

         The algorithm works like this.  We're meant to wander as far down
         the left of the tree as we can; once we're there, we call
         aNodeIterator with the data we found and a block which will continue
         the iteration over the rest of the tree and finally invoke aBlock.

         Observe that there are no explicit conditionals here.  It's all done
         with object dispatch.  And smoke.  And mirrors.

         Also note that this is tail-recursive.  The `stack' is built up in
         the hairy block constructions, which all go on the heap."

        <category: 'private iteration'>
        left
            inorderTell:
                [aNodeIterator
                    found: data
                    then: [right inorderTell: aBlock tell: aNodeIterator]]
            tell: aNodeIterator
    ]

    sameFringeAs: aNode [
        "Answer whether traversing the receiver inorder yields the same
         objects as traversing aNode."

        <category: 'comparison'>
        | ia ib |
        ia := self iterator.
        ib := aNode iterator.
        [ia atEnd] whileFalse:
            [ib atEnd ifTrue: [^false].
             (ia next = ib next) ifFalse: [^false]].
        ^ib atEnd
    ]

    displayOn: aStream [
        "Write a simple representation of self to the stream."

        <category: 'printing'>
        aStream nextPut: $(;
            display: left;
            display: data;
            display: right;
            nextPut: $)
    ]

    Node class >> main: anArray [
        "Noddy script main program."

        <category: 'command line'>
        [(Dictionary new
            at: 1 put:
                [(self parse: (anArray at: 1)) iterator do:
                     [:char | FileStream stdout nextPut: char].
                  FileStream stdout nl];
            at: 2 put:
                [FileStream stdout display:
                     (((self parse: (anArray at: 1))
                          sameFringeAs: (self parse: (anArray at: 2)))
                              ifTrue: ['match']
                              ifFalse: ['no match']);
                      nl ];
            at: anArray size ifAbsent: [self error: 'bad args'])
            value]
        on: Error do:
            [:error |
                FileStream stderr
                    nextPutAll: 'smalltalk-fringe: ';
                    nextPutAll: error messageText;
                    nl.
                ^1].
        ^0
    ]
]

PositionableStream extend [
    parseTree [
        "Answer a newly constructed tree, parsed from the receiver.

         The syntax is very simple:

                tree ::= empty | `(' tree char tree `)'

         where char is any character.  Ambiguity is resolved by deciding that
         something beginning with `(' where a tree is expected really is a
         tree and not an empty tree followed by the char `('."

        <category: 'parsing'>
        | left data right |

        self peek = $( ifFalse: [^LeafNode instance].
        self next.
        left := self parseTree.
        self atEnd ifTrue: [self error: 'no data'].
        data := self next.
        right := self parseTree.
        self next = $) ifFalse: [self error: 'missing )'].
        ^Node left: left data: data right: right
    ]
]

BasicNode subclass: LeafNode [
    <comment: 'I represent the leaves of a tree of Nodes.  I don''t hold any
kind of interesting state.  My methods provide the base cases for some of the
recursive protocols used to handle Nodes.'>
    <category: 'Toys-SameFringe'>

    instance := LeafNode new.

    displayOn: aStream [
        "Write a simple representation of self to the stream."

        <category: 'printing'>
        "Nothing to do!"
    ]

    isLeaf [
        "Answer true, because the receiver is a leaf node."

        <category: 'testing'>
        ^true
    ]

    inorderTell: aBlock tell: aNodeIterator [
        "This is the hairy part of the iteration protocol.

         But in this case it's simple.  We've overshot the end, so we just
         need to call aBlock to persuade our parent to announce itself to the
         iterator."

        <category: 'private iteration'>
        aBlock value
    ]

    LeafNode class >> instance [
        "Return the unique instance of the leaf node."

        <category: 'singleton'>
        ^instance
    ]
]

Stream subclass: NodeIterator [
    | item rest |

    <comment: 'I hold the state for external iteration of trees of Nodes and
(halfheartedly) implement the Stream protocol.'>
    <category: 'Toys-SameFringe'>

    found: anObject then: aBlock [
        "Stash the newly found item from the hairy iteration protocol.

         When the iteration protocol decides on the next leftmost item to
         return, it gives us anObject that it found, and aBlock which will
         continue until it finds the next object."

        <category: 'private iteration'>
        item := anObject.
        rest := aBlock.
    ]

    NodeIterator class >> for: aNode [
        "Answer a new iterator for the tree starting at aNode."

        <category: 'instance creation'>
        ^self new walk: aNode
    ]

    walk: aNode [
        "Start walking a subtree starting at aNode.

         We get the node to iterate itself and finally tell us that it's
         finished."

        <category: 'initialization'>
        aNode inorderTell: [rest := nil] tell: self
    ]

    next [
        "Answer the next element from the tree, or nil if we've hit the end."

        <category: 'reading'>
        | it |
        rest ifNil: [^nil].
        it := item.
        rest value.
        ^it
    ]

    peek [
        "Answer the next element without removing it."

        <category: 'reading'>
        rest ifNil: [^nil] ifNotNil: [^item]
    ]

    atEnd [
        "Answer whether we have reached the end of the iteration."

        <category: 'testing'>
        ^rest isNil
    ]
]