Abbreviations, simple: Difference between revisions

</pre>

=={{header|Ada}}==

<lang Ada>with Ada.Characters.Handling;

with Ada.Containers.Vectors;

with Ada.Strings.Fixed;

with Ada.Strings.Unbounded;

with Ada.Text_Io;

procedure Abbreviations_Simple is

use Ada.Strings.Unbounded;

subtype Ustring is Unbounded_String;

Empty_String : constant Ustring := Null_Unbounded_String;

type Word_Entry is record

Word : Ustring;

Min : Natural;

end record;

package Abbreviation_Vectors

is new Ada.Containers.Vectors (Index_Type => Positive,

Element_Type => Word_Entry);

use Abbreviation_Vectors;

type Scan_State is (Idle, In_Word, After_Word, In_Count);

Abbrev : Vector;

State : Scan_State := Idle;

Word : Ustring;

Count : Ustring;

procedure Append (Word_List : String)

is

procedure Flush is

Min : constant Natural := (if Count = ""

then Length (Word)

else Natural'Value (To_String (Count)));

begin

if Word /= Empty_String then

Append (Abbrev, Word_Entry'(Word => Word, Min => Min));

end if;

Word := Empty_String;

Count := Empty_String;

end Flush;

begin

for Char of Word_List loop

case Char is

when 'a' .. 'z' | 'A' .. 'Z' =>

case State is

when Idle | In_Count | After_Word =>

Flush;

State := In_Word;

when In_Word => null;

end case;

Append (Word, Char);

when '0' .. '9' =>

case State is

when Idle | In_Word =>

State := In_Count;

when In_Count => null;

when After_Word =>

State := In_Count;

Count := Empty_String;

end case;

Append (Count, Char);

when ' ' =>

case State is

when In_Word =>

State := After_Word;

when In_Count =>

Flush;

State := Idle;

when Idle | After_Word => null;

end case;

when others =>

raise Constraint_Error with "unexpected input";

end case;

end loop;

case State is

when In_Count =>

Flush;

State := Idle;

when In_Word =>

State := After_Word;

when others =>

null;

end case;

end Append;

function Match (Word : String) return String is

use Ada.Characters.Handling;

use Ada.Strings.Fixed;

Result : Ustring := To_Unbounded_String ("*error*");

Min : Natural := 0;

Upper_Word : constant String := To_Upper (Word);

begin

if Upper_Word = "" then

return "";

end if;

for Candidate of Abbrev loop

declare

Upper_Cand : constant String := To_Upper (To_String (Candidate.Word));

Length : constant Natural := Natural'Max (Candidate.Min,

Upper_Word'Length);

Upper_Abbrev_Cand : constant String := Head (Upper_Cand, Length);

Upper_Abbrev_Word : constant String := Head (Upper_Word, Length);

begin

if Upper_Word = Upper_Cand

and then Upper_Word'Length > Min

then

Result := To_Unbounded_String (Upper_Cand);

Min := Upper_Word'Length;

elsif Upper_Abbrev_Word = Upper_Abbrev_Cand

and then Upper_Abbrev_Word'Length > Min

then

Result := To_Unbounded_String (Upper_Cand);

Min := Upper_Abbrev_Word'Length;

end if;

end;

end loop;

return To_String (Result);

end Match;

procedure Put_Match (To : String) is

use Ada.Text_Io;

begin

Put ("Match to '"); Put (To);

Put ("' is '"); Put (Match (To));

Put_Line ("'");

end Put_Match;

procedure A (Item : String) renames Append;

begin

A ("add 1 alter 3 backup 2 bottom 1 Cappend 2 change 1 Schange Cinsert 2 Clast 3");

A ("compress 4 copy 2 count 3 Coverlay 3 cursor 3 delete 3 Cdelete 2 down 1 duplicate");

A ("3 xEdit 1 expand 3 extract 3 find 1 Nfind 2 Nfindup 6 NfUP 3 Cfind 2 findUP 3 fUP 2");

A ("forward 2 get help 1 hexType 4 input 1 powerInput 3 join 1 split 2 spltJOIN load");

A ("locate 1 Clocate 2 lowerCase 3 upperCase 3 Lprefix 2 macro merge 2 modify 3 move 2");

A ("msg next 1 overlay 1 parse preserve 4 purge 3 put putD query 1 quit read recover 3");

A ("refresh renum 3 repeat 3 replace 1 Creplace 2 reset 3 restore 4 rgtLEFT right 2 left");

A ("2 save set shift 2 si sort sos stack 3 status 4 top transfer 3 type 1 up 1");

Put_Match ("rePEAT");

Put_Match ("copies");

Put_Match ("put");

Put_Match ("mo");

Put_Match ("rest");

Put_Match ("types");

Put_Match ("fup.");

Put_Match ("6");

Put_Match ("poweRin");

Put_Match ("");

end Abbreviations_Simple;</lang>

{{out}}

<pre>

Match to 'rePEAT' is 'REPEAT'

Match to 'copies' is '*error*'

Match to 'put' is 'PUT'

Match to 'mo' is 'MOVE'

Match to 'rest' is 'RESTORE'

Match to 'types' is '*error*'

Match to 'fup.' is '*error*'

Match to '6' is '*error*'

Match to 'poweRin' is 'POWERINPUT'

Match to '' is ''