|
Ada (llenguatge de programació)
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] 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] Programa d'exempleAquest 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 CompiladorsDes del Març de 2008 es disposa d'una versió experimental sobre el sistema LLVM.[5]
CaracterístiquesEspecificació i API biblioteca estàndard aquí.[6] Lèxic
Sintaxi dels blocs de codifunction | procedure | declare
-- declaracions
begin
-- instruccions
exception
-- gestors d'excepcions:
when E: TipusExcepcio => -- tractament
when E: others => -- tracta altres excepcions
end NomDelBloc ;
TipusSi no s'especifica un tipus predefinit, es dedueix el tipus base per les clàusules de restricció:
sencersPredefinits:
type Recompte is range 0 .. 999 -- restricció de rang sobre sencers
aritmètica sense signe (modulars)
type Byte is mod 2**8
enumerats (discrets)
type Hexa is ('0', '9', 'A', 'B', 'C', 'D', 'E', 'F');
type Boolean is (False, True) ;
type Opcions is (OpcioA, OpcioB, OpcioC)
coma-flotant
type Percentatge is digits 4 range 0.0 .. 1.0 -- coma-flotant precisió amb restricció de rang
coma-fixa
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.
Entrada / Sortida específica per tipusEls 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) ;
Atributs
-- lectura
Positive'First -- el primer del tipus
-- escriptura
for Tipus'Atribut use ValorNouDeLAtribut -- modificació d'atributs actualitzables
Constructor del tipus i conversions-- constructor i components especificant '(x ,..) l'atribut per defecte: el constructor
K: Positive := Positive'(10)
-- conversió amb NomDelTipus(expressió)
Percentatge(Valor/100.0)
Tipus derivats i subtipus
type Poma is new Recompte range 0 .. 100
subtype OuDeLaDotzena is OuDelGalliner range 0 .. 12
Registres i punters
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 ;
Vectors, Tipus paramètrics, Variants
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 ;
Genèrics - Parametrització de tipus en mòduls, procediments i funcions
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
Depuració, Assercions i ContractesAssercionsDes 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) ; Precondicions i PostcondicionsDes 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;
API estàndard i predefinits
Gestió de memòriaAda permet a l'usuari un control fi de la gestió de memòria així com definir els seus propis gestors.[14] Tipus de gestorsGestors d'allotjament de mem. dinàmica (Storage_Pool) assignables a diferents tipus de dades[15][16] Munt d'allotjament (ang: heap) principal de vida il·limitadaAmb 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] Munt d'allotjament amb vida associada a un àmbitAmb 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.
Munt d'allotjament a la pilaAmb 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]
Tipus de punters
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
Registres amb membres punters i restricció de còpia/comparació superficials
Allotjament i desallotjament de dades referides per punters
Directives de compilació (Pragma) relacionades amb la memòria
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. herència
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 ;
Constructors, Destructors i ClonadorsPer 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]
Tipus definits per signatures (Interface)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 ;
Concurrència
Compilació
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
Fitxer de configuració del projecte
L'ordre d'inicialització dels mòdulsEl 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)
Generació de bibliotequesEn 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] JGNAT a la Màquina Virtual JavaAdaCore, 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
ExemplesComposició. Mòduls genèrics i Functors
-- 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 Composició en O.O. - Parametritzant per tipus d'objecteParametritzant 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 Comunicació síncrona (rendez-vous)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
Transferència de control asíncronaCà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;
protected - Exclusió mútua i accés condicionatLa 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
Allotjament dinàmic i Memòria d'àmbitVegeu #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
O.O. - Finalització controlada - Estructura amb component allotjat dinàmicament i comptador de referènciesClasse 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 Vegeu tambéReferències
BibliografiaEnllaços externs A Wikimedia Commons hi ha contingut multimèdia relatiu a: Ada
|
||||||||||||||||||||||||||||
Index:
pl ar de en es fr it arz nl ja pt ceb sv uk vi war zh ru af ast az bg zh-min-nan bn be ca cs cy da et el eo eu fa gl ko hi hr id he ka la lv lt hu mk ms min no nn ce uz kk ro simple sk sl sr sh fi ta tt th tg azb tr ur zh-yue hy my ace als am an hyw ban bjn map-bms ba be-tarask bcl bpy bar bs br cv nv eml hif fo fy ga gd gu hak ha hsb io ig ilo ia ie os is jv kn ht ku ckb ky mrj lb lij li lmo mai mg ml zh-classical mr xmf mzn cdo mn nap new ne frr oc mhr or as pa pnb ps pms nds crh qu sa sah sco sq scn si sd szl su sw tl shn te bug vec vo wa wuu yi yo diq bat-smg zu lad kbd ang smn ab roa-rup frp arc gn av ay bh bi bo bxr cbk-zam co za dag ary se pdc dv dsb myv ext fur gv gag inh ki glk gan guw xal haw rw kbp pam csb kw km kv koi kg gom ks gcr lo lbe ltg lez nia ln jbo lg mt mi tw mwl mdf mnw nqo fj nah na nds-nl nrm nov om pi pag pap pfl pcd krc kaa ksh rm rue sm sat sc trv stq nso sn cu so srn kab roa-tara tet tpi to chr tum tk tyv udm ug vep fiu-vro vls wo xh zea ty ak bm ch ny ee ff got iu ik kl mad cr pih ami pwn pnt dz rmy rn sg st tn ss ti din chy ts kcg ve
Portal di Ensiklopedia Dunia
