Run Code
|
API
|
Code Wall
|
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
ordenar.adb
Ada Dimentional System
Memory Alignment
nested ADA code, same procedure name
Queue (Using Tasking)
Ada.adb
1d array as 4d with easy reshaping
Stack (Using Tasking)
Ada Dimentional System
Iterator Interface