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). |