SABLE Programming Language
Copyright © 2008 Kuler Software Tools — All rights reserved
Now let's have some fun! This example is adapted from Microsoft .NET for Programmers by Fergal Grimes, published by Manning. I highly recommend this excellent book for those new to the CLR; it uses C#, but rather than focusing on a particular language, it gives a tour of the many application deployment options available on the platform. As such, it demonstrates many different uses for .NET, from Windows Services to mobile web applications.
This example is used by permission of the publisher. They have made the C# code available. Please compare the SABLE version, but be aware it's not a direct translation. SABLE uses idioms not common in C#, making some patterns easier to codify, leading to a slightly different approach in some areas. Since our focus is on a particular language, we're only going to look at the simplest deployment option, a text-based console application which doesn't cheat. Some classes and methods in the book are unused in this application, so we omit them here.
This program uses a number of library messages which we haven't defined, but I'm sure you'll understand what they do from their names.
The player begins with 100 credits and each round bets 1-5 credits. The application "deals" 5 cards and displays them as text, and the player selects which cards (if any) to hold by entering digits 1-5. Finally, the application replaces the cards not selected, prints the modified hand, scores it, and updates the player's credits. A pair of Jacks or better wins credits, with better hands winning more credits.
Enter amount of bet (1-5): 5 Betting 5... 9C 3S 5H 5S TD Enter all card numbers (1 to 5) to hold: 34 6S 5C 5H 5S 7H - Three of a Kind (Score=4, Bet=5, Win=20) Credits Remaining: 115
SABLE assemblypoker.dll {~ library reference: 'mscorlib.dll'; use: #System} {@ System.Reflection.ASSEMBLY_VERSION: '1.0.0.0'}
The heart of the application is deployed as a library (DLL). Then various deployments, including our console-based executable, reuse the same library.
/-#PokerCARD {~ object secret} "Represents a single card from a standard 52-card deck." {~ constants public} |NumberString| := '23456789TJQKA'. |SuitString| := 'CDHS'. {~ durables public} |number| {INT32}. "-Card value 2..14, 14 is Ace" |suit| {INT32}. "-Card suit as number 1..4" |name| {STRING}. "-E.g. 'AS' for Ace of Spades" +-'constructors'newRandom: randomON {RANDOM?}. "Create a new CARD, randomly generated using the given randomizer or a new one if given Nil." |random| := randomON ifNil: [{RANDOM} new]. number := random nextFrom: 2 until: 15. "Random card 2..14" suit := random nextFrom: 1 until: 5. "Random suit 1..4" name := {STRING} fromChars: #(NumberString at: number - 2, SuitString at: suit - 1). newNamed: name {STRING}. "Create a new CARD with the given name, which must be valid (e.g. 'TD' for Ten of Diamonds)." {~ require: 'name has two characters' as: [name size = 2]} {~ require: 'name has valid number' as: [NumberString contains: name @ 0]} {~ require: 'name has valid suit' as: [SuitString contains: name @ 1]} |num| := name @ 0. |suit| := name @ 1. My.number := (NumberString indexOf: num ifAbsent: [^^^{EXCEPTION} newMessage: 'Bad card number in ' + name] ) + 2. My.suit := (SuitString indexOf: suit ifAbsent: [^^^{EXCEPTION} newMessage: 'Bad suit letter in ' + name] ) + 1. My.name := name. =-'object protocol'equals: other {CARD} {~ ifMismatch: [^False]} ^{BOOLEAN}. {~ override} ^other.number = number and: [other.suit = suit] hashcode ^{INT32}. {~ override} ^suit << 4 + number to_STRING ^{STRING}. {~ override} ^name
There is one major feature of note here. The signature of >#indexOf:ifAbsent: accepts a block resulting in {INT32}, to specify a default value if the searched element isn't found.
"In STRING"indexOf: value {CHAR} ifAbsent: absentBlock {BLOCK[^INT32]} ^{INT32}. {~ macro} ^(My indexOf: value) ifLess: [absentBlock value] "usage"|result| := NumberString indexOf: num ifAbsent: [NumberString size].
But in >#newNamed: we saw it throw an exception instead. A block can end with any result statement in place of its result value; it simply branches away. This makes blocks extremely versatile while producing elegant and efficient code. The primary behavior there is assigning the fields number and suit, while testing for and throwing the exception are secondary considerations. SABLE highlights this fact. If you translate those lines to C# with the same efficiency, you can get shorter code, but it reverses the two, bringing the exception tests to prominance and burying the field assignments. (Left as an exercise for the reader.)
/-#PokerHAND {~ object} "Represents a 5 card poker hand, with facilities for calculating its score (more rare card combinations get a better score), and for drawing cards to replace those discarded by the player." {~ constants} |titles| := 'No Score//Jacks or Better/Two Pair/Three of a Kind/Straight/' 'Flush/Full House/Four of a Kind/Straight Flush/Royal Flush' split: #($/). {~ fields} |score| := -1. |cards| := {ARRAY[CARD]} new: 5. |isHeld| := {ARRAY[BOOLEAN]} new: 5. "All False by default" +-'constructors'newRandom: randomON {RANDOM?}. "Create a new HAND, randomly generated using the given randomizer or a new one if given Nil." |random| := randomON ifNil: [{RANDOM} new]. 0 until: 5 do: [:i | "Ensure we don't generate the same card twice into the hand." [cards at: i put: ({CARD} newRandom: random). Me doesCardArray: cards contain: cards @ i before: i. ] whileTrue]. fromHand: hand {HAND} holding: holdCards {STRING} random: randomON {RANDOM?}. "Initialize this hand from :hand, holding the cards indexed in :holdCards, and replacing the others using the given randomizer." cards := hand.cards cloned. Me holdCards: holdCards; draw: randomON. fromText: handText {STRING}. "Create this hand from the $SPACE-separated card names in :handText. There must be exactly five." Me cardsFromString: handText. fromText: handText {STRING} holding: holdCards {STRING} random: randomON {RANDOM?}. "Initialize from card names in :handText, holding those indexed in :holdCards, and replacing the others using the given randomizer." Me cardsFromString: handText; holdCards: holdCards; draw: randomON. =-'accessing'cardName: cardIndex {INT32} ^{STRING}. "Get the name of the card by 1-based index (card 1..5)." {~ require: 'valid card index' as: [[1 <= cardIndex] && [cardIndex <= 5]]} ^(cards at: cardIndex - 1) name score ^{INT32}. "The score of this hand, a multiplier times the bet that the hand wins; 0 for a losing hand." score < 0 then: [Me calculateScore]. ^score text ^{STRING}. "A space-separated list of my card's names." ^(My cardName: 1) + ' ' + (My cardName: 2) + ' ' + (My cardName: 3) + ' ' + (My cardName: 4) + ' ' + (My cardName: 5) title ^{STRING}. "A meaningful name for the value of this hand, given its score." ^titles @ My score =-'helpers' topsecretcalculateScore. "Compute the score of this hand." "Are cards all of the same suit?" |suit1| := cards first suit. |isFlush| := cards allSatisfy: [:card | card suit = suit1]. "Sort card values." |sortedValues| := cards collect: [:card | card number]. sortedValues sort. "Calls [ARRAY sort: sortedValues]" "Do we have a straight?" |partialStraight| := True. 0 until: 3 do: [:i | ((sortedValues @ i) + 1) ~= (sortedValues @ (i + 1)) then: [partialStraight := False]]. |isStraight| := partialStraight and: [(sortedValues @ 3 + 1) = (sortedValues @ 4)]. "Is it a straight to the ace?" |isTopStraight| := isStraight and: [sortedValues @ 4 = 14]. "Maybe it's a straight from the ace (i.e. 2, 3, 4, 5, A)." (partialStraight and: [sortedValues @ 3 = 5 and: [sortedValues @ 4 = 14]]) then: [isStraight := True]. "Count pairs, and maintain the number of pairs we see consecutively." |pairIndex| := 0. |numPairs| := 0. |numConsecutivePairs| := 1. 0 until: 4 do: [:i | (sortedValues @ i) = (sortedValues @ (i + 1)) then: [pairIndex := i. numPairs := numPairs + 1. [i > 0] && [(sortedValues @ i) = (sortedValues @ (i - 1))] then: [numConsecutivePairs := numConsecutivePairs + 1] ]]. "Now calculate score..." score := IF test if: [isTopStraight & isFlush] then: [10]; "-Royal flush" if: [isStraight & isFlush] then: [ 9]; "-Straight flush" if: [numConsecutivePairs = 3] then: [ 8]; "-Four of a kind" if: [numPairs = 3] then: [ 7]; "-Full house" if: [isFlush] then: [ 6]; "-Flush" if: [isStraight] then: [ 5]; "-Straight" if: [numConsecutivePairs = 2] then: [ 4]; "-Three of a kind" if: [numPairs = 2] then: [ 3]; "-Two pair" if: [numPairs = 1 & (sortedValues @ pairIndex > 10)] then: [ 2]; "-Pair" else: [0]. "-Zero, zilch, nada" cardsFromString: handText {STRING}. "Set my cards from five space-separated card names in :handText." |cardStrings| := handText split: ##($SPACE). cardStrings size ~= 5 then: [^^^{EXCEPTION} newMessage: 'Bad hand; 5 cards are required']. 0 until: 5 do: [:i | cards at: i put: ({CARD} newNamed: cardStrings @ i)]. doesCardArray: cardsDealt {ARRAY[CARD]} contain: card {CARD} before: count {INT32} ^{BOOLEAN}. "Does :cardsDealt contain card :card before index :count?" 0 until: count do: [:i | cardsDealt @ i = card then: [^True]]. ^False draw: randomON {RANDOM?}. "Draw new cards, replacing those which are not being held. Use the given randomizer, or a new one if it's Nil." "Remember which cards player has seen." |numSeen| := 5. |seen| := {ARRAY[CARD]} new: 10. cards startingFrom: 0 copyTo: seen atIndex: 0 count: 5. |random| := randomON ifNil: [{RANDOM} new]. 0 until: 5 do: [:i | isHeld @ i ifFalse: [[cards at: i put: ({CARD} newRandom: random). Me doesCardArray: seen contain: cards @ i before: numSeen ] whileTrue: [seen at: numSeen put: cards @ i. numSeen += 1]]]. holdCards: holdCards {STRING}. "Mark the cards listed in :holdCards by index 1-5 as being held. Ignore any characters other than digits 1-5." 0 until: 5 do: [:i | isHeld at: i put: (holdCards contains: $1 + i) ]. =-'object protocol'to_STRING ^{STRING}. {~ override} ^My text
This contains some improvements over the original algorithms in C#, with significant improvement in >#calculateScore, resulting in shorter, cleaner code. This is not to insult the original author. Language is a tool, and this author simply had a better tool: SABLE.
This class sent messages to its CARDs, >#name, >#suit, and >#number. But CARD did not define those methods; those are the names of its fields. As previously mentioned, only the declaring class or subclasses can reference its fields using dot notation, no matter what is their accessessibility. Instead, SABLE allows accessing them with messages. This maintains Smalltalk's emphasis on using messages instead of direct field access, without its requirement to declare getter and setter methods for every field.
/-#PokerBET {~ object} "Calculates the actual bet amount based on the requested bet and remaining credits, and provides a way to report what it did." {~ durables public} |amount| {INT32}. |credits| {INT32}. |message| {STRING}. +-'constructors'bet: bet {INT32} credits: creditsRemaining {INT32} min: minBet {INT32} max: maxBet {INT32}. |maxBet2|. IF test if: [creditsRemaining < minBet] then: [message := 'You don''t have enough credits to bet... Game over!'. amount := 0]; if: [bet < minBet] then: [message := 'You must bet the minimum... betting {0}.' format: minBet boxed. amount := minBet]; if: [(maxBet2 := maxBet min: creditsRemaining) < bet] then: [message := 'You can only bet {0}... betting {0}.' format: maxBet2 boxed. amount := maxBet2]; else: [message := ''. amount := bet]. credits := creditsRemaining - amount.
/-#PokerMACHINE {~ interface} "Represents the Video Poker machine, with facilities for dealing and drawing hands. A machine can have different minimum and maximum bets, and different starting credits." =-'card dealing'deal ^{HAND}. {~ abstract} "A new poker hand, effectively dealt from a newly-shuffled deck." draw: oldHand {HAND} holding: holdCards {STRING} ^{HAND}. {~ abstract} ":oldHand, with cards not indexed in :holdCards replaced." drawText: oldHand {STRING} holding: holdCards {STRING} ^{HAND}. {~ abstract} ":oldHand, with cards not indexed in :holdCards replaced." =-'properties'maxBet ^{INT32}. {~ abstract} "The maximum allowed bet." minBet ^{INT32}. {~ abstract} "The minimum allowed bet." startCredits ^{INT32}. {~ abstract} "The number of credits a new player starts with."
/-#PokerSIMPLE_MACHINE {~ object parent: MACHINE} "This is a very simple Video Poker machine with fixed defaults values. It doesn't cheat, always playing the cards it 'deals'." {~ durables} |random| {RANDOM}. +-'constructors'new. random := {RANDOM} new. =-'card dealing'deal ^{HAND}. ^{HAND} newRandom: random draw: oldHand {HAND} holding: holdCards {STRING} ^{HAND}. ^{HAND} fromHand: oldHand holding: holdCards random: random drawText: oldHand {STRING} holding: holdCards {STRING} ^{HAND}. ^{HAND} fromText: oldHand holding: holdCards random: random =-'properties'maxBet ^{INT32}. ^5 minBet ^{INT32}. ^1 startCredits ^{INT32}. ^100
This program validates that the scoring algorithm is working properly.
SABLE assemblypokertest.exe {~ console entryClass: #Poker.POKER_TEST method: #main; reference: 'mscorlib.dll'; use: #System; reference: 'poker.dll'; use: #Poker} {@ System.Reflection.ASSEMBLY_VERSION: '1.0.0.0'} /-#PokerPOKER_TEST {~ object} *-'application'assert: handCards {STRING} scores: expectedScore {INT32}. "Print the given hand and its score, with an additional tag to draw attention to any hand which doesn't score as expected." |hand| := {HAND} fromText: handCards. |score| := hand score. |problem| := score ~= expectedScore then: [' NO MATCH!']. CONSOLE writeLine: '{0} {1: 0}{2}' with: hand text with: score boxed with: problem. main. "Test the poker HAND scoring algorithm." THIS_CLASS assert: 'AS QS TS JS KS' scores: 10; assert: 'KC QC TC JC AC' scores: 10; assert: '9C QC TC JC KC' scores: 9; assert: '3C 6C 4C 2C 5C' scores: 9; assert: '3C AC 4C 2C 5C' scores: 9; assert: '2D TC TS TH TD' scores: 8; assert: 'TC 2D TS TH TD' scores: 8; assert: 'TC TS 2D TH TD' scores: 8; assert: 'TC TS TH 2D TD' scores: 8; assert: 'TC TS TH TD 2D' scores: 8; assert: '3C 3S 3H 9D 9C' scores: 7; assert: '3C 3S 9D 3H 9C' scores: 7; assert: '3C 9D 3S 3H 9C' scores: 7; assert: '9D 3C 3S 3H 9C' scores: 7; assert: '9D 3C 3S 9C 3H' scores: 7; assert: '9D 3C 9C 3S 3H' scores: 7; assert: '9D 3D 5D AD TD' scores: 6; assert: 'AS QS TS JS KD' scores: 5; assert: 'KC QC TS JC AC' scores: 5; assert: '9C QC TC JC KD' scores: 5; assert: '3C 6C 4C 2H 5C' scores: 5; assert: '3S AC 4C 2C 5C' scores: 5; assert: '3C 3S 3H 9D TC' scores: 4; assert: '3C 3S 9D 3H JC' scores: 4; assert: '3C 9D 3S 3H QC' scores: 4; assert: '9D 3C 3S 3H KC' scores: 4; assert: '4D 3C 3S 9C 3H' scores: 4; assert: '2D 3C 9C 3S 3H' scores: 4; assert: '9D 3C 3S KH KC' scores: 3; assert: '4D 3C 4S 9C 3H' scores: 3; assert: '2D 9C 9C 3S 3H' scores: 3; assert: '4D 3C KS TC KH' scores: 2; assert: 'JD 9C 5C 3S JH' scores: 2; assert: '2D QC 5C QS KH' scores: 2; assert: '4D 3C 4S TC KH' scores: 0; assert: '2D 9C 5C 3S 3H' scores: 0; assert: '2D 9C 5C 3S KH' scores: 0. CONSOLE writeLine: 'End POKER_TEST'.
Finally, we see the program which plays the game.
SABLE assemblypokercon.exe {~ console entryClass: #POKER_CONSOLE method: #main; reference: 'mscorlib.dll'; use: #System; use: #System.Collections; use: #System.Text; reference: 'poker.dll'; use: #Poker} {@ System.Reflection.ASSEMBLY_VERSION: '1.0.0.0'} /-#''POKER_CONSOLE {~ object} {~ fields topsecret} |machine| {MACHINE}. |minBet maxBet uiCredits uiBet| {INT32}. *-'entrypoint'main. {POKER_CONSOLE} new playGame. +-'constructors'new. =-'methods'playGame. "Play a series of hands until the user requests to stop or runs out of credits." Me printGreeting. machine := {SIMPLE_MACHINE} new. minBet := uiBet := machine minBet. maxBet := machine maxBet. uiCredits := machine startCredits. [uiCredits >= minBet] whileTrue: [Me playOneHand ifTrue: ["Exit requested" ^Void]]. CONSOLE writeLine: '*** Loser! *** :-)'. playOneHand ^{BOOLEAN}. {~ nonfunctional} "Play one hand of poker. Answer: Was exit requested?" CONSOLE write: 'Credits Remaining: {0}$LINE`' '$LINE`' 'Enter amount of bet ({1}-{2}): ' lineEscaped with: uiCredits boxed with: minBet boxed with: maxBet boxed. |reply| := CONSOLE readLine ifNil: [^True]. |newBet|. [newBet := INT32 parse: reply] try "-If the bet isn't a number," catch: [:exc | newBet := uiBet]. "- then use the previous bet." newBet = -1 then: [^True]. "-Exit program on a bet of -1." |bet| := {BET} bet: newBet credits: uiCredits min: minBet max: maxBet. |uiBet| := bet amount. uiCredits := bet credits. bet message isEmpty then: [CONSOLE writeLine: 'Betting {0}...' with: uiBet boxed] else: [CONSOLE writeLine: bet message + '$ALERT' escaped]. |dealHand| := machine deal. CONSOLE writeLine: '{0}' with: dealHand. CONSOLE write: 'Enter all card numbers (1 to 5) to hold: '. |holdCards| := CONSOLE readLine ifNil: [^True]. |drawHand| := machine draw: dealHand holding: holdCards. |uiWin| := drawHand score * uiBet. uiCredits := uiCredits + uiWin. |uiMsg| := drawHand to_STRING + ' - ' + drawHand title + ' (Score=' + drawHand score boxed + ', Bet=' + uiBet boxed + ', Win=' + uiWin boxed + ')'. CONSOLE writeLine: uiMsg. ^False printGreeting. CONSOLE write: '$LINE`' 'Welcome to the Console Version of Video Poker.$LINE`' 'Cards are numbered 1 to 5 from left to right.$LINE`' 'To hold cards, enter card numbers and hit Enter.$LINE`' 'You may bet 1 to 5 credits each hand.$LINE`' 'To exit, hit Ctrl-C, end the input stream, or bet -1.$LINE`' lineEscaped.
The only thing new here is STRING>~>#+:. As you would expect, this is optimized to concatenate all chained arguments in a single method call.