llenguatge de programació From Wikipedia, the free encyclopedia
Ada és un llenguatge de programació estructurat i fortament tipat que fou dissenyat per Jean Ichbiah de CII Honeywell Bull per encàrrec del Departament de Defensa dels Estats Units. És un llenguatge d'ús general, orientat a objectes i concurrent, podent arribar des de la facilitat de Pascal fins a la flexibilitat de C++. El seu nom prové d'Ada Lovelace sovint considerada la primera escriptora de programes d'ordinador.[1]
![]() | |
Tipus | wide-spectrum language (en) ![]() ![]() |
---|---|
Data de creació | 1980 ![]() |
Disseny | Jean Ichbiah i S. Tucker Taft ![]() |
Desenvolupador | Jean Ichbiah i S. Tucker Taft ![]() |
Epònim | Ada Lovelace ![]() |
Paradigma de programació | programació orientada a objectes, llenguatge imperatiu, programació estructurada i programació multiparadigma ![]() |
Dialecte de | SPARK ![]() |
Influenciat per | ALGOL 68, Pascal, Modula-2, C++, Smalltalk, Java, Llenguatge de programació Eiffel, ALGOL 60, Green i Ada 95 (en) ![]() ![]() |
Etiqueta d'Stack Exchange | Etiqueta ![]() |
Pàgina web | adaic.org ![]() |
Fou dissenyat pensant en la seguretat i amb una filosofia orientada a la reducció d'errors comuns i difícils de descobrir. Per això es basa en el tipat fort i en verificacions en temps d'execució (desactivables en benefici del rendiment). La sincronització de tasques es realitza mitjançant la primitiva de comunicació síncrona rendez-vouz (cat.: trobada).[2][3]
Ada es fa servir principalment en entorns en què es necessita una gran seguretat i fiabilitat, com pot ser la defensa, l'aeronàutica (Boeing o Airbus), la gestió del trànsit aeri (com Indra a l'Estat espanyol) i la indústria aeroespacial (ESA) entre d'altres, en estreta relació amb els Sistemes operatius de Temps Real.[4]
Aquest programa escriu "Hola, món!" al dispositiu de sortida per defecte (habitualment la línia d'ordres).
-- fitxer hola.adb
-- mòduls dels quals depèn
with Ada.Text_IO;
procedure Hola is
use Ada.Text_IO; -- importa espai de noms
begin
Put_Line("Hola, món!");
end Hola;
Compilació i execució a Linux
gnatmake hola.adb
./hola
Des del Març de 2008 es disposa d'una versió experimental sobre el sistema LLVM.[5]
Especificació i API biblioteca estàndard aquí.[6]
function | procedure | declare
-- declaracions
begin
-- instruccions
exception
-- gestors d'excepcions:
when E: TipusExcepcio => -- tractament
when E: others => -- tracta altres excepcions
end NomDelBloc ;
Si no s'especifica un tipus predefinit, es dedueix el tipus base per les clàusules de restricció:
Predefinits:
type Recompte is range 0 .. 999 -- restricció de rang sobre sencers
type Byte is mod 2**8
type Hexa is ('0', '9', 'A', 'B', 'C', 'D', 'E', 'F');
type Boolean is (False, True) ;
type Opcions is (OpcioA, OpcioB, OpcioC)
type Percentatge is digits 4 range 0.0 .. 1.0 -- coma-flotant precisió amb restricció de rang
type Durada is delta Resolució_rellotge -- coma-fixa binari
type Centim_DEuro is delta 0.01 digits 14 -- coma-fixa decimal quan incorpora precisió en dígits,
-- pels coma-fixa decimals la delta (resolució) ha d'ésser obligatòriament potència de deu.
Els mòduls d'entrada sortida són genèrics. Per imprimir o llegir valors, cal obtenir una instància del genèric adequat per al tipus específic.
-- instància del genèric 'Integer_IO' per a la precisió Long_Integer
package Long_Integer_IO is new Ada.Text_IO.Integer_IO (Long_Integer)
-- instància del genèric 'Float_IO' per a la precisió Long_Float
package Long_Float_IO is new Ada.Text_IO.Float_IO (Long_Float)
-- instància del genèric 'Fixed_IO' (coma-fixa) per al tipus específic
type Kilo_Octet is delta 2.0**10 ;
package Kilo_Octet_IO is new Ada.Text_IO.Fixed_IO (Kilo_Octet) ;
-- instància del genèric 'Enumeration_IO' per al tipus específic
type Discret is (OPCIO_A, OPCIO_B) ;
package Discret_IO is new Ada.Text_IO.Enumeration_IO (Discret) ;
-- instància del genèric 'Modular_IO' per al tipus específic
type Byte is mod 2**8 ;
package Byte_IO is new Ada.Text_IO.Modular_IO (Byte) ;
-- lectura
Positive'First -- el primer del tipus
-- escriptura
for Tipus'Atribut use ValorNouDeLAtribut -- modificació d'atributs actualitzables
-- constructor i components especificant '(x ,..) l'atribut per defecte: el constructor
K: Positive := Positive'(10)
-- conversió amb NomDelTipus(expressió)
Percentatge(Valor/100.0)
type Poma is new Recompte range 0 .. 100
subtype OuDeLaDotzena is OuDelGalliner range 0 .. 12
type Registre is record
A, B : Boolean;
Mida : Positive;
end record;
VarR : Registre := (A => False, B => True, Mida => 10) ;
-- Amb ''access''/''access constant'' només poden apuntar dins el propi dipòsit de dades (''storage pool'')
type PunterARegistre is [not_null] access Registre -- accés RW (només pot apuntar dins el dipòsit de dades del tipus)
type PunterARegistre is [not_null] access constant Registre -- accés RO
-- Amb ''access all'' els punters no tenen restriccions d'apuntament.
type PunterARegistre is [not_null] access all Registre -- accés RW (all: sense restricció de dipòsit d'apuntament)
punterARegistreTal.all := (A => False, B => True, Mida => 10) ;
type Tupla is record -- no limitat, admet assignació (:=) i comparació bit a bit (=) del registre
A, B : Boolean;
end record;
type Llista is limited record -- limitat, assignació (:=) i comparació bit a bit (=) prohibides
-- la comparació estructural, quan hi ha punters, no es pot basar
-- en la igualtat bit a bit de la primera cel·la.
Cap: Integer ;
Cua: access constant Llista -- PunterALlista
end record ;
type VectorDeSencers is array (1 .. 10) of Integer
-- exemple d'ús amb inicialització
-- (el d'índex 1 => 15, el segon 16, altres => valor_per_defecte)
VA: VectorDeSencers := (1 => 15, 2 => 16, others => 0)
type BUFFER(MIDA : BUFFER_SIZE := 100) is
record
Posicio : BUFFER_SIZE := 0;
Valor : STRING(1 .. MIDA);
end record;
type TIP_ARBRE is (FULLA, BRANCA) ;
type ARBRE_DE_SENCERS(Constructor: TIP_ARBRE) is record -- registre variant
case Constructor is
when FULLA => dadaFulla: Integer ;
when BRANCA => dadaNus: Integer ;
esquerre,dreta: access ARBRE_DE_SENCERS; -- punters a arbres
end case ;
end record ;
Vegeu exemple #Composició. Mòduls genèrics i Functors.
generic
type Item is private; -- paràmetre de tipus opac
type Poma is range <>; -- paràmetre de tipus enter, <>: abstracte en el rang
type Mass is digits <>; -- paràmetre de tipus coma flotant, <>: abstracte en la precisió
type Angle is delta <>; -- paràmetre de tipus coma fixa binari, <>: abstracte en la resolució (valor mínim)
type Esdeveniment is (<>); -- paràmetre de tipus enumerable (pels parèntesis) <>: abstracte en els valors
type Buffer(Length : Natural) is limited private; -- paràmetre de tipus indexat
-- (limited: assig. i comparació superficials prohibides (quan hi ha punters)) (private: opac)
type Table is array (Esdeveniment) of Item; -- paràmetre de tipus vector amb tipus d'elements i d'índex declarats prèviament
Des de l'Ada2005.[11]
pragma Assert([Check =>] boolean_expression[, [Message =>] string_expression]);
havent afegit la següent pragma de configuració a l'inici del fitxer o al fitxer de configuració del projecte gnat.adc
pragma Assertion_Policy(Check) ;
Des de l'Ada2012.[12]
generic
type Elem is private;
package Piles is
type Pila is private;
function Es_Buit(S: Pila) return Boolean;
function Es_Ple(S: Pila) return Boolean;
procedure Apila(S: in out Pila; X: in Elem)
with
Pre => not Es_Ple(S),
Post => not Es_Buit(S);
procedure Desapila(S: in out Pila; X: out Elem)
with
Pre => not Es_Buit(S),
Post => not Es_Ple(S);
private
...
end Stacks;
Ada permet a l'usuari un control fi de la gestió de memòria així com definir els seus propis gestors.[14]
Gestors d'allotjament de mem. dinàmica (Storage_Pool) assignables a diferents tipus de dades[15][16]
Amb el tipus de gestor Unbounded_No_Reclaim de System.Pool_Global
Segons la ref. el recol·lector de brossa no hi passa.[17] Al codi, però no a l'estàndard, hi diu: Allotjament per defecte dels tipus de punters declarats globalment.[18] GNAT de GNU permet associar-hi un recol·lector de brossa recompilant GCC amb --enable-objc-gc incorporant la biblio. libobjc-gc.a si l'arquitectura la suporta.[19]
Amb el tipus de gestor Unbounded_Reclaim_Pool de System.Pool_Local.
Quan l'execució surt de l'àmbit on el munt (Storage Pool) està definit, se'n reclama la memòria.[16] Al codi, però no a l'estàndard, hi diu: Allotjament per defecte dels tipus de punters declarats localment.[20] Sembla que era una pràctica en alguns compiladors de l'Ada83. AdaCore parla d'associació explícita.[16] Vegeu exemple #Allotjament dinàmic i Memòria d'àmbit.
Local_Pool: System.Pool_Local.Unbounded_Reclaim_Pool; -- munt reclamat en sortir de l'àmbit for Punter_A_T'Storage_Pool use Local_Pool ; -- en sortir de l'àmbit, el Local_Pool queda inaccessible -- i se n'executa automàticament el mètode ''Finalize'' que n'allibera la memòria.
Amb tipus de gestor Stack_Bounded_Pool de System.Pool_Size, per reservar memòria dinàmica a la pila de manera acotada.
Allotja elements d'un únic tipus.[21] El manual de AdaCore diu que aquest mòdul no està pensat per un ús directe per l'usuari, i que és el que es fa servir automàticament quan s'especifica el nombre d'elements per al tipus de punter.[16]
for Punter_A_T'Storage_Size use 10_000; -- reserva un Stack_Bounded_Pool per a 10000 elems. del tipus
type Punter_A_Sencer is access Integer ;
for Punter_A_Sencer'Storage_Pool use Nom_del_Pool; -- assignació de Storage_Pool específic a un tipus
package Persona is
type Objecte is tagged -- ''etiquetat'' (defineix el tipus com a constitutiu de classe)
private ; -- private: definició opaca dels camps
procedure MètodeDeLaInstància (This : Objecte); -- la instància és el primer paràmetre
procedure MètodeEstàtic (Param: Integer); -- no duu la instància com a primer paràmetre
function To_String(This: Objecte) return String; -- per a l'exemple a ''herència''
-- submòdul
package Eines is
-- Generadors i Funcions que no volem que s'heretin han d'estar en un submòdul.
function Nou_Persona (...) return Objecte ;
end Eines ;
private
type Objecte is tagged record -- camps de dades del tipus de la classe
Nom : String (1 .. 10);
Gènere : Tipus_Gènere;
end record;
end Persona;
Vegeu exemple.
Tipus_del_pare(This)
.with Persona;
package Programador is
type Objecte is new Persona.Objecte -- nou tipus ''Objecte'' derivat de Persona.Objecte
with private; -- opac, definit a l'àrea privada
overriding function To_String(This: Objecte) return String;
type Llenguatge is (LLENG_ADA, HASKELL, OCAML); -- ADA és paraula reservada
package Eines is -- submòdul per a funcions no heretables
function Nou_programador (pers: Persona.Objecte; esp: Llenguatge) return Objecte ;
end Eines ;
private
type Objecte is new Persona.Objecte with -- objecte derivat del tipus de la superclasse
record -- ampliació del registre de camps
Especialitat : Llenguatge;
end record;
end Programador;
-- implementació
with Ada.Text_IO ;
with Ada.Strings ;
package body Programador is
package body Eines is
function Nou_programador (pers: Persona.Objecte; esp: Llenguatge) return Objecte is
begin
return Objecte'(pers with Especialitat => esp); -- extensió de registre
end ;
end Eines ;
package Llenguatge_IO is new Ada.Text_IO.Enumeration_IO (Llenguatge) ;
function To_String(This: Objecte) return String is
str_Esp: String (1..20) ;
begin
Llenguatge_IO.Put(To => str_Esp, Item => This.Especialitat) ;
return (Persona.To_String(-- crida al mateix mètode, a la superclasse
Persona.Objecte(This)) -- caracterització a la superclasse
& "; Especialitat: " & str_Esp) ;
end ;
...
end Programador ;
Per fer una gestió fina de la memòria cal que els tipus implementin les classes Controlled o bé Limited_Controlled, que proporcionen mètodes per intervenir en les ops. de lligar un objecte a una variable i en deslligar-lo.
Sobre aquestes classes abstractes s'hi pot implementar, si hom vol, un mecanisme d'alliberament per comptador de referències.[30] Com a l'exemple més avall.
El mòdul Ada.Finalization incorpora les classes abstractes Controlled i Limited_Controlled que ofereixen mètodes cridats automàticament en inicialitzar, en assignar, i en sortir de l'àmbit les variables dels tipus de les classes que se'n derivin. Vegeu refs.[31][32]
Des de l'Ada2005.
package Imprimible is
type Objecte is interface;
procedure Imprimeix (This : Objecte) is abstract; -- is abstract => cal implementar-lo en classes derivades.
procedure UnAltreMètode (This : Objecte) is null; -- is null => buit, no requereix implem. en classes derivades.
end Imprimible;
with Programador ;
with Imprimible ;
package ProgramadorAmbImprimible is
type Objecte is new Programador.Objecte -- derivat de Programador.Objecte
and Imprimible.Objecte -- i també de Imprimible.Objecte
with private;
procedure Imprimeix (This : Objecte) ; -- redefineix el procediment virtual (abstracte a Imprimible)
private
-- declaració privada
end ProgramadorAmbImprimible ;
package body ProgramadorAmbImprimible is
procedure Imprimeix (This : Objecte) is -- implementa Imprimible
begin
...
end ;
end ProgramadorAmbImprimible ;
gnatmake hola.adb
gcc -c hola.adb
gnatbind hola # genera b~hola.ads i .adb que conté el ''package ada_main'' autogenerat de l'aplicació.
gnatlink hola
El mòdul autogenerat ada_main inclou els procediments d'inicialització adainit i de tancament adafinal. El procediment adainit executa la inicialització de cada mòdul en l'ordre deduït de les clàusules with i les pragmes Elaborate.
Vegeu ref.[35]
L'ordre d'inicialització es pot alterar quan a un mòdul li convé que un altre s'inicialitzi abans, especificant-ho amb la pragma Elaborate o Elaborate_All.[35]
-- força la inicialització prèvia del mòdul_M i els mòduls que importi.
-- alterant l'ordre d'exec. de les inicialitzacions al procés autogenerat ''adainit''
Pragma Elaborate_All (mòdul_M)
En cas de voler generar una biblioteca en comptes d'un executable, caldrà fer un programa principal de pega que cridi a les rutines de la biblioteca i extreure'n del mòdul principal generat (ada_main) els processos d'inicialització i tancament adainit i adafinal que inclourem a les rutines d'inicialització i finalització de la biblioteca de relligat dinàmic (.dll o bé .so), nom_biblioinit i nom_bibliofinal.[36]
AdaCore, mantenidor del compilador GNAT, disposa a la pàgina de descàrregues de codi obert d'una versió per a "jvm-windows"[37][38] que també funciona sobre Linux mitjançant l'emulador Wine excepte pels caràcters no anglosaxons (la codif. de caràcters és Latin-1 a Windows i UTF-8 a GNU/Linux).
Compilació a GNU/Linux:
wineconsole --backend=curses cmd
jvm-gnatmake -gnat05 principal
exit
Execució (a la consola Unix):
export JGNAT_JAR=~/.wine/drive_c/GNAT/2010/lib/jgnat.jar
java -cp .:$JGNAT_JAR principal
-- fitxer la_meva_biblio.ads -- signatura
generic
type T is private; -- paràmetre de tipus (''private'': tipus opac)
with function Producte (X, Y: T) return T; -- paràmetre funció
-- el param. actual ha de coincidir en la signatura de la funció
package La_Meva_Biblio is
function Quadrat (x:T) return T ;
end La_Meva_Biblio ;
-- fitxer la_meva_biblio.adb -- implementació
package body La_Meva_Biblio is
-- implementa Quadrat basat en la funció Producte que és paràmetre del genèric
function Quadrat (x:T) return T is
begin
return Producte (x, x) ;
end quadrat ;
end La_Meva_Biblio ;
-- fitxer el_meu_functor.ads -- signatura
with La_Meva_Biblio ;
generic
with package Biblio is new La_Meva_Biblio (<>); -- mòdul formal. cal que el mòdul paràmetre actual n'implementi la signatura
-- en aquest cas, cal que sigui derivat de La_Meva_Biblio
-- <>: indefinit en la parametrització (abstracte)
package El_meu_functor is
use Biblio; -- incorpora l'espai de noms del mòdul formal
function Cub(x: T) return T ;
function Quadrat(x: T) return T renames Biblio.quadrat; -- publica una funció del mòdul formal
end El_meu_functor ;
-- fitxer el_meu_functor.adb -- implementació
package body El_Meu_Functor is
function Cub (x:T) return T is
begin
return Producte (Quadrat(x), x) ;
end ;
end El_Meu_Functor ;
-- fitxer principal.adb
-- paquets per relligar amb el ''linker''
with La_Meva_Biblio ;
with El_Meu_Functor ;
with Ada.Text_IO;
procedure Principal is
-- nom curt per al mòdul
package TextIO renames Ada.Text_IO ;
-- instanciem mòduls genèrics per a l'entrada/sortida dels tipus primitius per als tipus concrets
package IntIO is new Ada.Text_IO.Integer_IO (Integer); -- Integer_IO per a precisió Integer
package LFloatIO is new Ada.Text_IO.Float_IO (Long_Float) ; -- Float_IO per a precisió Long_Float
package BoolIO is new Ada.Text_IO.Enumeration_IO (Boolean) ; -- Enumeration_IO per al cas Boolean
-- instanciem biblioteques
package La_Meva_Biblio_sobre_Sencers is new La_Meva_Biblio(T => Integer, Producte => "*") ;
package La_Meva_Biblio_sobre_Reals is new La_Meva_Biblio(T => Long_Float, Producte => "*") ;
package El_Meu_Functor_sobre_Sencers is new El_Meu_Functor(La_Meva_Biblio_sobre_Sencers) ;
package El_Meu_Functor_sobre_Reals is new El_Meu_Functor(La_Meva_Biblio_sobre_Reals) ;
-- declaració variables
i : constant Integer := 2 ;
j,k : Integer ;
x : constant Long_Float := 2.0 ;
y,z : Long_Float ;
comprovacio: Boolean ;
begin
j := La_Meva_Biblio_sobre_Sencers.Quadrat(i) ;
y := La_Meva_Biblio_sobre_Reals.Quadrat(x) ;
k := El_Meu_Functor_sobre_Sencers.Cub(i) ;
z := El_Meu_Functor_sobre_Reals.Cub(x) ;
TextIO.Put("Quadrat i Cub de 2 Integer, i comprovació:");
IntIO.Put(j, Width => 4); -- format: %4d
IntIO.Put(k, 4) ;
comprovacio := j = El_Meu_Functor_sobre_Sencers.Quadrat(i) ;
TextIO.Put(" ") ;
BoolIO.Put(comprovacio) ;
TextIO.New_Line(Spacing => 2); -- spacing: nombre de salts de línia
TextIO.Put("Quadrat i Cub de 2.0 Long_Float, i comprovació:");
LFloatIO.Put(y, Fore => 3, Aft => 2, Exp => 0); -- format: %3.2f; Exp (dígits exponent)
LFloatIO.Put(z, 3, 2, 0) ;
comprovacio := y = El_Meu_Functor_sobre_Reals.Quadrat(x) ;
TextIO.Put(" ") ;
BoolIO.Put(comprovacio) ;
TextIO.New_Line;
end Principal;
Compila i executa:
gnatmake principal.adb
./principal
dona el resultat:
Quadrat i Cub de 2 Integer, i comprovació: 4 8 TRUE Quadrat i Cub de 2.0 Long_Float, i comprovació: 4.00 8.00 TRUE
Parametritzant per tipus d'objecte amb requeriments de superclasse i interfaces
-- fitxer definicions.ads
package Definicions is
TITOL_APLICACIO : constant String := "Títol_aplicació" ;
end Definicions ;
-- fitxer imprimible.ads -- només signatura
package Imprimible is
type Objecte is interface ;
procedure Imprimeix(obj: Objecte) is abstract; -- is abstract => cal redefinir-lo en la classe derivada
-- procedure Imprimeix(obj: Objecte) is null; -- is null => no implementat, no és obligat redefinir-lo
end Imprimible ;
-- fitxer la_meva_biblio.ads -- signatura
with Persona ;
with Imprimible ;
generic
type T is new Persona.Objecte and Imprimible.Objecte with private; -- tipus formal
-- (cal que sigui derivat de Persona.Objecte
-- i que implementi Imprimible.Objecte)
package La_Meva_Biblio is
procedure ImprimeixISaltaLinia (obj:T) ;
end La_Meva_Biblio ;
-- fitxer la_meva_biblio.adb -- implementació
with Ada.Text_IO ;
with Ada.Text_IO.Bounded_IO ;
with Ada.Strings ;
with Ada.Strings.Bounded;
package body La_Meva_Biblio is
MAX_BUF : constant Integer := 20 ;
package SB_Buf is new Ada.Strings.Bounded.Generic_Bounded_Length (MAX_BUF) ;
package SB_Buf_IO is new Ada.Text_IO.Bounded_IO(SB_Buf) ;
package TextIO renames Ada.Text_IO ;
títol: SB_Buf.Bounded_String ;
procedure ImprimeixISaltaLinia (obj:T) is
begin
SB_Buf_IO.Put (títol) ;
Imprimeix (obj) ;
TextIO.New_Line(Spacing => 1) ;
end ImprimeixISaltaLinia ;
begin -- inicialització de mòdul
-- útil per inicialitzacions que depenen d'un altre mòdul
títol := SB_Buf.To_Bounded_String(Definicions.TITOL_APLICACIO & ": ") ;
end La_Meva_Biblio ;
-- fitxer persona.ads -- signatura
with Ada.Strings.Bounded; -- cadenes de text acotades
package Persona is
type Objecte is tagged private; -- ''tagged'': objectes, ''private'': opac, definit a l'àrea privada
function Put_To_String(obj: Objecte) return String ;
package Eines is -- mòdul niuat per a les funcions que no volem virtuals (heretables)
function Nou_Persona(nom: String; edat: Integer) return Objecte ;
end Eines ;
MAX_NOM : constant integer := 16 ;
package SB_Nom is new Ada.Strings.Bounded.Generic_Bounded_Length (MAX_NOM) ;
private
type Objecte is tagged record
Nom: SB_Nom.Bounded_String ;
Edat: Integer ;
end record ;
end Persona;
-- fitxer persona.adb -- implementació
with Ada.Text_IO ;
with Ada.Strings ;
with Ada.Strings.Fixed ;
with Ada.Strings.Bounded ;
package body Persona is
package IntIO is new Ada.Text_IO.Integer_IO (Integer) ;
package body Eines is -- mòdul niuat per les funcions que no volem virtuals (heretables)
function Nou_Persona(nom: String; edat: Integer) return Objecte is
begin
return Persona.Objecte'(Nom => Persona.SB_Nom.To_Bounded_String(nom)
, Edat => edat
) ;
exception
when E: Ada.Strings.Length_Error =>
Ada.Text_IO.Put("error: nom massa llarg, màxim: ") ;
IntIO.Put(MAX_NOM) ;
Ada.Text_IO.New_Line(1) ;
raise ;
end Nou_Persona ;
end Eines ;
-----------------------
function Put_To_String(obj: Objecte) return String is
MAX_BUF : constant Integer := 40 ;
package SB_Buf is new Ada.Strings.Bounded.Generic_Bounded_Length (MAX_BUF) ;
sb_buf1: SB_Buf.Bounded_String ;
buf2: String (1 .. 10) ;
use SB_Buf; -- incorpora espai de noms
use Ada.Strings ;
begin
sb_buf1 := To_Bounded_String(SB_Nom.To_String(obj.nom)) ;
IntIO.Put (To => buf2, Item => obj.edat) ;
return To_String(sb_buf1 & " " & Fixed.Trim(buf2, Left)) ;
end Put_To_String ;
end Persona;
-- fitxer programador.ads -- signatura
with Persona ;
with Imprimible ;
package Programador is
type Objecte is new Persona.Objecte -- deriva de Persona.Objecte
and Imprimible.Objecte -- i també de Imprimible.Objecte
with private; -- extensió de camps opaca (a l'àrea privada)
overriding function Put_To_String(obj: Objecte) return String; -- sobrescriu mètode de la superclasse
procedure Imprimeix (obj: Objecte) ;
type Llenguatge is (LLENG_ADA, HASKELL, OCAML, SCALA); -- LLENG_ADA doncs ADA és nom reservat
package Eines is -- mòdul niuat per les funcions que no volem virtuals (heretables)
function Nou_Programador(nom: String; edat: Integer; especialitat: Llenguatge)
return Objecte ;
end Eines ;
private
type Objecte is new Persona.Objecte and Imprimible.Objecte with record -- extensió de registre de camps
Especialitat: Llenguatge ;
end record;
end Programador;
-- fitxer programador.adb -- implementació
with Ada.Text_IO ;
with Ada.Strings ;
with Ada.Strings.Bounded ;
package body Programador is
package body Eines is -- mòdul niuat per les funcions que no volem virtuals (heretables)
function Nou_Programador(nom: String; edat: Integer; especialitat: Llenguatge)
return Objecte is
begin
return Objecte'(Persona.Eines.Nou_Persona(nom, edat) with Especialitat => especialitat) ;
end Nou_Programador ;
end Eines ;
------------
function Put_To_String(obj: Objecte) return String is
package Llenguatge_IO is new Ada.Text_IO.Enumeration_IO(Llenguatge) ;
MAX_BUF : constant Integer := 60 ;
package SB_Buf is new Ada.Strings.Bounded.Generic_Bounded_Length (MAX_BUF) ;
sb_buf1: SB_Buf.Bounded_String ;
buf2: String (1 .. 12) ;
use SB_Buf; -- incorpora espai de noms
begin
sb_buf1 := To_Bounded_String(
Persona.Put_To_String(-- crida al mètode homònim de la superclasse
Persona.Objecte(obj) -- cal fer un ''up-cast'' (caracterització) de l'objecte
-- al supertipus corresp. al mètode
)) ;
Llenguatge_IO.Put(buf2, obj.especialitat) ;
return To_String(sb_buf1 & " " & buf2) ;
end Put_To_String ;
------------
procedure Imprimeix (obj: Objecte) is
package TextIO renames Ada.Text_IO ;
begin
TextIO.Put ("Programador: ") ;
TextIO.Put (Put_To_String(obj)) ;
end Imprimeix ;
end Programador;
-- fitxer principal.adb
with La_Meva_Biblio ;
with Programador ;
procedure Principal is
package La_Meva_Biblio_ProgImp is new La_Meva_Biblio(T => Programador.Objecte) ;
obj : Programador.Objecte ;
use Programador; -- incorpora espai de noms del mòdul
use La_Meva_Biblio_ProgImp ;
begin
obj := Eines.Nou_Programador("Gabriel", 59, Especialitat => HASKELL) ;
ImprimeixISaltaLinia(obj) ;
end Principal;
Compila i executa:
gnatmake principal.adb ./principal
Vegeu ref.[39]
task: fil d'execució (ang: ''thread'')
entry: canal d'entrada (bústia de comunicació amb cua de missatges)
(when condició => accept canal) : entrada del canal amb guarda (procés condicionat)
-- fitxer prova.adb
with Ada.Strings ;
with Ada.Strings.Fixed ;
with Ada.Strings.Bounded ;
with Ada.Text_IO ;
with Ada.Text_IO.Bounded_IO ;
procedure Prova is
package TextIO renames Ada.Text_IO ;
str1 : String := "abcdefghi" ;
MAX_BUF : constant Integer := str1'Last ;
package SB_Buf is new Ada.Strings.Bounded.Generic_Bounded_Length (MAX_BUF) ;
package SB_Buf_IO is new Ada.Text_IO.Bounded_IO(SB_Buf) ;
sb_buf2 : SB_Buf.Bounded_String ;
type T_ESTAT is range 1..(MAX_BUF +1) ;
task Automata is -- task és fil d'execució (''thread'')
entry Llegeix(ch: in Character); -- canal d'entrada
entry Imprimeix; -- canal d'entrada
end Automata ;
task body Automata is -- l'activació s'inicia en completar la inicialització de l'objecte que l'enclou
Estat: T_ESTAT := T_ESTAT'First ;
-- use SB_Buf ;
begin
loop
select
when Estat < T_ESTAT'Last =>
accept Llegeix(ch: in Character) do
SB_Buf.Append(sb_buf2, ch) ;
TextIO.Put(ch); -- fem l'eco
end Llegeix ;
Estat := Estat +1 ;
or
when Estat = T_ESTAT'Last =>
accept Imprimeix do
TextIO.New_Line ;
SB_Buf_IO.Put(sb_buf2) ;
end Imprimeix ;
or
terminate; -- acaba quan hi ha una opció ''terminate'' oberta
-- i no hi ha entrades pendents
-- i totes les tasques (fils d'execució) estan igual
-- i el procés principal enllesteix.
-- o bé, en comptes d'acabar, especificar un lapse de temps i les accions a prendre
delay 1.0; TextIO.New_Line -- termini i accions subseqüents al venciment
end select ;
end loop ;
end Automata ;
begin
for i in str1'Range loop
Automata.Llegeix(str1(i)) ;
delay 0.2 ;
end loop ;
Automata.Imprimeix ;
end prova ;
gnatmake prova.adb
./prova
Càlculs abortables per venciment de terminis o altres esdeveniments esmentats a la clàusula select. Detalls a la documentació.[42]
select
-- ''delay or triggering statement''
delay 5.0;
Put_Line("El càlcul no convergeix");
then abort
-- Aquest càlcul està limitat en temps pel termini prèviament esmentat
Càlcul_que_pot_excedir_el_temps_tolerable(X, Y) ;
end select;
La construcció protected aporta coherència al manteniment d'estructures compartides per diferents fils d'execució.
Aporta un monitor a l'estructura per garantir l'exclusió mútua dels fils d'execució que executin els membres exportats de l'estructura.[43]
Les clàusules Entry permeten condicionar el desblocatge d'execució (monitor) a una condició expressada en la clàusula when.
-- fitxer prova.adb -- procés cua d'esdeveniments
with Ada.Text_IO ;
with Ada.Containers.Doubly_Linked_Lists ;
procedure Prova is
package TextIO renames Ada.Text_IO ;
type TEsdeveniment is (SUCCES_A, SUCCES_B, FINAL) ;
package TEsdeveniment_IO is new Ada.Text_IO.Enumeration_IO (TEsdeveniment) ;
package Cua_Esdev is new Ada.Containers.Doubly_Linked_Lists (TEsdeveniment); -- cua de dos caps, il·limitada
----------------
protected Cua_Protegida is
procedure Afegir(Esdev: TEsdeveniment); -- procedure (no bloca) (cua és il·limitada)
entry Retirar_Primer(Esdev: out TEsdeveniment); -- entry (pot blocar) (Retirar_Primer requereix cua no buida)
private
Cua: Cua_Esdev.List ;
end Cua_Protegida;
protected body Cua_Protegida is
procedure Afegir(Esdev: TEsdeveniment) is
begin
Cua_Esdev.Append(Cua, Esdev) ;
end Afegir;
entry Retirar_Primer (Esdev: out TEsdeveniment) -- canal d'entrada
when not Cua_Esdev.Is_Empty(Cua) is -- requeriment d'accés
begin
Esdev := Cua_Esdev.First_Element(Cua) ;
Cua_Esdev.Delete_First(Cua) ;
end Retirar_Primer;
end Cua_Protegida ;
----------------
task Processa_Esdeveniments; -- no exporta res
task body Processa_Esdeveniments is
Es_Final: Boolean := False ;
begin
while not Es_Final loop
declare
Esdev: TEsdeveniment ;
begin
Cua_Protegida.Retirar_Primer(Esdev) ;
TEsdeveniment_IO.Put(Esdev) ;
TextIO.New_Line ;
Es_Final := Esdev = FINAL ;
end ;
end loop ;
end Processa_Esdeveniments ;
begin
Cua_Protegida.Afegir (SUCCES_A) ;
Cua_Protegida.Afegir (SUCCES_B) ;
delay 1.0 ;
Cua_Protegida.Afegir (FINAL) ;
end Prova ;
gnatmake prova.adb
./prova
Vegeu #Gestió de memòria
-- fitxer prova_mem.ads
package Prova_Mem is
procedure Prova ;
end Prova_Mem ;
-- fitxer prova_mem.adb
with Ada.Text_IO ;
with Ada.Unchecked_Deallocation ;
with System.Pool_Local ;
with Ada.Exceptions ;
package body Prova_Mem is
package Except renames Ada.Exceptions ;
package Txt_IO renames Ada.Text_IO ;
package Int_IO is new Ada.Text_IO.Integer_IO (Integer) ;
package Boolean_IO is new Ada.Text_IO.Enumeration_IO (Boolean) ;
procedure Prova is
type Tipus is array (1..1000) of Integer;
type Ptr_A_Tipus is access Tipus;
Local_Pool : System.Pool_Local.Unbounded_Reclaim_Pool; -- memòria d'àmbit.
for Ptr_A_Tipus'Storage_Pool use Local_Pool ;
procedure Free_Ptr_A_Tipus is new Ada.Unchecked_Deallocation (Tipus, Ptr_A_Tipus);
subtype Ptr_No_Nul_A_Tipus is not null Ptr_A_Tipus ;
A : Ptr_A_Tipus;
procedure Allotja is
begin
A := new Tipus'(others=>10); -- allotja i inicialitza
end Allotja;
procedure DesAllotja is
begin
Free_Ptr_A_Tipus (A);
end DesAllotja;
procedure Comprova_Nul (B: Ptr_A_Tipus) is
begin
Txt_IO.Put ("Que és nul el punter? ") ;
Boolean_IO.Put (B = null) ;
Txt_IO.New_Line ;
end Comprova_Nul ;
procedure Imprimeix_Elem (B: Ptr_No_Nul_A_Tipus) is -- restringit pel subtipus, dispara exc. Constraint_Error
-- procedure Imprimeix_Elem (B: not null access Tipus) is -- alternativa
vec: Tipus ;
begin
vec := B.all ;
Txt_IO.Put ("El primer elem. és") ;
Int_IO.Put (vec(1), Width => 4) ;
Txt_IO.New_Line;
end Imprimeix_Elem ;
begin
Allotja ;
A.all := (others => 20) ;
Comprova_Nul(A) ;
Imprimeix_Elem(A) ;
Allotja ;
DesAllotja; -- A queda ''null''
Comprova_Nul(A) ;
begin
Imprimeix_Elem(A) ;
exception
when Constraint_Error => Txt_IO.Put_Line ("Restricció ''not null'' fallida: El punter era nul") ;
when E: others => Txt_IO.Put_Line ("disparada: " & Except.Exception_Name (E));
end ;
Allotja ;
end Prova; -- el Local_Pool queda fora d'àmbit i se'n reclama la memòria
end Prova_Mem ;
-- fitxer principal.adb
with Prova_Mem ;
procedure Principal is
begin
Prova_Mem.Prova ;
end ;
gnatmake principal.adb
./principal
Classe d'objectes amb Finalització controlada, derivats de la classe abstracta Ada.Finalization.Controlled. Mètodes cridats automàticament:
Vegeu #Constructors, Destructors i Clonadors.
-- fitxer controlat.ads
with Carrega ;
with Ada.Finalization;
package Controlat is
use Carrega ;
type Objecte is new Ada.Finalization.Controlled with -- classe derivada de ''Ada.Finalization.Controlled''
record
Ptr_A_La_Meva_Carrega: Carrega.Ptr_A_Carrega := null ;
end record;
private
procedure Initialize(Obj: in out Objecte); -- constructor buit (cridat quan no hi ha inicialització en la declaració)
procedure Adjust(Obj: in out Objecte); -- constructor de còpia (ajustatge després de còpia superficial)
procedure Finalize (Obj: in out Objecte); -- cridat en sortir de l'àmbit o quan l'obj. es deslliga de la variable quan és modificada
end Controlat;
-- fitxer controlat.adb
with Ada.Text_IO;
package body Controlat is
package Txt_IO renames Ada.Text_IO ;
package Int_IO is new Ada.Text_IO.Integer_IO (Integer) ;
procedure Initialize(Obj: in out Objecte) is -- constructor buit
begin
Txt_IO.Put("Initialize:");
Obj.Ptr_A_La_Meva_Carrega := Carrega.Nova_Carrega (Id => 1);
Txt_IO.New_Line ;
end;
procedure Adjust(Obj: in out Objecte) is -- constructor de còpia (ajustatge després de còpia superficial bit a bit)
begin
Txt_IO.Put("Adjust :");
Carrega.Incr_Refs(Obj.Ptr_A_La_Meva_Carrega) ;
Txt_IO.New_Line ;
end;
procedure Finalize (Obj: in out Objecte) is -- en sortir de l'àmbit o en ésser deslligat de la ref.
refs: Natural ;
begin
Txt_IO.Put("Finalize :");
if not Carrega.Es_Nul (Obj.Ptr_A_La_Meva_Carrega) then
Carrega.Decr_Refs(Obj.Ptr_A_La_Meva_Carrega, refs) ;
if refs = 0 then
Carrega.Allibera_Carrega (Obj.Ptr_A_La_Meva_Carrega) ;
Txt_IO.Put("; Desallotjat") ;
end if ;
end if ;
Txt_IO.New_Line ;
end;
end Controlat;
-- fitxer carrega.ads
with Ada.Unchecked_Deallocation;
package Carrega is
type Carrega is private ;
type Ptr_A_Carrega is access Carrega ;
function Nova_Carrega (Id: integer) return Ptr_A_Carrega ;
function Es_Nul(ptr_carr: Ptr_A_Carrega) return Boolean ;
procedure Incr_Refs (ptr_carr: in Ptr_A_Carrega) ;
procedure Decr_Refs (ptr_carr: in Ptr_A_Carrega; refs: out Natural) ;
procedure Allibera_Carrega (ptr_carr: in out Ptr_A_Carrega) ;
private
type Carrega is record
Id: Integer ;
Num_Refs: Natural := 1 ;
end record ;
procedure Free_Carrega is new Ada.Unchecked_Deallocation (Carrega, Ptr_A_Carrega);
end Carrega;
-- fitxer carrega.adb
with Ada.Text_IO;
package body Carrega is
package Txt_IO renames Ada.Text_IO ;
package Int_IO is new Ada.Text_IO.Integer_IO (Integer) ;
function Nova_Carrega (Id: integer) return Ptr_A_Carrega is
Ptr: Ptr_A_Carrega := null ;
begin
Ptr := new Carrega'(Id => Id, others => <>); -- ''<>'': valors per defecte
Txt_IO.Put(" Càrrega Id.: "); Int_IO.Put(Id, 4) ;
Txt_IO.Put(" Refs: "); Int_IO.Put(Ptr.all.Num_Refs, 4) ;
Txt_IO.New_Line ;
return Ptr ;
end Nova_Carrega ;
function Es_Nul(ptr_carr: Ptr_A_Carrega) return Boolean is
begin
return ptr_carr = null ;
end ;
procedure Incr_Refs (ptr_carr: in Ptr_A_Carrega) is
begin
ptr_carr.all.Num_Refs := ptr_carr.all.Num_Refs +1 ;
Txt_IO.Put(" Càrrega Id.: "); Int_IO.Put(ptr_carr.all.Id, 4) ;
Txt_IO.Put(" Refs: "); Int_IO.Put(ptr_carr.all.Num_Refs, 4) ;
end ;
procedure Decr_Refs (ptr_carr: in Ptr_A_Carrega; refs: out Natural) is
begin
if ptr_carr.all.Num_Refs > 0 then
ptr_carr.all.Num_Refs := ptr_carr.all.Num_Refs -1 ;
end if ;
refs := ptr_carr.all.Num_Refs ;
Txt_IO.Put(" Càrrega Id.: "); Int_IO.Put(ptr_carr.all.Id, 4) ;
Txt_IO.Put(" Refs: "); Int_IO.Put(ptr_carr.all.Num_Refs, 4) ;
end ;
procedure Allibera_Carrega (ptr_carr: in out Ptr_A_Carrega) is
begin
Free_Carrega(ptr_carr) ;
end ;
end Carrega;
-- fitxer principal.adb
with Carrega ;
with Controlat ;
with Ada.Finalization;
with Ada.Text_IO ;
procedure Principal is
package Txt_IO renames Ada.Text_IO ;
use Controlat ;
obj1: Controlat.Objecte; -- Sense inicialitzar, ''Initialize'' s'executa
begin
declare -- àmbit intern fet a posta per a l'exemple
obj2: Controlat.Objecte := (Ada.Finalization.Controlled
with Ptr_A_La_Meva_Carrega => Carrega.Nova_Carrega (Id => 2)); -- ''Initialize'' no actúa
obj3: Controlat.Objecte := (Ada.Finalization.Controlled
with Ptr_A_La_Meva_Carrega => Carrega.Nova_Carrega (Id => 3)); -- ''Initialize'' no actúa
begin
Txt_IO.New_Line; Txt_IO.Put_Line("-- obj2 := obj3 -- finalitza objecte de la var obj2; adjust objecte de la var obj3") ;
obj2 := obj3;
Txt_IO.New_Line;
Txt_IO.Put_Line("-- sortida àmbit intern, variables obj2 i obj3 surten del seu àmbit") ;
end; -- sortida de l'àmbit,
Txt_IO.New_Line;
Txt_IO.Put_Line("-- sortida àmbit extern, variable obj1 surt de l'àmbit") ;
end Principal;
Compila i executa:
gnatmake principal.adb
./principal
dona:
Initialize: Càrrega Id.: 1 Refs: 1 Càrrega Id.: 2 Refs: 1 Càrrega Id.: 3 Refs: 1 -- obj2 := obj3 -- finalitza objecte de la var obj2; adjust objecte de la var obj3 Finalize : Càrrega Id.: 2 Refs: 0; Desallotjat Adjust : Càrrega Id.: 3 Refs: 2 -- sortida àmbit intern, variables obj2 i obj3 surten del seu àmbit Finalize : Càrrega Id.: 3 Refs: 1 Finalize : Càrrega Id.: 3 Refs: 0; Desallotjat -- sortida àmbit extern, variable obj1 surt de l'àmbit Finalize : Càrrega Id.: 1 Refs: 0; Desallotjat
Seamless Wikipedia browsing. On steroids.
Every time you click a link to Wikipedia, Wiktionary or Wikiquote in your browser's search results, it will show the modern Wikiwand interface.
Wikiwand extension is a five stars, simple, with minimum permission required to keep your browsing private, safe and transparent.