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 !
Try opening a workspace and enter some expressions there (aka: select and "doIt").
Under Smalltalk/X, the Read-Eval-Print loop is entered when either the
display connection cannot be established, or by the startup.rc file explicitely demanding for it.
Also, a debug Read-Eval-Print can be entered by pressing CTRL-c into the terminal (console) window,
from which ST/X was started.
In addition, numbers (floats, fractions and integers) and array literals are very similar to the corresponding lisp types.
(Standard-) Smalltalk does not provide something similar to lists - although these
could be easily added (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 systems as they do in Lisp.
In addition, smalltalk provides block-literals, which are partially initialized lambda objects: the code is created at compile time, whilst the environment (closure) is added at execution time.
(eq? 'aaa 'aaa) -> #t
(eq? "aaa" "aaa") -> #f
(equal? 'aaa 'aaa) -> #t
(equal? "aaa" "aaa") -> #t
In smalltalk:
#aaa == #aaa -> true
'aaa' == 'aaa' -> false
#aaa = #aaa -> true
'aaa' = 'aaa' -> true
even the possible bugs are similar:
In lisp:
(eq? 1 1.0) -> #f
(eqv? 1 1.0) -> #f
(equal? 1 1.0) -> #f
(= 1 1.0) -> #t
In smalltalk:
1 == 1.0 -> false
1 = 1.0 -> true
1 closeTo: 0.999999 -> true
Smalltalk/X provides the following variable environments:
Smalltalk (globals, all classes)
ClassVariables (visible in a class and all of its subclasses)
ClassInstanceVariables (visible in a 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>
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.
(* 123456789012345678901234567890 123456789012345678901234567890)
-> 15241578753238836750495351562536198787501905199875019052100
in lisp, versus:
123456789012345678901234567890 * 123456789012345678901234567890
in smalltalk.
there are fractions (rational numbers) which are exact and are reduced:
in lisp, versus:
(* (/ (/ 1 3) 3) 9) -> 1
in 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). Therefore, no
precidence or associativeness is implied; much like in lisp, these are simply evaluated
from left to right.
i.e.
evaluates to 9 (left to right).
1 + 2 * 3
Other types are (almost) directly mapped:
| Class/ Type | Lisp | Smalltalk | |
|---|---|---|---|
| Boolean | #t #f | true false |
|
| String | "foo" | 'foo' | |
| Character | #\x | $x | |
| Symbolic Atom | 'foo | #'foo' | |
| Cons | a . b | as LispCons/Cons class | |
| List | (a ... b) | as LispCons/Cons class | |
| nil | nil () | nil | |
| Array | #(a b...) | #(a b...) | |
| ByteArray | -- | #[b1 b2...] | |
| Function | (lambda (x) 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.
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.
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:
Description:
makeAdder := [:n | [:x | x + n]].
addTwo := makeAdder value:2.
addTwo value:1
-> 3
makeAdder is a lambda which evaluates to a lambda.Much like lambdas in Lisp, Smalltalk blocks are used as functional arguments for map-like operations (
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.
(since hyphens are not valid in identifiers, the names have been translated according to smalltalk conventions) makeAdder is a block which evaluates a block.
Blocks are closures; i.e. they remember their defining environment.
do:, collect:, select:, detect:, findFirst: etc),
or to control behavior (sort-order, catch-behavior, exception handling) etc.
As another demonstration (and proof) of how blocks behave like lambdas,
the following snipplet 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.
and a memoised version of the fibionacci function:
Workspace addWorkspaceVariable:'FAC'.
Workspace addWorkspaceVariable:'MEMO'.
Workspace addWorkspaceVariable:'MFAC'.
"/ 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)
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 ] ).
Transcript endEntry.
Workspace addWorkspaceVariable:'FIB'.
Workspace addWorkspaceVariable:'MFIB'.
FIB := [:arg | arg fib ].
MFIB := MEMO value: FIB.
Transcript show:'FIB(10):' ; showCR: ( FIB value:10 ).
Transcript show:'MFIB(10):' ; show:CR: ( 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 ] ).
Transcript endEntry.
if, cond etc.) smalltalk passes a block,
which is evaluated as required.
| Lisp | Smalltalk |
| (if cond expr1 expr2) | cond ifTrue:[expr1] ifFalse:[expr2] |
| (cond ...) | no direct replacement use nested ifs or self send |
| (case ...) | no direct replacement use self send |
| (do ...) | whileTrue: / whileFalse: / doWhile: / loop etc. |
| (map f l1 l2) | collect: / collect:with: / collect:with:with: |
| (for-each ...) | do: |
another example, computing the pascal triangle:
and here are two versions in smalltalk - the first using
blocks:
(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)
notice, that the smalltalk version above returns an array instead of a list
(a cons class could be easily added, if required).
|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 version is an instance method in the Integer class:
SmallInteger compile:'
pascal
|pn_1 shL shR|
n == 1 ifTrue:[
^ #(1)
].
pn_1 := (self - n) pascal.
shL := #(0) , pn_1.
shR := pn_1 , #(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)
λx.B.
In Smalltalk, we use a block, and write
[:x | B]
To apply the function F to an argument a,
the usual lambda-calculus notation is just
(F a).
F value:a
Thus, if we apply the lambda
to the argument 5,
as in
λx.x
we get back the original 5.
( λx.x 5 )
In smalltalk, the above could be written as:
Smalltalk requires variables to be declared before used;
[:x | x] value:5
therefore, variables must be declared either globally with:
or as a workspace variable with:
Smalltalk at:x put:nil.
Workspace variables are preferable, since they do not interfere with
any smalltalk variable.
Workspace addWorkspaceVariable:x.
So, now we can assign our lambdas to a variable:
(Hint: you can click on the dark-red code snipplets below to evaluate them)
and apply it as in:
Workspace addWorkspaceVariable:#IDENTITY.
IDENTITY := [:x | x].
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.
IDENTITY value:'hello world'
Lets start with the definition of booleans and conditional execution:
lets try the above:
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]]].
((IF value:T) value:'then') value:'else'.
((IF value:F) value:'then') value:'else'.
negation and printing support for our convenience (not part of lambda calculus):
here are the definitions:
and some invocations:
Workspace addWorkspaceVariable:#NOT.
Workspace addWorkspaceVariable:#printBool.
NOT := [:b | ((IF value:b) value:F) value:T ].
printBool := [:f | ((IF value:f) value:'true') value:'false' ]
printBool value:T
printBool value:F
printBool value:(NOT value:T)
printBool value:(NOT value:F)
Then, we define pairs as often used to represent data structures,
and are required for our definition of numbers below:
try it:
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].
FIRST value: ((PAIR value:1) value:2)
Now, integers; first zero and a check:
SECOND value: ((PAIR value:1) value:2)
and then, recursively, all integers above:
Workspace addWorkspaceVariable:#ZERO.
Workspace addWorkspaceVariable:#IS_ZERO.
ZERO := (PAIR value:T) value:T.
IS_ZERO := [:n | FIRST value:n].
lets try some:
Workspace addWorkspaceVariable:#SUCC.
Workspace addWorkspaceVariable:#PRED.
SUCC := [:n | (PAIR value:F) value:n].
PRED := [:n | SECOND value:n].
and see if they compare to ZERO:
Workspace addWorkspaceVariable:#ONE.
Workspace addWorkspaceVariable:#TWO.
ONE := SUCC value:ZERO.
TWO := SUCC value:ONE.
printBool value:(IS_ZERO value:ZERO).
printBool value:(IS_ZERO value:ONE).
printBool value:(IS_ZERO value:(PRED value:ONE)).
again, only for our convenience, we add a utility to print numbers:
printBool value:(IS_ZERO value:(PRED value:(PRED value:TWO))).
and give it a try:
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 ].
convert_number value:ZERO
convert_number value:ONE
convert_number value:TWO
convert_number value:(SUCC value:TWO)
the Y combinator, which is required for recursion.
convert_number value:(FIRST value:((PAIR value:TWO) value:ONE))
Since smalltalk is strict, this is a bit tricky and you
can now start to bump your head against the nearest wall ...
now, we are ready to define addition:
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].
and see if our system can add two numbers:
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.
convert_number value: ( (ADD value:ZERO) value:ZERO )
convert_number value: ( (ADD value:ZERO) value:ONE )
convert_number value: ( (ADD value:ONE) value:ONE )
adding equality of two numbers, is now straight forward:
|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 )
is 2 = 2 ?
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 1 = 2 ?
printBool value: ( (EQ value:TWO) value:TWO )
is (1+1) = 2 ?
printBool value: ( (EQ value:ONE) value:TWO )
printBool value: ((EQ value:((ADD value:ONE) value:ONE)) value:TWO )
Copyright © 2002 eXept Software AG, all rights reserved
<info@exept.de>