[prev] [up] [next]

Smalltalk for Lispers (and Schemers)

Introduction

Besides the fundamental difference of function-oriented versus object oriented, Smalltalk shares a lot of other aspects, ideas and mechanisms with the Lisp programming language and systems, in particular with Scheme. This document shows some of them.

Please try to understand them - even if you are not a lisper, and even though some of them seem to be of academic interest only ;-)
It may also be very interesting to read, if you are a smalltalker !

Top-level and Read-Eval-Print-Loop (REPL)

Although present in some ST versions, this is usually deeply hidden behind a graphical user interface, and called "doIt".

Try opening a workspace and enter some expressions there (aka: select and "doIt").

In Smalltalk/X, a "real" Read-Eval-Print-Loop is entered when either the display connection cannot be established, or by the "startup.rc"-file explicitely demanding for it, or if ST/X is started with the "--eval" or the "--repl" command line option .
Also, a debug REPL can be entered by pressing CTRL-c (Interrupt-Key) into the terminal (console) window, from which ST/X was started.

Garbage Collection

As in Lisp, Smalltalk completely handles all administrative jobs with respect to allocation and reclaiming of memory storage used for objects, stack, functions, classes and methods.
It also cares for automatic finalization (i.e. closing and freeing) of underlying operating system resources, for example when a handle to an open file is reclaimed (in this case, the underlying file is closed) or when a graphic resource is no longer referenced (eg. a bitmap handle is freed).

Symbol Atoms

Like Lisp, Smalltalk provides atomic character strings, called "symbols". In Smalltalk, these behave much like strings, with the exception of being read-only (i.e. their character elements cannot be changed) and being unique (i.e. they can be compared using the identity compare operator #'==', as opposed to strings, which should be compared using the equality operator #'=').
The Smalltalk message "asSymbol" corresponds to Scheme's "string->symbol" function.

In addition, numbers (floats, fractions and integers) and array literals are very similar to the corresponding Lisp types.

Cons Cells and Lists

Standard Smalltalk does not define or mandate objects similar to lists or cons cells, although these could be easily added as library functions (and are in ST/X).
A standard syntax for literal conses has not been defined, and will probably never be, as lists do not play that dominant role in Smalltalk as they do in Lisp (however, there are classes like Association, LinkedList, etc. which provide some of the cons cell functionality. And ST/X actually includes a Cons class)

Literals

Much like in Lisp, literal constants are compiler generated objects (values). There are numbers, strings, symbols, characters, arrays and byteArrays. In ST/X, additionally supports inline objects and typed numeric arrays.

In Smalltalk, hexadecimal integer constants are prefixed with "16r", binary integers with "2r". Actually, any number base (up to 36) can be used. ST/X also allows C-language prefixes "0x", "0o" and "0b".

Blocks vs. Lambdas

Smalltalk provides block-literals, which are partially initialized lambda objects: the code is created at compile time, whilst the environment (closure) is created at execution time. The implementation details vary among the different Smalltalk systems, but in general, the semantic is the same as that of lambda functions in Scheme.

Values

Like Lisp's, Smalltalk objects are values. Like in Lisp, there is no concept of memory or storage - everything is (a reference to) an object.
As in Lisp, only references are passed around (and - unlike pure Lisp - sometimes stored into other objects).

eq? and equal?

Translate directly to the identity operator #'==' and the equality operator #'='. The identity operator #'==' is defined for every object (in the inherited Object superclass) and never redefined (actually, most Smalltalk compilers even inline that operation, effectively preventing it technically from ever being redefined).
The equality operator #'=' is typically redefined to compare an object's contents vs. another object's contents.

In Lisp:

    (eq? 'aaa 'aaa)      -> #t
    (eq? "aaa" "aaa")    -> #f (see note below)
    (equal? 'aaa 'aaa)   -> #t
    (equal? "aaa" "aaa") -> #t
In Smalltalk:
    #aaa == #aaa         -> true
    'aaa' == 'aaa'       -> false (see note below)
    #aaa = #aaa          -> true
    'aaa' = 'aaa'        -> true
even the possible bugs are similar: In Lisp:
    (eq? 1 1.0)        -> #f
    (eqv? 1 1.0)       -> #t
    (equal? 1 1.0)     -> #t / #f (undefined?)
    (= 1 1.0)          -> #t

    (eq? (1/3) (3/9))    -> #f
    (eqv? (1/3) (3/9))   -> #t
    (equal? (1/3) (3/9)) -> #t / #f (undefined?)
    (= (1/3) (3/9))      -> #t
In Smalltalk:
    1 == 1.0             -> false
    1 = 1.0              -> true
    1 closeTo: 0.999999  -> true

    (1/3) == (3/9)       -> false
    (1/3) = (3/9)        -> true
    (1/3) closeTo: (3/9) -> true
Note: some compilers generate code which shares constants within a compilation unit. This means, that sometimes you might get a true answer here, because the compiler reuses the string literal, making them "identical".

As a consequence of eq/== vs. equal/=, there are variations of other functions, which depend on the comparison method used:
In Lisp:

    (memq? ...)      - compare using eq?
    (member? ...)    - compare using equal?
    (assq? ...)      - find association using eq?
    (assoc? ...)     - find association using equal?
In Smalltalk:
    coll includesIdentical:el   - compare using ==
    coll includes:el            - compare using =
    IdentityDictionary at:key   - find in hashtable using == (identity)
    Dictionary at:key           - find in hashtable using = (equality)

Mutability of Literals

In ST/X, compiler generated literal constants are immutable. An exception will be raised if the program attempts to modify it. Many Scheme implementations show a similar behavior.

Variables

Much like in Lisp, variables are simple bindings, which associate names with objects. These associations are collected in so called environments (technically, a kind of Dictionary) in a scoped fashion. Inner scopes can access or overwrite bindings for variables which are defined in outer scopes.
The outermost scope is a globally visible environment (i.e. accessible from everywhere) and is called "Smalltalk". A method's or block's environment is kept in an object called "Context". These hold additional reflection information (such as "who called be", and "what is my code") in addition to the pure binding information. Contexts roughly correspond to Scheme's continuations.

Smalltalk/X provides the following scoped variable environments:

  Smalltalk (globals, all classes)
    Namespace (visible in all members)
      ClassVariables (visible in a class and all of its subclasses; shared among class and subclasses)
	ClassInstanceVariables (visible in all methods of a class, private in each class)
	InstanceVariables (visible in all methods of an instance)
	  MethodArguments (visible within a single method)
	     MethodLocals (visible within a single method)
	       BlockArguments (visible within a block)
		 BlockVariables (visible within a block)
		   <nested block arguments and variables>
    SharedPools (visible in all classes which announce interest in a particular pool)
    WorkspaceVariables (visible in all workspaces for DoIts)
      DoItVariables (visible in a single DoIt-evaluation)
The special Workspace- and DoIt- environments are only visible inside so called "workspaces", which are user interfaces for read-eval-print interpreters.

Arithmetic

is virtually identical from a semantic viewpoint. Big integers in Lisp:
    (* 123456789012345678901234567890 123456789012345678901234567890)
	-> 15241578753238836750495351562536198787501905199875019052100
correspond to LargeIntegers in Smalltalk:
    123456789012345678901234567890 * 123456789012345678901234567890

there are fractions (rational numbers) which are exact and are reduced. In Lisp:

    (* (/ (/ 1 3) 3) 9)   -> 1
versus Smalltalk:
    ((1 / 3) / 3) * 9     -> 1

In Smalltalk, arithmetic operators are actually simple message sends (aka. the language does not imply any particular semantics into those messages). Any method name (i.e. "operator") can be redefined and is comparable to a generic function in lisp. Therefore, no precedence or associativeness is implied; much like in Lisp, these are simply evaluated from left to right.
i.e.

    1 + 2 * 3
evaluates to 9 (left to right).

BuiltIn Types

Smalltalk does not (directly) provide a builtIn type comparable to Lisp's dotted pairs (lists). If required, these must be added via a Cons class, or simulated using other collections (OrderedCollections, Sets etc.).

Other types are (almost) directly mapped:
#b0101
Class/
Type
LispSmalltalkSmalltalk/X
Boolean #t
#f
true
false
String "foo"'foo'c'foo'
e'foo'
Character #\x$x
Integer 1234
#xFF
13452
16rFF
2r0101

0xFF
0b0101
Float 1.4e31.4e31.4f3
Fraction 1/31/3
Decimal 1.4s3
Complex 5+3i 5+3i
Symbolic Atom 'foo#'foo'
#foo
Cons a . b as Cons class
List (a ... b) as Cons class
nil nil
()
nil
Array #(a b...)#(a b...)
(vector a b...){a . b . ...}
ByteArray #u8[b1 b2...]#[b1 b2...]
typed Array #xx[b1 b2...] #xx[b1 b2...]
Function (lambda () body)
(lambda (x) body)
[body]
[:x | body]

Notice:
Conses can easily be added. Or, be replaced by associations (a->b), which are present and standardized in all Smalltalk implementations. Smalltalk/X contains a Cons class.

Notice:
ByteArrays do not really add any semantic functionality - they can be easily simulated using regular arrays. However, they require less memory and are therefore useful to represent bulk data. More such specialized bulk-data holder collections might exist in a particular Smalltalk dialect; look for classes like "FloatArray", "IntegerArray" etc.

Notice:
The brace array constructor "{...}" generates an array-instance, by evaluating its list element expressions at run time. In contrast to the "#(...)" construct, which defines a literal which is constructed from other literal constants at compile time. In Lisp, the corresponding would be "#(...)" as opposed to "(vector ...)".

Lambda

A Smalltalk block is what you know as a lambda. Blocks allow pretty much the same as lambdas do in Lisp: they are first class objects, which means, that they can be passed as argument, stored as value in variables or returned as value of other blocks or methods.
Whereas a Lisp-lambda is evaluated by putting it into the function position of a form, Smalltalk-blocks are evaluated by sending them a variant of the value message.

The corresponding code for defining a function in Lisp:

    (lambda (a b c) (... expression...))
becomes:
    [:a :b :c | ... expression...]
to evaluate such a function, place it in the function position of an expression in Lisp:
    (someFunction 1234)
which in Smalltalk becomes a message send of a value or value: message to the block:
    aBlock value:1234

Like Lisp functions, blocks can be nested and access their statically enclosing scope's variables.

For example, the following Lisp code:

    (define make-adder
	(lambda (n)
	    (lambda (x)
		(+ x n))))

    (define add-two (make-adder 2))

    (add-two 1)

    -> 3

translates almost directly into the Smalltalk code:

    makeAdder := [:n | [:x | x + n]].

    addTwo := makeAdder value:2.

    addTwo value:1
    -> 3
Notes / Description:
- makeAdder is a lambda which evaluates to a lambda.
- Lambdas are closures; i.e. they remember their defining environment.
- in Smalltalk, a block corresponds to a lambda; it is evaluated by sending it a value[:] message.
- hyphens are not valid in Smalltalk-identifiers, the names have been translated according to Smalltalk camelCase convention
- makeAdder is a block which evaluates to a block.
- Blocks are closures; i.e. they remember their defining environment.
Much like lambdas in Lisp, Smalltalk blocks are used as functional arguments for map-like operations (do:, collect:, select:, detect:, findFirst: etc), or to control behavior (sort-order, catch-behavior, exception handling etc.) or as callbacks from UI elements or timers.
The Lisp expression to generate a list of squared values:
    (map values (lambda (x) (x * x))
is written in Smalltalk as:
    values collect:[:x | x * x]

As another demonstration (and proof) of how blocks behave like lambdas, the following snippet implements memoised block (functions).
A memoised block remembers the value which was previously returned for some given argument, and immediately returns it without recomputing the value.

    "/ you should have "autodefine workspace variables" enabled
    "/  in the workspace's settings (so the names below need not be declared first).

    "/ a block(-function), which returns factorial(n)
    FAC := [:n | n factorial ].

    "/ a block(-function),
    "/  which generates and returns a memoised version if a given block(-function)
    "/ notice that the memory (table) is inside a closure, and an inner function
    "/ is returned. The table is completely hidden from the outside world.
    MEMO := [:fun |
		|table|

		table := Dictionary new.
		[:arg | table at:arg ifAbsentPut:[ fun value:arg ] ]
	   ].

    "/ generate a memoised version of FAC
    MFAC := MEMO value:FAC.

    "/ see if they compute the same values...
    Transcript show:'FAC(10):' ; showCR: ( FAC value:10 ).
    Transcript show:'MFAC(10):' ; showCR: ( MFAC value:10 ).

    "/ see how long it takes -
    "/ - the first time:
    Transcript show:'FAC time:' ; showCR: ( Time millisecondsToRun:[ FAC value: 10000 ] ).
    Transcript show:'MFAC time:' ; showCR: ( Time millisecondsToRun:[ MFAC value: 10000 ] ).

    "/ - the next time(s):
    Transcript show:'FAC time:' ; showCR: ( Time millisecondsToRun:[ FAC value: 10000 ] ).
    Transcript show:'MFAC time:' ; showCR: ( Time millisecondsToRun:[ MFAC value: 10000 ] ).
and a memoised version of the fibionacci function:
    FIB := [:arg | arg fib ].

    MFIB := MEMO value: FIB.

    Transcript show:'FIB(10):' ; showCR: ( FIB value:10 ).
    Transcript show:'MFIB(10):' ; showCR: ( MFIB value: 10 ).

    "/ see how long it takes -
    "/ - the first time:
    Transcript show:'FIB time:' ; showCR: ( Time millisecondsToRun:[ FIB value: 10000 ] ).
    Transcript show:'MFIB time:' ; showCR: ( Time millisecondsToRun:[ MFIB value: 10000 ] ).

    "/ - the next time(s):
    Transcript show:'FIB time:' ; showCR: ( Time millisecondsToRun:[ FIB value: 10000 ] ).
    Transcript show:'MFIB time:' ; showCR: ( Time millisecondsToRun:[ MFIB value: 10000 ] ).

Control

There is a slight difference here:
Lisp uses non-evaluating builtin special forms like (if ...) or (cond ...) (or user defined syntax, which expands to a non-evaluating special form),
whereas Smalltalk uses blocks, which are passed as unevaluated (lambdas) and evaluated as required.

In Smalltalk, arguments are always evaluated, and there is no such thing as syntax rules or macros. The programmer has to explicitely pass a block argument where lazy or partial evaluation is required. One might call this "programmer controlled lazy evaluation".

LispSmalltalk
(if cond expr1 expr2)cond ifTrue:[expr1] ifFalse:[expr2]
(cond ...)no direct replacement
use nested ifs or self send
(or the special switch-case methods)
(case ...)no direct replacement
use self send
(or the special switch-case methods)
(do ...)[cond] whileTrue:[...]
[cond] whileFalse:[...]
[...] doWhile:[cond]
[...] loop
and many others.
(map f list)
(map (lambda (el) ...) list)
collection collect:aBlock
collection collect:[:el | ...]
(for-each list f)
(for-each list (lambda (el) ...))
collection do:aBlock
collection do:[:el | ...]
(fold ...)collection inject:start into:aBlock

An example for lambdas/blocks, computing the Pascal triangle:

    (define (pascal n)
     (if (eq? n 1)
	'(1)
	(let* ((pn-1 (pascal (- n 1)))
	      (shL (append '(0) pn-1))
	      (shR (append pn-1 '(0))))
	     (map + shL shR))))

    (pascal 15)
    -> (1 14 91 364 1001 2002 3003 3432 3003 2002 1001 364 91 14 1)
And here possible versions in Smalltalk:
The first using a recursive block:
    |pascal|
    pascal := [:n |
		    n == 1 ifTrue:[
			#(1)
		    ] ifFalse:[
			|pn_1 shL shR|

			pn_1 := pascal value:(n - 1).
			shL := #(0) , pn_1.
			shR := pn_1 , #(0).
			shL with:shR collect:[:a :b | a + b]
		    ]
	       ].
    pascal value:15
    -> #(1 14 91 364 1001 2002 3003 3432 3003 2002 1001 364 91 14 1)
The second implements it as an instance method of the Integer class:
    >> in SmallInteger

    pascal
	|pascalOfnMinus1 shL shR|

	self == 1 ifTrue:[
	    ^ #(1)
	].

	pascalOfnMinus1 := (self - 1) pascal.
	shL := #(0) , pascalOfnMinus1.
	shR := pascalOfnMinus1 , #(0).
	^ shL with:shR collect:[:a :b | a + b]

    15 pascal
    -> #(1 14 91 364 1001 2002 3003 3432 3003 2002 1001 364 91 14 1)
The third as a class method in any class (maybe a private example/demos class):
    >> in Demo

    pascal:n
	|pascalOfnMinus1 shL shR|

	self == 1 ifTrue:[
	    ^ #(1)
	].

	pascalOfnMinus1 := self pascal:n-1.
	shL := #(0) , pascalOfnMinus1.
	shR := pascalOfnMinus1 , #(0).
	^ shL with:shR collect:[:a :b | a + b]

    Demo pascal:15
    -> #(1 14 91 364 1001 2002 3003 3432 3003 2002 1001 364 91 14 1)
(Notice, that the Smalltalk versions return an array instead of a list)

Returning Multiple Values

In Scheme, you pass a continuation (lambda) which expects multiple arguments, and pass the values back from the called function with "(values ...)". This actually invokes the value-receiving lambda in the caller. Conceptionally, "(values ...)" peeks at the caller to detect that a multi-arg lambda is there, although this is technically usually optimized by clever compilers.

A similar scheme is used in Smalltalk, where a multiple-value-receiving block is passed as argument to the called function.

The scheme call:


    (call-with-values
	(lambda ()
	    (values 1 2 3 4))
	(lambda (a b c d)
	    ... values-consumer-code ...
	)
    )
is written in Smalltalk as:

    rcvr someMethodWithMultipleValuesInto:[:a :b :c :d |
	    ... values-consumer-code ...
    ]
where "someMethodWithMultipleValuesInto:" gets the lambda as argument, and invokes it with:

    someMethodWithMultipleValuesInto:valuesConsumer
	...
	valuesConsumer valueWith:... with:... with:... with:...
In Smalltalk, this block is explicitly invoked in the caller, whereas it is implicitly invoked by "(values ...)" in Scheme.
Another difference is that in Scheme, the invocation is in tail position w.r.t the calling function, whereas it is a block invocation from within the called function in Smalltalk. As tail-call-optimization is not obligatory in Smalltalk (but sometimes offered as a compiler/optimization option), this is usually not an issue to Smalltalk programmers.

For the curious: Lambda Calculus in Smalltalk

The following (somewhat academic example) proves, that Smalltalk blocks are powerful enough to directly implement the functional lambda calculus.
This chapter implements booleans, conditional testing, numbers and some arithmetic operations directly as block (lambda) functions.

In the lambda-calculus, a function with formal parameter x and body B is denoted as:

    lambda x.B.
In Smalltalk, as a block, and write:
    [:x | B]
To apply the function F to an argument a, the usual lambda-calculus notation is just
    (F a).

in Smalltalk, write:
    F value:a

Thus, if we apply the lambda

    lambda x.x
to the argument 5, as in
    ( lambda x.x 5 )
we get back the original 5. In Smalltalk, this becomes:
    [:x | x] value:5
Smalltalk requires variables to be declared before used; therefore, variables must be declared either globally with:
    Smalltalk at:x put:nil.
or as a workspace variable with:
    Workspace addWorkspaceVariable:x.
Workspace variables are preferable, as they do not interfere or overwrite any existing Smalltalk global. For little snippet scripts like these, it is a good idea to enable the "automatic workspace variable" feature of your workspace window. Then, any undefined variable is automatically created and visible inside all workspaces.

So, now we can assign our lambdas to a variable:
(Hint: you can click on the dark-red code snippets below to evaluate them)

    Workspace addWorkspaceVariable:#IDENTITY.

    IDENTITY := [:x | x].
and apply it as in:
    IDENTITY value:'hello world'
Now let us define some operations in this lambda calculus, which only allows functions and invocations of them. To make things further complicated, lambda-invocation is only allowed with a single argument. However, that is not a problem, as we can "simulate" a two-argument function, by a function of one arg, which returns another function of one arg. This is called "currying", and in some functional languages a very common and well known paradigma (by the way: not named after the meal, but the mathematican Haskell Curry).
For example, a two-arg function P(x,y), which returns the sum of its two arguments, can be written as the one-arg function:
    P := [:x |
	    [:y |
		x + y ]].
and called with:
    (P value:5) value:10
In plain english words: P called with arg x, returns a function which expects an arg y, and adds the original x to this y. Therefore, in the call, the "(P value:5)" returns a function which adds 5 to its argument.

Notice, that the above can only be done in a language which supports closures, as the function returned by "(P value:5)" must somehow remember (close over) the passed in "x" argument value, and provide a prober value in its inner expression "x+y".

Lets start with the definition of booleans and conditional execution:

    Workspace addWorkspaceVariable:#T.
    Workspace addWorkspaceVariable:#F.
    Workspace addWorkspaceVariable:#IF.

    T := [:x |
	    [:y |
		x ]].

    F := [:x |
	    [:y |
		y]].

    IF := [:b |
	    [:x |
	      [:y |
		 (b value:x) value:y]]].
True is defined as a function which, when given two arguments (x and y) returns the first one (x). False as a function which, when given two arguments (x and y) returns the second one (y). Finally, IF is a function which passes the two alternatives to its boolean argument.
Lets try the above:
    ((IF value:T) value:'then') value:'else'.
    ((IF value:F) value:'then') value:'else'.

Next, we add negation and printing support for our convenience (not part of lambda calculus):
here are the definitions:

    Workspace addWorkspaceVariable:#NOT.
    Workspace addWorkspaceVariable:#printBool.

    NOT := [:b | ((IF value:b) value:F) value:T ].
    printBool := [:f | ((IF value:f) value:'true') value:'false' ]
and some invocations:
    printBool value:T
    printBool value:F
    printBool value:(NOT value:T)
    printBool value:(NOT value:F)

Then, we define pairs. These are often used to represent data structures; in Lisp, they are the fundamental objects. They are required for our definition of numbers which follows below.

    Workspace addWorkspaceVariable:#PAIR.
    Workspace addWorkspaceVariable:#FIRST.
    Workspace addWorkspaceVariable:#SECOND.

    PAIR := [:a |
	      [:b |
		 [:f | (f value:a) value:b] ]].

    FIRST := [:p | p value:T].
    SECOND := [:p | p value:F].
Wow, you might think: we don't even need memory; all is in the function (and actually the closure). PAIR is defined as a function which closes over its arguments, and later allows for either value to be retrieved by calling it with an appropriate selector (here, a boolean). The function returned by PAIR returns its first (closed-over) original argument if true is passed in, the value if the second original argument, if false is given. Thus, the "getters" FIRST and SECOND are simply calling that "pair-function".

That is really something you should lean back and think about for a moment: there is a "duality of objects (memory) and closures". Of course, that does not mean, that you can remove the memory from your machine - somewhere deep down in the Lisp- or Smalltalk impleemntation, closures are actually represented by memory cells, which hold on the original function arguments.

Try it:

    FIRST value:  ((PAIR value:1) value:2)
    SECOND value: ((PAIR value:1) value:2)
Now, we define natural numbers; starting with zero and a check:
    Workspace addWorkspaceVariable:#ZERO.
    Workspace addWorkspaceVariable:#IS_ZERO.

    ZERO := (PAIR value:T) value:T.

    IS_ZERO := [:n | FIRST value:n].
and then, recursively, all integers above:
    Workspace addWorkspaceVariable:#SUCC.
    Workspace addWorkspaceVariable:#PRED.

    SUCC := [:n | (PAIR value:F) value:n].
    PRED := [:n | SECOND value:n].
let's try some:
    Workspace addWorkspaceVariable:#ONE.
    Workspace addWorkspaceVariable:#TWO.

    ONE := SUCC value:ZERO.
    TWO := SUCC value:ONE.
and see if they compare to ZERO:
    printBool value:(IS_ZERO value:ZERO).
    printBool value:(IS_ZERO value:ONE).
    printBool value:(IS_ZERO value:(PRED value:ONE)).
    printBool value:(IS_ZERO value:(PRED value:(PRED value:TWO))).
again, only for our convenience, we add a utility to print numbers:
    Workspace addWorkspaceVariable:#IS_ZERO_asBoolean.
    Workspace addWorkspaceVariable:#convert_bool.
    Workspace addWorkspaceVariable:#convert_number_helper.
    Workspace addWorkspaceVariable:#convert_number.

    convert_bool := [:f | ((IF value:f) value:true) value:false ].
    IS_ZERO_asBoolean := [:n | convert_bool value:(IS_ZERO value:n) ].

    convert_number_helper := [:n :v|
		      (IS_ZERO_asBoolean value:n) ifTrue:[
			  v
		      ] ifFalse:[
			  convert_number_helper value:(PRED value:n) value:v + 1.
		      ].
		   ].

    convert_number := [:n | convert_number_helper value:n value:0 ].
and give it a try:
    convert_number value:ZERO
    convert_number value:ONE
    convert_number value:TWO
    convert_number value:(SUCC value:TWO)
    convert_number value:(FIRST value:((PAIR value:TWO) value:ONE))
the Y combinator, which is required for recursion.
Since Smalltalk is strict (i.e. always evaluating its arguments), this is a bit tricky and you can now start to bump your head against the nearest wall ...
    Workspace addWorkspaceVariable:#Y.
    Workspace addWorkspaceVariable:#FORCE.

    Y := [:f |
	    [:x |
	      [:y |
		 f value:(x value:x)]]
	    value:
	      [:x |
		[:y |
		  f value:(x value:x)]]].

    FORCE := [:x | x].
now, we are ready to define addition:
    Workspace addWorkspaceVariable:#A.
    Workspace addWorkspaceVariable:#ADD.

    A := [:g |
	    [:a |
	       [:b |
		   (((IF value:(IS_ZERO value:a))
		     value:( [:x | b] ))
		     value:( [:x | ((g value:FORCE)
				      value:(PRED value:a))
				      value:(SUCC value:b)])) value:FORCE]]].
    ADD := (Y value:A) value:FORCE.
and see if our system can add two numbers:
    convert_number value: ( (ADD value:ZERO) value:ZERO )
    convert_number value: ( (ADD value:ZERO) value:ONE )
    convert_number value: ( (ADD value:ONE) value:ONE )
    |two four|
    two   := (ADD value:ONE) value:ONE.
    four  := (ADD value:two) value:two.
    eight := (ADD value:four) value:four.
    convert_number value: ( (ADD value:eight) value:four )
adding equality of two numbers, is now straight forward:
    Workspace addWorkspaceVariable:#E.
    Workspace addWorkspaceVariable:#EQ.

    E := [:g |
	    [:a |
	       [:b |
		   (((IF value:(IS_ZERO value:a))
		     value:( [:x | (IS_ZERO value:b)] ))
		     value:( [:x | ((g value:FORCE)
				      value:(PRED value:a))
				      value:(PRED value:b)])) value:FORCE]]].
    EQ := (Y value:E) value:FORCE.
is 2 = 2 ?
    printBool value: ( (EQ value:TWO) value:TWO )
is 1 = 2 ?
    printBool value: ( (EQ value:ONE) value:TWO )
is (1+1) = 2 ?
    printBool value: ((EQ value:((ADD value:ONE) value:ONE)) value:TWO )
We leave it as an excercise to the reader to add subtraction, multiplication, factorials, non-natural numbers etc. Also, a few algorithms on lists might be useful here...


Copyright © 2002 Claus Gittinger, all rights reserved

<info@exept.de>

Doc $Revision: 1.44 $
Last modification: $Date: 2021/04/20 10:03:01 $