Contributed by Chris Rathman
:- module polymorph.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- import_module int, list, shape, circle, rectangle.
main -->
% create some shape instances (using existential wrapper)
{ Scribble = ([
'new shape'(makeRectangle(10, 20, 5, 6)),
'new shape'(makeCircle(15, 25, 8))]) },
% iterate through the list and handle shapes polymorphically
drawLoop(Scribble),
% call a rectangle specific instance
{ ARectangle = makeRectangle(0, 0, 15, 15) },
draw(setWidth(ARectangle, 30)).
:- pred drawLoop(list(shape), io__state, io__state).
:- mode drawLoop(in, di, uo) is det.
drawLoop([]) --> [].
drawLoop([shape(Hd) | Tl]) -->
draw(Hd),
draw(rMoveTo(Hd, 100, 100)),
drawLoop(Tl).
|
:- module shape. :- interface. :- import_module io, int. % declare method interfaces for the shape superclass :- typeclass shapeClass(T) where [ func getX(T) = int, func getY(T) = int, func setX(T, int) = T, func setY(T, int) = T, func moveTo(T, int, int) = T, func rMoveTo(T, int, int) = T, pred draw(T, io__state, io__state), mode draw(in, di, uo) is det ]. % declare existential shape type - useful for polymorphism :- type shape ---> some [T] shape(T) => shapeClass(T). :- implementation. |
:- module circle.
:- interface.
:- import_module int, shape.
% declare the record to hold circle parameters
:- type circleRecord.
% declare the constructor for the circle class
:- func makeCircle(int, int, int) = circleRecord.
% declare method interfaces for circle subclass
:- typeclass circleClass(T) <= shapeClass(T) where [
func getRadius(T) = int,
func setRadius(T, int) = T
].
% declare existential circle type - useful for polymorphism
:- type circle ---> some [T] circle(T) => circleClass(T).
% declare the methods for shape superclass
:- instance shapeClass(circleRecord).
% declare the methods for circle subclass
:- instance circleClass(circleRecord).
:- implementation.
:- import_module io.
% declare the record to hold circle parameters
:- type circleRecord
---> circleRecord(
x :: int,
y :: int,
radius :: int
).
% map the methods for shape superclass
:- instance shapeClass(circleRecord) where [
func(getX/1) is getX_Circle,
func(getY/1) is getY_Circle,
func(setX/2) is setX_Circle,
func(setY/2) is setY_Circle,
func(moveTo/3) is moveTo_Circle,
func(rMoveTo/3) is rMoveTo_Circle,
pred(draw/3) is draw_Circle
].
% map the methods for circle subclass
:- instance circleClass(circleRecord) where [
func(getRadius/1) is getRadius_Circle,
func(setRadius/2) is setRadius_Circle
].
% declare the constructor for the circle class
makeCircle(X, Y, Radius) = circleRecord(X, Y, Radius).
% read accessors
:- func getX_Circle(circleRecord) = int.
getX_Circle(This) = This^x.
:- func getY_Circle(circleRecord) = int.
getY_Circle(This) = This^y.
:- func getRadius_Circle(circleRecord) = int.
getRadius_Circle(This) = This^radius.
% write accessors
:- func setX_Circle(circleRecord, int) = circleRecord.
setX_Circle(This, X) = This^x := X.
:- func setY_Circle(circleRecord, int) = circleRecord.
setY_Circle(This, Y) = This^y := Y.
:- func setRadius_Circle(circleRecord, int) = circleRecord.
setRadius_Circle(This, Radius) = This^radius := Radius.
% move the shape position
:- func moveTo_Circle(circleRecord, int, int) = circleRecord.
moveTo_Circle(This, X, Y) = setY(setX(This, X), Y).
:- func rMoveTo_Circle(circleRecord, int, int) = circleRecord.
rMoveTo_Circle(This, DX, DY) = moveTo(This, getX(This) + DX, getY(This) + DY).
% draw the circle
:- pred draw_Circle(circleRecord, io__state, io__state).
:- mode draw_Circle(in, di, uo) is det.
draw_Circle(This) -->
io__write_string("Drawing a circle at:("),
io__write_int(getX_Circle(This)),
io__write_string(","),
io__write_int(getY_Circle(This)),
io__write_string("), radius "),
io__write_int(getRadius_Circle(This)),
io__nl.
|
:- module rectangle.
:- interface.
:- import_module int, shape.
% declare the record to hold rectangle parameters
:- type rectangleRecord.
% declare the constructor for the rectangle class
:- func makeRectangle(int, int, int, int) = rectangleRecord.
% declare method interfaces for rectangle subclass
:- typeclass rectangleClass(T) <= shapeClass(T) where [
func getWidth(T) = int,
func getHeight(T) = int,
func setWidth(T, int) = T,
func setHeight(T, int) = T
].
% declare existential rectangle type - useful for polymorphism
:- type rectangle ---> some [T] rectangle(T) => rectangleClass(T).
% declare the methods for shape superclass
:- instance shapeClass(rectangleRecord).
% declare the methods for rectangle subclass
:- instance rectangleClass(rectangleRecord).
:- implementation.
:- import_module io.
% declare the record to hold rectangle parameters
:- type rectangleRecord
---> rectangleRecord(
x :: int,
y :: int,
width :: int,
height :: int
).
% map the methods for shape superclass
:- instance shapeClass(rectangleRecord) where [
func(getX/1) is getX_Rectangle,
func(getY/1) is getY_Rectangle,
func(setX/2) is setX_Rectangle,
func(setY/2) is setY_Rectangle,
func(moveTo/3) is moveTo_Rectangle,
func(rMoveTo/3) is rMoveTo_Rectangle,
pred(draw/3) is draw_Rectangle
].
% map the methods for rectangle subclass
:- instance rectangleClass(rectangleRecord) where [
func(getWidth/1) is getWidth_Rectangle,
func(getHeight/1) is getHeight_Rectangle,
func(setWidth/2) is setWidth_Rectangle,
func(setHeight/2) is setHeight_Rectangle
].
% declare the constructor for the rectangle class
makeRectangle(X, Y, Width, Height) = rectangleRecord(X, Y, Width, Height).
% read accessors
:- func getX_Rectangle(rectangleRecord) = int.
getX_Rectangle(This) = This^x.
:- func getY_Rectangle(rectangleRecord) = int.
getY_Rectangle(This) = This^y.
:- func getWidth_Rectangle(rectangleRecord) = int.
getWidth_Rectangle(This) = This^width.
:- func getHeight_Rectangle(rectangleRecord) = int.
getHeight_Rectangle(This) = This^height.
% write accessors
:- func setX_Rectangle(rectangleRecord, int) = rectangleRecord.
setX_Rectangle(This, X) = This^x := X.
:- func setY_Rectangle(rectangleRecord, int) = rectangleRecord.
setY_Rectangle(This, Y) = This^y := Y.
:- func setWidth_Rectangle(rectangleRecord, int) = rectangleRecord.
setWidth_Rectangle(This, Width) = This^width := Width.
:- func setHeight_Rectangle(rectangleRecord, int) = rectangleRecord.
setHeight_Rectangle(This, Height) = This^height := Height.
% move the shape position
:- func moveTo_Rectangle(rectangleRecord, int, int) = rectangleRecord.
moveTo_Rectangle(This, X, Y) = setY(setX(This, X), Y).
:- func rMoveTo_Rectangle(rectangleRecord, int, int) = rectangleRecord.
rMoveTo_Rectangle(This, DX, DY) = moveTo(This, getX(This) + DX, getY(This) + DY).
% draw the rectangle
:- pred draw_Rectangle(rectangleRecord, io__state, io__state).
:- mode draw_Rectangle(in, di, uo) is det.
draw_Rectangle(This) -->
io__write_string("Drawing a rectangle at:("),
io__write_int(getX_Rectangle(This)),
io__write_string(","),
io__write_int(getY_Rectangle(This)),
io__write_string("), width "),
io__write_int(getWidth_Rectangle(This)),
io__write_string(", height "),
io__write_int(getHeight_Rectangle(This)),
io__nl.
|
mmake polymorph.depend mmake polymorph |
Drawing a rectangle at:(10,20), width 5, height 6 Drawing a rectangle at:(110,110), width 5, height 6 Drawing a circle at:(15,25), radius 8 Drawing a circle at:(115,115), radius 8 Drawing a rectangle at:(0,0), width 30, height 15 |
% these are some alternative forms of the methods getX_Circle(circleRecord(X,_,_)) = X. getY_Circle(circleRecord(_,Y,_)) = Y. getRadius_Circle(circleRecord(_,_,Radius)) = Radius. setX_Circle(circleRecord(_,Y,Radius), X) = circleRecord(X, Y, Radius). setY_Circle(circleRecord(X,_,Radius), Y) = circleRecord(X, Y, Radius). setRadius_Circle(circleRecord(X,Y,_), Radius) = circleRecord(X, Y, Radius). moveTo_Circle(circleRecord(_,_,Radius), X, Y) = circleRecord(X, Y, Radius). moveTo_Circle(This, X, Y) = makeCircle(X, Y, getRadius(This)). rMoveTo_Circle(circleRecord(X,Y,Radius), DX, DY) = circleRecord(X+DX, Y+DY, Radius). |