672910f27b
I started from tabs that are not on the beginning of lines, and in several places I did further cleanings. If you're worried about knowing who wrote some code, for example, if you get to this commit in "git blame", then note that you can use the "-w" flag in many git commands to ignore whitespaces. For example, to see per-line authors, use "git blame -w <file>". Another example: to see the (*much* smaller) non-whitespace changes in this (or any other) commit, use "git log -p -w -1 <sha1>".
819 lines
19 KiB
Racket
Executable File
819 lines
19 KiB
Racket
Executable File
#lang eopl
|
|
(require tests/eopl/private/utils)
|
|
|
|
(require "data-structures.rkt") ; for expval constructors
|
|
(require "lang.rkt") ; for scan&parse
|
|
(require "interp.rkt") ; for value-of-program
|
|
|
|
;; run : String -> ExpVal
|
|
(define run
|
|
(lambda (string)
|
|
(value-of-program (scan&parse string))))
|
|
|
|
(define equal-answer?
|
|
(lambda (ans correct-ans)
|
|
(equal? ans (sloppy->expval correct-ans))))
|
|
|
|
(define sloppy->expval
|
|
(lambda (sloppy-val)
|
|
(cond
|
|
((number? sloppy-val) (num-val sloppy-val))
|
|
((boolean? sloppy-val) (bool-val sloppy-val))
|
|
((list? sloppy-val) (list-val (map sloppy->expval sloppy-val)))
|
|
(else
|
|
(eopl:error 'sloppy->expval
|
|
"Can't convert sloppy value to expval: ~s"
|
|
sloppy-val)))))
|
|
|
|
(define-syntax-rule (check-run (name str res) ...)
|
|
(begin
|
|
(cond [(eqv? 'res 'error)
|
|
(check-exn always? (lambda () (run str)))]
|
|
[else
|
|
(check equal-answer? (run str) 'res (symbol->string 'name))])
|
|
...))
|
|
|
|
|
|
;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
|
|
(check-run
|
|
;; simple arithmetic
|
|
(positive-const "11" 11)
|
|
(negative-const "-33" -33)
|
|
(simple-arith-1 "-(44,33)" 11)
|
|
|
|
;; nested arithmetic
|
|
(nested-arith-left "-(-(44,33),22)" -11)
|
|
(nested-arith-right "-(55, -(22,11))" 44)
|
|
|
|
;; simple variables
|
|
(test-var-1 "x" 10)
|
|
(test-var-2 "-(x,1)" 9)
|
|
(test-var-3 "-(1,x)" -9)
|
|
|
|
;; simple unbound variables
|
|
(test-unbound-var-1 "foo" error)
|
|
(test-unbound-var-2 "-(x,foo)" error)
|
|
|
|
;; simple conditionals
|
|
(if-true "if zero?(0) then 3 else 4" 3)
|
|
(if-false "if zero?(1) then 3 else 4" 4)
|
|
|
|
;; test dynamic typechecking
|
|
(no-bool-to-diff-1 "-(zero?(0),1)" error)
|
|
(no-bool-to-diff-2 "-(1,zero?(0))" error)
|
|
(no-int-to-if "if 1 then 2 else 3" error)
|
|
|
|
;; make sure that the test and both arms get evaluated
|
|
;; properly.
|
|
(if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
|
|
(if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
|
|
|
|
;; and make sure the other arm doesn't get evaluated.
|
|
(if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
|
|
(if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
|
|
|
|
;; simple let
|
|
(simple-let-1 "let x = 3 in x" 3)
|
|
|
|
;; make sure the body and rhs get evaluated
|
|
(eval-let-body "let x = 3 in -(x,1)" 2)
|
|
(eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
|
|
|
|
;; check nested let and shadowing
|
|
(simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
|
|
(check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
|
|
(check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
|
|
|
|
;; simple applications
|
|
(apply-proc-in-rator-pos "(proc(x) -(x,1) 30)" 29)
|
|
(apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
|
|
(let-to-proc-1 "(proc(f)(f 30) proc(x)-(x,1))" 29)
|
|
|
|
|
|
(nested-procs "((proc (x) proc (y) -(x,y) 5) 6)" -1)
|
|
(nested-procs2 "let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6)"
|
|
-1)
|
|
|
|
(y-combinator-1 "
|
|
let fix = proc (f)
|
|
let d = proc (x) proc (z) ((f (x x)) z)
|
|
in proc (n) ((f (d d)) n)
|
|
in let
|
|
t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
|
|
in let times4 = (fix t4m)
|
|
in (times4 3)" 12)
|
|
|
|
;; simple letrecs
|
|
(simple-letrec-1 "letrec f(x) = -(x,1) in (f 33)" 32)
|
|
(simple-letrec-2
|
|
"letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), -2) in (f 4)"
|
|
8)
|
|
|
|
(simple-letrec-3
|
|
"let m = -5
|
|
in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
|
|
20)
|
|
|
|
; (fact-of-6 "letrec
|
|
; fact(x) = if zero?(x) then 1 else *(x, (fact sub1(x)))
|
|
;in (fact 6)"
|
|
; 720)
|
|
|
|
(HO-nested-letrecs
|
|
"letrec even(odd) = proc(x) if zero?(x) then 1 else (odd -(x,1))
|
|
in letrec odd(x) = if zero?(x) then 0 else ((even odd) -(x,1))
|
|
in (odd 13)" 1)
|
|
|
|
|
|
(begin-test-1
|
|
"begin 1; 2; 3 end"
|
|
3)
|
|
|
|
;; extremely primitive testing for mutable variables
|
|
|
|
(assignment-test-1 "let x = 17
|
|
in begin set x = 27; x end"
|
|
27)
|
|
|
|
|
|
(gensym-test
|
|
"let g = let count = 0 in proc(d)
|
|
let d = set count = -(count,-1)
|
|
in count
|
|
in -((g 11), (g 22))"
|
|
-1)
|
|
|
|
(even-odd-via-set "
|
|
let x = 0
|
|
in letrec even(d) = if zero?(x) then 1
|
|
else let d = set x = -(x,1)
|
|
in (odd d)
|
|
odd(d) = if zero?(x) then 0
|
|
else let d = set x = -(x,1)
|
|
in (even d)
|
|
in let d = set x = 13 in (odd -99)" 1)
|
|
|
|
(example-for-book-1 "
|
|
let f = proc (x) proc (y)
|
|
begin
|
|
set x = -(x,-1);
|
|
-(x,y)
|
|
end
|
|
in ((f 44) 33)"
|
|
12)
|
|
|
|
;; multiple arguments
|
|
(nested-procs2 "let f = proc(x,y) -(x,y) in (f -(10,5) 6)"
|
|
-1)
|
|
|
|
|
|
(twice-cps "
|
|
let twice = proc(f, x, k)
|
|
(f x proc (z) (f z k))
|
|
in (twice
|
|
proc (x, k) (k -(x,1))
|
|
11
|
|
proc(z) z)"
|
|
9)
|
|
|
|
(cps-neither-basic "
|
|
let f = proc (x) proc (y) -(x, y)
|
|
g = proc (z) -(z, 1)
|
|
in ((f 27) (g 11))"
|
|
17)
|
|
|
|
(create-empty-class
|
|
"class c1 extends object 3" 3)
|
|
|
|
(create-class-with-method "
|
|
class c1 extends object
|
|
field y
|
|
method gety()y 33 "
|
|
33)
|
|
|
|
(create-object "
|
|
class c1 extends object
|
|
method initialize()0
|
|
let o1 = new c1() in 11
|
|
" 11)
|
|
|
|
|
|
(send-msg-1 "
|
|
class c1 extends object
|
|
field s
|
|
method initialize()set s = 44
|
|
method gets()s
|
|
method sets(v)set s = v
|
|
|
|
let o1 = new c1() in send o1 gets()
|
|
"
|
|
44)
|
|
|
|
(send-msg-2 "
|
|
class c1 extends object
|
|
field s
|
|
method initialize()set s = 44
|
|
method gets()s
|
|
method sets(v)set s = v
|
|
|
|
let o1 = new c1()
|
|
t1 = 0
|
|
t2 = 0
|
|
in begin
|
|
set t1 = send o1 gets();
|
|
send o1 sets(33);
|
|
set t2 = send o1 gets();
|
|
list(t1, t2)
|
|
end
|
|
"
|
|
(44 33))
|
|
|
|
(test-self-1 "
|
|
class c extends object
|
|
field s
|
|
method initialize(v)set s = v
|
|
method sets(v)set s = v
|
|
method gets()s
|
|
method testit()send self sets(13)
|
|
|
|
let o = new c (11)
|
|
t1 = 0
|
|
t2 = 0
|
|
in begin
|
|
set t1 = send o gets();
|
|
send o testit();
|
|
set t2 = send o gets();
|
|
list(t1,t2)
|
|
end" (11 13))
|
|
|
|
;; (two-queues "
|
|
;; class queue extends object
|
|
;; field q_in
|
|
;; field q_out
|
|
;; field ans
|
|
;; method initialize()send self reset()
|
|
;; method reset()
|
|
;; begin
|
|
;; set q_in = nil();
|
|
;; set q_out = nil();
|
|
;; send self countup()
|
|
;; end
|
|
|
|
;; method empty?()if null?(q_in) then null?(q_out)
|
|
;; else 0
|
|
;; method enq(x)begin
|
|
;; send self countup();
|
|
;; set q_in = cons(x,q_in)
|
|
;; end
|
|
;; method deq()
|
|
;; letrec reverse(l) = (reverse_help l nil())
|
|
;; reverse_help(inp,out) = if null?(inp) then out
|
|
;; else (reverse_help
|
|
;; cdr(inp) cons(car(inp), out))
|
|
;; in if send self empty?() then 0
|
|
;; else begin
|
|
;; send self countup();
|
|
;; if null?(q_out) then
|
|
;; begin set q_out = (reverse q_in);
|
|
;; set q_in = nil()
|
|
;; end
|
|
;; else 0;
|
|
;; set ans = car(q_out);
|
|
;; set q_out = cdr(q_out);
|
|
;; ans
|
|
;; end
|
|
;; method countup()1 % stub
|
|
;; method get_total()1 % stub
|
|
|
|
;; let o1 = new queue ()
|
|
;; o2 = new queue ()
|
|
;; t1 = 0 t2 = 0 t3 = 0
|
|
;; t4 = 0 t5 = 0 t6 = 0
|
|
;; tot1 = 0 tot2 = 0
|
|
;; in begin
|
|
;; send o1 enq(11);
|
|
;; send o2 enq(21);
|
|
;; send o1 enq(12);
|
|
;; send o2 enq(22);
|
|
;; set t1 = send o1 deq();
|
|
;; set t2 = send o1 deq();
|
|
;; set t3 = send o2 deq();
|
|
;; set t4 = send o2 deq();
|
|
;; set t5 = send o1 get_total();
|
|
;; set t6 = send o2 get_total();
|
|
;; list(t1,t2,t3,t4,t5,t6)
|
|
;; end" (11 12 21 22 1 1))
|
|
|
|
;; next one is queue with shared counter object (passed at initialization)
|
|
|
|
(counter-1 "
|
|
class counter extends object
|
|
field count
|
|
method initialize()set count = 0
|
|
method countup()set count = -(count, -1)
|
|
method getcount()count
|
|
|
|
let o1 = new counter ()
|
|
t1 = 0
|
|
t2 = 0
|
|
in begin
|
|
set t1 = send o1 getcount();
|
|
send o1 countup();
|
|
set t2 = send o1 getcount();
|
|
list(t1,t2)
|
|
end
|
|
" (0 1))
|
|
|
|
(shared-counter-1 "
|
|
class counter extends object
|
|
field count
|
|
method initialize()set count = 0
|
|
method countup()set count = -(count, -1)
|
|
method getcount()count
|
|
|
|
class c1 extends object
|
|
field n
|
|
field counter1
|
|
method initialize(a_counter)
|
|
begin
|
|
set n = 0;
|
|
set counter1 = a_counter
|
|
end
|
|
method countup()
|
|
begin
|
|
send counter1 countup();
|
|
set n = -(n,-1)
|
|
end
|
|
method getstate()list(n, send counter1 getcount())
|
|
|
|
let counter1 = new counter()
|
|
in let o1 = new c1(counter1)
|
|
o2 = new c1(counter1)
|
|
in begin
|
|
send o1 countup();
|
|
send o2 countup();
|
|
send o2 countup();
|
|
list( send o1 getstate(),
|
|
send o2 getstate())
|
|
end
|
|
"
|
|
((1 3) (2 3)))
|
|
|
|
;; (two-queues-with-counter "
|
|
;; class counter extends object
|
|
;; field c_count
|
|
;; method initialize()set c_count = 0
|
|
;; method countup()set c_count = add1(c_count)
|
|
;; method getcount()c_count
|
|
|
|
;; class queue extends object
|
|
;; field q_in
|
|
;; field q_out
|
|
;; field ans
|
|
;; field count
|
|
;; method initialize(the_counter)
|
|
;; begin
|
|
;; set count = the_counter; % must do this first, because reset counts.
|
|
;; send self reset()
|
|
;; end
|
|
|
|
;; method reset()begin set q_in = nil();
|
|
;; set q_out = nil();
|
|
;; send self countup()
|
|
;; end
|
|
;; method empty?()if null?(q_in) then null?(q_out)
|
|
;; else 0
|
|
;; method enq(x)begin
|
|
;; send self countup();
|
|
;; set q_in = cons(x,q_in)
|
|
;; end
|
|
;; method deq()
|
|
;; letrec reverse(l) = (reverse_help l nil())
|
|
;; reverse_help(inp,out) = if null?(inp) then out
|
|
;; else (reverse_help
|
|
;; cdr(inp) cons(car(inp), out))
|
|
;; in if send self empty?() then 0
|
|
;; else begin
|
|
;; send self countup();
|
|
;; if null?(q_out) then
|
|
;; begin set q_out = (reverse q_in);
|
|
;; set q_in = nil()
|
|
;; end
|
|
;; else 0;
|
|
;; set ans = car(q_out);
|
|
;; set q_out = cdr(q_out);
|
|
;; ans
|
|
;; end
|
|
;; method countup()send count countup()
|
|
;; method get_total()send count getcount()
|
|
|
|
;; let counter1 = new counter() in
|
|
;; let o1 = new queue (counter1)
|
|
;; o2 = new queue (counter1)
|
|
;; t1 = 0 t2 = 0 t3 = 0
|
|
;; t4 = 0 t5 = 0 t6 = 0
|
|
;; tot1 = 0 tot2 = 0
|
|
;; in begin
|
|
;; send o1 enq(11);
|
|
;; send o2 enq(21);
|
|
;; send o1 enq(12);
|
|
;; send o2 enq(22);
|
|
;; set t1 = send o1 deq();
|
|
;; set t2 = send o1 deq();
|
|
;; set t3 = send o2 deq();
|
|
;; set t4 = send o2 deq();
|
|
;; set t5 = send o1 get_total();
|
|
;; set t6 = send o2 get_total();
|
|
;; list(t1,t2,t3,t4,t5,t6)
|
|
;; end" '(11 12 21 22 10 10))
|
|
|
|
|
|
;; Chris's first example
|
|
|
|
(chris-1 "
|
|
class aclass extends object
|
|
field i
|
|
method initialize(x) set i = x
|
|
method m(y) -(i,-(0,y))
|
|
|
|
let o1 = new aclass(3)
|
|
in send o1 m(2)"
|
|
5)
|
|
|
|
(for-book-1 "
|
|
class c1 extends object
|
|
field i
|
|
field j
|
|
method initialize(x) begin set i = x; set j = -(0,x) end
|
|
method countup(d) begin set i = -(i,-(0,d)); set j = -(j,d) end
|
|
method getstate()list(i,j)
|
|
|
|
let o1 = new c1(3)
|
|
t1 = 0
|
|
t2 = 0
|
|
in begin
|
|
set t1 = send o1 getstate();
|
|
send o1 countup(2);
|
|
set t2 = send o1 getstate();
|
|
list(t1,t2)
|
|
end"
|
|
((3 -3) (5 -5)))
|
|
|
|
|
|
(odd-even-via-self "
|
|
class oddeven extends object
|
|
method initialize()1
|
|
method even(n)if zero?(n) then 1 else send self odd (-(n,1))
|
|
method odd(n) if zero?(n) then 0 else send self even (-(n,1))
|
|
|
|
let o1 = new oddeven() in send o1 odd(13)"
|
|
1)
|
|
|
|
(inherit-1 "
|
|
class c1 extends object
|
|
field ivar1
|
|
method initialize()set ivar1 = 1
|
|
|
|
class c2 extends c1
|
|
field ivar2
|
|
method initialize()
|
|
begin
|
|
super initialize();
|
|
set ivar2 = 1
|
|
end
|
|
method setiv1(n)set ivar1 = n
|
|
method getiv1()ivar1
|
|
|
|
let o = new c2 ()
|
|
t1 = 0
|
|
in begin
|
|
send o setiv1(33);
|
|
send o getiv1()
|
|
end
|
|
" 33)
|
|
|
|
(inherit-2 "
|
|
class c1 extends object
|
|
field ivar1
|
|
method initialize()set ivar1 = 1
|
|
|
|
method setiv1(n)set ivar1 = n
|
|
method getiv1()ivar1
|
|
|
|
method foo()1
|
|
method call-foo-from-superclass()send self foo()
|
|
|
|
|
|
class c2 extends c1
|
|
field ivar2
|
|
method initialize()
|
|
begin super initialize(); set ivar2 = 1 end
|
|
|
|
|
|
method foo()2
|
|
|
|
method setiv2(n)set ivar2 = n
|
|
method getiv2()ivar2
|
|
|
|
method self-and-super-foo()
|
|
list( send self foo(), super foo())
|
|
|
|
method test-self-from-super()
|
|
super call-foo-from-superclass()
|
|
|
|
|
|
let o = new c2 ()
|
|
t1 = 0 t2 = 0 t3 = 0 t4 = 0
|
|
in begin
|
|
send o setiv1(33);
|
|
list(
|
|
send o getiv1(),
|
|
send o self-and-super-foo(),
|
|
send o call-foo-from-superclass(),
|
|
send o test-self-from-super()
|
|
)
|
|
end
|
|
" (33 (2 1) 2 2))
|
|
|
|
(inherit-3 "
|
|
class c1 extends object
|
|
method initialize()1
|
|
method m1()1
|
|
|
|
class c2 extends c1
|
|
method m1()super m1()
|
|
method m2()2
|
|
|
|
class c3 extends c2
|
|
method m1()3
|
|
method m2()super m2()
|
|
method m3()super m1()
|
|
|
|
let o = new c3 ()
|
|
in list( send o m1(),
|
|
send o m2(),
|
|
send o m3()
|
|
)
|
|
" (3 2 1))
|
|
|
|
(chris-2 "
|
|
class c1 extends object
|
|
method initialize() 1
|
|
method ma()1
|
|
method mb()send self ma()
|
|
|
|
class c2 extends c1 % just use c1's initialize
|
|
method ma() 2
|
|
|
|
let x = new c2 ()
|
|
in list(send x ma(),send x mb())
|
|
"
|
|
(2 2))
|
|
|
|
|
|
(for-book-2 "
|
|
class c1 extends object
|
|
method initialize()1
|
|
method m1()1
|
|
method m2()100
|
|
method m3()send self m2()
|
|
|
|
class c2 extends c1
|
|
method m2()2
|
|
|
|
let o1 = new c1()
|
|
o2 = new c2()
|
|
in list(send o1 m1(), % returns 1
|
|
send o1 m2(), % returns 100
|
|
send o1 m3(), % returns 100
|
|
send o2 m1(), % returns 1 (from c1)
|
|
send o2 m2(), % returns 2 (from c2)
|
|
send o2 m3() % returns 2 (c1's m3 calls c2's m2)
|
|
)
|
|
"
|
|
(1 100 100 1 2 2))
|
|
|
|
(sum-leaves "
|
|
class tree extends object
|
|
method initialize()1
|
|
|
|
class interior_node extends tree
|
|
field left
|
|
field right
|
|
method initialize(l,r)
|
|
begin
|
|
set left = l; set right = r
|
|
end
|
|
method sum() -(send left sum(), -(0, send right sum()))
|
|
|
|
class leaf_node extends tree
|
|
field value
|
|
method initialize(v)set value = v
|
|
method sum()value
|
|
|
|
let o1 = new interior_node (
|
|
new interior_node (
|
|
new leaf_node(3),
|
|
new leaf_node(4)),
|
|
new leaf_node(5))
|
|
in send o1 sum()
|
|
"
|
|
12)
|
|
|
|
(check-shadowed-fields "
|
|
class c1 extends object
|
|
field x
|
|
field y
|
|
method initialize(v) begin set x = v; set y = 0 end
|
|
method m1() x
|
|
|
|
class c2 extends c1
|
|
field x
|
|
method initialize(v1,v2) begin set x = v2;
|
|
super initialize(v1) end
|
|
method m2()list(x,y)
|
|
|
|
class c3 extends c2
|
|
field x
|
|
method initialize(v1,v2,v3) begin set x = v3;
|
|
super initialize(v1,v2)
|
|
end
|
|
method m3()x
|
|
|
|
let o = new c3(1,2,3)
|
|
in list (send o m1(), send o m2(), send o m3())
|
|
"
|
|
(1 (2 0) 3))
|
|
|
|
(static-super "
|
|
class c1 extends object
|
|
method initialize () 1
|
|
method m2() send self m3()
|
|
method m3() 13
|
|
class c2 extends c1
|
|
method m2() 22
|
|
method m3() 23
|
|
method m1() super m2()
|
|
class c3 extends c2
|
|
method m2() 32
|
|
method m3() 33
|
|
let o3 = new c3()
|
|
in send o3 m1()"
|
|
33)
|
|
|
|
|
|
(every-concept "
|
|
class a extends object
|
|
field i
|
|
field j
|
|
method initialize() 1
|
|
method setup()
|
|
begin
|
|
set i = 15;
|
|
set j = 20;
|
|
50
|
|
end
|
|
method f() send self g()
|
|
method g() -(i,-(0,j))
|
|
|
|
class b extends a
|
|
field j
|
|
field k
|
|
method setup()
|
|
begin
|
|
set j = 100;
|
|
set k = 200;
|
|
super setup();
|
|
send self h()
|
|
end
|
|
method g()
|
|
list(i,j,k)
|
|
method h() super g()
|
|
|
|
class c extends b
|
|
method g() super h()
|
|
method h() -(k,-(0,j))
|
|
|
|
let p = proc(o)
|
|
let u = send o setup ()
|
|
in list(u,
|
|
send o g(),
|
|
send o f())
|
|
in list((p new a()),
|
|
(p new b()),
|
|
(p new c()))
|
|
"
|
|
((50 35 35) (35 (15 100 200) (15 100 200)) (300 35 35))
|
|
)
|
|
|
|
(colorpoint-1 "
|
|
class point extends object
|
|
field x
|
|
field y
|
|
method initialize (initx, inity)
|
|
begin
|
|
set x = initx;
|
|
set y = inity
|
|
end
|
|
method move (dx, dy)
|
|
begin
|
|
set x = -(x,-(0,dx));
|
|
set y = -(y,-(0,dy))
|
|
end
|
|
method get_location () list(x,y)
|
|
class colorpoint extends point
|
|
field color
|
|
method set_color (c) set color = c
|
|
method get_color () color
|
|
let p = new point(3, 4)
|
|
cp = new colorpoint(10, 20)
|
|
in begin
|
|
send p move(3, 4);
|
|
send cp set_color(87);
|
|
send cp move(10, 20);
|
|
list(send p get_location(), % returns (6 8)
|
|
send cp get_location(), % returns (20 40)
|
|
send cp get_color()) % returns 87
|
|
end"
|
|
((6 8) (20 40) 87)
|
|
)
|
|
|
|
|
|
(colorpoint-2 "
|
|
class point extends object
|
|
field x
|
|
field y
|
|
method initialize (initx, inity)
|
|
begin
|
|
set x = initx;
|
|
set y = inity
|
|
end
|
|
method move (dx, dy)
|
|
begin
|
|
set x = +(x,dx);
|
|
set y = +(y,dy)
|
|
end
|
|
method get_location () list(x,y)
|
|
class colorpoint extends point
|
|
field color
|
|
method set_color (c) set color = c
|
|
method get_color () color
|
|
method initialize (x,y,c)
|
|
begin
|
|
super initialize (x,y);
|
|
set color = c
|
|
end
|
|
let p = new point(3, 4)
|
|
cp = new colorpoint(10, 20, 30)
|
|
in begin
|
|
send p move(3, 4);
|
|
send cp set_color(87);
|
|
send cp move(10, 20);
|
|
list(send p get_location(), % returns (6 8)
|
|
send cp get_location(), % returns (20 40)
|
|
send cp get_color()) % returns 87
|
|
end"
|
|
((6 8) (20 40) 87)
|
|
|
|
)
|
|
|
|
|
|
(example-for-impl "
|
|
class c1 extends object
|
|
field x
|
|
field y
|
|
method initialize ()
|
|
begin
|
|
set x = 11;
|
|
set y = 12
|
|
end
|
|
method m1 () -(x,y)
|
|
method m2 () send self m3()
|
|
class c2 extends c1
|
|
field y
|
|
method initialize ()
|
|
begin
|
|
super initialize();
|
|
set y = 22
|
|
end
|
|
method m1 (u,v) -(-(x,u), -(y,v))
|
|
method m3 () 23
|
|
class c3 extends c2
|
|
field x
|
|
field z
|
|
method initialize ()
|
|
begin
|
|
super initialize();
|
|
set x = 31;
|
|
set z = 32
|
|
end
|
|
method m3 () -(x,-(y,z))
|
|
let o3 = new c3()
|
|
in send o3 m1(7,8)
|
|
"
|
|
-10)
|
|
|
|
|
|
)
|
|
|