<# Start with a string of the commands #>
$cmdTableStr =
"Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy
 COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find
 NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput
 Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO
 MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT
 READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT
 RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up"
<# String of inputs #>
$userWordStr = "riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin"

$outputStr = $null # Set this string to null only so all variables are intialized

$cmdTabArray = @() # Arrays for the commands and the inputs
$userWordArray = @()

<# Split the strings into arrays using a space as the delimiter.
   This also removes "blank" entries, which fits the requirement
   "A blank input (or a null input) should return a null string." #>
$cmdTabArray = $cmdTableStr.Split(" ", [System.StringSplitOptions]::RemoveEmptyEntries)
$userWordArray = $userWordStr.Split(" ", [System.StringSplitOptions]::RemoveEmptyEntries)

<# Begins a loop to iterate through the inputs #>
foreach($word in $userWordArray)
{
    $match = $false # Variable set to false so that if a match is never found, the "*error*" string can be appended
    foreach($cmd in $cmdTabArray)
    {
        <# This test: 1) ensures inputs match the leading characters of the command
                      2) are abbreviations of the command
                      3) the abbreviations is at least the number of capital characters in the command #>
        if($cmd -like "$word*" -and ($word.Length -ge ($cmd -creplace '[a-z]').Length))
        {
            $outputStr += $cmd.ToUpper() + " " # Adds the command in all caps to the output string
            $match = $true # Sets the variable so that "*error*" is not appended
            break # Break keep the loop from continuing and wasting time once a match was found
        }
    }
    if($match -eq $false){ $outputStr += "*error* " } # Appends error if no match was found
}
# Below lines display the input and output
"User text: " + $userWordStr
"Full text: " + $outputStr


ack(m,n)
 where
  ack(m,n) = if m eq 0 then n+1
                       else if n eq 0 then ack(m-1,1)
                                      else ack(m-1, ack(m, n-1)) fi
                       fi;
 end


:- initialization(main).

command_table("Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy
COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find
NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput
Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO
MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT
READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT
RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up").

validate("", _, "") :- !.

validate(Word, Commands, Result) :-
    member(Command, Commands),
    string_concat(Prefix, Suffix, Command),
    string_upper(Prefix, Prefix),
    string_lower(Suffix, Suffix),
    string_lower(Word, LowWord),
    string_lower(Prefix, LowPrefix),
    string_concat(LowPrefix, _, LowWord),
    string_lower(Command, LowCommand),
    string_concat(LowWord, _, LowCommand),
    string_upper(Command, Result),
    !.

validate(_, _, "*error*").

main :-
    current_prolog_flag(argv, Args),
    command_table(Table),
    split_string(Table, " \t\n", "", Commands),
    forall(member(Arg, Args), (
        atom_string(Arg, Word),
        validate(Word, Commands, Result),
        format("~w ", Result)
    )),
    nl.


command_table_text = \
"""Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy
COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find
NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput
Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO
MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT
READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT
RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up"""

user_words = "riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin"

def find_abbreviations_length(command_table_text):
    """ find the minimal abbreviation length for each word by counting capital letters.
        a word that does not have capital letters gets it's full length as the minimum.
    """
    command_table = dict()
    for word in command_table_text.split():
        abbr_len = sum(1 for c in word if c.isupper())
        if abbr_len == 0:
            abbr_len = len(word)
        command_table[word] = abbr_len
    return command_table

def find_abbreviations(command_table):
    """ for each command insert all possible abbreviations"""
    abbreviations = dict()
    for command, min_abbr_len in command_table.items():
        for l in range(min_abbr_len, len(command)+1):
            abbr = command[:l].lower()
            abbreviations[abbr] = command.upper()
    return abbreviations

def parse_user_string(user_string, abbreviations):
    user_words = [word.lower() for word in user_string.split()]
    commands = [abbreviations.get(user_word, "*error*") for user_word in user_words]
    return " ".join(commands)

command_table = find_abbreviations_length(command_table_text)
abbreviations_table = find_abbreviations(command_table)

full_words = parse_user_string(user_words, abbreviations_table)

print("user words:", user_words)
print("full words:", full_words)


function ackermann(m: int, n: int): int = (
   if m==0 then n+1
   else if n==0 then ackermann(m-1,1)
   else ackermann(m-1,ackermann(m,n-1))
)


#lang racket

(define command-string
  "Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy
   COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find
   NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput
   Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO
   MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT
   READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT
   RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up")

(define input-string
  "riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin")

(define (make-command command)
  (cons (string-upcase command)
        (list->string (takef (string->list command) char-upper-case?))))

(define commands (map make-command (string-split command-string)))

(string-join
 (for/list ([s (in-list (string-split input-string))])
   (define up (string-upcase s))
   (or (for/or ([command (in-list commands)])
         (match-define (cons full-command abbrev) command)
         (and (string-prefix? up abbrev)
              (string-prefix? full-command up)
              full-command))
       "*error*"))
 " ")


<
Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy
COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find
NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput
Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO
MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT
READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT
RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up
> ~~ m:g/ ((<.:Lu>+) <.:Ll>*) /;

my %abr = '' => '', |$/.map: {
    my $abbrv = .[0].Str.fc;
    |map { $abbrv.substr( 0, $_ ) => $abbrv.uc },
    .[0][0].Str.chars .. $abbrv.chars
};

sub abbr-easy ( $str ) { %abr{$str.trim.fc} // '*error*' }

# Testing
for 'riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin', '' -> $str {
    put ' Input: ', $str;
    put 'Output: ', join ' ', $str.words.map: &abbr-easy;
}


Module Checkit {
      Def ackermann(m,n) =If(m=0-> n+1, If(n=0-> ackermann(m-1,1), ackermann(m-1,ackermann(m,n-1))))
      For m = 0 to 3 {For n = 0 to 4 {Print m;" ";n;" ";ackermann(m,n)}}
}
Checkit

Module Checkit {
      Module Inner (ack) {
            For m = 0 to 3 {For n = 0 to 4 {Print m;" ";n;" ";ack(m,n)}}
      }
      Inner lambda (m,n) ->If(m=0-> n+1, If(n=0-> lambda(m-1,1),lambda(m-1,lambda(m,n-1))))
}
Checkit


/*REXX program validates a user  "word"  against a  "command table"  with abbreviations.*/
parse arg uw                                     /*obtain optional arguments from the CL*/
if uw=''  then uw= 'riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin'
say 'user words: '   uw

@= 'Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy'   ,
   'COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find'   ,
   'NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput'   ,
   'Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO'   ,
   'MErge MOve MODify MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT'   ,
   'READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT'   ,
   'RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up'

say 'full words: '   validate(uw)                /*display the result(s) to the terminal*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
validate: procedure expose @;  arg x;  upper @   /*ARG   capitalizes all the  X  words. */
          $=                                     /*initialize the return string to null.*/
             do j=1  to words(x);   _=word(x, j) /*obtain a word from the     X  list.  */
               do k=1  to words(@); a=word(@, k) /*get a legitimate command name from @.*/
               L=verify(_, 'abcdefghijklmnopqrstuvwxyz', "M")  /*maybe get abbrev's len.*/
               if L==0  then L=length(_)         /*0?  Command name can't be abbreviated*/
               if abbrev(a, _, L)   then do; $=$ a;  iterate j;  end  /*is valid abbrev?*/
               end   /*k*/
             $=$ '*error*'                       /*processed the whole list, not valid. */
             end     /*j*/
          return strip($)                        /*elide the superfluous leading blank. */


#!/usr/bin/env ruby

cmd_table = File.read(ARGV[0]).split
user_str = File.read(ARGV[1]).split

user_str.each do |abbr|
  candidate = cmd_table.find do |cmd|
    cmd.count('A-Z') <= abbr.length && abbr.casecmp(cmd[0...abbr.length]).zero?
  end

  print candidate.nil? ? '*error*' : candidate.upcase

  print ' '
end

puts


use std::collections::HashMap;

fn main() {
    let commands = "
        Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy \
        COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find \
        NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput \
        Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO \
        MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT \
        READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT \
        RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up \
    ";
    let split = commands.split_ascii_whitespace();
    let count_hashtable: HashMap<&str, usize> = split.map(|word| {
        (word, word.chars().take_while(|c| c.is_ascii_uppercase()).count())
    }).collect();

    let line = "riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin";
    let mut words_vec: Vec<String> = vec![];
    for word in line.split_ascii_whitespace() {
        let split = commands.split_ascii_whitespace();
        let abbr = split.filter(|x| {
            x.to_ascii_lowercase().starts_with(&word.to_ascii_lowercase()) &&
            word.len() >= *count_hashtable.get(x).unwrap()
        }).next();
        words_vec.push(match abbr {
            Some(word) => word.to_ascii_uppercase(),
            None => String::from("*error*"),
        });
    }
    let corrected_line = words_vec.join(" ");
    println!("{}", corrected_line);
}


object Main extends App {
    implicit class StrOps(i: String) {
        def isAbbreviationOf(target: String): Boolean = {
            @scala.annotation.tailrec
            def checkPAsPrefixOfM(p: List[Char], m: List[Char]): Boolean = (p, m) match {
                case (Nil, _) => true //prefix empty
                case (_, Nil) => false //main string empty
                case (ph :: pt, mh :: mt) if ph.toUpper == mh.toUpper => checkPAsPrefixOfM(pt, mt) //case insensitive match of head characters
                case _ => false
            }
            i.length >= target.count(_.isUpper) && checkPAsPrefixOfM(i.toList, target.toList)
        }
    }

    val commands = """
              |Add ALTer BAckup Bottom CAppend Change SCHANGE CInsert CLAst COMPress COpy
              |COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find
              |NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput
              |Join SPlit SPLTJOIN LOAD Locate CLocate LOWercase UPPercase LPrefix MACRO
              |MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD Query QUIT
              |READ RECover REFRESH RENum REPeat Replace CReplace RESet RESTore RGTLEFT
              |RIght LEft SAVE SET SHift SI SORT SOS STAck STATus TOP TRAnsfer Type Up
      """.stripMargin.replace("\n", " ").trim.split(" ")

    val input = "riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin".split(" ").filter(!_.isEmpty)

    val resultLine = input.map{ i =>
        commands.find(c => i.isAbbreviationOf(c)).map(_.toUpperCase).getOrElse("*error*")
    }.mkString(" ")

    println(resultLine)
}


            NORMAL MODE IS INTEGER
            DIMENSION LIST(3000)
            SET LIST TO LIST

            INTERNAL FUNCTION(DUMMY)
            ENTRY TO ACKH.
LOOP        WHENEVER M.E.0
                FUNCTION RETURN N+1
            OR WHENEVER N.E.0
                M=M-1
                N=1
                TRANSFER TO LOOP
            OTHERWISE
                SAVE RETURN
                SAVE DATA M
                N=N-1
                N=ACKH.(0)
                RESTORE DATA M
                RESTORE RETURN
                M=M-1
                TRANSFER TO LOOP
            END OF CONDITIONAL
            ERROR RETURN
            END OF FUNCTION

            INTERNAL FUNCTION(MM,NN)
            ENTRY TO ACK.
            M=MM
            N=NN
            FUNCTION RETURN ACKH.(0)
            END OF FUNCTION

            THROUGH SHOW, FOR I=0, 1, I.G.3
            THROUGH SHOW, FOR J=0, 1, J.G.8
SHOW        PRINT FORMAT ACKF,I,J,ACK.(I,J)

            VECTOR VALUES ACKF = $4HACK(,I1,1H,,I1,4H) = ,I4*$
            END OF PROGRAM


Ackermann := proc( m :: nonnegint, n :: nonnegint )
  option remember; # optional automatic memoization
  if m = 0 then
    n + 1
  elif n = 0 then
    thisproc( m - 1, 1 )
  else
    thisproc( m - 1, thisproc( m, n - 1 ) )
  end if
end proc:


proc appendCmd {word} {
  # Procedure to append the correct command from the global list ::cmds
  # for the word given as parameter to the global list ::result.
  # If a matching word has been found and appended to ::result, this procedure
  # behaves like a "continue" statement, causing the loop containing it to
  # jump over the rest of the body.
  set candidates [lsearch -inline -all -nocase -glob $::cmds "${word}*"]
  foreach cand $candidates {
    if {[string length $word] >= $::minLen($cand)} {
      lappend ::result [string toupper $cand]
      return -code continue
    }
  }
}

set cmds {Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy
   COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find
   NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput
   Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO
   MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT
   READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT
   RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up}

# Find the minimum lengths necessary for each command.
foreach c $cmds {
  regexp {^[A-Z]+} $c match
  set minLen($c) [string length $match]
}

set words {riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin}
set result {}

foreach w $words {
  appendCmd $w
  lappend result *error*
}

puts $result


Private Function ValidateUserWords(userstring As String) As String
    Dim s As String
    Dim user_words() As String
    Dim command_table As Scripting.Dictionary
    Set command_table = New Scripting.Dictionary
    Dim abbreviations As Scripting.Dictionary
    Set abbreviations = New Scripting.Dictionary
    abbreviations.CompareMode = TextCompare
    Dim commandtable() As String
    Dim commands As String
    s = s & "Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy "
    s = s & "COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find "
    s = s & "NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput "
    s = s & "Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO "
    s = s & "MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT "
    s = s & "READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT "
    s = s & "RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up "
    commandtable = Split(s, " ")
    Dim i As Integer
    For Each word In commandtable
        If Len(word) > 0 Then
            i = 1
            Do While Mid(word, i, 1) >= "A" And Mid(word, i, 1) <= "Z"
                i = i + 1
            Loop
            command_table.Add Key:=word, Item:=i - 1
        End If
    Next word
    For Each word In command_table
        For i = command_table(word) To Len(word)
            On Error Resume Next
            abbreviations.Add Key:=Left(word, i), Item:=UCase(word)
        Next i
    Next word
    user_words() = Split(userstring, " ")
    For Each word In user_words
        If Len(word) > 0 Then
            If abbreviations.exists(word) Then
                commands = commands & abbreviations(word) & " "
            Else
                commands = commands & "*error* "
            End If
        End If
    Next word
    ValidateUserWords = commands
End Function
Public Sub program()
    Dim guserstring As String
    guserstring = "riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin"
    Debug.Print "user words:", guserstring
    Debug.Print "full words:", ValidateUserWords(guserstring)
End Sub


$RecursionLimit=Infinity
Ackermann1[m_,n_]:=
 If[m==0,n+1,
  If[ n==0,Ackermann1[m-1,1],
   Ackermann1[m-1,Ackermann1[m,n-1]]
  ]
 ]

 Ackermann2[0,n_]:=n+1;
 Ackermann2[m_,0]:=Ackermann1[m-1,1];
 Ackermann2[m_,n_]:=Ackermann1[m-1,Ackermann1[m,n-1]]


// Command table:
Buf_Switch(#10=Buf_Free)
Ins_Text("
   Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy
   COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find
   NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput
   Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO
   MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT
   READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT
   RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up
")

// Example input:
Buf_Switch(#11=Buf_Free)
Ins_Text("riG rePEAT copies  put mo   rest    types   fup.    6       poweRin ")
BOF

// Main program
#20 = Reg_Free()			// Text register for the word to be converted
Repeat(ALL) {
    Buf_Switch(#11)			// Buffer for example input
    Search("|!|X", ERRBREAK)		// Find next non-space character
    #30 = Cur_Pos			// #30 = begin of a word
    Search("|X", NOERR+NORESTORE)	// Find whitespace (end of the word)
    Reg_Copy_Block(#20, #30, Cur_Pos)	// Get the word to text register #20
    Call("acronym_to_word")		// Convert acronym to full word
    Reg_Type(#20)			// Display the full word
    Type_Char(' ')			// Display a space character
}
Buf_Switch(#10) Buf_Quit(OK)		// Clean-up
Buf_Switch(#11) Buf_Quit(OK)
Reg_Empty(#20)
Return

// Convert an acronym to full word in uppercase
// Input:  @(#20) = the acronym
// Return: @(#20) = the full word
//
:acronym_to_word:
if (Reg_Size(#20) == 0) {		// If zero length input,
    return				// return zero length string
}
Buf_Switch(#10)				// Switch to command table
BOF
While (!At_EOF) {
    if (Search("|S|@(#20)", NOERR)) {		// Find (the first part of) the word
	Char					// Skip the separator
	#31 = Cur_Pos				// #31 = Begin of the acronym
	Char(Reg_Size(#20))			// Check if the acronym is log enough
	if (Cur_Char < 'A' || Cur_Char > 'Z') {	// Not a capital letter, verified
	    Search("|X")			// Find the end of the word
	    Reg_Copy_Block(#20, #31, Cur_Pos)	// Get the word into text register #20
	    Buf_Switch(Buf_Free)		// Convert to upper case using tmp buffer
	    Reg_Ins(#20)
	    Case_Upper_Block(0, Cur_Pos)
	    Reg_Copy_Block(#20, 0, Cur_Pos)
	    Buf_Quit(OK)
	    break				// Word found, exit loop
	}
    } else {					// Not found
	Reg_Set(#20, "*error*")
	break
    }
}
Return


function A = ackermannFunction(m,n)
    if m == 0
        A = n+1;
    elseif (m > 0) && (n == 0)
        A = ackermannFunction(m-1,1);
    else
        A = ackermannFunction( m-1,ackermannFunction(m,n-1) );
    end
end


import encoding.utf8

fn validate(commands []string, words []string, min_len []int) []string {
    mut results := []string{}
    if words.len == 0 {
        return results
    }
    for word in words {
        mut match_found := false
        wlen := word.len
        for i, command in commands {
            if min_len[i] == 0 || wlen < min_len[i] || wlen > command.len {
                continue
            }
            c := utf8.to_upper(command)
            w := utf8.to_upper(word)
            if c.index(w) or {-1} ==0 {
                results << c
                match_found = true
                break
            }
        }
        if !match_found {
            results << "*error*"
        }
    }
    return results
}

fn main() {
mut table := "Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy " +
    "COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find " +
    "NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput " +
     "Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO " +
    "MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT " +
    "READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT " +
    "RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up "
    table = table.trim_space()
    commands := table.fields()
    clen := commands.len
    mut min_len := []int{len: clen}
    for i in 0..clen {
        mut count := 0
        for c in commands[i].split('') {
            if c >= 'A' && c <= 'Z' {
                count++
            }
        }
        min_len[i] = count
    }
    sentence :=  "riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin"
    words := sentence.fields()
    results := validate(commands, words, min_len)
    for j in 0..words.len {
        print("${words[j]} ")
    }
    print("\nfull words:  ")
    println(results.join(" "))
}


import "/fmt" for Fmt
import "/str" for Str

var table =
    "Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy " +
    "COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find " +
    "NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput " +
     "Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO " +
    "MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT " +
    "READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT " +
    "RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up"

var validate = Fn.new { |commands, words, minLens|
    var results = []
    if (words.count == 0) return results
    for (word in words) {
        var matchFound = false
        var wlen = word.count
        for (i in 0...commands.count) {
            var command = commands[i]
            if (minLens[i] != 0 && wlen >= minLens[i] && wlen <= command.count) {
                var c = Str.upper(command)
                var w = Str.upper(word)
                if (c.startsWith(w)) {
                    results.add(c)
                    matchFound = true
                    break
                }
            }
        }
        if (!matchFound) results.add("*error*")
    }
    return results
}

var commands = table.split(" ")
// get rid of empty entries
for (i in commands.count-1..0) if (commands[i] == "") commands.removeAt(i)
var clen = commands.count
var minLens = [0] * clen
for (i in 0...clen) {
    var count = 0
    for (c in commands[i].codePoints) {
        if (c >= 65 && c <= 90) count = count + 1 // A to Z
    }
    minLens[i] = count
}
var sentence = "riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin"
var words = sentence.split(" ")
// get rid of empty entries
for (i in words.count-1..0) if (words[i] == "") words.removeAt(i)
var results = validate.call(commands, words, minLens)
System.write("user words:  ")
for (j in 0...words.count) {
    System.write("%(Fmt.s(-results[j].count, words[j])) ")
}
System.write("\nfull words:  ")
System.print(results.join(" "))


ackermann(m, n) := if integerp(m) and integerp(n) then ackermann[m, n] else 'ackermann(m, n)$

ackermann[m, n] := if m = 0 then n + 1
                   elseif m = 1 then 2 + (n + 3) - 3
                   elseif m = 2 then 2 * (n + 3) - 3
                   elseif m = 3 then 2^(n + 3) - 3
                   elseif n = 0 then ackermann[m - 1, 1]
                   else ackermann[m - 1, ackermann[m, n - 1]]$

tetration(a, n) := if integerp(n) then block([b: a], for i from 2 thru n do b: a^b, b) else 'tetration(a, n)$

/* this should evaluate to zero */
ackermann(4, n) - (tetration(2, n + 3) - 3);
subst(n = 2, %);
ev(%, nouns);


data "Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy"
data "COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find"
data "NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput"
data "Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO"
data "MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT"
data "READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT"
data "RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up"
data ""

dim abrev$(1)

do
    read a$
    if a$ = "" break
    s$ = s$ + " " + a$
loop

size = token(s$, abrev$())

do
    input "Input abbreviation: " a$
    l1 = len(a$)

    if l1 = 0 break
    test = false
    for i = 1 to size
        l2 = uppers(abrev$(i))
        if lower$(left$(abrev$(i), l1)) = lower$(left$(a$, l1)) and l1 >= l2 then
            print upper$(abrev$(i))
            test = true
        end if
    next
    if not test print "*error*"
loop

sub uppers(s$)
    local l, i, c$, n

    l = len(s$)
    for i = 1 to l
        c$ = mid$(s$, i, 1)
        if c$ >= "A" and c$ <= "Z" n = n + 1
    next
    return n
end sub


commands:=Data(0,String,	// "Add\0ALTer\0..."
#<<<
"Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy
 COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find
 NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput
 Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO
 MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT
 READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT
 RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up "
.split());
#<<<

testText:=" riG   rePEAT copies  put mo   rest    types "
	  "fup.    6       poweRin";

testText.split().apply('wrap(word){
   sz,w := word.len(),word + "*";
   foreach c in (commands){	// rather inelegant but gotta ignore case
      // check for length requirement and, if there, verify
      if(c.matches(w) and sz>=(c-"abcdefghijklmnopqrstuvwxyz").len())
	 return(c.toUpper());
   }
   "*error*"
.concat(" ").println();


fn ackermann m n =
(
    if m == 0 then
    (
        return n + 1
    )
    else if n == 0 then
    (
        ackermann (m-1) 1
    )
    else
    (
        ackermann (m-1) (ackermann m (n-1))
    )
)


:- func ack(integer, integer) = integer.
ack(M, N) = R :- ack(M, N, R).

:- pred ack(integer::in, integer::in, integer::out) is det.
ack(M, N, R) :-
	( ( M < integer(0)
	  ; N < integer(0) ) -> throw(bounds_error)
	; M = integer(0)     -> R = N + integer(1)
	; N = integer(0)     -> ack(M - integer(1), integer(1), R)
	;                       ack(M - integer(1), ack(M, N - integer(1)), R) ).


(
  :n :m
  (
    ((m 0 ==) (n 1 +))
    ((n 0 ==) (m 1 - 1 ackermann))
    ((true) (m 1 - m n 1 - ackermann ackermann))
  ) case
) :ackermann


ackermann = function(m, n)
    if m == 0 then return n+1
    if n == 0 then return ackermann(m - 1, 1)
    return ackermann(m - 1, ackermann(m, n - 1))
end function

for m in range(0, 3)
    for n in range(0, 4)
        print "(" + m + ", " + n + "): " + ackermann(m, n)
    end for
end for


fun ackermann( 0, n ) = n + 1
	| ( m, 0 ) = ackermann( m - 1, 1 )
	| ( m, n ) = ackermann( m - 1, ackermann(m, n - 1) )


MODULE ackerman;

IMPORT  ASCII, NumConv, InOut;

VAR     m, n            : LONGCARD;
        string          : ARRAY [0..19] OF CHAR;
        OK              : BOOLEAN;

PROCEDURE Ackerman (x, y   : LONGCARD) : LONGCARD;

BEGIN
  IF    x = 0  THEN  RETURN  y + 1
  ELSIF y = 0  THEN  RETURN  Ackerman (x - 1 , 1)
  ELSE
    RETURN  Ackerman (x - 1 , Ackerman (x , y - 1))
  END
END Ackerman;

BEGIN
  FOR  m := 0  TO  3  DO
    FOR  n := 0  TO  6  DO
      NumConv.Num2Str (Ackerman (m, n), 10, string, OK);
      IF  OK  THEN
        InOut.WriteString (string)
      ELSE
        InOut.WriteString ("* Error in number * ")
      END;
      InOut.Write (ASCII.HT)
    END;
    InOut.WriteLn
  END;
  InOut.WriteLn
END ackerman.


MODULE Ack EXPORTS Main;

FROM IO IMPORT Put;
FROM Fmt IMPORT Int;

PROCEDURE Ackermann(m, n: CARDINAL): CARDINAL =
  BEGIN
    IF m = 0 THEN
      RETURN n + 1;
    ELSIF n = 0 THEN
      RETURN Ackermann(m - 1, 1);
    ELSE
      RETURN Ackermann(m - 1, Ackermann(m, n - 1));
    END;
  END Ackermann;

BEGIN
  FOR m := 0 TO 3 DO
    FOR n := 0 TO 6 DO
      Put(Int(Ackermann(m, n)) & " ");
    END;
    Put("\n");
  END;
END Ack.


Ackermann(m,n)	;
	If m=0 Quit n+1
	If m>0,n=0 Quit $$Ackermann(m-1,1)
	If m>0,n>0 Quit $$Ackermann(m-1,$$Ackermann(m,n-1))
	Set $Ecode=",U13-Invalid parameter for Ackermann: m="_m_", n="_n_","

Write $$Ackermann(1,8) ; 10
Write $$Ackermann(2,8) ; 19
Write $$Ackermann(3,5) ; 253


/**
 Ackermann recursion, in Neko
 Tectonics:
    nekoc ackermann.neko
    neko ackermann 4 0
*/
ack = function(x,y) {
   if (x == 0) return y+1;
   if (y == 0) return ack(x-1,1);
   return ack(x-1, ack(x,y-1));
};

var arg1 = $int($loader.args[0]);
var arg2 = $int($loader.args[1]);

/* If not given, or negative, default to Ackermann(3,4) */
if (arg1 == null || arg1 < 0) arg1 = 3;
if (arg2 == null || arg2 < 0) arg2 = 4;

try
   $print("Ackermann(", arg1, ",", arg2, "): ", ack(arg1,arg2), "\n")
catch problem
   $print("Ackermann(", arg1, ",", arg2, "): ", problem, "\n")


using System;
using Nemerle.IO;

def ackermann(m, n) {
    def A = ackermann;
    match(m, n) {
        | (0, n) => n + 1
        | (m, 0) when m > 0 => A(m - 1, 1)
        | (m, n) when m > 0 && n > 0 => A(m - 1, A(m, n - 1))
        | _ => throw Exception("invalid inputs");
    }
}

for(mutable m = 0; m < 4; m++) {
    for(mutable n = 0; n < 5; n++) {
        print("ackermann($m, $n) = $(ackermann(m, n))\n");
    }
}


/* NetRexx */
options replace format comments java crossref symbols binary

numeric digits 66

parse arg j_ k_ .
if j_ = '' | j_ = '.' | \j_.datatype('w') then j_ = 3
if k_ = '' | k_ = '.' | \k_.datatype('w') then k_ = 5

loop m_ = 0 to j_
  say
  loop n_ = 0 to k_
    say 'ackermann('m_','n_') =' ackermann(m_, n_).right(5)
    end n_
  end m_
return

method ackermann(m, n) public static
  select
    when m = 0 then rval = n + 1
    when n = 0 then rval = ackermann(m - 1, 1)
    otherwise       rval = ackermann(m - 1, ackermann(m, n - 1))
    end
  return rval


#! /usr/local/bin/newlisp

(define (ackermann m n)
  (cond ((zero? m) (inc n))
        ((zero? n) (ackermann (dec m) 1))
        (true (ackermann (- m 1) (ackermann m (dec n))))))


from strutils import parseInt

proc ackermann(m, n: int64): int64 =
  if m == 0:
    result = n + 1
  elif n == 0:
    result = ackermann(m - 1, 1)
  else:
    result = ackermann(m - 1, ackermann(m, n - 1))

proc getNumber(): int =
  try:
    result = stdin.readLine.parseInt
  except ValueError:
    echo "An integer, please!"
    result = getNumber()
  if result < 0:
    echo "Please Enter a non-negative Integer: "
    result = getNumber()

echo "First non-negative Integer please: "
let first = getNumber()
echo "Second non-negative Integer please: "
let second = getNumber()
echo "Result: ", $ackermann(first, second)


# Task: Ackermann function
#
# A simple straightforward recursive implementation.
module ackermann_function

fun ack(m, n: Int): Int
do
	if m == 0 then return n + 1
	if n == 0 then return ack(m-1,1)
	return ack(m-1, ack(m, n-1))
end

for m in [0..3] do
	for n in [0..6] do
		print ack(m,n)
	end
	print ""
end


MODULE ackerman;

IMPORT  Out;

VAR     m, n    : INTEGER;

PROCEDURE Ackerman (x, y   : INTEGER) : INTEGER;

BEGIN
  IF    x = 0  THEN  RETURN  y + 1
  ELSIF y = 0  THEN  RETURN  Ackerman (x - 1 , 1)
  ELSE
    RETURN  Ackerman (x - 1 , Ackerman (x , y - 1))
  END
END Ackerman;

BEGIN
  FOR  m := 0  TO  3  DO
    FOR  n := 0  TO  6  DO
      Out.Int (Ackerman (m, n), 10);
      Out.Char (9X)
    END;
    Out.Ln
  END;
  Out.Ln
END ackerman.


class Ackermann {
  function : Main(args : String[]) ~ Nil {
    for(m := 0; m <= 3; ++m;) {
      for(n := 0; n <= 4; ++n;) {
        a := Ackermann(m, n);
        if(a > 0) {
          "Ackermann({$m}, {$n}) = {$a}"->PrintLine();
        };
      };
    };
  }

  function : Ackermann(m : Int, n : Int) ~ Int {
    if(m > 0) {
      if (n > 0) {
        return Ackermann(m - 1, Ackermann(m, n - 1));
      }
      else if (n = 0) {
        return Ackermann(m - 1, 1);
      };
    }
    else if(m = 0) {
      if(n >= 0) {
        return n + 1;
      };
    };

    return -1;
  }
}


let rec a m n =
  if m=0 then (n+1) else
  if n=0 then (a (m-1) 1) else
  (a (m-1) (a m (n-1)))


function r = ackerman(m, n)
  if ( m == 0 )
    r = n + 1;
  elseif ( n == 0 )
    r = ackerman(m-1, 1);
  else
    r = ackerman(m-1, ackerman(m, n-1));
  endif
endfunction

for i = 0:3
  disp(ackerman(i, 4));
endfor


: A( m n -- p )
   m ifZero: [ n 1+ return ]
   m 1- n ifZero: [ 1 ] else: [ A( m, n 1- ) ] A
;


loop m = 0 to 3
    loop n = 0 to 6
        say "Ackermann("m", "n") =" ackermann(m, n)
    end
end

::routine ackermann
  use strict arg m, n
  -- give us some precision room
  numeric digits 10000
  if m = 0 then return n + 1
  else if n = 0 then return ackermann(m - 1, 1)
  else return ackermann(m - 1, ackermann(m, n - 1))


#include <order/interpreter.h>

#define ORDER_PP_DEF_8ack ORDER_PP_FN(    \
8fn(8X, 8Y,                               \
    8cond((8is_0(8X), 8inc(8Y))           \
          (8is_0(8Y), 8ack(8dec(8X), 1))  \
          (8else, 8ack(8dec(8X), 8ack(8X, 8dec(8Y)))))))

ORDER_PP(8to_lit(8ack(3, 4)))      // 125


declare

  fun {Ack M N}
     if     M == 0 then N+1
     elseif N == 0 then {Ack M-1 1}
     else               {Ack M-1 {Ack M N-1}}
     end
  end

in

  {Show {Ack 3 7}}


Program Ackerman;

function ackermann(m, n: Integer) : Integer;
begin
   if m = 0 then
      ackermann := n+1
   else if n = 0 then
      ackermann := ackermann(m-1, 1)
   else
      ackermann := ackermann(m-1, ackermann(m, n-1));
end;

var
   m, n	: Integer;

begin
   for n := 0 to 6 do
      for m := 0 to 3 do
	 WriteLn('A(', m, ',', n, ') = ', ackermann(m,n));
end.


function ack(integer m, integer n)
    if m=0 then
        return n+1
    elsif m=1 then
        return n+2
    elsif m=2 then
        return 2*n+3
    elsif m=3 then
        return power(2,n+3)-3
    elsif m>0 and n=0 then
        return ack(m-1,1)
    else
        return ack(m-1,ack(m,n-1))
    end if
end function

constant limit = 23,
         fmtlens = {1,2,2,2,3,3,3,4,4,4,4,5,5,5,6,6,6,7,7,7,7,8,8,8}

atom t0 = time()
printf(1,"   0")
for j=1 to limit do
    string fmt = sprintf(" %%%dd",fmtlens[j+1])
    printf(1,fmt,j)
end for
printf(1,"\n")
for i=0 to 5 do
    printf(1,"%d:",i)
    for j=0 to iff(i>=4?5-i:limit) do
        string fmt = sprintf(" %%%dd",fmtlens[j+1])
        printf(1,fmt,{ack(i,j)})
    end for
    printf(1,"\n")
end for


def ack
    var n var m

    m 0 == if
        n 1 +
    else
        n 0 == if
            m 1 - 1 ack
        else
            m 1 - m n 1 - ack ack
        endif
    endif
enddef

3 6 ack print nl


function ackermann( $m , $n )
{
    if ( $m==0 )
    {
        return $n + 1;
    }
    elseif ( $n==0 )
    {
        return ackermann( $m-1 , 1 );
    }
    return ackermann( $m-1, ackermann( $m , $n-1 ) );
}

echo ackermann( 3, 4 );
// prints 125


go =>
    foreach(M in 0..3)
        println([m=M,[a(M,N) : N in 0..16]])
    end,
    nl,
    printf("a2(4,1): %d\n", a2(4,1)),
    nl,
    time(check_larger(3,10000)),
    nl,
    time(check_larger(4,2)),
    nl.

% Using a2/2 and chop off large output
check_larger(M,N) =>
    printf("a2(%d,%d): ", M,N),
    A = a2(M,N).to_string,
    Len = A.len,
    if Len < 50 then
      println(A)
    else
      println(A[1..20] ++ ".." ++ A[Len-20..Len])
    end,
    println(digits=Len).

% Plain tabled (memoized) version with guards
table
a(0, N) = N+1 => true.
a(M, 0) = a(M-1,1), M > 0 => true.
a(M, N) = a(M-1,a(M, N-1)), M > 0, N > 0 => true.

% Faster and pure function version (no guards).
% (Based on Python example.)
table
a2(0,N) = N + 1.
a2(1,N) = N + 2.
a2(2,N) = 2*N + 3.
a2(3,N) = 8*(2**N - 1) + 5.
a2(M,N) = cond(N == 0,a2(M-1, 1), a2(M-1, a2(M, N-1))).


(de ack (X Y)
   (cond
      ((=0 X) (inc Y))
      ((=0 Y) (ack (dec X) 1))
      (T (ack (dec X) (ack X (dec Y)))) ) )


int main(){
   write(ackermann(3,4) + "\n");
}

int ackermann(int m, int n){
   if(m == 0){
      return n + 1;
   } else if(n == 0){
      return ackermann(m-1, 1);
   } else {
      return ackermann(m-1, ackermann(m, n-1));
   }
}


Ackerman: procedure (m, n) returns (fixed (30)) recursive;
   declare (m, n) fixed (30);
   if m = 0 then return (n+1);
   else if m > 0 & n = 0 then return (Ackerman(m-1, 1));
   else if m > 0 & n > 0 then return (Ackerman(m-1, Ackerman(m, n-1)));
   return (0);
end Ackerman;


DECLARE

  FUNCTION ackermann(pi_m IN NUMBER,
                     pi_n IN NUMBER) RETURN NUMBER IS
  BEGIN
    IF pi_m = 0 THEN
      RETURN pi_n + 1;
    ELSIF pi_n = 0 THEN
      RETURN ackermann(pi_m - 1, 1);
    ELSE
      RETURN ackermann(pi_m - 1, ackermann(pi_m, pi_n - 1));
    END IF;
  END ackermann;

BEGIN
  FOR n IN 0 .. 6 LOOP
    FOR m IN 0 .. 3 LOOP
      DBMS_OUTPUT.put_line('A(' || m || ',' || n || ') = ' || ackermann(m, n));
    END LOOP;
  END LOOP;
END;


/ackermann{
/n exch def
/m exch def %PostScript takes arguments in the reverse order as specified in the function definition
m 0 eq{
n 1 add
}if
m 0 gt n 0 eq and
{
m 1 sub 1 ackermann
}if
m 0 gt n 0 gt and{
m 1 sub m n 1 sub ackermann ackermann
}if
}def


ack = (m, n):
  if (m == 0): n + 1
. elsif (n == 0): ack(m - 1, 1)
. else: ack(m - 1, ack(m, n - 1)).
.

4 times(m):
  7 times(n):
    ack(m, n) print
    " " print.
  "\n" print.


FUNCTION PBMAIN () AS LONG
    DIM m AS QUAD, n AS QUAD

    m = ABS(VAL(INPUTBOX$("Enter a whole number.")))
    n = ABS(VAL(INPUTBOX$("Enter another whole number.")))

    MSGBOX STR$(Ackermann(m, n))
END FUNCTION

FUNCTION Ackermann (m AS QUAD, n AS QUAD) AS QUAD
    IF 0 = m THEN
        FUNCTION = n + 1
    ELSEIF 0 = n THEN
        FUNCTION = Ackermann(m - 1, 1)
    ELSE    ' m > 0; n > 0
        FUNCTION = Ackermann(m - 1, Ackermann(m, n - 1))
    END IF
END FUNCTION


function ackermann ([long] $m, [long] $n) {
    if ($m -eq 0) {
        return $n + 1
    }

    if ($n -eq 0) {
        return (ackermann ($m - 1) 1)
    }

    return (ackermann ($m - 1) (ackermann $m ($n - 1)))
}


int ackermann(int m, int n) {
  if (m == 0)
    return n + 1;
  else if (m > 0 && n == 0)
    return ackermann(m - 1, 1);
  else
    return ackermann( m - 1, ackermann(m, n - 1) );
}

// Call function to produce output:
// the first 4x7 Ackermann numbers
void setup() {
  for (int m=0; m<4; m++) {
    for (int n=0; n<7; n++) {
      print(ackermann(m, n), " ");
    }
    println();
  }
}


:- table ack/3. % memoization reduces the execution time of ack(4,1,X) from several
                % minutes to about one second on a typical desktop computer.
ack(0, N, Ans) :- Ans is N+1.
ack(M, 0, Ans) :- M>0, X is M-1, ack(X, 1, Ans).
ack(M, N, Ans) :- M>0, N>0, X is M-1, Y is N-1, ack(M, Y, Ans2), ack(X, Ans2, Ans).


Procedure.q Ackermann(m, n)
  If m = 0
    ProcedureReturn n + 1
  ElseIf  n = 0
    ProcedureReturn Ackermann(m - 1, 1)
  Else
    ProcedureReturn Ackermann(m - 1, Ackermann(m, n - 1))
  EndIf
EndProcedure

Debug Ackermann(3,4)


data Iter = f => FoldNat <const $f One, $f>
data Ackermann = FoldNat <const Succ, Iter>


def ack1(M, N):
   return (N + 1) if M == 0 else (
      ack1(M-1, 1) if N == 0 else ack1(M-1, ack1(M, N-1)))


                           forward is ackermann ( m n --> r )
  [ over 0 = iff
      [ nip 1 + ] done
    dup 0 = iff
      [ drop 1 - 1
        ackermann ] done
     over 1 - unrot 1 -
     ackermann ackermann ]   resolves ackermann ( m n --> r )

  3 10 ackermann echo


ackermann <- function(m, n) {
  if ( m == 0 ) {
    n+1
  } else if ( n == 0 ) {
    ackermann(m-1, 1)
  } else {
    ackermann(m-1, ackermann(m, n-1))
  }
}


#lang racket
(define (ackermann m n)
  (cond [(zero? m) (add1 n)]
        [(zero? n) (ackermann (sub1 m) 1)]
        [else (ackermann (sub1 m) (ackermann m (sub1 n)))]))


ackermann: func [m n] [
    case [
        m = 0 [n + 1]
        n = 0 [ackermann m - 1 1]
        true [ackermann m - 1 ackermann m n - 1]
    ]
]


let _m = Sys.argv[2]
let _n = Sys.argv[3]

let m = int_of_string(_m)
let n = int_of_string(_n)

let rec a = (m, n) =>
  switch (m, n) {
  | (0, n) => (n+1)
  | (m, 0) => a(m-1, 1)
  | (m, n) => a(m-1, a(m, n-1))
  }

Js.log("ackermann(" ++ _m ++ ", " ++ _n ++ ") = "
    ++ string_of_int(a(m, n)))


/*REXX program  calculates and displays  some values for the  Ackermann function.       */
            /*╔════════════════════════════════════════════════════════════════════════╗
              ║  Note:  the Ackermann function  (as implemented here)  utilizes deep   ║
              ║         recursive and is limited by the largest number that can have   ║
              ║         "1"  (unity) added to a number  (successfully and accurately). ║
              ╚════════════════════════════════════════════════════════════════════════╝*/
high=24
         do     j=0  to 3;                    say
             do k=0  to high % (max(1, j))
             call tell_Ack  j, k
             end   /*k*/
         end       /*j*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
tell_Ack:  parse arg mm,nn;   calls=0            /*display an echo message to terminal. */
           #=right(nn,length(high))
           say 'Ackermann('mm", "#')='right(ackermann(mm, nn), high),
                                      left('', 12)     'calls='right(calls, high)
           return
/*──────────────────────────────────────────────────────────────────────────────────────*/
ackermann: procedure expose calls                /*compute value of Ackermann function. */
           parse arg m,n;   calls=calls+1
           if m==0  then return n+1
           if n==0  then return ackermann(m-1, 1)
                         return ackermann(m-1, ackermann(m, n-1) )


for m = 0 to 3
        for n = 0 to 4
                see "Ackermann(" + m + ", " + n + ") = " + Ackermann(m, n) + nl
         next
next

func Ackermann m, n
        if m > 0
           if n > 0
                return Ackermann(m - 1, Ackermann(m, n - 1))
            but n = 0
                return Ackermann(m - 1, 1)
            ok
        but m = 0
            if n >= 0
                return n + 1
            ok
        ok
Raise("Incorrect Numerical input !!!")


ackermann: 	#x: a1, y: a2, return: a0
beqz a1, npe #case m = 0
beqz a2, mme #case m > 0 & n = 0
addi sp, sp, -8 #case m > 0 & n > 0
sw ra, 4(sp)
sw a1, 0(sp)
addi a2, a2, -1
jal ackermann
lw a1, 0(sp)
addi a1, a1, -1
mv a2, a0
jal ackermann
lw t0, 4(sp)
addi sp, sp, 8
jr t0, 0
npe:
addi a0, a2, 1
jr ra, 0
mme:
addi sp, sp, -4
sw ra, 0(sp)
addi a1, a1, -1
li a2, 1
jal ackermann
lw t0, 0(sp)
addi sp, sp, 4
jr t0, 0


def ack(m, n)
  if m == 0
    n + 1
  elsif n == 0
    ack(m-1, 1)
  else
    ack(m-1, ack(m, n-1))
  end
end


print ackermann(1, 2)

function ackermann(m, n)
   if (m = 0)             then ackermann = (n + 1)
   if (m > 0) and (n = 0) then ackermann = ackermann((m - 1), 1)
   if (m > 0) and (n > 0) then ackermann = ackermann((m - 1), ackermann(m, (n - 1)))
end function


fn ack(m: isize, n: isize) -> isize {
    if m == 0 {
        n + 1
    } else if n == 0 {
        ack(m - 1, 1)
    } else {
        ack(m - 1, ack(m, n - 1))
    }
}

fn main() {
    let a = ack(3, 4);
    println!("{}", a); // 125
}


class MAIN is

  ackermann(m, n:INT):INT
    pre m >= 0 and n >= 0
  is
    if m = 0 then return n + 1; end;
    if n = 0 then return ackermann(m-1, 1); end;
    return ackermann(m-1, ackermann(m, n-1));
  end;

  main is
    n, m :INT;
    loop n := 0.upto!(6);
      loop m := 0.upto!(3);
        #OUT + "A(" + m + ", " + n + ") = " + ackermann(m, n) + "\n";
      end;
    end;
  end;
end;


def ack(m: BigInt, n: BigInt): BigInt = {
  if (m==0) n+1
  else if (n==0) ack(m-1, 1)
  else ack(m-1, ack(m, n-1))
}


clear
function acker=ackermann(m,n)
    global calls
    calls=calls+1
    if m==0 then     acker=n+1
    else
        if n==0 then acker=ackermann(m-1,1)
                else acker=ackermann(m-1,ackermann(m,n-1))
        end
    end
endfunction
function printacker(m,n)
    global calls
    calls=0
    printf('ackermann(%d,%d)=',m,n)
    printf('%d  calls=%d\n',ackermann(m,n),calls)
endfunction
maxi=3; maxj=6
for i=0:maxi
   for j=0:maxj
       printacker(i,j)
   end
end


const func integer: ackermann (in integer: m, in integer: n) is func
  result
    var integer: result is 0;
  begin
    if m = 0 then
      result := succ(n);
    elsif n = 0 then
      result := ackermann(pred(m), 1);
    else
      result := ackermann(pred(m), ackermann(m, pred(n)));
    end if;
  end func;


program ackermann;

(for m in [0..3])
  print(+/ [rpad('' + ack(m, n), 4): n in [0..6]]);
end;

proc ack(m, n);
  return {[0,n+1]}(m) ? ack(m-1, {[0,1]}(n) ? ack(m, n-1));
end proc;

end program;


 BEGIN
    INTEGER procedure
    Ackermann(g, p); SHORT INTEGER g, p;
        Ackermann:= IF g = 0 THEN p+1
            ELSE Ackermann(g-1, IF p = 0 THEN 1
                         ELSE Ackermann(g, p-1));

    INTEGER g, p;
    FOR p := 0 STEP 3 UNTIL 13 DO BEGIN
    	g := 4 - p/3;
        outtext("Ackermann("); outint(g, 0);
        outchar(','); outint(p, 2); outtext(") = ");
        outint(Ackermann(g, p), 0); outimage
    END
END


[email protected](Integer traits) ackermann: [email protected](Integer traits)
[
  m isZero
    ifTrue: [n + 1]
    ifFalse:
      [n isZero
	 ifTrue: [m - 1 ackermann: n]
	 ifFalse: [m - 1 ackermann: (m ackermann: n - 1)]]
].


|ackermann|
ackermann := [ :n :m |
  (n = 0) ifTrue: [ (m + 1) ]
          ifFalse: [
           (m = 0) ifTrue: [ ackermann value: (n-1) value: 1 ]
                   ifFalse: [
                        ackermann value: (n-1)
                                  value: ( ackermann value: n
                                                     value: (m-1) )
                   ]
          ]
].

(ackermann value: 0 value: 0) displayNl.
(ackermann value: 3 value: 4) displayNl.


DEF ACK(M,N)
 IF M==0 THEN
  RETURN N+1
 ELSEIF M>0 AND N==0 THEN
  RETURN ACK(M-1,1)
 ELSE
  RETURN ACK(M-1,ACK(M,N-1))
 ENDIF
END


define('ack(m,n)') :(ack_end)
ack     ack = eq(m,0) n + 1 :s(return)
        ack = eq(n,0) ack(m - 1,1) :s(return)
        ack = ack(m - 1,ack(m,n - 1)) :(return)
ack_end

*       # Test and display ack(0,0) .. ack(3,6)
L1      str = str ack(m,n) ' '
        n = lt(n,6) n + 1 :s(L1)
        output = str; str = ''
        n = 0; m = lt(m,3) m + 1 :s(L1)
end


NNI ==> NonNegativeInteger

A:(NNI,NNI) -> NNI

A(m,n) ==
  m=0 => n+1
  m>0 and n=0 => A(m-1,1)
  m>0 and n>0 => A(m-1,A(m,n-1))

-- Example
matrix [[A(i,j) for i in 0..3] for j in 0..3]


--#SET TERMINATOR @

SET SERVEROUTPUT ON@

CREATE OR REPLACE FUNCTION ACKERMANN(
  IN M SMALLINT,
  IN N BIGINT
 ) RETURNS BIGINT
 BEGIN
  DECLARE RET BIGINT;
  DECLARE STMT STATEMENT;

  IF (M = 0) THEN
   SET RET = N + 1;
  ELSEIF (N = 0) THEN
   PREPARE STMT FROM 'SET ? = ACKERMANN(? - 1, 1)';
   EXECUTE STMT INTO RET USING M;
  ELSE
   PREPARE STMT FROM 'SET ? = ACKERMANN(? - 1, ACKERMANN(?, ? - 1))';
   EXECUTE STMT INTO RET USING M, M, N;
  END IF;
  RETURN RET;
 END @

BEGIN
 DECLARE M SMALLINT DEFAULT 0;
 DECLARE N SMALLINT DEFAULT 0;
 DECLARE MAX_LEVELS CONDITION FOR SQLSTATE '54038';
 DECLARE CONTINUE HANDLER FOR MAX_LEVELS BEGIN END;

 WHILE (N <= 6) DO
  WHILE (M <= 3) DO
   CALL DBMS_OUTPUT.PUT_LINE('ACKERMANN(' || M || ', ' || N || ') = ' || ACKERMANN(M, N));
   SET M = M + 1;
  END WHILE;
  SET M = 0;
  SET N = N + 1;
 END WHILE;
END @


mata
function ackermann(m,n) {
	if (m==0) {
		return(n+1)
	} else if (n==0) {
		return(ackermann(m-1,1))
	} else {
		return(ackermann(m-1,ackermann(m,n-1)))
	}
}

for (i=0; i<=3; i++) printf("%f\n",ackermann(i,4))
5
6
11
125
end


func ackerman(m:Int, n:Int) -> Int {
    if m == 0 {
        return n+1
    } else if n == 0 {
        return ackerman(m-1, 1)
    } else {
        return ackerman(m-1, ackerman(m, n-1))
    }
}


proc ack {m n} {
    if {$m == 0} {
        expr {$n + 1}
    } elseif {$n == 0} {
        ack [expr {$m - 1}] 1
    } else {
        ack [expr {$m - 1}] [ack $m [expr {$n - 1}]]
    }
}


PROGRAM:ACKERMAN
:If not(M
:Then
:N+1→N
:Return
:Else
:If not(N
:Then
:1→N
:M-1→M
:prgmACKERMAN
:Else
:N-1→N
:M→L1(1+dim(L1
:prgmACKERMAN
:Ans→N
:L1(dim(L1))-1→M
:dim(L1)-1→dim(L1
:prgmACKERMAN
:End
:End


function ackermann(%m,%n)
{
   if(%m==0)
      return %n+1;
   if(%m>0&&%n==0)
      return ackermann(%m-1,1);
   if(%m>0&&%n>0)
      return ackermann(%m-1,ackermann(%m,%n-1));
}


// library: math: get: ackermann: recursive <description></description> <version>1.0.0.0.5</version> <version control></version control> (filenamemacro=getmaare.s) [kn, ri, tu, 27-12-2011 14:46:59]
INTEGER PROC FNMathGetAckermannRecursiveI( INTEGER mI, INTEGER nI )
 IF ( mI == 0 )
  RETURN( nI + 1 )
 ENDIF
 IF ( nI == 0 )
  RETURN( FNMathGetAckermannRecursiveI( mI - 1, 1 ) )
 ENDIF
 RETURN( FNMathGetAckermannRecursiveI( mI - 1, FNMathGetAckermannRecursiveI( mI, nI - 1 ) ) )
END

PROC Main()
STRING s1[255] = "2"
STRING s2[255] = "3"
IF ( NOT ( Ask( "math: get: ackermann: recursive: m = ", s1, _EDIT_HISTORY_ ) ) AND ( Length( s1 ) > 0 ) ) RETURN() ENDIF
IF ( NOT ( Ask( "math: get: ackermann: recursive: n = ", s2, _EDIT_HISTORY_ ) ) AND ( Length( s2 ) > 0 ) ) RETURN() ENDIF
 Message( FNMathGetAckermannRecursiveI( Val( s1 ), Val( s2 ) ) ) // gives e.g. 9
END


(defmacro defmemofun (name (. args) . body)
  (let ((hash (gensym "hash-"))
        (argl (gensym "args-"))
        (hent (gensym "hent-"))
        (uniq (copy-str "uniq")))
    ^(let ((,hash (hash :equal-based)))
       (defun ,name (,*args)
         (let* ((,argl (list ,*args))
                (,hent (inhash ,hash ,argl ,uniq)))
           (if (eq (cdr ,hent) ,uniq)
             (set (cdr ,hent) (block ,name (progn ,*body)))
             (cdr ,hent)))))))

(defmemofun ack (m n)
  (cond
    ((= m 0) (+ n 1))
    ((= n 0) (ack (- m 1) 1))
    (t (ack (- m 1) (ack m (- n 1))))))

(each ((i (range 0 3)))
  (each ((j (range 0 4)))
    (format t "ack(~a, ~a) = ~a\n" i j (ack i j))))


ack() {
  local m=$1
  local n=$2
  if [ $m -eq 0 ]; then
    echo -n $((n+1))
  elif [ $n -eq 0 ]; then
    ack $((m-1)) 1
  else
    ack $((m-1)) $(ack $m $((n-1)))
  fi
}


#import std
#import nat

ackermann =

~&al^?\[email protected] ~&ar?(
   ^R/~&f ^/[email protected] ^|R/~& ^|/~& predecessor,
   ^|R/~& ~&\1+ [email protected])


[ack
       [ [pop zero?] [popd succ]
         [zero?]     [pop pred 1 ack]
         [true]      [[dup pred swap] dip pred ack ack ]
       ] when].


uint64 ackermann(uint64 m, uint64 n) {
  if (m == 0) return n + 1;
  if (n == 0) return ackermann(m - 1, 1);
  return ackermann(m - 1, ackermann(m, n - 1));
}

void main () {
  for (uint64 m = 0; m < 4; ++m) {
    for (uint64 n = 0; n < 10; ++n) {
      print(@"A($m,$n) = $(ackermann(m,n))\n");
    }
  }
}


Private Function Ackermann_function(m As Variant, n As Variant) As Variant
    Dim result As Variant
    Debug.Assert m >= 0
    Debug.Assert n >= 0
    If m = 0 Then
        result = CDec(n + 1)
    Else
        If n = 0 Then
            result = Ackermann_function(m - 1, 1)
        Else
            result = Ackermann_function(m - 1, Ackermann_function(m, n - 1))
        End If
    End If
    Ackermann_function = CDec(result)
End Function
Public Sub main()
    Debug.Print "           n=",
    For j = 0 To 7
        Debug.Print j,
    Next j
    Debug.Print
    For i = 0 To 3
        Debug.Print "m=" & i,
        For j = 0 To 7
            Debug.Print Ackermann_function(i, j),
        Next j
        Debug.Print
    Next i
End Sub


option explicit
'~ dim depth
function ack(m, n)
	'~ wscript.stdout.write depth & " "
	if m = 0 then
		'~ depth = depth + 1
		ack = n + 1
		'~ depth = depth - 1
	elseif m > 0 and n = 0 then
		'~ depth = depth + 1
		ack = ack(m - 1, 1)
		'~ depth = depth - 1
	'~ elseif m > 0 and n > 0 then
	else
		'~ depth = depth + 1
		ack = ack(m - 1, ack(m, n - 1))
		'~ depth = depth - 1
	end if

end function


Option Explicit
Dim calls As Long
Sub main()
    Const maxi = 4
    Const maxj = 9
    Dim i As Long, j As Long
    For i = 0 To maxi
        For j = 0 To maxj
            Call print_acker(i, j)
        Next j
    Next i
End Sub 'main
Sub print_acker(m As Long, n As Long)
    calls = 0
    Debug.Print "ackermann("; m; ","; n; ")=";
    Debug.Print ackermann(m, n), "calls="; calls
End Sub 'print_acker
Function ackermann(m As Long, n As Long) As Long
    calls = calls + 1
    If m = 0 Then
        ackermann = n + 1
    Else
        If n = 0 Then
            ackermann = ackermann(m - 1, 1)
        Else
            ackermann = ackermann(m - 1, ackermann(m, n - 1))
        End If
    End If
End Function 'ackermann


fn ackermann(m int, n int ) int {
    if m == 0 {
        return n + 1
    }
    else if n == 0 {
        return ackermann(m - 1, 1)
    }
    return ackermann(m - 1, ackermann(m, n - 1) )
}

fn main() {
    for m := 0; m <= 4; m++ {
        for n := 0; n < ( 6 - m ); n++ {
            println('Ackermann($m, $n) = ${ackermann(m, n)}')
        }
    }
}


def (ackermann m n)
  (if m=0
        n+1
      n=0
        (ackermann m-1 1)
      :else
        (ackermann m-1 (ackermann m n-1)))


// To use recursion definition and declaration must be on separate lines
var Ackermann
Ackermann = Fn.new {|m, n|
    if (m == 0) return n + 1
    if (n == 0) return Ackermann.call(m - 1, 1)
    return Ackermann.call(m - 1, Ackermann.call(m, n - 1))
}

var pairs = [ [1, 3], [2, 3], [3, 3], [1, 5], [2, 5], [3, 5] ]
for (pair in pairs) {
    var p1 = pair[0]
    var p2 = pair[1]
    System.print("A[%(p1), %(p2)] = %(Ackermann.call(p1, p2))")
}


section .text

global _main
_main:
    mov eax, 3 ;m
    mov ebx, 4 ;n
    call ack ;returns number in ebx
    ret

ack:
    cmp eax, 0
    je M0 ;if M == 0
    cmp ebx, 0
    je N0 ;if N == 0
    dec ebx ;else N-1
    push eax ;save M
    call ack1 ;ack(m,n) -> returned in ebx so no further instructions needed
    pop eax ;restore M
    dec eax ;M - 1
    call ack1 ;return ack(m-1,ack(m,n-1))
    ret
    M0:
        inc ebx ;return n + 1
        ret
    N0:
        dec eax
        inc ebx ;ebx always 0: inc -> ebx = 1
        call ack1 ;return ack(M-1,1)
        ret


(defun ackermann (m n)
    (cond
        ((= m 0) (+ n 1))
        ((= n 0) (ackermann (- m 1) 1))
        (t (ackermann (- m 1) (ackermann m (- n 1))))))


include c:\cxpl\codes;

func Ackermann(M, N);
int M, N;
[if M=0 then return N+1;
 if N=0 then return Ackermann(M-1, 1);
return Ackermann(M-1, Ackermann(M, N-1));
]; \Ackermann

int M, N;
[for M:= 0 to 3 do
    [for N:= 0 to 7 do
        [IntOut(0, Ackermann(M, N));  ChOut(0,9\tab\)];
    CrLf(0);
    ];
]


  <xsl:template name="ackermann">
    <xsl:param name="m"/>
    <xsl:param name="n"/>

    <xsl:choose>
      <xsl:when test="$m = 0">
        <xsl:value-of select="$n+1"/>
      </xsl:when>
      <xsl:when test="$n = 0">
        <xsl:call-template name="ackermann">
          <xsl:with-param name="m" select="$m - 1"/>
          <xsl:with-param name="n" select="'1'"/>
        </xsl:call-template>
      </xsl:when>
      <xsl:otherwise>
        <xsl:variable name="p">
          <xsl:call-template name="ackermann">
            <xsl:with-param name="m" select="$m"/>
            <xsl:with-param name="n" select="$n - 1"/>
          </xsl:call-template>
        </xsl:variable>

        <xsl:call-template name="ackermann">
          <xsl:with-param name="m" select="$m - 1"/>
          <xsl:with-param name="n" select="$p"/>
        </xsl:call-template>
      </xsl:otherwise>
    </xsl:choose>
  </xsl:template>


sub ack(M,N)
    if M = 0 return N + 1
    if N = 0 return ack(M-1,1)
    return ack(M-1,ack(M, N-1))
end sub

print ack(3, 4)


func ack(m, n) {
    if(m == 0)
        return n + 1;
    else if(n == 0)
        return ack(m - 1, 1);
    else
        return ack(m - 1, ack(m, n - 1));
}


    OPT --syntax=abf : OUTPUT "ackerman.com"
    ORG $100
    jr demo_start

;--------------------------------------------------------------------------------------------------------------------
; entry: ackermann_fn
; input: bc = m, hl = n
; output: hl = A(m,n) (16bit only)
ackermann_fn.inc_n:
    inc hl
ackermann_fn:
    inc hl
    ld a,c
    or b
    ret z               ; m == 0 -> return n+1
    ; m > 0 case        ; bc = m, hl = n+1
    dec bc
    dec hl              ; m-1, n restored
    ld a,l
    or h
    jr z,.inc_n         ; n == 0 -> return A(m-1, 1)
    ; m > 0, n > 0      ; bc = m-1, hl = n
    push bc
    inc bc
    dec hl
    call ackermann_fn   ; n = A(m, n-1)
    pop bc
    jp ackermann_fn     ; return A(m-1,A(m, n-1))

;--------------------------------------------------------------------------------------------------------------------
; helper functions for demo printing 4x9 table
print_str:
    push bc
    push hl
    ld c,9
.call_cpm:
    call 5
    pop hl
    pop bc
    ret
print_hl:
    ld b,' '
    ld e,b
    call print_char
    ld de,-10000
    call extract_digit
    ld de,-1000
    call extract_digit
    ld de,-100
    call extract_digit
    ld de,-10
    call extract_digit
    ld a,l
print_digit:
    ld b,'0'
    add a,b
    ld e,a
print_char:
    push bc
    push hl
    ld c,2
    jr print_str.call_cpm
extract_digit:
    ld a,-1
.digit_loop:
    inc a
    add hl,de
    jr c,.digit_loop
    sbc hl,de
    or a
    jr nz,print_digit
    ld e,b
    jr print_char

;--------------------------------------------------------------------------------------------------------------------
demo_start:             ; do m: [0,4) cross n: [0,9) table
    ld bc,0
.loop_m:
    ld hl,0             ; bc = m, hl = n = 0
    ld de,txt_m_is
    call print_str
    ld a,c
    or '0'
    ld e,a
    call print_char
    ld e,':'
    call print_char
.loop_n:
    push bc
    push hl
    call ackermann_fn
    call print_hl
    pop hl
    pop bc
    inc hl
    ld a,l
    cp 9
    jr c,.loop_n
    ld de,crlf
    call print_str
    inc bc
    ld a,c
    cp 4
    jr c,.loop_m
    rst 0               ; return to CP/M

txt_m_is:   db  "m=$"
crlf:       db  10,13,'$'


(A) m n
comment:
(=) m 0
(add1) n

(A) m n
comment:
(=) n 0
(A) (sub1) m 1

(A) m n
comment:
#true
(A) (sub1) m (A) m (sub1) n

(add1) n
comment:
#true
(003) "+" n 1

(sub1) n
comment:
#true
(003) "-" n 1

(=) n1 n2
comment:
#true
(003) "=" n1 n2


pub fn ack(m: u64, n: u64) u64 {
    if (m == 0) return n + 1;
    if (n == 0) return ack(m - 1, 1);
    return ack(m - 1, ack(m, n - 1));
}

pub fn main() !void {
    const stdout = @import("std").io.getStdOut().writer();

    var m: u8 = 0;
    while (m <= 3) : (m += 1) {
        var n: u8 = 0;
        while (n <= 8) : (n += 1)
            try stdout.print("{d:>8}", .{ack(m, n)});
        try stdout.print("\n", .{});
    }
}


F can_make_word(word)
   I word == ‘’
      R 0B

   V blocks_remaining = ‘BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM’.split(‘ ’)

   L(ch) word.uppercase()
      L(block) blocks_remaining
         I ch C block
            blocks_remaining.remove(block)
            L.break
      L.was_no_break
         R 0B
   R 1B

print([‘’, ‘a’, ‘baRk’, ‘booK’, ‘treat’, ‘COMMON’, ‘squad’, ‘Confused’].map(w -> ‘'’w‘': ’can_make_word(w)).join(‘, ’))


*        ABC Problem               21/07/2016
ABC      CSECT
         USING  ABC,R13            base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         " <-
         ST     R15,8(R13)         " ->
         LR     R13,R15            " addressability
         LA     R8,1               l=1
LOOPL    C      R8,=A(NN)          do l=1 to hbound(words)
         BH     ELOOPL
         LR     R1,R8              l
         MH     R1,=H'20'          *20
         LA     R10,WORDS-20(R1)   @words(l)
         MVC    STATUS,=CL5'true'  cflag='true'
         MVC    TBLOCKS,BLOCKS     tblocks=blocks
         MVC    CC(1),0(R10)       cc=substr(words(l),1,1)
         LA     R6,1               i=1
LOOPI    CLI    CC,C' '            do while cc<>' '
         BE     ELOOPI
         SR     R7,R7              k=0
         LH     R0,=H'1'           m=1
LOOPM    CH     R0,=AL2(L'TBLOCKS) do m=1 to length(tblocks)
         BH     ELOOPM
         LA     R5,TBLOCKS-1       @tblocks[0]
         AR     R5,R0              @tblocks[m]
         CLC    0(1,R5),CC         if substr(tblocks,m,1)=cc
         BNE    INDEXM
         LR     R7,R0              k=m=index(tblocks,cc)
         B      ELOOPM
INDEXM   AH     R0,=H'1'           m=m+1
         B      LOOPM
ELOOPM   LTR    R7,R7              if k=0
         BNZ    OKK
         MVC    STATUS,=CL5'false' cflag='false'
         B      EIFK0
OKK      LA     R4,TBLOCKS-2       @tblocks[-1]
         AR     R4,R7              +k
         CLI    0(R4),C'('         if substr(tblocks,k-1,1)='('
         BNE    SECOND
         LA     R0,1               j=1
         B      EIFBLOCK
SECOND   LA     R0,3               j=3
EIFBLOCK LR     R2,R7              k
         SR     R2,R0              k-j
         LA     R4,TBLOCKS-1       @tblocks[0]
         AR     R4,R2              @tblocks[k-j]
         MVC    0(5,R4),=CL5' '    substr(tblocks,k-j,5)='     '
EIFK0    LA     R6,1(R6)           i=i+1
         LR     R4,R10             @words
         AR     R4,R6              +i
         BCTR   R4,0               -1
         MVC    CC,0(R4)           cc=substr(words,i,1)
         B      LOOPI
ELOOPI   MVC    PG(20),0(R10)      tabword(l)
         MVC    PG+20(5),STATUS    status
         XPRNT  PG,80              print buffer
         LA     R8,1(R8)           l=l+1
         B      LOOPL
ELOOPL   L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    " restore
         XR     R15,R15            " rc=0
         BR     R14                exit
WORDS    DC     CL20'A',CL20'BARK',CL20'BOOK',CL20'TREAT',CL20'COMMON'
         DC     CL20'SQUAD',CL20'CONFUSE'
BLOCKS   DS     0CL122
 DC CL61'((B O) (X K) (D Q) (C P) (N A) (G T) (R E) (T G) (Q D) (F S) '
 DC CL61'(J W) (H U) (V I) (A N) (O B) (E R) (F S) (L Y) (P C) (Z M)) '
TBLOCKS  DS     CL(L'BLOCKS)       work blocks
CC       DS     CL1                letter to find
STATUS   DS     CL5                true/false
PG       DC     CL80' '            buffer
         YREGS
NN       EQU    (BLOCKS-WORDS)/L'WORDS  number of words
         END    ABC


		org	100h
		jmp	test
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;;; Subroutine 'blocks': takes a $-terminated string in
		;;; DE containing a word, and checks whether it can be
		;;; written with the blocks.
		;;; Returns: carry flag set if word is accepted.
		;;; Uses registers: A, B, D, E, H, L
blocks:		push	d		; Store string pointer
		lxi	h,blockslist	; At the start, all blocks are
		lxi	d,blocksavail	; available
		mvi	b,40
blocksinit:	mov	a,m
		stax	d
		inx	h
		inx	d
		dcr	b
		jnz	blocksinit
		pop	d		; Restore string pointer
blockschar:	ldax	d		; Get current character
		cpi	'$'		; End of string?
		stc			; Set carry flag (accept string)
		rz			; And then we're done
		ani	0DFh		; Make uppercase
		lxi	h,blocksavail	; Is it available?
		mvi	b,40
blockscheck:	cmp	m
		jz	blocksaccept	; Yes, we found it
		inx	h		; Try next available char
		dcr	b
		jnz	blockscheck
		ana	a		; Char unavailable, clear
		ret			; carry and stop.
blocksaccept:	mvi	m,0		; We've now used this char
		mov	a,l		; And its blockmate
		xri	1
		mov	l,a
		mvi	m,0
		inx	d		; Try next char in string
		jmp	blockschar
		;; Note: 'blocksavail' must not cross page boundary
blockslist:	db	'BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM'
blocksavail:	ds	40
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;;; Test code: run the subroutine on the given words.
test:		lxi	h,words
doword:		mov	e,m		; Get pointer to next word
		inx	h
		mov	d,m
		inx	h
		mov	a,e		; If zero, end of word list
		ora	d
		rz
		push	h		; Save pointer to list
		push	d		; Save pointer to word
		mvi	c,9		; Write word to console
		call	5
		pop	d		; Retrieve word ponter
		call	blocks		; Run the 'blocks' routine
		lxi	d,yes		; Say 'yes',
		jc	yesno		; if the carry is set.
		lxi	d,no		; Otherwise, say 'no'.
yesno:		mvi	c,9
		call	5
		pop	h		; Restore list pointer
		jmp	doword		; Do next word
yes:		db	': Yes',13,10,'$'
no:		db	': No',13,10,'$'
words:		dw	wrda,wrdbark,wrdbook,wrdtreat,wrdcommon
		dw	wrdsquad,wrdconfuse,0
wrda:		db	'A$'
wrdbark:	db	'BARK$'
wrdbook:	db	'BOOK$'
wrdtreat:	db	'TREAT$'
wrdcommon:	db	'COMMON$'
wrdsquad:	db	'SQUAD$'
wrdconfuse:	db	'CONFUSE$'


	cpu	8086
	bits	16
	org	100h
section	.text
	jmp	demo
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;; Subroutine "blocks": see if the $-terminated string in DS:BX
	;;; can be written with the blocks.
	;;; Returns: carry flag set if word is accepted.
	;;; Uses registers: AL, BX, CX, SI, DI
	;;; Assumes CS=DS=ES
blocks:	mov	si,.list	; Set all blocks available
	mov	di,.avail
	mov	cx,20
	rep	movsw
.char:	mov 	al,[bx]		; Get current character
	inc	bx
	cmp	al,'$'		; Are we at the end?
	je	.ok		; Then the string is accepted
	mov	cx,40		; If not, check if block is available
	mov	di,.avail
	repne	scasb
	test	cx,cx		; This clears the carry flag
	jz	.out		; If zero, block is not available
	dec	di		; Zero out the block we found
	mov	[di],ch		; CH is guaranteed 0 here
	xor	di,1		; Point at other character on block
	mov	[di],ch		; Zero out that one too.
	jmp	.char
.ok:	stc
.out:	ret
.list:	db	'BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM'
.avail:	db	'                                        '
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;; Test code: run the subroutine on the given words
demo:	mov	bp,words
wrd:	mov	dx,[bp]		; Get word
	test	dx,dx		; End of words?
	jz	stop
	mov	ah,9		; Print word
	int	21h
	mov	bx,dx		; Run subroutine
	call	blocks
	mov	dx,yes		; Print yes or no depending on carry
	jc	print
	mov	dx,no
print:	mov	ah,9
	int	21h
	inc	bp
	inc	bp
	jmp	wrd
stop:	ret
section	.data
yes:	db	': Yes',13,10,'$'
no:	db	': No',13,10,'$'
words:	dw	.a,.bark,.book,.treat,.cmn,.squad,.confs,0
.a:	db	'A$'
.bark:	db	'BARK$'
.book:	db	'BOOK$'
.treat:	db	'TREAT$'
.cmn:	db	'COMMON$'
.squad:	db	'SQUAD$'
.confs:	db	'CONFUSE$'


\ ========================================================================================
\ You are given a collection of ABC blocks
\ There are twenty blocks with two letters on each block.
\ A complete alphabet is guaranteed amongst all sides of the blocks.
\
\ Write a function that takes a string (word) and determines whether
\ the word can be spelled with the given collection of blocks.
\
\ Rules:
\ 1. Once a letter on a block is used that block cannot be used again
\ 2. The function should be case-insensitive
\ 3. Show the output on this page for the following 7 words in the following example
\    can_make_word(???) where ??? is resp.:
\        "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"
\
\ NOTE:
\ to make the program readable for even n00bs, I have a comment at the end of each line.
\ The comments take the form of:
\                    \ <stack> | <rstack>
\ in order to be able to follow exactly what the program does.
\ ========================================================================================

["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"] var, blks
["a", "AbBa", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"] var, chkwrds

needs stack/rstack

a:new var, paths \ Keeps the combinatory explosion of letter paths
var wrd
var success
var ix

: uni2char "" swap s:+ ;

: char2uni 0 s:@ nip ;

: rreset rstack st:clear drop ;

: addoneletter \ ix path --                   \ ix path | letter
  [email protected]                                          \ ix path letter | letter
  s:+                                         \ ix newpath | letter
  paths @                                     \ ix newpath paths | letter
  -rot                                        \ paths ix newval | letter
  a:!                                         \ paths | letter
  drop                                        \ | letter
  ;

: oneletter \ letter --                       \ letter
  >r                                          \ | letter
  paths @ ' addoneletter a:each drop          \ | letter
  ;

: addtwoletters \ ix path --                  \ ix path | letter1 letter2 halflen
  swap                                        \ path ix | letter1 letter2 halflen
  dup                                         \ path ix ix | letter1 letter2 halflen
  [email protected]                                          \ path ix ix halflen | letter1 letter2 halflen
  n:<                                         \ path ix bool | letter1 letter2 halflen
  if                                          \ path ix | letter1 letter2 halflen
    swap                                      \ ix path | letter1 letter2 halflen
    1 rpick                                   \ ix path letter | letter1 letter2 halflen
  else
    swap                                      \ ix path | letter1 letter2 halflen
    2 rpick                                   \ ix path letter | letter1 letter2 halflen
  then
  s:+                                         \ ix newpath | letter1 letter2 halflen
  paths @                                     \ ix newpath paths | letter1 letter2 halflen
  -rot                                        \ paths ix newpath | letter1 letter2 halflen
  a:!                                         \ paths | letter1 letter2 halflen
  drop                                        \ | letter1 letter2 halflen
  ;

: twoletters \ letters --                     \ letters
  \ fetch the 2 letters
  dup                                         \ letters letters
  1 s:lsub                                    \ letters letter1
  >r                                          \ letters | letter1
  1 s:rsub                                    \ letter2 | letter1
  >r                                          \ | letter1 letter2
  \ duplicate paths in itself
  paths @ dup a:+                             \ paths | letter1 letter2
  \ halfway length of array
  a:len                                       \ paths len | letter1 letter2
  2 /                                         \ paths halflen | letter1 letter2
  >r                                          \ paths | letter1 letter2 halflen
  \ add letters to paths
  ' addtwoletters a:each drop                 \ | letter1 letter2 halflen
  rreset                                      \
  ;

: chkletter \ letter -- letter                \ letter
  dup                                         \ letter letter
  wrd @                                       \ letter letter word
  swap uni2char                               \ letter word letter
  s:search                                    \ letter word index
  null?                                       \ letter word index bool
  nip                                         \ letter word bool
  if                                          \ letter word
    2drop                                     \
    ""                                        \ letter
  else                                        \ letter word
    drop                                      \ letter
  then                                        \
  ;

: buildpaths \ ix blk --                      \ ix blk
  nip                                         \ blk
  ' chkletter s:map                           \ resultletters
  s:len                                       \ resultletters len
  dup                                         \ resultletters len len
  0                                           \ resultletters len len 0
  n:=                                         \ resultletters len bool
  if                                          \ resultletters len
    \ This block contains no letters of current word
    2drop                                     \
    ;;                                        \ exit word
  then                                        \ resultletters len
  1                                           \ resultletters len 1
  n:=                                         \ resultletters bool
  if                                          \ resultletters
    oneletter                                 \
  else                                        \ resultletters
    twoletters                                \
  then
  ;

: chkokpath \ ix wrdch --                     \ ix wrdch | path
  swap                                        \ wrdch ix | path
  ix !                                        \ wrdch | path
  [email protected]                                          \ wrdch path | path
  dup                                         \ wrdch path path | path
  ""                                          \ wrdch path path "" | path
  s:=                                         \ wrdch path bool | path
  if                                          \ wrdch path | path
    \ Path is empty - no match
    2drop                                     \ | path
    break                                     \ | path
    ;;                                        \ | path
  then
  swap                                        \ path wrdch | path
  uni2char                                    \ path wrdch | path
  s:search                                    \ path pos | path
  null?                                       \ path pos bool | path
  if                                          \ path pos | path
    \ Letter not found in path - no match
    2drop                                     \ | path
    break                                     \ | path
  else                                        \ path pos | path
    wrd @                                     \ path pos wrd | path
    s:len                                     \ path pos wrd len | path
    nip                                       \ path pos len | path
    n:1-                                      \ path pos cix | path
    ix @                                      \ path pos cix ix | path
    n:=                                       \ path pos bool | path
    if                                        \ path pos | path
      \ We have a match!
      true success !                          \ path pos | path
      2drop                                   \ | path
      break                                   \ | path
    else                                      \ path pos | path
      1                                       \ path pos len | path
      s:-                                     \ restpath | path
      rdrop >r                                \ | restpath
    then
  then
  ;

: chkpath \ ix path --                        \ ix path
  nip                                         \ path
  >r                                          \ | path
  wrd @                                       \ wrd | path
  ' chkokpath s:each                          \ | path
  rdrop                                       \
  success @                                   \ success
	if                                          \
	  break                                     \
  then
  ;

: chkwrd \ ix wrd --                          \ ix wrd
  nip                                         \ wrd
  s:uc                                        \ wrdupper
  "Word=" . dup .                             \ wrdupper
  wrd !                                       \
  \ other word - clear paths
  paths @ a:clear "" a:push drop              \
  \ create path tree for this word
  blks @ ' buildpaths a:each drop             \
  \ check if word can be made from a path
  false success !                             \
  paths @ ' chkpath a:each drop               \
  success @                                   \ success
  "\t\t" . . cr                               \
  ;

: app:main
  chkwrds @ ' chkwrd a:each drop              \ check if word can be made
  bye
  ;


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program problemABC64.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ TRUE, 1
.equ FALSE, 0

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessTitre1:        .asciz "Can_make_word: @ \n"
szMessTrue:          .asciz "True.\n"
szMessFalse:         .asciz "False.\n"
szCarriageReturn:    .asciz "\n"

szTablBloc:          .asciz "BO"
                     .asciz "XK"
                     .asciz "DQ"
                     .asciz "CP"
                     .asciz "NA"
                     .asciz "GT"
                     .asciz "RE"
                     .asciz "TG"
                     .asciz "QD"
                     .asciz "FS"
                     .asciz "JW"
                     .asciz "HU"
                     .asciz "VI"
                     .asciz "AN"
                     .asciz "OB"
                     .asciz "ER"
                     .asciz "FS"
                     .asciz "LY"
                     .asciz "PC"
                     .asciz "ZM"
                     .equ NBBLOC, (. -  szTablBloc) / 3

szWord1:             .asciz "A"
szWord2:             .asciz "BARK"
szWord3:             .asciz "BOOK"
szWord4:             .asciz "TREAT"
szWord5:             .asciz "COMMON"
szWord6:             .asciz "SQUAD"
szWord7:             .asciz "CONFUSE"
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
.align 4
qtabTopBloc:         .skip 8 * NBBLOC
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                // entry of program
    ldr x0,qAdrszWord1
    bl traitBlock                    // control word

    ldr x0,qAdrszWord2
    bl traitBlock                    // control word

    ldr x0,qAdrszWord3
    bl traitBlock                    // control word

    ldr x0,qAdrszWord4
    bl traitBlock                    // control word

    ldr x0,qAdrszWord5
    bl traitBlock                    // control word

    ldr x0,qAdrszWord6
    bl traitBlock                    // control word

    ldr x0,qAdrszWord7
    bl traitBlock                    // control word

100:                                  // standard end of the program
    mov x0, #0                        // return code
    mov x8, #EXIT                     // request to exit program
    svc #0                            // perform the system call

qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrszWord1:              .quad szWord1
qAdrszWord2:              .quad szWord2
qAdrszWord3:              .quad szWord3
qAdrszWord4:              .quad szWord4
qAdrszWord5:              .quad szWord5
qAdrszWord6:              .quad szWord6
qAdrszWord7:              .quad szWord7
/******************************************************************/
/*          traitement                                           */
/******************************************************************/
/* x0 contains word */
traitBlock:
    stp x1,lr,[sp,-16]!       // save  registres
    mov x1,x0
    ldr x0,qAdrszMessTitre1   // insertion word in message
    bl strInsertAtCharInc
    bl affichageMess          // display title message
    mov x0,x1
    bl controlBlock           // control
    cmp x0,#TRUE              // ok ?
    bne 1f
    ldr x0,qAdrszMessTrue     // yes
    bl affichageMess
    b 100f
1:                            // no
    ldr x0,qAdrszMessFalse
    bl affichageMess
100:
    ldp x1,lr,[sp],16         // restaur des  2 registres
    ret
qAdrszMessTitre1:         .quad szMessTitre1
qAdrszMessFalse:          .quad szMessFalse
qAdrszMessTrue:           .quad szMessTrue
/******************************************************************/
/*        control if letters are in block                       */
/******************************************************************/
/* x0 contains word */
controlBlock:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    mov x5,x0              // save word address
    ldr x4,qAdrqtabTopBloc
    ldr x6,qAdrszTablBloc
    mov x2,#0
    mov x3,#0
1:                          // init table top block used
    str x3,[x4,x2,lsl #3]
    add x2,x2,#1
    cmp x2,#NBBLOC
    blt 1b
    mov x2,#0
2:                          // loop to load letters
    ldrb w3,[x5,x2]
    cbz w3,10f              // end
    mov x0,0xDF
    and x3,x3,x0         // transform in capital letter
    mov x8,#0
3:                          // begin loop control block
    ldr x7,[x4,x8,lsl #3]   // block already used ?
    cbnz x7,5f              // yes
    add x9,x8,x8,lsl #1     // no -> index * 3
    ldrb w7,[x6,x9]         // first block letter
    cmp w3,w7               // equal ?
    beq 4f
    add x9,x9,#1
    ldrb w7,[x6,x9]         // second block letter
    cmp w3,w7               // equal ?
    beq 4f
    b 5f
4:
    mov x7,#1               // top block
    str x7,[x4,x8,lsl #3]   // block used
    add x2,x2,#1
    b 2b                    // next letter
5:
    add x8,x8,#1
    cmp x8,#NBBLOC
    blt 3b
    mov x0,#FALSE           // no letter find on block -> false
    b 100f
10:                         // all letters are ok
    mov x0,#TRUE
100:
    ldp x8,x9,[sp],16       // restaur des  2 registres
    ldp x6,x7,[sp],16       // restaur des  2 registres
    ldp x4,x5,[sp],16       // restaur des  2 registres
    ldp x2,x3,[sp],16       // restaur des  2 registres
    ldp x1,lr,[sp],16       // restaur des  2 registres
    ret
qAdrqtabTopBloc:   .quad qtabTopBloc
qAdrszTablBloc:    .quad szTablBloc
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


REPORT z_rosetta_abc.

" Type declaration for blocks of letters
TYPES: BEGIN OF block,
         s1 TYPE char1,
         s2 TYPE char1,
       END OF block,

       blocks_table TYPE STANDARD TABLE OF block.

DATA: blocks TYPE blocks_table.

CLASS word_maker DEFINITION.
  PUBLIC SECTION.
    CLASS-METHODS:
      can_make_word
        IMPORTING word          TYPE string
                  letter_blocks TYPE blocks_table
        RETURNING VALUE(found)  TYPE abap_bool.
ENDCLASS.

CLASS word_maker IMPLEMENTATION.
  METHOD can_make_word.

    " Create a reader stream that reads 1 character at a time
    DATA(reader) = NEW cl_abap_string_c_reader( word ).

    DATA(blocks) = letter_blocks.

    WHILE reader->data_available( ).

      DATA(ch) = to_upper( reader->read( 1 ) ).
      found = abap_false.

      LOOP AT blocks REFERENCE INTO DATA(b).
        IF ch = b->s1 OR ch = b->s2.
          found = abap_true.
          DELETE blocks INDEX sy-tabix.
          EXIT. " the inner loop once a character is found
        ENDIF.
      ENDLOOP.

      " If a character could not be found, stop looking further
      IF found = abap_false.
        RETURN.
      ENDIF.
    ENDWHILE.

  ENDMETHOD.
ENDCLASS.

START-OF-SELECTION.

  blocks = VALUE #( ( s1 = 'B' s2 = 'O' ) ( s1 = 'X' s2 = 'K' )
                    ( s1 = 'D' s2 = 'Q' ) ( s1 = 'C' s2 = 'P' )
                    ( s1 = 'N' s2 = 'A' ) ( s1 = 'G' s2 = 'T' )
                    ( s1 = 'R' s2 = 'E' ) ( s1 = 'T' s2 = 'G' )
                    ( s1 = 'Q' s2 = 'D' ) ( s1 = 'F' s2 = 'S' )
                    ( s1 = 'J' s2 = 'W' ) ( s1 = 'H' s2 = 'U' )
                    ( s1 = 'V' s2 = 'I' ) ( s1 = 'A' s2 = 'N' )
                    ( s1 = 'O' s2 = 'B' ) ( s1 = 'E' s2 = 'R' )
                    ( s1 = 'F' s2 = 'S' ) ( s1 = 'L' s2 = 'Y' )
                    ( s1 = 'P' s2 = 'C' ) ( s1 = 'Z' s2 = 'M' )
                  ).

  WRITE:/ COND string( WHEN word_maker=>can_make_word( word = 'A'        letter_blocks = blocks ) = abap_true THEN 'True' ELSE 'False' ).
  WRITE:/ COND string( WHEN word_maker=>can_make_word( word = 'BARK'     letter_blocks = blocks ) = abap_true THEN 'True' ELSE 'False' ).
  WRITE:/ COND string( WHEN word_maker=>can_make_word( word = 'BOOK'     letter_blocks = blocks ) = abap_true THEN 'True' ELSE 'False' ).
  WRITE:/ COND string( WHEN word_maker=>can_make_word( word = 'TREAT'    letter_blocks = blocks ) = abap_true THEN 'True' ELSE 'False' ).
  WRITE:/ COND string( WHEN word_maker=>can_make_word( word = 'COMMON'   letter_blocks = blocks ) = abap_true THEN 'True' ELSE 'False' ).
  WRITE:/ COND string( WHEN word_maker=>can_make_word( word = 'SQUAD'    letter_blocks = blocks ) = abap_true THEN 'True' ELSE 'False' ).
  WRITE:/ COND string( WHEN word_maker=>can_make_word( word = 'CONFUSE'  letter_blocks = blocks ) = abap_true THEN 'True' ELSE 'False' ).


DEFINE COUNT="20"
CHAR ARRAY sideA="BXDCNGRTQFJHVAOEFLPZ"
CHAR ARRAY sideB="OKQPATEGDSWUINBRSYCM"
BYTE ARRAY used(COUNT)

BYTE FUNC ToUpper(BYTE c)
  IF c>='a AND c<='z THEN
    RETURN (c-'a+'A)
  FI
RETURN (c)

BYTE FUNC CanBeUsed(CHAR c)
  BYTE i

  FOR i=0 TO COUNT-1
  DO
    IF used(i)=0 AND (sideA(i+1)=c OR sideB(i+1)=c) THEN
      used(i)=1
      RETURN (1)
    FI
  OD
RETURN (0)

BYTE FUNC Check(CHAR ARRAY s)
  BYTE i
  CHAR c

  FOR i=0 TO COUNT-1
  DO used(i)=0 OD

  FOR i=1 TO s(0)
  DO
    c=ToUpper(s(i))
    IF CanBeUsed(c)=0 THEN
      RETURN (0)
    FI
  OD
RETURN (1)

PROC Test(CHAR ARRAY s)
  Print(s) Print(": ")
  IF Check(s) THEN
    PrintE("can be made")
  ELSE
    PrintE("can not be made")
  FI
RETURN

PROC Main()
  Test("a")
  Test("bARk")
  Test("book")
  Test("TReat")
  Test("coMMon")
  Test("SQuaD")
  Test("CoNfUsE")
RETURN


Build with gnatchop abc.ada; gnatmake abc_problem


# determine whether we can spell words with a set of blocks                  #

# construct the list of blocks                                               #
[][]STRING blocks = ( ( "B", "O" ), ( "X", "K" ), ( "D", "Q" ), ( "C", "P" )
                    , ( "N", "A" ), ( "G", "T" ), ( "R", "E" ), ( "T", "G" )
                    , ( "Q", "D" ), ( "F", "S" ), ( "J", "W" ), ( "H", "U" )
                    , ( "V", "I" ), ( "A", "N" ), ( "O", "B" ), ( "E", "R" )
                    , ( "F", "S" ), ( "L", "Y" ), ( "P", "C" ), ( "Z", "M" )
                    );

# Returns TRUE if we can spell the word using the blocks, FALSE otherwise    #
# Returns TRUE for an empty string                                           #
PROC can spell = ( STRING word, [][]STRING blocks )BOOL:
    BEGIN

        # construct a set of flags to indicate whether the blocks are used   #
        # or not                                                             #
        [ 1 LWB blocks : 1 UPB blocks ]BOOL used;
        FOR block pos FROM LWB used TO UPB used
        DO
            used[ block pos ] := FALSE
        OD;

        # initialliy assume we can spell the word                            #
        BOOL result := TRUE;

        # check we can spell the word with the set of blocks                 #
        FOR word pos FROM LWB word TO UPB word WHILE result
        DO
            CHAR c = IF   is lower( word[ word pos ] )
                     THEN to upper( word[ word pos ] )
                     ELSE           word[ word pos ]
                     FI;

            # look through the unused blocks for the current letter          #
            BOOL found := FALSE;
            FOR block pos FROM 1 LWB blocks TO 1 UPB blocks
            WHILE NOT found
            DO
                IF  (  c = blocks[ block pos ][ 1 ][ 1 ]
                    OR c = blocks[ block pos ][ 2 ][ 1 ]
                    )
                AND NOT used[ block pos ]
                THEN
                    # found an unused block with the required letter         #
                    found             := TRUE;
                    used[ block pos ] := TRUE
                FI
            OD;

            result := found

        OD;

        result
    END; # can spell #

main: (

    # test the can spell procedure                                           #
    PROC test can spell = ( STRING word, [][]STRING blocks )VOID:
        write( ( ( "can spell: """
                 + word
                 + """ -> "
                 + IF can spell( word, blocks ) THEN "yes" ELSE "no" FI
                 )
               , newline
               )
             );

    test can spell( "A",       blocks );
    test can spell( "BaRK",    blocks );
    test can spell( "BOOK",    blocks );
    test can spell( "TREAT",   blocks );
    test can spell( "COMMON",  blocks );
    test can spell( "SQUAD",   blocks );
    test can spell( "CONFUSE", blocks )

)


% determine whether we can spell words with a set of blocks                  %
begin
    % Returns true  if we can spell the word using the blocks,               %
    %         false otherwise                                                %
    % As strings are fixed length in Algol W, the length of the string is    %
    % passed as a separate parameter                                         %
    logical procedure canSpell ( string(20) value word
                               ; integer    value wordLength
                               ) ;
    begin

        % convert a character to upper-case                                  %
        % assumes the letters are contiguous in the character set            %
        % as in ASCII and Unicode - not correct for EBCDIC                   %
        string(1) procedure toUpper( string(1) value c ) ;
            if c < "a" or c > "z" then c
                                  else code( ( decode( c ) - decode( "a" ) )
                                           + decode( "A" )
                                           ) ;

        logical       spellable;
        integer       wordPos,  blockPos;
        string(20)    letters1, letters2;

        % make local copies the faces so we can remove the used blocks       %
        letters1 := face1;
        letters2 := face2;

        % check we can spell the word with the set of blocks                 %
        spellable := true;
        wordPos   := 0;
        while wordPos < wordLength and spellable do begin
            string(1) letter;
            letter    := toUpper( word( wordPos // 1 ) );
            if letter not = " " then begin
                spellable := false;
                blockPos  := 0;
                while blockPos < 20 and not spellable do begin
                    if letter = letters1( blockPos // 1 )
                    or letter = letters2( blockPos // 1 )
                    then begin
                        % found the letter - remove the used block from the  %
                        % remaining blocks                                   %
                        letters1( blockPos // 1 ) := " ";
                        letters2( blockPos // 1 ) := " ";
                        spellable := true
                    end;
                    blockPos := blockPos + 1
                end
            end;
            wordPos := wordPos + 1;
        end;

        spellable
    end canSpell ;

    % the letters available on the faces of the blocks                       %
    string(20) face1, face2;
    face1 := "BXDCNGRTQFJHVAOEFLPZ";
    face2 := "OKQPATEGDSWUINBRSYCM";

    begin
        % test the can spell procedure                                       %
        procedure testCanSpell ( string(20) value word
                               ; integer    value wordLength
                               ) ;
            write( if canSpell( word, wordLength ) then "can   " else "cannot"
                 , " spell """
                 , word
                 , """"
                 );

        testCanSpell( "a",       1 );
        testCanSpell( "bark",    4 );
        testCanSpell( "BOOK",    4 );
        testCanSpell( "treat",   5 );
        testCanSpell( "commoN",  6 );
        testCanSpell( "Squad",   5 );
        testCanSpell( "confuse", 7 )
    end
end.


static Boolean canMakeWord(List<String> src_blocks, String word) {
    if (String.isEmpty(word)) {
        return true;
    }

    List<String> blocks = new List<String>();
    for (String block : src_blocks) {
        blocks.add(block.toUpperCase());
    }

    for (Integer i = 0; i < word.length(); i++) {
        Integer blockIndex = -1;
        String c = word.mid(i, 1).toUpperCase();

        for (Integer j = 0; j < blocks.size(); j++) {
            if (blocks.get(j).contains(c)) {
                blockIndex = j;
                break;
            }
        }

        if (blockIndex == -1) {
            return false;
        } else {
            blocks.remove(blockIndex);
        }
    }

    return true;
}

List<String> blocks = new List<String>{
    'BO', 'XK', 'DQ', 'CP', 'NA',
    'GT', 'RE', 'TG', 'QD', 'FS',
    'JW', 'HU', 'VI', 'AN', 'OB',
    'ER', 'FS', 'LY', 'PC', 'ZM'
};
System.debug('"": ' + canMakeWord(blocks, ''));
System.debug('"A": ' + canMakeWord(blocks, 'A'));
System.debug('"BARK": ' + canMakeWord(blocks, 'BARK'));
System.debug('"book": ' + canMakeWord(blocks, 'book'));
System.debug('"treat": ' + canMakeWord(blocks, 'treat'));
System.debug('"COMMON": ' + canMakeWord(blocks, 'COMMON'));
System.debug('"SQuAd": ' + canMakeWord(blocks, 'SQuAd'));
System.debug('"CONFUSE": ' + canMakeWord(blocks, 'CONFUSE'));


abc←{{0=⍴⍵:1 ⋄ 0=⍴h←⊃⍵:0 ⋄ ∇(t←1↓⍵)~¨⊃h:1 ⋄ ∇(⊂1↓h),t}⍸¨↓⍵∘.∊⍺}


set blocks to {"bo", "xk", "dq", "cp", "na", "gt", "re", "tg", "qd", "fs", ¬
    "jw", "hu", "vi", "an", "ob", "er", "fs", "ly", "pc", "zm"}

canMakeWordWithBlocks("a", blocks)
canMakeWordWithBlocks("bark", blocks)
canMakeWordWithBlocks("book", blocks)
canMakeWordWithBlocks("treat", blocks)
canMakeWordWithBlocks("common", blocks)
canMakeWordWithBlocks("squad", blocks)
canMakeWordWithBlocks("confuse", blocks)

on canMakeWordWithBlocks(theString, constBlocks)
    copy constBlocks to theBlocks
    if theString = "" then return true
    set i to 1
    repeat
        if i > (count theBlocks) then exit repeat
        if character 1 of theString is in item i of theBlocks then
            set item i of theBlocks to missing value
            set theBlocks to strings of theBlocks
            if canMakeWordWithBlocks(rest of characters of theString as string, theBlocks) then
                return true
            end if
        end if
        set i to i + 1
    end repeat
    return false
end canMakeWordWithBlocks