Source code in the pl/i programming language

*process source xref attributes or(!);
 lsht: Proc Options(main);
 Call test('kitten'      ,'sitting');
 Call test('rosettacode' ,'raisethysword');
 Call test('Sunday'      ,'Saturday');
 Call test('Vladimir_Levenshtein[1965]',
           'Vladimir_Levenshtein[1965]');
 Call test('this_algorithm_is_similar_to',
            'Damerau-Levenshtein_distance');
 Call test('','abc');

 test: Proc(s,t);
 Dcl (s,t) Char(*) Var;
 Put Edit('          1st string  = >'!!s!!'<')(Skip,a);
 Put Edit('          2nd string  = >'!!t!!'<')(Skip,a);
 Put Edit('Levenshtein distance  =',LevenshteinDistance(s,t))
         (Skip,a,f(3));
 Put Edit('')(Skip,a);
 End;

 LevenshteinDistance: Proc(s,t) Returns(Bin Fixed(31));
 Dcl (s,t) Char(*) Var;
 Dcl (sl,tl) Bin Fixed(31);
 Dcl ld      Bin Fixed(31);
 /* for all i and j, d[i,j] will hold the Levenshtein distance between
 *  the first i characters of s and the first j characters of t;
 *  note that d has (m+1)*(n+1) values                               */
 sl=length(s);
 tl=length(t);
 Begin;
   Dcl d(0:sl,0:tl) Bin Fixed(31);
   Dcl (i,j,ii,jj)  Bin Fixed(31);
   d=0;
   Do i=1 To sl;  /* source prefixes can be transformed into         */
     d(i,0)=i;    /* empty string by dropping all characters         */
     End;
   Do j=1 To tl;  /* target prefixes can be reached from             */
     d(0,j)=j;    /* empty source prefix by inserting every character*/
     End;
   Do j=1 To tl;
     jj=j-1;
     Do i=1 To sl;
       ii=i-1;
       If substr(s,i,1)=substr(t,j,1) Then
         d(i,j)=d(ii,jj);                  /* no operation required  */
       Else
         d(i,j)=1+min(d(ii,j),             /* a deletion             */
                      d(i,jj),             /* an insertion           */
                      d(ii,jj));           /* a substitution         */
       End;
     End;
   ld=d(sl,tl);
   End;
 Return(ld);
 End;
 End;

*process source attributes xref or(!);
 ld3: Proc Options(main);
 Dcl ld(0:30,0:30) Bin Fixed(31);
 call test('kitten'      ,'sitting');
 call test('rosettacode' ,'raisethysword');
 call test('Sunday'      ,'Saturday');
 call test('Vladimir_Levenshtein[1965]',
           'Vladimir_Levenshtein[1965]');
 call test('this_algorithm_is_similar_to',
           'Damerau-Levenshtein_distance');
 call test('','abc');

 test: Proc(s,t);
 Dcl (s,t) Char(*);
 ld=-1;
 Put Edit('          1st string  = >'!!s!!'<')(Skip,a);
 Put Edit('          2nd string  = >'!!t!!'<')(Skip,a);
 Put Edit('Levenshtein distance  =',
          LevenshteinDistance(s,length(s),t,length(t)))
         (Skip,a,f(3));
 Put Edit('')(Skip,a);
 End;

 LevenshteinDistance: Proc(s,sl,t,tl) Recursive Returns(Bin Fixed(31));
 Dcl (s,t) Char(*);
 Dcl (sl,tl) Bin Fixed(31);
 Dcl cost    Bin Fixed(31);
 If ld(sl,tl)^=-1 Then
   Return(ld(sl,tl));
 Select;
   When(sl=0) ld(sl,tl)=tl;
   When(tl=0) ld(sl,tl)=sl;
   Otherwise Do;
     /* test if last characters of the strings match */
     cost=(substr(s,sl,1)^=substr(t,tl,1));
     /* return minimum of delete char from s, delete char from t,
        and delete char from both */
     ld(sl,tl)=min(LevenshteinDistance(s,sl-1,t,tl  )+1,
                   LevenshteinDistance(s,sl  ,t,tl-1)+1,
                   LevenshteinDistance(s,sl-1,t,tl-1)+cost));
     End;
   End;
 Return(ld(sl,tl));
 End;
 End;