Run Code
|
API
|
Code Wall
|
Users
|
Misc
|
Feedback
|
Login
|
Theme
|
Privacy
|
Patreon
Dynamic Dispatching with no dynamic allocation
--GNAT 4.9.3 with Ada.Text_IO; use Ada.Text_IO; procedure main is package animals is type walk is interface; function can_walk(self : walk) return boolean is abstract; type swim is interface; function can_swim(self : swim) return boolean is abstract; type fly is interface; function can_fly(self : fly) return boolean is abstract; type animal is abstract new walk and swim and fly with record name : string(1..5); end record; function can_walk(self : animal) return boolean is abstract; function can_swim(self : animal) return boolean is abstract; function can_fly(self : animal) return boolean is abstract; subtype animal_class is animal'class; type animal_list is array(positive range <>) of access animal_class; type mammal is new animal with record legs : integer; fins : integer; end record; function can_walk(self : mammal) return boolean; function can_swim(self : mammal) return boolean; function can_fly(self : mammal) return boolean; type reptile is new animal with record legs : integer; fins : integer; end record; function can_walk(self : reptile) return boolean; function can_swim(self : reptile) return boolean; function can_fly(self : reptile) return boolean; type bird is new reptile with record wings : integer; end record; function can_fly(self : bird) return boolean; package constructor is function make_mammal(name : string; legs, fins : integer) return mammal; function make_reptile(name : string; legs, fins : integer) return reptile; function make_bird(name : string; legs, fins, wings : integer) return bird; end constructor; end animals; package body animals is function can_walk(self : mammal) return boolean is begin if self.legs >= 2 then return True; else return false; end if; end can_walk; function can_swim(self : mammal) return boolean is begin return false; end can_swim; function can_fly(self : mammal) return boolean is begin return false; end can_fly; function can_walk(self : reptile) return boolean is begin if self.legs >= 2 then return True; else return false; end if; end can_walk; function can_swim(self : reptile) return boolean is begin if self.fins > 0 then return True; else return false; end if; end can_swim; function can_fly(self : reptile) return boolean is begin return false; end can_fly; function can_fly(self : bird) return boolean is begin if self.wings > 0 then return True; else return false; end if; end can_fly; package body constructor is function make_mammal(name : string; legs, fins : integer) return mammal is self : mammal := (name => name, legs=> legs, fins=> fins); begin return self; end make_mammal; function make_reptile(name : string; legs, fins : integer) return reptile is self : reptile := (name => name, legs=> legs, fins=> fins); begin return self; end make_reptile; function make_bird(name : string; legs, fins, wings : integer) return bird is self : bird := (make_reptile(name,legs,fins) with wings=> wings); begin return self; end make_bird; end constructor; end animals; use animals, animals.constructor; dog : aliased animal_class := make_mammal(name => "dog ", legs => 4, fins=>0); snake : aliased animal_class := make_reptile(name => "snake", legs => 0, fins=>0); fish : aliased animal_class := make_reptile(name => "fish ", fins => 2, legs=>0); kite : aliased animal_class := make_bird(name => "kite ", wings=>2 , legs => 0, fins=>0); my_animals : animal_list := (dog'access,snake'access,fish'access,kite'access); begin for i in my_animals'range loop Put (my_animals(i).name); if my_animals(i).can_walk then Put(" walking "); elsif not my_animals(i).can_swim and not my_animals(i).can_fly then Put(" crawling "); end if; if my_animals(i).can_swim then Put (" swimming "); end if; if my_animals(i).can_fly then Put (" flying "); end if; new_line; end loop; end main;
run
|
edit
|
history
|
help
1
Please
log in
to post a comment.
Ada Dimentional System
macro-like function
plop
Controlled types (temporary anonymous objects)
ada rocks!
es_perfecto.adb
susuma_dos_enteros.adb
Dynamic Dispatching
Ada.adb
Bc130400116
Please log in to post a comment.