Skip to content

Instantly share code, notes, and snippets.

function Levenshtein_Distance (Left, Right : String) return Natural is
D : array (Left'First - 1 .. Left'Last, Right'First - 1 .. Right'Last) of Integer;
begin
for I1 in D'Range (1) loop
D (I1, D'First (2)) := I1;
end loop;
for I2 in D'Range (2) loop
D (D'First (1), I2) := I2;
end loop;
for I1 in Left'Range loop
@ytomino
ytomino / urr.adb
Created March 6, 2011 07:13
Universal Representation of Real numbers
with Ada.Unchecked_Conversion;
with Ada.Numerics.Long_Long_Elementary_Functions;
with Interfaces;
package body URR is
function Shift_Left (Value : URR_Representation; Amount : Natural) return URR_Representation;
pragma Import (Intrinsic, Shift_Left);
function To_URR_Real (X : URR_Representation) return URR_Real is
begin
with Interfaces;
package body UTF_9 is
use type Interfaces.Unsigned_32;
function From_UTF_9 (Single_Character : UTF_9_String) return Wide_Wide_Character is
I : Natural := Single_Character'First;
nonet : Interfaces.Unsigned_32 := UTF_9_Character'Pos (Single_Character (I));
ucs4 : Interfaces.Unsigned_32 := nonet and 8#377#;
begin
while (nonet and 8#400#) /= 0 loop
@ytomino
ytomino / colors.adb
Created March 6, 2011 07:24
RGB - HSV conversion
package body Colors is
function To_HSV (Source : RGB) return HSV is
Max : constant Lightness := Lightness'Max (Lightness'Max (Source.Blue, Source.Green), Source.Red);
Min : constant Lightness := Lightness'Min (Lightness'Min (Source.Blue, Source.Green), Source.Red);
Diff : constant Lightness := Max - Min;
Result : HSV;
begin
Result.Value := Max;
if Max > Min then
@ytomino
ytomino / dda.adb
Created March 6, 2011 07:29
Digital Differential Analyzer
package body DDA is
procedure Line_Excluding_Last (X1, Y1, X2, Y2 : Integer;
Point : not null access procedure (X, Y : Integer))
is
function Sign (X : Integer) return Integer is
begin
if X > 0 then
return 1;
elsif X < 0 then
@ytomino
ytomino / boyer_moore_search.adb
Created March 6, 2011 07:40
Boyer-Moore String Search Algorithm
package body Boyer_Moore_Search is
function Table (Pattern : Array_Type) return Table_Type is
begin
return Result : Table_Type (Pattern'Length - 1) do
-- Table 1
for I in Element_Type loop
Result.Occurrence (I) := -1;
end loop;
for I in Pattern'Range loop
@ytomino
ytomino / crossover.adb
Created March 6, 2011 07:45
The crossover operator for Genetic Algorithm
function Crossover (X, Y : Array_Type; Start_Index : Index_Type) return Array_Type is
Result : Array_Type := X;
Start_Item : constant Element_Type := X (Start_Index);
Index : Index_Type := Start_Index;
begin
while Y (Index) /= Start_Item loop
for I in X'Range loop
if X (I) = Y (Index) then
Result (Index) := Y (Index);
Index := I;
@ytomino
ytomino / difference.adb
Created March 6, 2011 07:53
diff algorithm
with Ada.Unchecked_Deallocation;
with System.Pool_Local;
package body Difference is
procedure Diff (
Left, Right : in Container_Type;
Notify : not null access procedure (
Left_Low : Index_Type; Left_High : Index_Type'Base;
Right_Low : Index_Type; Right_High : Index_Type'Base))
is
@ytomino
ytomino / trampoline.ll
Created May 10, 2011 16:36
LLVM trampoline test
; llvm-as trampoline.ll && llvm-ld trampoline.bc && ./a.out
declare i8* @llvm.init.trampoline(i8*, i8*, i8*)
declare i32 @printf(i8*, ...)
declare void @__enable_execute_stack(i8*) ; libgcc
@flat.fmt = private constant [4 x i8] c"%s\0a\00"
define void @flat(i8* %x) {
@ytomino
ytomino / c++exn.ll
Created May 11, 2011 20:37
LLVM exception test with libstdc++
; llvm-as c++exn.ll && llvm-ld -native c++exn.bc -lstdc++.6 && ./a.out
; LLVM primitives
declare i8* @llvm.eh.exception() nounwind readonly
declare i32 @llvm.eh.selector(i8*, i8*, ...) nounwind
declare i32 @llvm.eh.typeid.for(i8*) nounwind
; libc
declare i32 @puts(i8*)