#include "mozart.h"
#include <string.h>

OZ_BI_define(c_strdup,1,1)
{
  OZ_declareVirtualString(0, s1);
  char* s2 = strdup(s1);
  OZ_Term s3 = OZ_string(s2);
  free( s2 );
  OZ_RETURN( s3 );
}
OZ_BI_end

OZ_C_proc_interface * oz_init_module(void)
{
  static OZ_C_proc_interface table[] = {
    {"strdup",1,1,c_strdup},
    {0,0,0,0}
  };
  return table;
}


use Inline C => q{
    char *copy;
    char * c_dup(char *orig) {
        return copy = strdup(orig);
    }
    void c_free() {
        free(copy);
    }
};
print c_dup('Hello'), "\n";
c_free();


without js -- not from a browser, mate!
constant shlwapi = open_dll("shlwapi.dll"),
         kernel32 = open_dll("kernel32.dll")
constant xStrDup = define_c_func(shlwapi,"StrDupA",{C_PTR},C_PTR),
         xLocalFree = define_c_func(kernel32,"LocalFree",{C_PTR},C_PTR)
constant HelloWorld = "Hello World!"

atom pMem = c_func(xStrDup,{HelloWorld})
?peek_string(pMem)
assert(c_func(xLocalFree,{pMem})==NULL)


(load "@lib/gcc.l")

(gcc "str" NIL                # The 'gcc' function passes all text
   'duptest )                 # until /**/ to the C compiler

any duptest(any ex) {
   any x = evSym(cdr(ex));    // Accept a symbol (string)
   char str[bufSize(x)];      // Create a buffer to unpack the name
   char *s;

   bufString(x, str);         // Upack the string
   s = strdup(str);           // Make a duplicate
   x = mkStr(s);              // Build a new Lisp string
   free(s);                   // Dispose the duplicate
   return x;
}
/**/

(println 'Duplicate (duptest "Hello world!"))


declare strdup entry (character (30) varyingz) options (fastcall16);

put (strdup('hello world') );


:- module(plffi, [strdup/2]).
:- use_foreign_library(plffi).


; Call_a_foreign_language_function.fasm -> Call_a_foreign_language_function.obj
; the assembler code...

; format COFF or
; format COFF64 classic (DJGPP) variants of COFF file

; format MS COFF or
; format MS COFF64 Microsoft's variants of COFF file

format  MS COFF

include "Win32A.Inc"

section ".text" executable readable code

proc	strucase stdcall str:dword
xor	eax,eax
mov	ebx,[str]
strucase_loop:
mov	al,byte[ebx]
cmp	al,0
jz	strucase_is_null_byte
cmp	al,'a'
jb	strucase_skip
cmp	al,'z'
ja	strucase_skip
and	al,11011111b
strucase_skip:
; mov	byte[ebx],al
xchg	al,byte[ebx]
inc	ebx
jmp	strucase_loop
strucase_is_null_byte:
xor	eax,eax
mov	eax,[str]
ret
endp

public strucase as "[email protected]"


import ctypes
libc = ctypes.CDLL("/lib/libc.so.6")
libc.strcmp("abc", "def")     # -1
libc.strcmp("hello", "hello") #  0


#lang racket/base
(require ffi/unsafe)

(provide strdup)

;; Helper: create a Racket string from a C string pointer.
(define make-byte-string
  (get-ffi-obj "scheme_make_byte_string" #f (_fun _pointer -> _scheme)))

;; Take special care not to allow NULL (#f) to be passed as an input,
;; as that will crash strdup.
(define _string/no-null
  (make-ctype _pointer
    (lambda (x)
      (unless (string? x)
        (raise-argument-error '_string/no-null "string" x))
      (string->bytes/utf-8 x))
    ;; We don't use _string/no-null as an output type, so don't care:
    (lambda (x) x)))

; Make a Scheme string from the C string, and free immediately.
(define _string/free
  (make-ctype _pointer
    ;; We don't use this as an input type, so we don't care.
    (lambda (x) x)
    (lambda (x)
      (cond
       [x
        (define s (bytes->string/utf-8 (make-byte-string x)))
        (free x)
        s]
       [else
        ;; We should never get null from strdup unless we're out of
        ;; memory:
        (error 'string/free "Out of memory")]))))

(define strdup
  (get-ffi-obj "strdup" #f (_fun _string/no-null -> _string/free)))

;; Let's try it:
(strdup "Hello World!")


use NativeCall;

sub strdup(Str $s --> Pointer) is native {*}
sub puts(Pointer $p --> int32) is native {*}
sub free(Pointer $p --> int32) is native {*}

my $p = strdup("Success!");
say 'puts returns ', puts($p);
say 'free returns ', free($p);


  Declare Function CreateFileW Lib "Kernel32" (FileName As WString, DesiredAccess As Integer, ShareMode As Integer, SecurityAttributes As Integer, _
        CreateDisposition As Integer, Flags As Integer, Template As Integer) As Integer
  Declare Function WriteFile Lib "Kernel32" (fHandle As Integer, writeData As Ptr, numOfBytes As Integer, ByRef numOfBytesWritten As Integer, _
        overlapped As Ptr) As Boolean
  Declare Function GetLastError Lib "Kernel32" () As Integer
  Declare Function CloseHandle Lib "kernel32" (hObject As Integer) As Boolean

  Const FILE_SHARE_READ = &h00000001
  Const FILE_SHARE_WRITE = &h00000002
  Const OPEN_EXISTING = 3

  Dim fHandle As Integer = CreateFileW("C:\foo.txt", 0,  FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
  If fHandle > 0 Then
    Dim mb As MemoryBlock = "Hello, World!"
    Dim bytesWritten As Integer
    If Not WriteFile(fHandle, mb, mb.Size, bytesWritten, Nil) Then
      MsgBox("Error Number: " + Str(GetLastError))
    End If
    Call CloseHandle(fHandle)
  Else
    MsgBox("Error Number: " + Str(GetLastError))
  End If


/*REXX program  calls (invoke)  a "foreign"  (non-REXX)  language routine/program.      */

cmd = "MODE"                                     /*define the command that is to be used*/
opts= 'CON:  CP  /status'                        /*define the options to be used for cmd*/

address  'SYSTEM'  cmd  opts                     /*invoke a cmd via the SYSTEM interface*/

                                                 /*stick a fork in it,  we're all done. */


/* rc_strdup.c */
#include <stdlib.h>   /* free() */
#include <string.h>   /* strdup() */
#include <ruby.h>

static VALUE
rc_strdup(VALUE obj, VALUE str_in)
{
    VALUE str_out;
    char *c, *d;

    /*
     * Convert Ruby value to C string.  May raise TypeError if the
     * value isn't a string, or ArgumentError if it contains '\0'.
     */
    c = StringValueCStr(str_in);

    /* Call strdup() and perhaps raise Errno::ENOMEM. */
    d = strdup(c);
    if (d == NULL)
	rb_sys_fail(NULL);

    /* Convert C string to Ruby string. */
    str_out = rb_str_new_cstr(d);
    free(d);
    return str_out;
}

void
Init_rc_strdup(void)
{
    VALUE mRosettaCode = rb_define_module("RosettaCode");
    rb_define_module_function(mRosettaCode, "strdup", rc_strdup, 1);
}


extern crate libc;

//c function that returns the sum of two integers
extern {
    fn add_input(in1: libc::c_int, in2: libc::c_int) -> libc::c_int;
}

fn main() {
    let (in1, in2) = (5, 4);
    let output = unsafe {
        add_input(in1, in2) };
    assert!( (output == (in1 + in2) ),"Error in sum calculation") ;
}


object JNIDemo {
  try System.loadLibrary("JNIDemo")

  private def callStrdup(s: String)

  println(callStrdup("Hello World!"))
}


Object subclass:'CallDemo'!
!CallDemo class methods!
strdup:arg
    <cdecl: mustFree char* 'strdup' (char*) module:'libc'>
! !

Transcript showCR:( CallDemo strdup:'Hello' )


#include <stdlib.h>
#include "stplugin.h"

STDLL stata_call(int argc, char *argv[]) {
    int i, j, n = strtol(argv[1], NULL, 0);

    for (i = 1; i <= n; i++) {
        for (j = 1; j <= n; j++) {
            // Don't forget array indices are 1-based in Stata.
            SF_mat_store(argv[0], i, j, 1.0/(double)(i+j-1));
        }
    }
    return 0;
}


import Foundation

let hello = "Hello, World!"
let fromC = strdup(hello)
let backToSwiftString = String.fromCString(fromC)


package require critcl
critcl::code {
    #include <math.h>
}
critcl::cproc tcl::mathfunc::ilogb {double value} int {
    return ilogb(value);
}
package provide ilogb 1.0


This is the TXR Lisp interactive listener of TXR 176.
Use the :quit command or type Ctrl-D on empty line to exit.
1> (with-dyn-lib nil
     (deffi strdup "strdup" str-d (str)))
#:lib-0177
2> (strdup "hello, world!")
"hello, world!"


/* call_foreign_language_function.wren */

class C {
    foreign static strdup(s)
}

var s = "Hello World!"
System.print(C.strdup(s))


option casemap:none

strdup  proto :qword
printf  proto :qword, :vararg
exit    proto :dword

.data
bstr    db "String 1",0

.data?
buff    dq ?

.code
main proc
  invoke printf, CSTR("Copying %s to buff with strdup using invoke....",10), addr bstr
  invoke strdup, addr bstr
  mov buff, rax
  invoke printf, CSTR("buff now = %s",10), buff
  invoke exit, 0
  ret
main endp
end
;Now, we could target a specific ABI by assigning the call values to the registers like
;.code
;main proc
;  lea rdi, bstr
;  call strdup
;  mov buff, rax
;main endp
;end


const std = @import("std");
const c = @cImport({
    @cInclude("stdlib.h"); // `free`
    @cInclude("string.h"); // `strdup`
});

pub fn main() !void {
    const string = "Hello World!";
    var copy = c.strdup(string);

    try std.io.getStdOut().writer().print("{s}\n", .{copy});
    c.free(copy);
}


//-*-c-*-
// flf.c, Call a foreign-language function

// export zklRoot=/home/ZKL
// clang -O -fPIC -I $zklRoot/VM  -c -o flf.o flf.c
// clang flf.o -L$zklRoot/Lib -lzkl -shared -Wl,-soname,flf.so -o flf.so

#include <string.h>

#include "zklObject.h"
#include "zklMethod.h"
#include "zklString.h"
#include "zklImports.h"

    // strlen(str)
static Instance *zkl_strlen(Instance *_,pArglist arglist,pVM vm)
{
   Instance *s  = arglistGetString(arglist,0,"strlen",vm);
   size_t    sz = strlen(stringText(s));
   return intCreate(sz,vm);
}

static int one;

DllExport void *construct(void *vm)
{
   if (!vm) return (void *)ZKLX_PROTOCOL;	// handshake
   	// If this is reloaded, nothing happens except
	// construct() is called again so don't reinitialize
   if (!one)	// static items are zero
   {
      // do some one time initialization
      one = 1;
   }
   return methodCreate(Void,0,zkl_strlen,vm);
}


F bwt(String =s)
   ‘Apply Burrows-Wheeler transform to input string.’
   assert("\002" !C s & "\003" !C s, ‘Input string cannot contain STX and ETX characters’)
   s = "\002"s"\003"
   V table = sorted((0 .< s.len).map(i -> @s[i..]‘’@s[0 .< i]))
   V last_column = table.map(row -> row[(len)-1..])
   R last_column.join(‘’)

F ibwt(String r)
   ‘Apply inverse Burrows-Wheeler transform.’
   V table = [‘’] * r.len
   L 0 .< r.len
      table = sorted((0 .< r.len).map(i -> @r[i]‘’@table[i]))
   V s = table.filter(row -> row.ends_with("\003"))[0]
   R s.rtrim("\003").trim("\002")

L(text) [‘banana’,
         ‘appellee’,
         ‘dogwood’,
         ‘TO BE OR NOT TO BE OR WANT TO BE OR NOT?’,
         ‘SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES’]
   V transformed = bwt(text)
   V invTransformed = ibwt(transformed)

   print(‘Original text:                ’text)
   print(‘After transformation:         ’transformed.replace("\2", ‘^’).replace("\3", ‘|’))
   print(‘After inverse transformation: ’invTransformed)
   print()


stx←@+2
BWT ← { # Burrows-Wheeler Transform and its inverse as an invertible function
  𝕊: "Input contained STX"!⊑stx¬∘∊𝕩 ⋄ (⍋↓𝕩) ⊏ stx∾𝕩;
  𝕊⁼: 1↓(⊑˜⍟(↕≠𝕩)⟜⊑ ⍋)⊸⊏ 𝕩
}


#include <string.h>
#include <stdio.h>
#include <stdlib.h>

const char STX = '\002', ETX = '\003';

int compareStrings(const void *a, const void *b) {
    char *aa = *(char **)a;
    char *bb = *(char **)b;
    return strcmp(aa, bb);
}

int bwt(const char *s, char r[]) {
    int i, len = strlen(s) + 2;
    char *ss, *str;
    char **table;
    if (strchr(s, STX) || strchr(s, ETX)) return 1;
    ss = calloc(len + 1, sizeof(char));
    sprintf(ss, "%c%s%c", STX, s, ETX);
    table = malloc(len * sizeof(const char *));
    for (i = 0; i < len; ++i) {
        str = calloc(len + 1, sizeof(char));
        strcpy(str, ss + i);
        if (i > 0) strncat(str, ss, i);
        table[i] = str;
    }
    qsort(table, len, sizeof(const char *), compareStrings);
    for(i = 0; i < len; ++i) {
        r[i] = table[i][len - 1];
        free(table[i]);
    }
    free(table);
    free(ss);
    return 0;
}

void ibwt(const char *r, char s[]) {
    int i, j, len = strlen(r);
    char **table = malloc(len * sizeof(const char *));
    for (i = 0; i < len; ++i) table[i] = calloc(len + 1, sizeof(char));
    for (i = 0; i < len; ++i) {
        for (j = 0; j < len; ++j) {
            memmove(table[j] + 1, table[j], len);
            table[j][0] = r[j];
        }
        qsort(table, len, sizeof(const char *), compareStrings);
    }
    for (i = 0; i < len; ++i) {
        if (table[i][len - 1] == ETX) {
            strncpy(s, table[i] + 1, len - 2);
            break;
        }
    }
    for (i = 0; i < len; ++i) free(table[i]);
    free(table);
}

void makePrintable(const char *s, char t[]) {
    strcpy(t, s);
    for ( ; *t != '\0'; ++t) {
        if (*t == STX) *t = '^';
        else if (*t == ETX) *t = '|';
    }
}

int main() {
    int i, res, len;
    char *tests[6], *t, *r, *s;
    tests[0] = "banana";
    tests[1] = "appellee";
    tests[2] = "dogwood";
    tests[3] = "TO BE OR NOT TO BE OR WANT TO BE OR NOT?";
    tests[4] = "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
    tests[5] = "\002ABC\003";
    for (i = 0; i < 6; ++i) {
        len = strlen(tests[i]);
        t = calloc(len + 1, sizeof(char));
        makePrintable(tests[i], t);
        printf("%s\n", t);
        printf(" --> ");
        r = calloc(len + 3, sizeof(char));
        res = bwt(tests[i], r);
        if (res == 1) {
            printf("ERROR: String can't contain STX or ETX\n");
        }
        else {
            makePrintable(r, t);
            printf("%s\n", t);
        }
        s = calloc(len + 1, sizeof(char));
        ibwt(r, s);
        makePrintable(s, t);
        printf(" --> %s\n\n", t);
        free(t);
        free(r);
        free(s);
    }
    return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;

namespace BurrowsWheeler {
    class Program {
        const char STX = (char)0x02;
        const char ETX = (char)0x03;

        private static void Rotate(ref char[] a) {
            char t = a.Last();
            for (int i = a.Length - 1; i > 0; --i) {
                a[i] = a[i - 1];
            }
            a[0] = t;
        }

        // For some reason, strings do not compare how whould be expected
        private static int Compare(string s1, string s2) {
            for (int i = 0; i < s1.Length && i < s2.Length; ++i) {
                if (s1[i] < s2[i]) {
                    return -1;
                }
                if (s2[i] < s1[i]) {
                    return 1;
                }
            }
            if (s1.Length < s2.Length) {
                return -1;
            }
            if (s2.Length < s1.Length) {
                return 1;
            }
            return 0;
        }

        static string Bwt(string s) {
            if (s.Any(a => a == STX || a == ETX)) {
                throw new ArgumentException("Input can't contain STX or ETX");
            }
            char[] ss = (STX + s + ETX).ToCharArray();
            List<string> table = new List<string>();
            for (int i = 0; i < ss.Length; ++i) {
                table.Add(new string(ss));
                Rotate(ref ss);
            }
            table.Sort(Compare);
            return new string(table.Select(a => a.Last()).ToArray());
        }

        static string Ibwt(string r) {
            int len = r.Length;
            List<string> table = new List<string>(new string[len]);
            for (int i = 0; i < len; ++i) {
                for (int j = 0; j < len; ++j) {
                    table[j] = r[j] + table[j];
                }
                table.Sort(Compare);
            }
            foreach (string row in table) {
                if (row.Last() == ETX) {
                    return row.Substring(1, len - 2);
                }
            }
            return "";
        }

        static string MakePrintable(string s) {
            return s.Replace(STX, '^').Replace(ETX, '|');
        }

        static void Main() {
            string[] tests = new string[] {
                "banana",
                "appellee",
                "dogwood",
                "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
                "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
                "\u0002ABC\u0003"
            };

            foreach (string test in tests) {
                Console.WriteLine(MakePrintable(test));
                Console.Write(" --> ");

                string t = "";
                try {
                    t = Bwt(test);
                    Console.WriteLine(MakePrintable(t));
                } catch (Exception e) {
                    Console.WriteLine("ERROR: {0}", e.Message);
                }

                string r = Ibwt(t);
                Console.WriteLine(" --> {0}", r);
                Console.WriteLine();
            }
        }
    }
}


#include <algorithm>
#include <iostream>
#include <vector>

const int STX = 0x02;
const int ETX = 0x03;

void rotate(std::string &a) {
    char t = a[a.length() - 1];
    for (int i = a.length() - 1; i > 0; i--) {
        a[i] = a[i - 1];
    }
    a[0] = t;
}

std::string bwt(const std::string &s) {
    for (char c : s) {
        if (c == STX || c == ETX) {
            throw std::runtime_error("Input can't contain STX or ETX");
        }
    }

    std::string ss;
    ss += STX;
    ss += s;
    ss += ETX;

    std::vector<std::string> table;
    for (size_t i = 0; i < ss.length(); i++) {
        table.push_back(ss);
        rotate(ss);
    }
    //table.sort();
    std::sort(table.begin(), table.end());

    std::string out;
    for (auto &s : table) {
        out += s[s.length() - 1];
    }
    return out;
}

std::string ibwt(const std::string &r) {
    int len = r.length();
    std::vector<std::string> table(len);
    for (int i = 0; i < len; i++) {
        for (int j = 0; j < len; j++) {
            table[j] = r[j] + table[j];
        }
        std::sort(table.begin(), table.end());
    }
    for (auto &row : table) {
        if (row[row.length() - 1] == ETX) {
            return row.substr(1, row.length() - 2);
        }
    }
    return {};
}

std::string makePrintable(const std::string &s) {
    auto ls = s;
    for (auto &c : ls) {
        if (c == STX) {
            c = '^';
        } else if (c == ETX) {
            c = '|';
        }
    }
    return ls;
}

int main() {
    auto tests = {
        "banana",
        "appellee",
        "dogwood",
        "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
        "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
        "\u0002ABC\u0003"
    };

    for (auto &test : tests) {
        std::cout << makePrintable(test) << "\n";
        std::cout << " --> ";

        std::string t;
        try {
            t = bwt(test);
            std::cout << makePrintable(t) << "\n";
        } catch (std::runtime_error &e) {
            std::cout << "Error " << e.what() << "\n";
        }

        std::string r = ibwt(t);
        std::cout << " --> " << r << "\n\n";
    }

    return 0;
}


import std.algorithm.iteration;
import std.algorithm.mutation;
import std.algorithm.searching;
import std.algorithm.sorting;
import std.array;
import std.stdio;
import std.string;

immutable STX = 0x02;
immutable ETX = 0x03;

string bwt(string s) {
    if (s.any!"a==0x02 || a==0x03") {
        throw new Exception("Input can't contain STX or ETX");
    }
    char[] ss = (STX ~ s ~ ETX).dup;
    string[] table;
    foreach (i; 0..ss.length) {
        table ~= ss.idup;
        bringToFront(ss[0..$-1], ss[$-1..$]);
    }
    table.sort();
    return table.map!"a[$-1]".array;
}

string ibwt(string r) {
    const len = r.length;
    string[] table;
    table.length = len;
    foreach (_; 0..len) {
        foreach (i; 0..len) {
            table[i] = r[i] ~ table[i];
        }
        table.sort();
    }
    foreach (row; table) {
        if (row[$-1] == ETX) {
            return row[1..len-1];
        }
    }
    return "";
}

string makePrintable(string s) {
    return tr(s, "\u0002\u0003", "^|");
}

void main() {
    immutable tests = [
        "banana",
        "appellee",
        "dogwood",
        "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
        "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
        "\u0002ABC\u0003"
    ];

    foreach (test; tests) {
        writeln(test.makePrintable);
        write(" --> ");

        string t;
        try {
            t = bwt(test);
            writeln(t.makePrintable);
        } catch (Exception e) {
            writeln("ERROR: ", e.message);
        }

        auto r = ibwt(t);
        writeln(" --> ", r);
        writeln;
    }
}


USING: formatting io kernel math.transforms.bwt sequences ;
{
    "banana" "dogwood" "TO BE OR NOT TO BE OR WANT TO BE OR NOT?"
    "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES"
} [
    [ print ] [ bwt ] bi
    2dup "  bwt-->%3d %u\n" printf
    ibwt "  ibwt->    %u\n" printf nl
] each


package main

import (
    "fmt"
    "sort"
    "strings"
)

const stx = "\002"
const etx = "\003"

func bwt(s string) (string, error) {
    if strings.Index(s, stx) >= 0 || strings.Index(s, etx) >= 0 {
        return "", fmt.Errorf("String can't contain STX or ETX")
    }
    s = stx + s + etx
    le := len(s)
    table := make([]string, le)
    table[0] = s
    for i := 1; i < le; i++ {
        table[i] = s[i:] + s[:i]
    }
    sort.Strings(table)
    lastBytes := make([]byte, le)
    for i := 0; i < le; i++ {
        lastBytes[i] = table[i][le-1]
    }
    return string(lastBytes), nil
}

func ibwt(r string) string {
    le := len(r)
    table := make([]string, le)
    for range table {
        for i := 0; i < le; i++ {
            table[i] = r[i:i+1] + table[i]
        }
        sort.Strings(table)
    }
    for _, row := range table {
        if strings.HasSuffix(row, etx) {
            return row[1 : le-1]
        }
    }
    return ""
}

func makePrintable(s string) string {
    // substitute ^ for STX and | for ETX to print results
    t := strings.Replace(s, stx, "^", 1)
    return strings.Replace(t, etx, "|", 1)
}

func main() {
    tests := []string{
        "banana",
        "appellee",
        "dogwood",
        "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
        "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
        "\002ABC\003",
    }
    for _, test := range tests {
        fmt.Println(makePrintable(test))
        fmt.Print(" --> ")
        t, err := bwt(test)
        if err != nil {
            fmt.Println("ERROR:", err)
        } else {
            fmt.Println(makePrintable(t))
        }
        r := ibwt(t)
        fmt.Println(" -->", r, "\n")
    }
}


class BWT {
    private static final String STX = "\u0002"
    private static final String ETX = "\u0003"

    private static String bwt(String s) {
        if (s.contains(STX) || s.contains(ETX)) {
            throw new IllegalArgumentException("String cannot contain STX or ETX")
        }

        String ss = STX + s + ETX
        List<String> table = new ArrayList<>()
        for (int i = 0; i < ss.length(); i++) {
            String before = ss.substring(i)
            String after = ss.substring(0, i)
            table.add(before + after)
        }
        Collections.sort(table)

        StringBuilder sb = new StringBuilder()
        for (String str : table) {
            sb.append(str[str.length() - 1])
        }
        return sb.toString()
    }

    private static String ibwt(String r) {
        int len = r.length()
        List<String> table = new ArrayList<>()
        for (int i = 0; i < len; ++i) {
            table.add("")
        }
        for (int j = 0; j < len; ++j) {
            for (int i = 0; i < len; ++i) {
                table[i] = r[i] + table[i]
            }
            Collections.sort(table)
        }
        for (String row : table) {
            if (row.endsWith(ETX)) {
                return row.substring(1, len - 1)
            }
        }
        return ""
    }

    private static String makePrintable(String s) {
        // substitute ^ for STX and | for ETX to print results
        return s.replace(STX, "^").replace(ETX, "|")
    }

    static void main(String[] args) {
        List<String> tests = new ArrayList<>()
        tests.add("banana")
        tests.add("appellee")
        tests.add("dogwood")
        tests.add("TO BE OR NOT TO BE OR WANT TO BE OR NOT?")
        tests.add("SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES")
        tests.add("\u0002ABC\u0003")

        for (String test : tests) {
            println(makePrintable(test))
            print(" --> ")
            String t = ""
            try {
                t = bwt(test)
                println(makePrintable(t))
            } catch (IllegalArgumentException e) {
                println("ERROR: " + e.getMessage())
            }
            String r = ibwt(t)
            printf(" --> %s\n\n", r)
        }
    }
}


-- A straightforward, inefficient implementation of the Burrows–Wheeler
-- transform, based on the description in the Wikipedia article.
--
-- Special characters are *not* used to indicate the start or end of sequences,
-- so all strings can be represented.

import Data.List ((!!), find, sort, tails, transpose)
import Data.Maybe (fromJust)
import Text.Printf (printf)

newtype BWT a = BWT [Val a]

bwt :: Ord a => [a] -> BWT a
bwt xs = let n  = length xs + 2
             ys = transpose $ sort $ take n $ tails $ cycle $ pos xs
         in BWT $ ys !! (n-1)

invBwt :: Ord a => BWT a -> [a]
invBwt (BWT xs) = let ys = iterate step (map (const []) xs) !! length xs
                  in unpos $ fromJust $ find ((== Post) . last) ys
  where step = sort . zipWith (:) xs

data Val a = In a | Pre | Post deriving (Eq, Ord)

pos :: [a] -> [Val a]
pos xs = Pre : map In xs ++ [Post]

unpos :: [Val a] -> [a]
unpos xs = [x | In x <- xs]

main :: IO ()
main = mapM_ testBWT [ "", "a", "BANANA", "dogwood",
                       "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
                       "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES" ]

testBWT :: String -> IO ()
testBWT xs = let fwd = bwt xs
                 inv = invBwt fwd
             in printf "%s\n\t%s\n\t%s\n" xs (pretty fwd) inv
  where pretty (BWT ps) = map prettyVal ps
        prettyVal (In c) = c
        prettyVal Pre    = '^'
        prettyVal Post   = '|'


   NB. transform and inverse
   bwt=: {:"[email protected]:(/:~ :[:)@:(|."0 1~ [email protected]:[email protected]:#)@:((2{a.) , ,&(3{a.))@:(([ ('STX or ETX invalid in input' (13!:8) 21 + 0:))^:(1 e. (2 3{a.)&e.)) :.(}[email protected]:}:@:({~ ((3{a.) [: :i.~ {:"1))@:((,"0 1 /:~ :[:)^:(#@[)&(0$00)))

   NB. demonstrate the transform
   A=: <@bwt ;._2 ] 0 :0
    tests[0] = "banana";
    tests[1] = "appellee";
    tests[2] = "dogwood";
    tests[3] = "TO BE OR NOT TO BE OR WANT TO BE OR NOT?";
    tests[4] = "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
)
�;�  =] a [" s0nnb"taate s
�;�  =] e [" s1"elptlepate s
�;�  =] d [" s2o"toodwte sg
�;�  =]OOORREEETTR ? [" TW   BBB  ATTT   NNOOONOO"   s3tte s
�,�  =] S "TEXYDST[ .E.IXXIIXXSSMPPS.B..EE.".USFXDIIOIIITs4tte s

   NB. and the restoring transformation
   bwt inv&> A
    tests[0] = "banana";
    tests[1] = "appellee";
    tests[2] = "dogwood";
    tests[3] = "TO BE OR NOT TO BE OR WANT TO BE OR NOT?";
    tests[4] = "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",

   NB. the final test pattern
   bwt  a. {~ 2 , (a. i. 'ABC') , 3
|STX or ETX invalid in input: bwt
|       bwt a.{~2,(a.i.'ABC'),3


import java.util.ArrayList;
import java.util.List;

public class BWT {
    private static final String STX = "\u0002";
    private static final String ETX = "\u0003";

    private static String bwt(String s) {
        if (s.contains(STX) || s.contains(ETX)) {
            throw new IllegalArgumentException("String cannot contain STX or ETX");
        }

        String ss = STX + s + ETX;
        List<String> table = new ArrayList<>();
        for (int i = 0; i < ss.length(); i++) {
            String before = ss.substring(i);
            String after = ss.substring(0, i);
            table.add(before + after);
        }
        table.sort(String::compareTo);

        StringBuilder sb = new StringBuilder();
        for (String str : table) {
            sb.append(str.charAt(str.length() - 1));
        }
        return sb.toString();
    }

    private static String ibwt(String r) {
        int len = r.length();
        List<String> table = new ArrayList<>();
        for (int i = 0; i < len; ++i) {
            table.add("");
        }
        for (int j = 0; j < len; ++j) {
            for (int i = 0; i < len; ++i) {
                table.set(i, r.charAt(i) + table.get(i));
            }
            table.sort(String::compareTo);
        }
        for (String row : table) {
            if (row.endsWith(ETX)) {
                return row.substring(1, len - 1);
            }
        }
        return "";
    }

    private static String makePrintable(String s) {
        // substitute ^ for STX and | for ETX to print results
        return s.replace(STX, "^").replace(ETX, "|");
    }

    public static void main(String[] args) {
        List<String> tests = List.of(
            "banana",
            "appellee",
            "dogwood",
            "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
            "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
            "\u0002ABC\u0003"
        );
        for (String test : tests) {
            System.out.println(makePrintable(test));
            System.out.print(" --> ");
            String t = "";
            try {
                t = bwt(test);
                System.out.println(makePrintable(t));
            } catch (IllegalArgumentException e) {
                System.out.println("ERROR: " + e.getMessage());
            }
            String r = ibwt(t);
            System.out.printf(" --> %s\n\n", r);
        }
    }
}


# substitute ^ for STX and | for ETX
def makePrintable:
  if . == null then null
  else sub("\u0002"; "^") | sub("\u0003"; "|")
  end;

def bwt:
  {stx: "\u0002", etx: "\u0003"} as $x
  | if index($x.stx) >= 0 or index($x.etx) >= 0 then null
    else $x.stx + . + $x.etx
    | . as $s
    | (reduce range(0; length) as $i ([];
         .[$i] = $s[$i:] + $s[:$i]) | sort) as $table
    | reduce range(0; length) as $i ("";
         . + $table[$i][-1:])
    end;

def ibwt:
  . as $r
  | length as $len
  | reduce range(0;$len) as $i ([];
        reduce range(0; $len) as $j (.;
	.[$j] = $r[$j:$j+1] + .[$j]) | sort)
  | first( .[] | select(endswith("\u0003")))
  | .[1:-1] ;


bwsort(vec) = sort(vec, lt = (a, b) -> string(a) < string(b))

function burrowswheeler_encode(s)
    if match(r"\x02|\x03", s) != nothing
        throw("String for Burrows-Wheeler input cannot contain STX or ETX")
    end
    s = "\x02" * s * "\x03"
    String([t[end] for t in bwsort([circshift([c for c in s], n) for n in 0:length(s)-1])])
end

function burrowswheeler_decode(s)
    len, v = length(s), [c for c in s]
    m = fill(' ', len, len)
    for col in len:-1:1
        m[:, col] .= v
        for (i, row) in enumerate(bwsort([collect(r) for r in eachrow(m)]))
            m[i, :] .= row
        end
    end
    String(m[findfirst(row -> m[row, end] == '\x03', 1:len), 2:end-1])
end

for s in ["BANANA", "dogwood", "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
    "TO BE OR NOT TO BE OR WANT TO BE OR NOT?", "Oops\x02"]
    println("Original: ", s, "\nTransformation: ", burrowswheeler_encode(s),
        "\nInverse transformation: ", burrowswheeler_decode(burrowswheeler_encode(s)), "\n")
end


// Version 1.2.60

const val STX = "\u0002"
const val ETX = "\u0003"

fun bwt(s: String): String {
    if (s.contains(STX) || s.contains(ETX)) {
        throw RuntimeException("String can't contain STX or ETX")
    }
    val ss = STX + s + ETX
    val table = Array<String>(ss.length) { ss.substring(it) + ss.substring(0, it) }
    table.sort()
    return String(table.map { it[it.lastIndex] }.toCharArray())
}

fun ibwt(r: String): String {
    val len = r.length
    val table = Array<String>(len) { "" }
    repeat(len) {
        for (i in 0 until len) {
            table[i] = r[i].toString() + table[i]
        }
        table.sort()
    }
    for (row in table) {
        if (row.endsWith(ETX)) {
            return row.substring(1, len - 1)
        }
    }
    return ""
}

fun makePrintable(s: String): String {
    // substitute ^ for STX and | for ETX to print results
    return s.replace(STX, "^").replace(ETX, "|")
}

fun main(args: Array<String>) {
    val tests = listOf(
        "banana",
        "appellee",
        "dogwood",
        "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
        "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
        "\u0002ABC\u0003"
    )
    for (test in tests) {
        println(makePrintable(test))
        print(" --> ")
        var t = ""
        try {
            t = bwt(test)
            println(makePrintable(t))
        }
        catch (ex: RuntimeException) {
            println("ERROR: " + ex.message)
        }
        val r = ibwt(t)
        println(" --> $r\n")
    }
}


#!/bin/ksh

# Burrows–Wheeler transform

#	# Variables:
#
export LC_COLLATE=POSIX

STX=\^		# start marker
ETX=\|		# end marker

typeset -a str
str[0]='BANANA'
str[1]='appellee'
str[2]='dogwood'
str[3]='TO BE OR NOT TO BE OR WANT TO BE OR NOT?'
str[4]='SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES'
str[5]='|ABC^'

#	# Functions:
#

#	# Function _bwt(str, arr, lc) - sort all circular shifts of arr, return last col
#
function _bwt {
	typeset _str ; _str="$1"
	typeset _arr ; nameref _arr="$2"
	typeset _lastcol ; nameref _lastcol="$3"
	typeset _i _j _newstr ; integer _i _j

	[[ ${_str} == *+("$STX"|"$ETX")* ]] && return 1

	_str="$STX${_str}$ETX"
	for ((_i=0; _i<${#_str}; _i++)); do
		_newstr=${_str:${#_str}-1:1}
		for ((_j=0; _j<${#_str}-1; _j++)); do
			_newstr+=${_str:${_j}:1}
		done
		_arr+=( "${_newstr}" )
		_str="${_newstr}"
	done

	set -sA arr		# Sort arr

	for ((_i=0; _i<${#_arr[*]}; _i++)); do
		_lastcol+=${_arr[_i]:${#_arr[_i]}-1:1}
	done
}

#	# Function _ibwt(str) - inverse bwt
#
function _ibwt {
	typeset _str ; _str="$1"
	typeset _arr _vec _ret _i ; typeset -a _arr _vec ; integer _i

	_intovec "${_str}" _vec
	for ((_i=1; _i<${#_str}; _i++)); do
		_intoarr _vec _arr
		set -sA _arr
	done

	for ((_i=0; _i<${#arr[*]}; _i++)); do
		[[ "${arr[_i]}" == ${STX}*${ETX} ]] && echo "${arr[_i]}" && return
	done
}

#	# Function _intovec(str, vec) - trans str into vec[]
#
function _intovec {
	typeset _str ; _str="$1"
	typeset _vec ; nameref _vec="$2"
	typeset _i ; integer _i

	for ((_i=0; _i<${#_str}; _i++)); do
		_vec+=( "${_str:${_i}:1}" )
	done
}

#	# Function _intoarr(i, vec, arr) - insert vec into arr
#
function _intoarr {
	typeset _vec ; nameref _vec="$1"
	typeset _arr ; nameref _arr="$2"
	typeset _j ; integer _j

	for ((_j=0; _j<${#_vec[*]}; _j++)); do
		_arr="${_vec[_j]}${_arr[_j]}"
	done
}

 ######
# main #
 ######

for ((i=0; i<${#str[*]}; i++)); do
	unset arr lastcol result ; typeset -a arr

	print -- "${str[i]}"
	_bwt "${str[i]}" arr lastcol
	(( $? )) && print "ERROR: string cannot contain $STX or $ETX" && continue

	print -- "${lastcol}"
	result=$(_ibwt "${lastcol}")
	print -- "${result}"
	echo
done


STX = string.char(tonumber(2,16))
ETX = string.char(tonumber(3,16))

function bwt(s)
    if s:find(STX, 1, true) then
        error("String cannot contain STX")
    end
    if s:find(ETX, 1, true) then
        error("String cannot contain ETX")
    end

    local ss = STX .. s .. ETX
    local tbl = {}
    for i=1,#ss do
        local before = ss:sub(i + 1)
        local after = ss:sub(1, i)
        table.insert(tbl, before .. after)
    end

    table.sort(tbl)

    local sb = ""
    for _,v in pairs(tbl) do
        sb = sb .. string.sub(v, #v, #v)
    end

    return sb
end

function ibwt(r)
    local le = #r
    local tbl = {}

    for i=1,le do
        table.insert(tbl, "")
    end
    for j=1,le do
        for i=1,le do
            tbl[i] = r:sub(i,i) .. tbl[i]
        end
        table.sort(tbl)
    end

    for _,row in pairs(tbl) do
        if row:sub(le,le) == ETX then
            return row:sub(2, le - 1)
        end
    end

    return ""
end

function makePrintable(s)
    local a = s:gsub(STX, '^')
    local b = a:gsub(ETX, '|')
    return b
end

function main()
    local tests = {
        "banana",
        "appellee",
        "dogwood",
        "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
        "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
        STX .. "ABC" .. ETX
    }

    for _,test in pairs(tests) do
        print(makePrintable(test))
        io.write(" --> ")
        local t = ""
        if xpcall(
            function () t = bwt(test) end,
            function (err) print("ERROR: " .. err) end
        ) then
            print(makePrintable(t))
        end
        local r = ibwt(t)
        print(" --> " .. r)
        print()
    end
end

main()


ClearAll[BurrowWheeler, InverseBurrowWheeler]
BurrowWheeler[sin_String, {bdelim_, edelim_}] := Module[{s},
  s = Characters[bdelim <> sin <> edelim];
  s = RotateLeft[s, #] & /@ Range[Length[s]];
  StringJoin[LexicographicSort[s][[All, -1]]]
  ]
InverseBurrowWheeler[sin_String, {bdelim_, edelim_}] := Module[{s, chars},
  chars = Characters[sin];
  s = ConstantArray[{}, Length[chars]];
  Do[
   s = LexicographicSort[MapThread[Prepend, {s, chars}]];
   ,
   {Length[chars]}
   ];
  StringTake[StringJoin[SelectFirst[s, Last /* EqualTo[edelim]]], {2, -2}]
  ]
BurrowWheeler["BANANA", {"^", "|"}]
InverseBurrowWheeler[%, {"^", "|"}]
BurrowWheeler["appellee", {"^", "|"}]
InverseBurrowWheeler[%, {"^", "|"}]
BurrowWheeler["dogwood", {"^", "|"}]
InverseBurrowWheeler[%, {"^", "|"}]


import algorithm
from sequtils import repeat
import strutils except repeat

const
  Stx = '\2'
  Etx = '\3'

#---------------------------------------------------------------------------------------------------

func bwTransform*(s: string): string =
  ## Apply Burrows–Wheeler transform to input string.

  doAssert(Stx notin s and Etx notin s, "Input string cannot contain STX and ETX characters")

  let s = Stx & s & Etx  # Add start and end of text marker.

  # Build the table of rotated strings and sort it.
  var table = newSeqOfCap[string](s.len)
  for i in 0..s.high:
    table.add(s[i + 1..^1] & s[0..i])
  table.sort()

  # Extract last column of the table.
  for item in table:
    result.add(item[^1])

#---------------------------------------------------------------------------------------------------

func invBwTransform*(r: string): string =
  ## Apply inverse Burrows–Wheeler transform.

  # Build table.
  var table = repeat("", r.len)
  for _ in 1..r.len:
    for i in 0..<r.len:
      table[i] = r[i] & table[i]
    table.sort()

  # Find the correct row (ending in ETX).
  var idx = 0
  while not table[idx].endsWith(Etx):
    inc idx
  result = table[idx][1..^2]

#———————————————————————————————————————————————————————————————————————————————————————————————————

when isMainModule:

  proc displaybleString(s: string): string =
    ## Build a displayable string from a string containing STX and ETX characters.

    s.multiReplace(("\2", "¹"), ("\3", "²"))

  for text in ["banana",
               "appellee",
               "dogwood",
               "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
               "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES"]:
    let transformed = text.bwTransform()
    let invTransformed = transformed.invBwTransform()

    echo ""
    echo "Original text:                ", text
    echo "After transformation:         ", transformed.displaybleString()
    echo "After inverse transformation: ", invTransformed


program BurrowsWheeler;

{$mode objfpc}{$H+}  // Lazarus default mode; long strings
uses SysUtils;       // only for console output
const STR_BASE = 1;  // first character in a Pascal string has index [1].
type TComparison = -1..1;

procedure Encode( const input : string;
                  out encoded : string;
                  out index : integer);
var
  n : integer;
  perm : array of integer;
  i, j, k : integer;
  incr, v : integer;

        // Subroutine to compare rotations whose *last* letters have zero-based
        //  indices a, b. Returns 1, 0, -1 according as the rotation ending at a
        //  is >, =, < the rotation ending at b.
        function CompareRotations( a, b : integer) : TComparison;
        var
          p, q, nrNotTested : integer;
        begin
          result := 0;
          p := a;
          q := b;
          nrNotTested := n;
          repeat
            inc(p); if (p = n) then p := 0;
            inc(q); if (q = n) then q := 0;
            if (input[p + STR_BASE] = input[q + STR_BASE]) then dec( nrNotTested)
            else if (input[p + STR_BASE] > input[q + STR_BASE]) then result := 1
            else result := -1
          until (result <> 0) or (nrNotTested = 0);
        end;
begin
  n := Length( input);
  SetLength( perm, n);
  for j := 0 to n - 1 do perm[j] := j;

  // Sort string indices by comparing the associated rotations, as above.
  // This is a Shell sort from Press et al., Numerical Recipes, 3rd edn, pp 422-3.
  // Other sorting algorithms might be used.
  incr := 1;
  repeat
    incr := 3*incr + 1
  until (incr >= n);
  repeat
    incr := incr div 3;
    for i := incr to n - 1 do begin
      v := perm[i];
      j := i;
      while (j >= incr) and (CompareRotations( perm[j - incr], v) = 1) do begin
        perm[j] := perm[j - incr];
        dec( j, incr);
      end;
      perm[j] := v;
    end; // for
  until (incr = 1);

  // Apply the sorted array to create the output.
  SetLength( encoded, n);
  for j := 0 to n - 1 do begin
    k := perm[j];
    encoded[j + STR_BASE] := input[k + STR_BASE];
    if (k = n - 1) then index := j;
  end;
end;

{------------------------------------------------------------------------------
Given an encoded string and the associated index, one way to rebuild
the original string is to do the following, or its equivalent:

Given        Make an array     Sort the array    Rebuild the original string
'NNBAAA'     [0] = ('N', 0)    [0] = ('A', 3)    Start with given index 3
index = 3    [1] = ('N', 1)    [1] = ('A', 4)    [3] gives 'B', next index = 2
             [2] = ('B', 2)    [2] = ('A', 5)    [2] gives 'A', next index = 5
             [3] = ('A', 3)    [3] = ('B', 2)    [5] gives 'N', next index = 1
             [4] = ('A', 4)    [4] = ('N', 0)    [1] gives 'A', next index = 4
             [5] = ('A', 5)    [5] = ('N', 1)    [4] gives 'N', next index = 0
                                                 [0] gives 'A', next index = 3
                                                 3 = start index, so stop
                                                 Result = 'BANANA'

If the original string consists of two or more repetitions of a substring,
  the above method will stop when that substring has been built, e.g.
  'CANCAN' will stop at 'CAN'.
We therefore need to test for the rebuilt string being too short, and if so
  make enough copies of the decoded part to fill the required length.

It's possible to take the above description literally, and write a decoding
  routine that uses a record type consisting of a character and an integer.
A more efficient way is to create an integer array containing only the indices,
  in the above example (3, 4, 5, 2, 0, 1). A first pass counts the occurrences
  of each character in the encoded string. If the character set is ['A'..'Z']
  then the indices associated with 'A' are stored from [0]. If 'A' occurs a times,
  the indices associated with 'B' are stored from [a]; if 'B' occurs b times,
  the indices associated with 'C' are stored from [a + b]; and so on.
}
function Decode( encoded : string;
                 index : integer) : string;
var
  charInfo : array [char] of integer;
  perm : array of integer;
  n, j, k : integer;
  c : char;
  total, prev : integer;

begin
  n := Length( encoded);
  // An empty encoded string will crash the code below, so trap it here.
  if (n = 0) then begin
    result := '';
    exit;
  end;

  // Count the occurrences of each possible character.
  for c := Low(char) to High(char) do charInfo[c] := 0;
  for j := 0 to n - 1 do begin
    c := encoded[j + STR_BASE];
    inc( charInfo[c]);
  end;

  // Cumulate, i.e. charInfo[k] := sum of old charInfo from 0 to k - 1
  total := 0;
  prev := 0;
  for c := Low(char) to High(char) do begin
    inc( total, prev);
    prev := CharInfo[c];
    charInfo[c] := total;
  end;

  // Make the array "perm"
  SetLength( perm, n);
  for j := 0 to n - 1 do begin
    c := encoded[j + STR_BASE];
    k := charInfo[c];
    perm[k] := j;
    inc( charInfo[c]);
  end;

  // Apply the array "perm" to re-create the original string.
  SetLength( result, n);
  k := 0; // index into result
  j := index;
  repeat
    j := perm[j];
    result[k + STR_BASE] := encoded[j + STR_BASE];
    inc(k);
  until (j = index);

  // If the original consisted of M repetitions of the same string, then
  //   at this point exactly 1/M of the result has been filled in.
  // For M > 1 (shown by k < n), complete the result by copying the first part.
  if (k < n) then begin
    Assert( n mod k = 0); // we should have n = M*k
    for j := k to n - 1 do result[j + STR_BASE] := result[j - k + STR_BASE];
  end;
end;

procedure Test( const s : string);
var
  encoded, decoded : string;
  index : integer;
begin
  WriteLn( '');
  WriteLn( '     ' + s);
  Encode( s, {out} encoded, index);
  WriteLn( '---> ' + encoded);
  WriteLn( '       index = ' + SysUtils.IntToStr( index));
  decoded := Decode( encoded, index);
  WriteLn( '---> ' + decoded);
end;

begin
  Test( 'BANANA');
  Test( 'CANAAN');
  Test( 'CANCAN');
  Test( 'appellee');
  Test( 'dogwood');
  Test( 'TO BE OR NOT TO BE OR WANT TO BE OR NOT?');
  Test( 'SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES');
end.


use utf8;
binmode STDOUT, ":utf8";

use constant STX => '👍 ';

sub transform {
    my($s) = @_;
    my($t);
    warn "String can't contain STX character." and exit if $s =~ /STX/;
    $s = STX . $s;
    $t .= substr($_,-1,1) for sort map { rotate($s,$_) } 1..length($s);
    return $t;
}

sub rotate { my($s,$n) = @_; join '', (split '', $s)[$n..length($s)-1, 0..$n-1] }

sub ɯɹoɟsuɐɹʇ {
    my($s) = @_;
    my @s = split '', $s;
    my @t = sort @s;
    map { @t = sort map { $s[$_] . $t[$_] } 0..length($s)-1 } 1..length($s)-1;
    for (@t) {
        next unless /${\(STX)}$/;  # interpolate the constant
        chop $_ and return $_
    }
}

for $phrase (qw<BANANA dogwood SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES>,
    'TO BE OR NOT TO BE OR WANT TO BE OR NOT?') {
    push @res, 'Original:            '. $phrase;
    push @res, 'Transformed:         '. transform $phrase;
    push @res, 'Inverse transformed: '. ɯɹoɟsuɐɹʇ transform $phrase;
    push @res, '';
}

print join "\n", @res;


-- demo\rosetta\burrows_wheeler.exw
--/*
The traditional method:

    7 banana$           $banana 6
    6 $banana   ===>    a$banan 5
    5 a$banan           ana$ban 3
    4 na$bana   sort    anana$b 1
    3 ana$ban           banana$ 7
    2 nana$ba   ===>    na$bana 4
    1 anana$b           nana$ba 2
                              ^ desired answer == "annb$aa"

First ignore the numbers: the desired answer is found by creating a table of all
rotations of "banana$", sorting it, and then extracting the right-hand column.

However, there is no need to actually create such a table, which could be very
expensive for long strings, instead just number them logically (admittedly that
was somewhat arbitrarily chosen to get the indexes to work out nicely, I picked
the original index of the last character), and perform a custom sort on those.

The latter effectively just recreates the rotations one character at a time until
there is a mismatch (which there always will be since there is only one $).
The left hand column is my arbitrary numbering scheme and the right hand column
is those sorted into order, which is also the indexes to the original string of
the characters that we want.

The code below uses $ as the terminator, but eg 1 (== '\#01') should be fine,
except of course for the display of that on a console.
--*/
with javascript_semantics
constant terminator = '$'

function rot_sort(integer i,j, sequence s)
-- i,j are indexes of the last character, so bump before first compare.
-- eg/ie rot_sort(i,j,s) should yield compare(rotate(s,i),rotate(s,j)),
--       as in rot_sort(7,6,"banana$") == compare("banana$","$banana")
--       - but one character at a time rather than constructing both.
    integer l = length(s)
    while true do
        i = mod(i,l)+1
        j = mod(j,l)+1
        integer c = compare(s[i],s[j])
        if c!=0 then return c end if
    end while
end function

function burrows_wheeler_transform(string s)
    if find(terminator,s) then return "error" end if
    s &= terminator
    integer l = length(s)
    sequence t = custom_sort(routine_id("rot_sort"),tagset(l),{s})
    string res = repeat(' ',l)
    for i=1 to l do
        res[i] = s[t[i]]
    end for
    return res
end function

--/*
Inversion. The traditional method is add column and sort, seven times,
to reconstruct the table above, then pick the entry that ends with the
marker. Showing that technique in full detail here is not helpful, and
like above that would be hideously inefficient for large strings.

                $banana         1  $ (1 ) a  2
                a$banan         2  a ( 1) n  6
                ana$ban         3  a ( 2) n  7
                anana$b         4  a ( 3) b  5
                banana$         5  b      $  1
                na$bana         6  n (2 ) a  3
                nana$ba         7  n (3 ) a  4
                ^     ^            ^      ^  ^
                f     l            f      l  t

However, we already have the last column, and the first is just that
sorted alphabetically, and with just those two, we have all possible
character pairings of the original message. The trick is in figuring
out how to stitch them together in the right order. If you carefully
study the three that end in a, and the three that start in a, notice
the $banan,na$ban,nana$b parts are sorted in the same order, whether
they are prefixed with a or not. That is, the middle (parenthesised)
matching numbers are both 123, not 123 and say 231. It is quite hard
to see that being useful, but eventually the penny should drop. The
right-hand 1 with an a rotated right gives the left-hand 1, and the
same goes for 2 and 3: they are in fact links to the prior pairing.

In other words the first a in l always corresponds to the first in f,
the second to the second, and so on, and that (amazingly) forms the
order in which the pairings need to be daisy-chained together.

Try following (1->)2a->6n->3a->7n->4a->5b->$, == reverse("banana"),
in the above f and t tables.

The code below builds a queue of 'a' ({1,6,7}, built backwards) then
we pop {2,3,4} into those slots in t as we find 'a' in f, likewise
for all other letters, forming the links for each pairing as shown.
See the trivial step 3 scan below, then go back and stare at f and
t as shown above, and once again, eventually the penny should drop.
I will admit I had to read ten or so explanations before I got it.
--*/

function inverse_burrows_wheeler(string s)
    if find('\0',s) then ?9/0 end if -- (doable, but needs some +1s)
    integer l = length(s), c
    string f = sort(s)
    sequence q = repeat(0,256), -- queue heads (per char)
             x = repeat(0,l),   -- queue links
             t = repeat(0,l)    -- reformed/pairing links
    -- Step 1. discover/build queues (backwards)
    for i=l to 1 by -1 do
        c = s[i]
        x[i] = q[c]
        q[c] = i
    end for
    -- Step 2. reform/pop char queues into pairing links
    for i=1 to l do
        c = f[i]
        t[q[c]] = i
        q[c] = x[q[c]]
    end for
    -- Step 3. rebuild (backwards)
    c = find(terminator,f)
    if c=0 then return "error" end if
    string res = repeat(' ',l-1)
    for i=l-1 to 1 by -1 do
        c = t[c]        -- (first time in, skip the end marker)
        res[i] = f[c]
    end for
    return res
end function

procedure test(string src)
string enc = burrows_wheeler_transform(src),
       dec = inverse_burrows_wheeler(enc)
    src = shorten(src,"characters")
    enc = shorten(enc,"characters")
    dec = shorten(dec,"characters")
    printf(1,"original: %s --> %s\n inverse: %s\n",{src,enc,dec})
end procedure

test("banana")
test("dogwood")
test("TO BE OR NOT TO BE OR WANT TO BE OR NOT?")
test("SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES")


def bwt(s):
    """Apply Burrows-Wheeler transform to input string."""
    assert "\002" not in s and "\003" not in s, "Input string cannot contain STX and ETX characters"
    s = "\002" + s + "\003"  # Add start and end of text marker
    table = sorted(s[i:] + s[:i] for i in range(len(s)))  # Table of rotations of string
    last_column = [row[-1:] for row in table]  # Last characters of each row
    return "".join(last_column)  # Convert list of characters into string

def ibwt(r):
    """Apply inverse Burrows-Wheeler transform."""
    table = [""] * len(r)  # Make empty table
    for i in range(len(r)):
        table = sorted(r[i] + table[i] for i in range(len(r)))  # Add a column of r
    s = [row for row in table if row.endswith("\003")][0]  # Find the correct row (ending in ETX)
    return s.rstrip("\003").strip("\002")  # Get rid of start and end markers


# STX can be any character that doesn't appear in the text.
# Using a visible character here for ease of viewing.

constant \STX = '👍';

# Burrows-Wheeler transform
sub transform (Str $s is copy) {
    note "String can't contain STX character." and exit if $s.contains: STX;
    $s = STX ~ $s;
    (^$s.chars).map({ $s.comb.list.rotate: $_ }).sort[*;*-1].join
}

# Burrows-Wheeler inverse transform
sub ɯɹoɟsuɐɹʇ (Str $s) {
    my @t = $s.comb.sort;
    @t = ($s.comb Z~ @t).sort for 1..^$s.chars;
    @t.first( *.ends-with: STX ).chop
}

# TESTING
for |<BANANA dogwood SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES>,
    'TO BE OR NOT TO BE OR WANT TO BE OR NOT?', "Oops{STX}"
    -> $phrase {
    say 'Original:            ', $phrase;
    say 'Transformed:         ', transform $phrase;
    say 'Inverse transformed: ', ɯɹoɟsuɐɹʇ transform $phrase;
    say '';
}


/*REXX program performs a  Burrows─Wheeler transform  (BWT)  on a character string(s).  */
$.=                                              /*the default text for (all) the inputs*/
parse arg $.1                                    /*obtain optional arguments from the CL*/
if $.1=''  then do;  $.1= "banana"               /*Not specified?  Then use the defaults*/
                     $.2= "BANANA"
                     $.3= "appellee"
                     $.4= "dogwood"
                     $.5= "TO BE OR NOT TO BE OR WANT TO BE OR NOT?"
                     $.6= "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES"
                     $.7= "^ABC|"
                     $.7= "bad─bad thingy"'fd'x  /* ◄─── this string can't be processed.*/
                end
                                                 /* [↑]  show blank line between outputs*/
       do t=1  while $.t\='';  if t\==1 then say /*process each of the inputs (or input)*/
       out=  BWT($.t)                            /*invoke the  BWT  function, get result*/
       ori= iBWT(out)                            /*   "    "  iBWT      "      "     "  */
       say '   input ───► '   $.t                /*display    input      string to term.*/
       say '  output ───► '   out                /*   "       output        "    "   "  */
       say 'original ───► '   ori                /*   "    reconstituted    "    "   "  */
       end    /*t*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
BWT:   procedure expose ?.; parse arg y,,$       /*obtain the input;  nullify $ string. */
       ?.1= 'fd'x;          ?.2= "fc"x           /*assign the  STX  and  ETX  strings.  */
          do i=1  for 2                          /* [↓]  check for invalid input string.*/
          _= verify(y, ?.i, 'M');  if _==0  then iterate;        er= '***error***  BWT: '
          say er "invalid input: "    y
          say er 'The input string contains an invalid character at position' _"."; exit _
          end   /*i*/                            /* [↑]  if error,  perform a hard exit.*/
       y= ?.1 || y || ?.2;      L= length(y)     /*get the input & add a fence; gel len.*/
       @.1= y;                  m= L - 1         /*define the first element of the table*/
                    do j=2  for m;        _= j-1 /*now, define the rest of the elements.*/
                    @.j= right(@._,1)left(@._,m) /*construct a table from the  Y  input.*/
                    end   /*j*/                  /* [↑]  each element: left & right part*/
       call cSort L                              /*invoke lexicographical sort for array*/
                    do k=1  for L                /* [↓]  construct the answer from array*/
                    $= $  ||  right(@.k, 1)      /*build the answer from each of  ···   */
                    end   /*k*/                  /* ··· the array's right─most character*/
       return $                                  /*return the constructed answer.       */
/*──────────────────────────────────────────────────────────────────────────────────────*/
iBWT:  procedure expose ?.; parse arg y,,@.      /*obtain the input;  nullify @. string.*/
       L= length(y)                              /*compute the length of the input str. */
                   do   j=1  for L               /* [↓]  step through each input letters*/
                     do k=1  for L               /* [↓]  step through each row of table.*/
                     @.k= substr(y, k, 1) || @.k /*construct a row of the table of chars*/
                     end   /*k*/                 /* [↑]  order of table row is inverted.*/
                   call cSort L                  /*invoke lexicographical sort for array*/
                   end    /*j*/                  /* [↑]  answer is the penultimate entry*/
         do #=1
         if right(@.#, 1)==?.2  then return substr(@.#, 2, L-2)  /*return correct result*/
         end   /*#*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
cSort: procedure expose @.;  parse arg n;  m=n-1 /*N: is the number of @ array elements.*/
           do m=m  for m  by -1  until ok;  ok=1 /*keep sorting the  @ array until done.*/
             do j=1  for m;  k= j+1;   if @.j<<[email protected].k  then iterate   /*elements in order?*/
             _= @.j;  @.j= @.k;  @.k= _;   ok= 0 /*swap two elements;  flag as not done.*/
             end   /*j*/
           end     /*m*/;       return


STX = "\u0002"
ETX = "\u0003"

def bwt(s)
    for c in s.split('')
        if c == STX or c == ETX then
            raise ArgumentError.new("Input can't contain STX or ETX")
        end
    end

    ss = ("%s%s%s" % [STX, s, ETX]).split('')
    table = []
    for i in 0 .. ss.length - 1
        table.append(ss.join)
        ss = ss.rotate(-1)
    end

    table = table.sort
    return table.map{ |e| e[-1] }.join
end

def ibwt(r)
    len = r.length
    table = [""] * len
    for i in 0 .. len - 1
        for j in 0 .. len - 1
            table[j] = r[j] + table[j]
        end
        table = table.sort
    end
    for row in table
        if row[-1] == ETX then
            return row[1 .. -2]
        end
    end
    return ""
end

def makePrintable(s)
    s = s.gsub(STX, "^")
    return s.gsub(ETX, "|")
end

def main
    tests = [
        "banana",
        "appellee",
        "dogwood",
        "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
        "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
        "\u0002ABC\u0003"
    ]
    for test in tests
        print makePrintable(test), "\n"
        print " --> "

        begin
            t = bwt(test)
            print makePrintable(t), "\n"

            r = ibwt(t)
            print " --> ", r, "\n\n"
        rescue ArgumentError => e
            print e.message, "\n"
            print " -->\n\n"
        end
    end
end

main()


use core::cmp::Ordering;

const STX: char = '\u{0002}';
const ETX: char = '\u{0003}';

// this compare uses simple alphabetical sort, but for the special characters (ETX, STX)
// it sorts them later than alphanumeric characters
pub fn special_cmp(lhs: &str, rhs: &str) -> Ordering {
    let mut iter1 = lhs.chars();
    let mut iter2 = rhs.chars();

    loop {
        match (iter1.next(), iter2.next()) {
            (Some(lhs), Some(rhs)) => {
                if lhs != rhs {
                    let is_lhs_special = lhs == ETX || lhs == STX;
                    let is_rhs_special = rhs == ETX || rhs == STX;

                    let result = if is_lhs_special == is_rhs_special {
                        lhs.cmp(&rhs)
                    } else if is_lhs_special {
                        Ordering::Greater
                    } else {
                        Ordering::Less
                    };

                    return result;
                }
            }
            (Some(_), None) => return Ordering::Greater,
            (None, Some(_)) => return Ordering::Less,
            (None, None) => return lhs.cmp(&rhs),
        }
    }
}

fn burrows_wheeler_transform(input: &str) -> String {
    let mut table: Vec<String> = vec![];

    // add markers for the start and end
    let input_string = format!("{}{}{}", STX, input, ETX);

    // create all possible rotations
    for (i, _) in input_string.char_indices() {
        table.push(format!(
            "{}{}",
            &input_string[input_string.len() - 1 - i..],
            &input_string[0..input_string.len() - 1 - i]
        ));
    }

    // sort rows alphabetically
    table.sort_unstable_by(|lhs, rhs| special_cmp(&lhs, &rhs));

    // return the last column
    table
        .iter()
        .map(|s| s.chars().nth_back(0).unwrap())
        .collect::<String>()
}

fn inverse_burrows_wheeler_transform(input: &str) -> String {
    let mut table: Vec<String> = vec![String::new(); input.len()];
    for _ in 0..input.len() {
        // insert the charatcers of the encoded input as a first column for each row
        for (j, s) in table.iter_mut().enumerate() {
            *s = format!("{}{}", input.chars().nth(j).unwrap(), s);
        }

        // sort rows alphabetically
        table.sort_unstable_by(|lhs, rhs| special_cmp(&lhs, &rhs));
    }

    // return the row which has the end marker at the last position
    table
        .into_iter()
        .filter(|s| s.ends_with(ETX))
        .collect::<String>()
        // remove start and markers
        .replace(STX, "")
        .replace(ETX, "")
}

fn main() {
    let input = [
        "banana",
        "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
        "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
    ];
    for s in input.iter() {
        let bwt = burrows_wheeler_transform(s);
        let ibwt = inverse_burrows_wheeler_transform(&bwt);
        println!("Input: {}", s);
        println!("\tBWT: {}", bwt.replace(STX, "^").replace(ETX, "|"));
        println!("\tInverse BWT: {}", ibwt);
    }
}


import scala.collection.mutable.ArrayBuffer

object BWT {
  val STX = '\u0002'
  val ETX = '\u0003'

  def bwt(s: String): String = {
    if (s.contains(STX) || s.contains(ETX)) {
      throw new RuntimeException("String can't contain STX or ETX")
    }
    var ss = STX + s + ETX
    var table = new ArrayBuffer[String]()
    (0 until ss.length).foreach(_ => {
      table += ss
      ss = ss.substring(1) + ss.charAt(0)
    })
    table.sorted.map(a => a.last).mkString
  }

  def ibwt(r: String): String = {
    var table = Array.fill(r.length)("")
    (0 until r.length).foreach(_ => {
      (0 until r.length).foreach(i => {
        table(i) = r.charAt(i) + table(i)
      })
      table = table.sorted
    })
    table.indices.foreach(i => {
      val row = table(i)
      if (row.last == ETX) {
        return row.substring(1, row.length - 1)
      }
    })
    ""
  }

  def makePrintable(s: String): String = {
    s.replace(STX, '^').replace(ETX, '|')
  }

  def main(args: Array[String]): Unit = {
    val tests = Array("banana",
      "appellee",
      "dogwood",
      "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
      "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
      "\u0002ABC\u0003"
    )

    tests.foreach(test => {
      println(makePrintable(test))
      print(" --> ")

      try {
        val t = bwt(test)
        println(makePrintable(t))
        val r = ibwt(t)
        printf(" --> %s\n", r)
      } catch {
        case e: Exception => printf("ERROR: %s\n", e.getMessage)
      }

      println()
    })
  }
}


class BurrowsWheelerTransform (String L = "\002") {

    method encode(String s) {
        assert(!s.contains(L), "String cannot contain `#{L.dump}`")
        s = (L + s)
        s.len.of{|i| s.substr(i) + s.substr(0, i) }.sort.map{.last}.join
    }

    method decode(String s) {
        var t = s.len.of("")
        var c = s.chars
        { t = (c »+« t).sort } * s.len
        t.first { .begins_with(L) }.substr(L.len)
    }
}

var tests = [
    "banana", "appellee", "dogwood", "TOBEORNOTTOBEORTOBEORNOT"
    "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
]

var bwt = BurrowsWheelerTransform(L: '$')

tests.each { |str|
    var enc = bwt.encode(str)
    var dec = bwt.decode(enc)
    say "BWT(#{dec.dump}) = #{enc.dump}"
    assert_eq(str, dec)
}


import Foundation

private let stx = "\u{2}"
private let etx = "\u{3}"

func bwt(_ str: String) -> String? {
  guard !str.contains(stx), !str.contains(etx) else {
    return nil
  }

  let ss = stx + str + etx
  let table = ss.indices.map({i in ss[i...] + ss[ss.startIndex..<i] }).sorted()

  return String(table.map({str in str.last!}))
}

func ibwt(_ str: String) -> String? {
  let len = str.count
  var table = Array(repeating: "", count: len)

  for _ in 0..<len {
    for i in 0..<len {
      table[i] = String(str[str.index(str.startIndex, offsetBy: i)]) + table[i]
    }

    table.sort()
  }

  for row in table where row.hasSuffix(etx) {
    return String(row.dropFirst().dropLast())
  }

  return nil
}

func readableBwt(_ str: String) -> String {
  return str.replacingOccurrences(of: "\u{2}", with: "^").replacingOccurrences(of: "\u{3}", with: "|")
}

let testCases = [
  "banana",
  "appellee",
  "dogwood",
  "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
  "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
  "\u{2}ABC\u{3}"
]

for test in testCases {
  let b = bwt(test) ?? "error"
  let c = ibwt(b) ?? "error"

  print("\(readableBwt(test)) -> \(readableBwt(b)) -> \(readableBwt(c))")
}


Module Module1

    ReadOnly STX As Char = Chr(&H2)
    ReadOnly ETX As Char = Chr(&H3)

    Sub Rotate(Of T)(a As T())
        Dim o = a.Last
        For i = a.Length - 1 To 1 Step -1
            a(i) = a(i - 1)
        Next
        a(0) = o
    End Sub

    Private Function Compare(s1 As String, s2 As String) As Integer
        Dim i = 0
        While i < s1.Length AndAlso i < s2.Length
            Dim a = s1(i)
            Dim b = s2(i)
            If a < b Then
                Return -1
            End If
            If b < a Then
                Return 1
            End If
            i += 1
        End While
        If s1.Length < s2.Length Then
            Return -1
        End If
        If s2.Length < s1.Length Then
            Return 1
        End If
        Return 0
    End Function

    Function Bwt(s As String) As String
        If s.Any(Function(c) c = STX OrElse c = ETX) Then
            Throw New ArgumentException("Input can't contain STX or ETX")
        End If
        Dim ss = (STX + s + ETX).ToCharArray
        Dim table As New List(Of String)
        For i = 0 To ss.Length - 1
            table.Add(New String(ss))
            Rotate(ss)
        Next
        table.Sort(Function(a As String, b As String) Compare(a, b))
        Return New String(table.Select(Function(a) a.Last).ToArray)
    End Function

    Function Ibwt(r As String) As String
        Dim len = r.Length
        Dim sa(len - 1) As String
        Dim table As New List(Of String)(sa)
        For i = 0 To len - 1
            For j = 0 To len - 1
                table(j) = r(j) + table(j)
            Next
            table.Sort(Function(a As String, b As String) Compare(a, b))
        Next
        For Each row In table
            If row.Last = ETX Then
                Return row.Substring(1, len - 2)
            End If
        Next
        Return ""
    End Function

    Function MakePrintable(s As String) As String
        Return s.Replace(STX, "^").Replace(ETX, "|")
    End Function

    Sub Main()
        Dim tests As String() = {
            "banana",
            "appellee",
            "dogwood",
            "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
            "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
            STX + "ABC" + ETX
        }

        For Each test In tests
            Console.WriteLine(MakePrintable(test))
            Console.Write(" --> ")

            Dim t = ""
            Try
                t = Bwt(test)
                Console.WriteLine(MakePrintable(t))
            Catch ex As Exception
                Console.WriteLine("ERROR: {0}", ex.Message)
            End Try

            Dim r = Ibwt(t)
            Console.WriteLine(" --> {0}", r)
            Console.WriteLine()
        Next
    End Sub

End Module


import "/sort" for Sort

var stx = "\x02"
var etx = "\x03"

var bwt = Fn.new { |s|
    if (s.indexOf(stx) >= 0 || s.indexOf(etx) >= 0) return null
    s = stx + s + etx
    var len = s.count
    var table = [""] * len
    table[0] = s
    for (i in 1...len) table[i] = s[i..-1] + s[0...i]
    Sort.quick(table)
    var lastChars = [""] * len
    for (i in 0...len) lastChars[i] = table[i][len-1]
    return lastChars.join()
}

var ibwt = Fn.new { |r|
    var len = r.count
    var table = [""] * len
    for (i in 0...len) {
        for (j in 0...len) table[j] = r[j] + table[j]
        Sort.quick(table)
    }
    for (row in table) {
        if (row.endsWith(etx)) return row[1...len-1]
    }
    return ""
}

var makePrintable = Fn.new { |s|
    // substitute ^ for STX and | for ETX to print results
    s = s.replace(stx, "^")
    return s.replace(etx, "|")
}

var tests = [
    "banana",
    "appellee",
    "dogwood",
    "TO BE OR NOT TO BE OR WANT TO BE OR NOT?",
    "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES",
    "\x02ABC\x03"
]
for (test in tests) {
    System.print(makePrintable.call(test))
    System.write(" --> ")
    var t = bwt.call(test)
    if (t == null) {
        System.print("ERROR: String can't contain STX or ETX")
        t = ""
    } else {
        System.print(makePrintable.call(t))
    }
    var r = ibwt.call(t)
    System.print(" --> %(r)\n")
}


class BurrowsWheelerTransform{
   fcn init(chr="$"){ var special=chr; }
   fcn encode(str){
      _assert_(not str.holds(special), "String cannot contain char \"%s\"".fmt(special) );
      str=str.append(special);
      str.len().pump(List().merge,'wrap(n){ String(str[n,*],str[0,n]) })
      .pump(String,T("get",-1));	// last char of each "permutation"
   }
   fcn decode(str){
      table:=List.createLong(str.len(),"");	// ("",""..), mutable
      do(str.len()){
	 foreach n in (str.len()){ table[n]=str[n] + table[n] }
	 table.sort();
      }   // --> ("$dogwood","d$dogwoo","dogwood$",...)
      table.filter1("%s*".fmt(special).glob)[1,*];  // str[0]==$, often first element
   }
}


F no_args() {}
// call
no_args()

F fixed_args(x, y)
   print(‘x=#., y=#.’.format(x, y))
// call
fixed_args(1, 2) // x=1, y=2

// named arguments
fixed_args(x' 1, y' 2)

F opt_args(x = 1)
   print(x)
// calls
opt_args()      // 1
opt_args(3.141) // 3.141


X        DS     F
Y        DS     F
Z        DS     F


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

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

/***********************/
/* Initialized data */
/***********************/
.data
szMessage:      .asciz "Hello. \n"       // message
szRetourLigne:  .asciz "\n"
szMessResult:   .asciz "Resultat : "      // message result

/***********************/
/* No Initialized data */
/***********************/
.bss
sZoneConv:  .skip  100

.text
.global main
main:
    ldr x0,=szMessage           // adresse of message  short program
    bl affichageMess            // call function with 1 parameter (x0)

                                // call function with parameters in register
    mov x0,#5
    mov x1,#10
    bl fonction1                // call function with 2 parameters (x0,x1)
    ldr x1,qAdrsZoneConv        // result in x0
    bl conversion10S            // call function with 2 parameter (x0,x1)
    ldr x0,=szMessResult
    bl affichageMess            // call function with 1 parameter (x0)
    ldr x0,qAdrsZoneConv
    bl affichageMess
    ldr x0,qAdrszRetourLigne
    bl affichageMess
                                // call function with parameters on stack
    mov x0,#5
    mov x1,#10
    stp x0,x1,[sp,-16]!         // store  registers on stack
    bl fonction2                // call function with 2 parameters on the stack
                                // result in x0
    ldr x1,qAdrsZoneConv
    bl conversion10S            // call function with 2 parameter (x0,x1)
    ldr x0,=szMessResult
    bl affichageMess            // call function with 1 parameter (x0)
    ldr x0,qAdrsZoneConv
    bl affichageMess
    ldr x0,qAdrszRetourLigne
    bl affichageMess
                                // end of  program
    mov x0, #0                  // return code
    mov x8, #EXIT               // request to exit program
    svc 0                       // perform the system call
qAdrsZoneConv:              .quad sZoneConv
qAdrszRetourLigne:          .quad szRetourLigne
/******************************************************************/
/*     call function parameter in register             */
/******************************************************************/
/* x0 value one */
/* x1 value two */
/* return in x0 */
fonction1:
    stp x2,lr,[sp,-16]!        // save  registers
    mov x2,#20
    mul x0,x0,x2
    add x0,x0,x1
    ldp x2,lr,[sp],16          // restaur  2 registres
    ret                        // retour adresse lr x30

/******************************************************************/
/*     call function parameter in the stack             */
/******************************************************************/
/* return in x0 */
fonction2:
    stp fp,lr,[sp,-16]!        // save  registers
    add fp,sp,#16              // address parameters in the stack
    stp x1,x2,[sp,-16]!        // save  others registers
    ldr x0,[fp]                // second paraméter
    ldr x1,[fp,#8]             // first parameter
    mov x2,#-20
    mul x0,x0,x2
    add x0,x0,x1
    ldp x1,x2,[sp],16          // restaur  2 registres
    ldp fp,lr,[sp],16          // restaur  2 registres
    add sp,sp,#16              // very important, for stack aligned
    ret                        // retour adresse lr x30

/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


  myfunction();       /* function with no arguments in statement context */
  myfunction(6,b);    // function with two arguments in statement context
  stringit("apples");    //function with a string argument


# Note functions and subroutines are called procedures (or PROCs) in Algol 68 #
# A function called without arguments: #
f;
# Algol 68 does not expect an empty parameter list for calls with no arguments, "f()" is a syntax error #
# A function with a fixed number of arguments: #
f(1, x);

# variable number of arguments: #
# functions that accept an array as a parameter can effectively provide variable numbers of arguments #
# a "literal array" (called a row-display in Algol 68) can be passed, as is often the case for the I/O #
# functions - e.g.: #
print( ( "the result is: ", r, " after ", n, " iterations", newline ) );
# the outer brackets indicate the parameters of print, the inner brackets indicates the contents are a "literal array" #

# ALGOL 68 does not support optional arguments, though in some cases an empty array could be passed to a function #
# expecting an array, e.g.: #
f( () );

# named arguments - see the Algol 68 sample in: http://rosettacode.org/wiki/Named_parameters #

# In "Talk:Call a function" a statement context is explained as
"The function is used as an instruction (with a void context),
rather than used within an expression."
Based on that, the examples above are already in a statement context.
Technically, when a function that returns other than VOID (i.e. is not a subroutine)
is called in a statement context, the result of the call is "voided" i.e. discarded.
If desired, this can be made explicit using a cast, e.g.: #
VOID(f);

# A function's return value being used: #
x := f(y);

# There is no distinction between built-in functions and user-defined functions. #

# A subroutine is simply a function that returns VOID. #

# If the function is declared with argument(s) of mode REF MODE,
then those arguments are being passed by reference. #
# Technically, all parameters are passed by value, however the value of a REF MODE is a reference... #


% Note, in Algol W, functions are called procedures %
% calling a function with no parameters: %
f;

% calling a function with a fixed number of parameters %
g( 1, 2.3, "4" );

% Algol W does not support optional parameters in general, however constructors for records can %
% be called wither with parameters (one for each field in the record) or no parameters #

% Algol W does not support variable numbers of parameters, except for the built-in I/O functions #
% Algol W does not support named arguments %

% A function can be used in a statement context by calling it, as in the examples above %

% First class context: A function can be passed as a parameter to another procedure, e.g.: %
v := integrate( sin, 0, 1 )
% assuming a suitable definition of integrate %
% Algol W does not support functions returning functions %

% obtaining the return value of a function: e.g.: %
v := g( x, y, z );

% There is no syntactic distinction between user-defined and built-in functions %

% Subroutines and functions are both procedures, a subroutine is a procedure with no return type %
% (called a proper procedure in Algol W) %
% There is no syntactic distinction between a call to a function and a call to a subroutine %
% other than the context %

% In Algol W, parameters are passed by value, result or value result. This must be stated in the %
% definition of the function/subroutine. Value parameters are passed by value, result and value result %
% are effectively passed by reference and assigned on function exit. Result parameters are "out" parameters %
% and value result parameters are "in out". %
% Algol W also has "name" parameters (not to be confused with named parameters). Functions with name %
% parameters are somewhat like macros %

% Partial application is not possible in Algol W %


/* ARM assembly Raspberry PI  */
/*  program callfonct.s   */

/* Constantes    */
.equ STDOUT, 1
.equ WRITE,  4
.equ EXIT,   1

/***********************/
/* Initialized data */
/***********************/
.data
szMessage:      .asciz "Hello. \n"       @ message
szRetourLigne: .asciz "\n"
szMessResult:  .ascii "Resultat : "      @ message result
sMessValeur:   .fill 12, 1, ' '
                   .asciz "\n"
/***********************/
/* No Initialized data */
/***********************/
.bss
iValeur:  .skip  4     @ reserve 4 bytes in memory

.text
.global main
main:
    ldr r0,=szMessage          @ adresse of message  short program
    bl affichageMess            @ call function with 1 parameter (r0)

    @ call function with parameters in register
    mov r0,#5
    mov r1,#10
    bl fonction1            @ call function with 2 parameters (r0,r1)
    ldr r1,=sMessValeur                           @ result in r0
    bl conversion10S       @ call function with 2 parameter (r0,r1)
    ldr r0,=szMessResult
    bl affichageMess            @ call function with 1 parameter (r0)

    @ call function with parameters on stack
    mov r0,#5
    mov r1,#10
    push {r0,r1}
    bl fonction2            @ call function with 2 parameters on the stack
                              @ result in r0
    ldr r1,=sMessValeur
    bl conversion10S       @ call function with 2 parameter (r0,r1)
    ldr r0,=szMessResult
    bl affichageMess            @ call function with 1 parameter (r0)

 /* end of  program */
    mov r0, #0                  @ return code
    mov r7, #EXIT              @ request to exit program
    swi 0                       @ perform the system call

/******************************************************************/
/*     call function parameter in register             */
/******************************************************************/
/* r0 value one */
/* r1 value two */
/* return in r0 */
fonction1:
    push {fp,lr}    /* save des  2 registres */
    push {r1,r2}    /* save des autres registres */
    mov r2,#20
    mul r0,r2
    add r0,r0,r1
    pop {r1,r2}     /* restaur des autres registres */
    pop {fp,lr}    /* restaur des  2 registres */
    bx lr           /* retour procedure */

/******************************************************************/
/*     call function parameter in the stack             */
/******************************************************************/
/* return in r0 */
fonction2:
    push {fp,lr}    /* save des  2 registres */
    add fp,sp,#8    /* address parameters in the stack*/
    push {r1,r2}    /* save des autres registres */
    ldr r0,[fp]
    ldr r1,[fp,#4]
    mov r2,#-20
    mul r0,r2
    add r0,r0,r1
    pop {r1,r2}     /* restaur des autres registres */
    pop {fp,lr}    /* restaur des  2 registres */
    add sp,#8      /* very important, for stack aligned */
    bx lr          /* retour procedure */

/******************************************************************/
/*     affichage des messages   avec calcul longueur              */
/******************************************************************/
/* r0 contient l adresse du message */
affichageMess:
    push {fp,lr}    /* save des  2 registres */
    push {r0,r1,r2,r7}    /* save des autres registres */
    mov r2,#0   /* compteur longueur */
1:       /*calcul de la longueur */
    ldrb r1,[r0,r2]  /* recup octet position debut + indice */
    cmp r1,#0       /* si 0 c est fini */
    beq 1f
    add r2,r2,#1   /* sinon on ajoute 1 */
    b 1b
1:  /* donc ici r2 contient la longueur du message */
    mov r1,r0        /* adresse du message en r1 */
    mov r0,#STDOUT      /* code pour écrire sur la sortie standard Linux */
    mov r7, #WRITE                  /* code de l appel systeme 'write' */
    swi #0                      /* appel systeme */
    pop {r0,r1,r2,r7}     /* restaur des autres registres */
    pop {fp,lr}    /* restaur des  2 registres */
    bx lr	        /* retour procedure */
/***************************************************/
/*   conversion registre en décimal   signé  */
/***************************************************/
/* r0 contient le registre   */
/* r1 contient l adresse de la zone de conversion */
conversion10S:
    push {fp,lr}    /* save des  2 registres frame et retour */
    push {r0-r5}   /* save autres registres  */
    mov r2,r1       /* debut zone stockage */
    mov r5,#'+'     /* par defaut le signe est + */
    cmp r0,#0       /* nombre négatif ? */
    movlt r5,#'-'     /* oui le signe est - */
    mvnlt r0,r0       /* et inversion en valeur positive */
    addlt r0,#1

    mov r4,#10   /* longueur de la zone */
1: /* debut de boucle de conversion */
    bl divisionpar10 /* division  */
    add r1,#48        /* ajout de 48 au reste pour conversion ascii */
    strb r1,[r2,r4]  /* stockage du byte en début de zone r5 + la position r4 */
    sub r4,r4,#1      /* position précedente */
    cmp r0,#0
    bne 1b	       /* boucle si quotient different de zéro */
    strb r5,[r2,r4]  /* stockage du signe à la position courante */
    subs r4,r4,#1   /* position précedente */
    blt  100f         /* si r4 < 0  fin  */
    /* sinon il faut completer le debut de la zone avec des blancs */
    mov r3,#' '   /* caractere espace */
2:
    strb r3,[r2,r4]  /* stockage du byte  */
    subs r4,r4,#1   /* position précedente */
    bge 2b        /* boucle si r4 plus grand ou egal a zero */
100:  /* fin standard de la fonction  */
    pop {r0-r5}   /*restaur des autres registres */
    pop {fp,lr}   /* restaur des  2 registres frame et retour  */
    bx lr

/***************************************************/
/*   division par 10   signé                       */
/* Thanks to http://thinkingeek.com/arm-assembler-raspberry-pi/*
/* and   http://www.hackersdelight.org/            */
/***************************************************/
/* r0 contient le dividende   */
/* r0 retourne le quotient */
/* r1 retourne le reste  */
divisionpar10:
  /* r0 contains the argument to be divided by 10 */
   push {r2-r4}   /* save autres registres  */
   mov r4,r0
   ldr r3, .Ls_magic_number_10 /* r1 <- magic_number */
   smull r1, r2, r3, r0   /* r1 <- Lower32Bits(r1*r0). r2 <- Upper32Bits(r1*r0) */
   mov r2, r2, ASR #2     /* r2 <- r2 >> 2 */
   mov r1, r0, LSR #31    /* r1 <- r0 >> 31 */
   add r0, r2, r1         /* r0 <- r2 + r1 */
   add r2,r0,r0, lsl #2   /* r2 <- r0 * 5 */
   sub r1,r4,r2, lsl #1   /* r1 <- r4 - (r2 * 2)  = r4 - (r0 * 10) */
   pop {r2-r4}
   bx lr                  /* leave function */
   .align 4
.Ls_magic_number_10: .word 0x66666667


printHello: $[][
	print "Hello World!"
]

sayHello: $[name][
	print ["Hello" name "!"]
]

printAll: $[args][
	loop args [arg][
		print arg
	]
]

getNumber: $[][3]

; Calling a function that requires no arguments
printHello

; Calling a function with a fixed number of arguments
sayHello "John"

; Calling a function with a variable number of arguments
printAll ["one" "two" "three"]

; Using a function in statement context
if true [printHello]
print getNumber

; Using a function in first-class context within an expression
if getNumber=3 [print "yep, it worked"]

; Obtaining the return value of a function:
num: getNumber

print num


; Call a function without arguments:
f()

; Call a function with a fixed number of arguments:
f("string", var, 15.5)

; Call a function with optional arguments:
f("string", var, 15.5)

; Call a function with a variable number of arguments:
f("string", var, 15.5)

; Call a function with named arguments:
    ; AutoHotkey does not have named arguments. However, in v1.1+,
    ; we can pass an object to the function:
f({named: "string", otherName: var, thirdName: 15.5})

; Use a function in statement context:
f(1), f(2) ; What is statement context?

; No first-class functions in AHK

; Obtaining the return value of a function:
varThatGetsReturnValue := f(1, "a")

; Cannot distinguish built-in functions

; Subroutines are called with GoSub; functions are called as above.
; Subroutines cannot be passed variables

; Stating whether arguments are passed by value or by reference:
; [v1.1.01+]: The IsByRef() function can be used to determine
;     whether the caller supplied a variable for a given ByRef parameter.
; A variable cannot be passed by value to a byRef parameter. Instead, do this:
f(tmp := varIdoNotWantChanged)
; the function f will receive the value of varIdoNotWantChanged, but any
; modifications will be made to the variable tmp.

; Partial application is impossible.


BEGIN {
  sayhello()       # Call a function with no parameters in statement context
  b=squareit(3)    # Obtain the return value from a function with a single parameter in first class context
}


function Copialo$ (txt$, siNo, final$)
	nuevaCadena$ = ""

	for cont = 1 to siNo
		nuevaCadena$ += txt$
	next cont

	return trim(nuevaCadena$) + final$
end function

subroutine Saludo()
	print "Hola mundo!"
end subroutine

subroutine testCadenas (txt$)
	for cont = 1 to length(txt$)
		print mid(txt$, cont, 1); "";
	next cont
end subroutine

subroutine testNumeros (a, b, c)
	print a, b, c
end subroutine

call Saludo()
print Copialo$("Saludos ", 6, "")
print Copialo$("Saludos ", 3, "!!")
print
call testNumeros(1, 2, 3)
call testNumeros(1, 2, 0)
print
call testCadenas("1, 2, 3, 4, cadena, 6, 7, 8, \#incluye texto\#")
end


:: http://rosettacode.org/wiki/Call_a_function
:: Demonstrate the different syntax and semantics provided for calling a function.

@echo off

echo Calling myFunction1
call:myFunction1
echo.

echo Calling myFunction2 11 8
call:myFunction2 11 8
echo.

echo Calling myFunction3 /fi and saving the output into %%filecount%%
call:myFunction3 /fi
echo.%filecount%
echo.

echo Calling myFunction4 1 2 3 4 5
call:myFunction4 1 2 3 4 5
echo.

echo Calling myFunction5 "filename=test.file" "filepath=C:\Test Directory\"
call:myFunction5 "filename=test.file" "filepath=C:\Test Directory\"
echo.
echo Calling myFunction5 "filepath=C:\Test Directory\" "filename=test.file"
call:myFunction5 "filepath=C:\Test Directory\" "filename=test.file"
echo.

pause>nul
exit

:: Requires no arguments
:myFunction1
	echo myFunction1 has been called.
	goto:eof

:: Fixed number of arguments (%a% & %b%)
:myFunction2
	:: Returns %a% + %b%
	setlocal
	set /a c=%~1+%~2
	endlocal & echo %c%
	goto:eof

:: Optional arguments
:myFunction3
	:: Returns the amount of folders + files in the current directory
	:: /fi Returns only file count
	:: /fo Returns only folder count

	setlocal
	set count=0

	if "%~1"=="" set "command=dir /b"
	if "%~1"=="/fi" set "command=dir /b /A-d"
	if "%~1"=="/fo" set "command=dir /b /Ad"

	for /f "usebackq" %%i in (`%command%`) do set /a count+=1

	endlocal & set filecount=%count%
	goto:eof

:: Variable number of arguments
:myFunction4
	:: Returns sum of arguments
	setlocal
	:myFunction4loop
	set sum=0
	for %%i in (%*) do set /a sum+=%%i
	endlocal & echo %sum%
	goto:eof

:: Named Arguments (filepath=[path] & filename=[name])
:myFunction5
	:: Returns the complete path based off the 2 arguments
	if "%~1"=="" then goto:eof
	setlocal enabledelayedexpansion
	set "param=%~1"

	for /l %%i in (1,1,2) do (
		for /f "tokens=1,2 delims==" %%j in ("!param!") do set %%j=%%k
		set "param=%~2"
	)
	endlocal & echo.%filepath%%filename%
	goto:eof


/* function with no argument */
f();

/* fix number of arguments */
g(1, 2, 3);

/* Optional arguments: err...
   Feel free to make sense of the following.  I can't. */
int op_arg();
int main()
{
	op_arg(1);
	op_arg(1, 2);
	op_arg(1, 2, 3);
	return 0;
}
int op_arg(int a, int b)
{
	printf("%d %d %d\n", a, b, (&b)[1]);
	return a;
}  /* end of sensible code */

/* Variadic function: how the args list is handled solely depends on the function */
void h(int a, ...)
{
	va_list ap;
	va_start(ap);
	...
}
/* call it as: (if you feed it something it doesn't expect, don't count on it working) */
h(1, 2, 3, 4, "abcd", (void*)0);

/* named arguments: this is only possible through some pre-processor abuse
*/
struct v_args {
    int arg1;
    int arg2;
    char _sentinel;
};

void _v(struct v_args args)
{
    printf("%d, %d\n", args.arg1, args.arg2);
}

#define v(...) _v((struct v_args){__VA_ARGS__})

v(.arg2 = 5, .arg1 = 17); // prints "17,5"
/* NOTE the above implementation gives us optional typesafe optional arguments as well (unspecified arguments are initialized to zero)*/
v(.arg2=1); // prints "0,1"
v();  // prints "0,0"

/* as a first-class object (i.e. function pointer) */
printf("%p", f); /* that's the f() above */

/* return value */
double a = asin(1);

/* built-in functions: no such thing. Compiler may interally give special treatment
   to bread-and-butter functions such as memcpy(), but that's not a C built-in per se */

/* subroutines: no such thing. You can goto places, but I doubt that counts. */

/* Scalar values are passed by value by default. However, arrays are passed by reference. */
/* Pointers *sort of* work like references, though. */


/* a function that has no argument */
	public int MyFunction();

	/* a function with a fixed number of arguments */
	FunctionWithArguments(4, 3, 2);

	/* a function with optional arguments */
	public void OptArg();

	public static void Main()
	{
		OptArg(1);
		OptArg(1, 2);
		OptArg(1, 2, 3);
	}
	public void ExampleMethod(int required,
        string optionalstr = "default string",
		int optionalint = 10)
	/* If you know the first and the last parameter */
	ExampleMethod(3, optionalint: 4);

	/* If you know all the parameter */
	ExampleMethod(3, "Hello World", 4);

	/* Variable number of arguments use array */
	public static void UseVariableParameters(params int[] list)

	/* Obtain return value from function */
	public internal MyFunction();
	int returnValue = MyFunction();


CALL "No-Arguments"

*> Fixed number of arguments.
CALL "2-Arguments" USING Foo Bar

CALL "Optional-Arguments" USING Foo
CALL "Optional-Arguments" USING Foo Bar
*> If an optional argument is omitted and replaced with OMITTED, any following
*> arguments can still be specified.
CALL "Optional-Arguments" USING Foo OMITTED Bar
*> Interestingly, even arguments not marked as optional can be omitted without
*> a compiler warning. It is highly unlikely the function will still work,
*> however.
CALL "2-Arguments" USING Foo

*> COBOL does not support a variable number of arguments, or named arguments.

*> Values to return can be put in either one of the arguments or, in OpenCOBOL,
*> the RETURN-CODE register.
*> A standard function call cannot be done in another statement.
CALL "Some-Func" USING Foo
MOVE Return-Code TO Bar

*> Intrinsic functions can be used in any place a literal value may go (i.e. in
*> statements) and are optionally preceded by FUNCTION.
*> Intrinsic functions that do not take arguments may optionally have a pair of
*> empty parentheses.
*> Intrinsic functions cannot be defined by the user.
MOVE FUNCTION PI TO Bar
MOVE FUNCTION MEDIAN(4, 5, 6) TO Bar

*> Built-in functions/subroutines typically have prefixes indicating which
*> compiler originally incorporated it:
*>  - C$      - ACUCOBOL-GT
*>  - CBL_    - Micro Focus
*>  - CBL_OC_ - OpenCOBOL
*> Note: The user could name their functions similarly if they wanted to.
CALL "C$MAKEDIR" USING Foo
CALL "CBL_CREATE_DIR" USING Foo
CALL "CBL_OC_NANOSLEEP" USING Bar
*> Although some built-in functions identified by numbers.
CALL X"F4" USING Foo Bar

*> Parameters can be passed in 3 different ways:
*>  - BY REFERENCE - this is the default way in OpenCOBOL and this clause may
*>       be omitted. The address of the argument is passed to the function.
*>       The function is allowed to modify the variable.
*>  - BY CONTENT - a copy is made and the function is passed the address
*>      of the copy, which it can then modify. This is recomended when
*>      passing a literal to a function.
*>  - BY VALUE - the function is passed the address of the argument (like a
*>      pointer). This is mostly used to provide compatibility with other
*>      languages, such as C.
CALL "Modify-Arg" USING BY REFERENCE Foo *> Foo is modified.
CALL "Modify-Arg" USING BY CONTENT Foo   *> Foo is unchanged.
CALL "C-Func" USING BY VALUE Bar

*> Partial application is impossible as COBOL does not support first-class
*> functions.
*> However, as functions are called using a string of their PROGRAM-ID,
*> you could pass a 'function' as an argument to another function, or store
*> it in a variable, or get it at runtime.
ACCEPT Foo *> Get a PROGRAM-ID from the user.
CALL "Use-Func" USING Foo
CALL Foo USING Bar


(defn one []
  "Function that takes no arguments and returns 1"
  1)

(one); => 1


# Calling a function that requires no arguments
foo()

# Calling a function with a fixed number of arguments
foo 1

# Calling a function with optional arguments
# (Optional arguments are done using an object with named keys)
foo 1, optionalBar: 1, optionalBaz: 'bax'

# Calling a function with a variable number of arguments
# for a function `foo` defined as `foo = ( args... ) ->`
foo 1, 2, 3, 4

# Calling a function with named arguments
# (Named arguments are done using an object with named keys)
foo bar: 1, bax: 'baz'

# Using a function in statement context
x = foo 1

# Using a function in first-class context within an expression
# (For `foo` defined as `foo = ( x ) -> x + 1`
x = [ 1, 2, 3 ].map foo

# Obtaining the return value of a function
x = foo 1

# Arguments are passed by value, even objects. Objects
# are passed as the _value_ of the reference to an object.
# Example:
bar = ( person ) ->
    # Since `person` is a reference
    # to the person passed in, we can assign
    # a new value to its `name` key.
    person.name = 'Bob'

    # Since `person` is just the value of
    # the original reference, assigning to it
    # does not modify the original reference.
    person = new Person 'Frank'

# Partial application is only possible manually through closures
curry = ( f, fixedArgs... ) ->
    ( args... ) -> f fixedArgs..., args...

# Example usage
add = ( x, y ) -> x + y

add2 = curry add, 2

add2 1 #=> 3


;Calling a function that requires no arguments
(defun a () "This is the 'A' function")
(a)
;Calling a function with a fixed number of arguments
(defun b (x y) (list x y))
(b 1 2)
;Calling a function with optional arguments
(defun c (&optional x y) (list x y))
(c 1)
;Calling a function with a variable number of arguments
(defun d (&rest args) args)
(d 1 2 3 4 5 6 7 8)
;Calling a function with named arguments
(defun e (&key (x 1) (y 2)) (list x y))
(e :x 10 :y 20)
;Using a function in first-class context within an expression
(defun f (func) (funcall func))
(f #'a)
;Obtaining the return value of a function
(defvar return-of-a (a))
;Is partial application possible and how
(defun curry (function &rest args-1)
  (lambda (&rest args-2)
    (apply function (append args-1 args-2))))
(funcall (curry #'+ 1) 2)


// No arguments
myfunction

// All functions can take a variable number of arguments.
// These can be accessed from within the function with the aliases:
// $arg1, $arg2, $arg3... $numargs tells the amount of args passed.
myfunction word "text string" 1 3.14

// Getting a function's return value
retval = (myfunction)

// Trying to do a variable lookup on a builtin function will return an empty
// string. This can be used to distinguish builtin functions from user-defined
// ones.
if (strcmp $echo "") [echo builtin function]          // true
if (strcmp $myfunction "") [echo builtin function]    // false