with Ada.Text_IO, Ada.Containers.Indefinite_Doubly_Linked_Lists; use Ada.Text_IO;

procedure Swallow_Fly is

   package Strings is new Ada.Containers.Indefinite_Doubly_Linked_Lists(String);

   Lines, Animals: Strings.List;

   procedure Swallow(Animal: String;
                     Second_Line: String;
                     Permanent_Second_Line: Boolean := True) is

      procedure Print(C: Strings.Cursor) is
      begin
         Put_Line(Strings.Element(C));
      end Print;

   begin
      Put_Line("There was an old lady who swallowed a " & Animal & ",");
      Put_Line(Second_Line);
      if not Animals.Is_Empty then
         Lines.Prepend("She swallowed the " & Animal & " to catch the " &
			 Animals.Last_Element & ",");
      end if;
      Lines.Iterate(Print'Access);
      New_Line;
      if Permanent_Second_Line then
         Lines.Prepend(Second_Line);
      end if;
      Animals.Append(Animal); -- you need "to catch the " most recent animal
   end Swallow;

   procedure Swallow_TSA(Animal: String; Part_Of_Line_2: String) is
   begin
      Swallow(Animal, Part_Of_Line_2 &", to swallow a " & Animal & ";", False);
   end Swallow_TSA;

   procedure Swallow_SSA(Animal: String; Part_Of_Line_2: String) is
   begin
      Swallow(Animal, Part_Of_Line_2 &" she swallowed a " & Animal & ";", False);
   end Swallow_SSA;

begin
   Lines.Append("Perhaps she'll die!");

   Swallow("fly", "But I don't know why she swallowed the fly,");
   Swallow("spider",  "That wriggled and jiggled and tickled inside her;");
   Swallow_TSA("bird", "Quite absurd");
   Swallow_TSA("cat", "Fancy that");
   Swallow_TSA("dog", "What a hog");
   Swallow_TSA("pig", "Her mouth was so big");
   Swallow_TSA("goat","She just opened her throat");
   Swallow_SSA("cow", "I don't know how");
   Swallow_TSA("donkey", "It was rather wonky");

   Put_Line("There was an old lady who swallowed a horse ...");
   Put_Line("She's dead, of course!");
end Swallow_Fly;


#!/usr/local/bin/a68g --script #

STRING sw=" swallow ",swd=sw[:UPB sw-1]+"ed ", tsa=". To"+sw+"a";

INT count prev := 0; [9]STRING prev;

PROC vs = (STRING in wot,[]STRING co)VOID: (
  STRING wot = " "+in wot;
  printf(($g$,"I know an old lady who",swd,"a",wot,".",$l$));
  IF UPB co = 1 THEN
    printf(($gl$,co))
  ELIF UPB co > 1 THEN
    printf(($g$,co,wot+".",$l$))
  FI;
  IF count prev NE UPB prev THEN
    prev[count prev+:=1]:=wot;
    FOR i FROM count prev BY -1 TO 2 DO
      printf(($gl$,"She"+swd+"the"+prev[i]+" to catch the"+prev[i-1]+"."))
    OD;
    printf(($gl$,"I don't know why she"+swd+"the fly.",
                 "Perhaps she'll die.", $l$))
  FI
);

vs("fly",());
vs("spider","That wriggled and jiggled and tickled inside her.");
vs("Bird",("Quite absurd",tsa));
vs("Cat",("Fancy that",tsa));
vs("Dog",("What a hog",tsa));
vs("Pig",("Her mouth was so big",tsa));
vs("Goat",("She just opened her throat",tsa));
vs("Cow",("I don't know how",tsa));
vs("Donkey",("It was rather wonky",tsa));
vs("Horse","She's dead, of course!")


GLq(f,a,b,n)={
  my(P=pollegendre(n),Pp=P',x=polroots(P));
  (b-a)*sum(i=1,n,f((b-a)*x[i]/2+(a+b)/2)/(1-x[i]^2)/subst(Pp,'x,x[i])^2)
};
# \\ Turn on timer
GLq(x->exp(x), -3, 3, 5) \\ As of version 2.4.4, this can be written GLq(exp, -3, 3, 5)


program Legendre(output);

const Order   = 5;
      Order1 = Order - 1;
      Epsilon = 1E-12;
      Pi = 3.1415926;

var Roots   : array[0..Order1] of real;
    Weight  : array[0..Order1] of real;
    LegCoef : array [0..Order,0..Order] of real;
    I : integer;

function F(X:real) : real;
begin
  F := Exp(X);
end;

procedure PrepCoef;
var I, N : integer;
begin
  for I:=0 to Order do
    for N := 0 to Order do
      LegCoef[I,N] := 0;
  LegCoef[0,0] := 1;
  LegCoef[1,1] := 1;
  For N:=2 to Order do
    begin
      LegCoef[N,0] := -(N-1) * LegCoef[N-2,0] / N;
      For I := 1 to Order do
        LegCoef[N,I] := ((2*N-1) * LegCoef[N-1,I-1] - (N-1)*LegCoef[N-2,I]) / N;
    end;
end;

function LegEval(N:integer; X:real) : real;
var I : integer;
    Result : real;
begin
  Result := LegCoef[n][n];
  for I := N-1 downto 0 do
    Result := Result * X + LegCoef[N][I];
  LegEval := Result;
end;

function LegDiff(N:integer; X:real) : real;
begin
  LegDiff := N * (X * LegEval(N,X) - LegEval(N-1,X)) / (X*X-1);
end;

procedure LegRoots;
var I     : integer;
    X, X1 : real;
begin
  for I := 1 to Order do
    begin
      X := Cos(Pi * (I-0.25) / (Order+0.5));
        repeat
          X1 := X;
          X := X - LegEval(Order,X) / LegDiff(Order, X);
        until Abs (X-X1) < Epsilon;
      Roots[I-1] := X;
      X1 := LegDiff(Order,X);
      Weight[I-1] := 2 / ((1-X*X) * X1*X1);
    end;
end;

function LegInt(A,B:real) : real;
var I      : integer;
    C1, C2, Result : real;
begin
  C1 := (B-A)/2;
  C2 := (B+A)/2;
  Result := 0;
  For I := 0 to Order-1 do
    Result := Result + Weight[I] * F(C1*Roots[I] + C2);
  Result := C1 * Result;
  LegInt := Result;
end;

begin
  PrepCoef;
  LegRoots;

  Write('Roots:  ');
  for I := 0 to Order-1 do
    Write (' ',Roots[I]:13:10);
  Writeln;

  Write('Weight: ');
  for I := 0 to Order-1 do
    Write (' ', Weight[I]:13:10);
  writeln;

  Writeln('Integrating Exp(x) over [-3, 3]: ',LegInt(-3,3):13:10);
  Writeln('Actual value: ',Exp(3)-Exp(-3):13:10);
end.


oldLady←{
    N←⎕TC[3]
    a←'fly' 'spider' 'bird' 'cat' 'dog' 'goat' 'cow' 'horse'
    v←⊂'I don''t know why she swallowed that fly - Perhaps she''ll die',N
    v←v,⊂'That wiggled and jiggled and tickled inside her!'
    v←v,⊂'How absurd to swallow a bird'
    v←v,⊂'Imagine that! She swallowed a cat!'
    v←v,⊂'What a hog to swallow a dog'
    v←v,⊂'She just opened her throat and swallowed that goat'
    v←v,⊂'I don''t know how she swallowed that cow'
    v←v,⊂'She''s dead, of course.'
    l←'There was an old lady who swallowed a '
    ∊{
        ∊l,a[⍵],N,v[⍵],N,(⍵<8)/{
            ⍵=0:''
            r←'She swallowed the ',a[⍵],' to catch the ',a[⍵-1],N
            r,(⍵≤3)/v[⍵-1],N
        }¨⌽1↓⍳⍵
    }¨⍳8
}


.global _start
_start:	eor	r8,r8,r8	@ Verse counter
verse:	add	r8,r8,#1	@ Next verse
	ldr	r1,=lady	@ There was an old lady who swallowed...
	bl	pstr
	mov	r2,r8
	bl	pbeast		@ <an animal>
	ldr	r1,=comma
	bl	pstr
	mov	r2,r8
	bl	pverse		@ Print the corresponding verse
	cmp	r8,#1		@ First verse?
	beq	verse		@ Then we're not swallowing anything yet
	cmp	r8,#8		@ Otherwise, is the lady dead yet?
	moveq	r7,#1		@ If so, stop.
	swieq	#0
	mov	r9,r8		@ Otherwise, start swallowing
swallo:	ldr	r1,=swa1	@ She swallowed the ...
	bl	pstr
	mov	r2,r9		@ <current animal>
	bl	pbeast
	ldr	r1,=swa2	@ ...to catch the...
	bl	pstr
	sub	r9,r9,#1
	mov	r2,r9		@ <previous animal>
	bl	pbeast
	ldr	r1,=comma
	bl	pstr
	cmp	r9,#2		@ Print the associated verse for 2 and 1
	movle	r2,r9
	blle 	pverse
	cmp	r9,#1		@ Last animal?
	bgt	swallo		@ If not, keep swallowing
	b	verse		@ But if so, next verse
pverse:	ldr	r1,=verses	@ Print verse R2
	b	pstrn
pbeast:	ldr	r1,=beasts	@ Print animal R2
pstrn:	ldrb	r0,[r1],#1	@ R2'th string from R1 - get byte
	tst	r0,r0		@ Zero yet?
	bne	pstrn 		@ If not keep going
	subs	r2,r2,#1	@ Is this the right string?
	bne	pstrn		@ If not keep going
@ Print 0-terminated string starting at R1 using Linux.
pstr:	mov	r2,r1		@ Find end
1:	ldrb	r0,[r2],#1	@ Get current byte
	tst	r0,r0		@ Zero yet?
	bne	1b		@ If not keep scanning
	sub	r2,r2,r1	@ Calculate string length
	mov	r0,#1		@ 1 = Linux stdout
	mov	r7,#4		@ 4 = Linux write syscall
	push	{lr}		@ Keep link register
	swi 	#0		@ Do syscall
	pop	{lr}		@ Restore link register
	bx	lr
lady:	.ascii	"There was an old lady who swallowed a "
beasts:	.ascii	"\0fly\0spider\0bird\0cat\0dog\0goat\0cow\0horse"
verses:	.ascii	"\0I don't know why she swallowed that fly - "
	.ascii	"Perhaps she'll die.\n\n"
	.ascii	"\0That wiggled and jiggled and tickled inside her!\n"
	.ascii	"\0How absurd to swallow a bird\n"
	.ascii	"\0Imagine that! She swallowed a cat!\n"
	.ascii	"\0What a hog to swallow a dog\n"
	.ascii	"\0She just opened her throat and swallowed that goat\n"
	.ascii	"\0I don't know how she swallowed that cow\n"
	.asciz	"\0She's dead, of course.\n"
swa1:	.asciz	"She swallowed the "
swa2:	.asciz	" to catch the "
comma:	.asciz	",\n"


Animals := [["fly",	"I don't know why she swallowed the "]
	  , ["spider",	"That wriggled and jiggled and tickled inside her"]
	  , ["bird",	"Quite absurd"]
	  , ["cat",	"Fancy that"]
	  , ["dog",	"What a hog"]
	  , ["pig",	"Her mouth was so big"]
	  , ["goat",	"She just opened her throat"]
	  , ["cow",	"I don't know how"]
	  , ["donkey",	"It was rather wonky"]
	  , ["horse",	"She's dead, of course!"]]

for i, V in Animals {
	Output .= "I know an old lady who swallowed a " V.1 ".`n"
	. (i = 1 ? Saved := V.2 V.1 ".`nPerhaps she'll die.`n`n"
	: V.2 (i = Animals.MaxIndex() ? "" : (i = 2 ? "" : ". To swallow a " V.1) ".`n"
	. (Saved := "She swallowed the " V.1 " to catch the " Animals[i - 1].1 ".`n" Saved)))
}

MsgBox, % Output


use List::Util qw(sum);
use constant pi => 3.14159265;

sub legendre_pair {
    my($n, $x) = @_;
    if ($n == 1) { return $x, 1 }
    my ($m1, $m2) = legendre_pair($n - 1, $x);
    my $u = 1 - 1 / $n;
    (1 + $u) * $x * $m1 - $u * $m2, $m1;
}

sub legendre {
    my($n, $x) = @_;
    (legendre_pair($n, $x))[0]
}

sub legendre_prime {
    my($n, $x) = @_;
    if ($n == 0) { return 0 }
    if ($n == 1) { return 1 }
    my ($m0, $m1) = legendre_pair($n, $x);
    ($m1 - $x * $m0) * $n / (1 - $x**2);
}

sub approximate_legendre_root {
    my($n, $k) = @_;
    my $t = (4*$k - 1) / (4*$n + 2);
    (1 - ($n - 1) / (8 * $n**3)) * cos(pi * $t);
}

sub newton_raphson {
    my($n, $r) = @_;
    while (abs(my $dr = - legendre($n,$r) / legendre_prime($n,$r)) >= 2e-16) {
        $r += $dr;
    }
    $r;
}

sub legendre_root {
    my($n, $k) = @_;
    newton_raphson($n, approximate_legendre_root($n, $k));
}

sub weight {
    my($n, $r) = @_;
    2 / ((1 - $r**2) * legendre_prime($n, $r)**2)
}

sub nodes {
    my($n) = @_;
    my %node;
    $node{'0'} = weight($n, 0) if 0 != $n%2;
    for (1 .. int $n/2) {
        my $r = legendre_root($n, $_);
        my $w = weight($n, $r);
        $node{$r} = $w; $node{-$r} = $w;
    }
    return %node
}

sub quadrature {
    our($n, $a, $b) = @_;
    sub scale { ($_[0] * ($b - $a) + $a + $b) / 2 }
    %nodes = nodes($n);
    ($b - $a) / 2 * sum map { $nodes{$_} * exp(scale($_)) } keys %nodes;
}

printf("Gauss-Legendre %2d-point quadrature ∫₋₃⁺³ exp(x) dx ≈ %.13f\n", $_, quadrature($_, -3, +3) )
        for 5 .. 10, 20;


# syntax: GAWK -f OLD_LADY_SWALLOWED_A_FLY.AWK
BEGIN {
    arr[++i] = "fly/"
    arr[++i] = "spider/That wriggled and jiggled and tickled inside her"
    arr[++i] = "bird/Quite [email protected]"
    arr[++i] = "cat/Fancy [email protected]"
    arr[++i] = "dog/What a [email protected]"
    arr[++i] = "pig/Her mouth was so [email protected]"
    arr[++i] = "goat/Opened her throat and down went the goat"
    arr[++i] = "cow/I don't know [email protected]"
    arr[++i] = "donkey/It was rather [email protected]"
    arr[++i] = "horse/She's dead of course"
    leng = i # array length
    for (i=1; i<=leng; i++) {
      s = arr[i]
      A[i] = substr(s,1,index(s,"/")-1) # critter name
      text = substr(s,index(s,"/")+1)
      sub(/@/," to swallow a "A[i],text)
      printf("I know an old lady who swallowed a %s.\n",A[i])
      if (text != "") {
        printf("%s.\n",text)
      }
      if (i == leng) {
        break
      }
      for (j=i; j>1; j--) {
        printf("She swallowed the %s to catch the %s.\n",A[j],A[j-1])
      }
      printf("I don't know why she swallowed the fly.\n")
      printf("Perhaps she'll die.\n\n")
    }
    exit(0)
}


with javascript_semantics
integer order = 0

sequence legendreRoots = {},
         legendreWeights = {}

function legendre(integer term, atom z)
    if term=0 then
        return 1
    elsif term=1 then
        return z
    else
        return ((2*term-1)*z*legendre(term-1,z)-(term-1)*legendre(term-2,z))/term
    end if
end function

function legendreDerivative(integer term, atom z)
    if term=0
    or term=1 then
        return term
    end if
    return (term*(z*legendre(term,z)-legendre(term-1,z)))/(z*z-1)
end function

procedure getLegendreRoots()
    legendreRoots = {}
    for index=1 to order do
        atom y = cos(PI*(index-0.25)/(order+0.5))
        while 1 do
            atom y1 = y
            y -= legendre(order,y)/legendreDerivative(order,y)
            if abs(y-y1)<2e-16 then exit end if
        end while
        legendreRoots &= y
    end for
end procedure

procedure getLegendreWeights()
    legendreWeights = {}
    for index=1 to order do
        atom lri = legendreRoots[index],
             diff = legendreDerivative(order,lri),
             weight = 2 / ((1-power(lri,2))*power(diff,2))
        legendreWeights &= weight
    end for
end procedure

function gaussLegendreQuadrature(integer f, lowerLimit, upperLimit, n)
    order = n

    getLegendreRoots()
    getLegendreWeights()

    atom c1 = (upperLimit - lowerLimit) / 2
    atom c2 = (upperLimit + lowerLimit) / 2
    atom s = 0

    for i = 1 to order do
        s += legendreWeights[i] * f(c1 * legendreRoots[i] + c2)
    end for

    return c1 * s
end function

string fmt = iff(machine_bits()=32?"%.13f":"%.14f"), res
for i=5 to 11 by 6 do
    res = sprintf(fmt,{gaussLegendreQuadrature(exp, -3, 3, i)})
    if i=5 then
        puts(1,"roots:") ?legendreRoots
        puts(1,"weights:") ?legendreWeights
    end if
    printf(1,"Gauss-Legendre %2d-point quadrature for exp over [-3..3] = %s\n",{order,res})
end for
res = sprintf(fmt,{exp(3)-exp(-3)})
printf(1,"                                     compared to actual = %s\n",{res})


((main {fly !})

(fly
    {{"There was an old lady who swallowed a " <<
        iter 1 - dup
        <- 0 animal ! nl << ->
           1 animal !    <<
        {iter 10 ~=}{
            " " <<
            {iter 1 =}{last}{fnord} ifte
            iter 1 - 0 animal ! nl <<
                {"She swallowed the " <<
                this_iter ! 0 animal ! <<
                " to catch the " <<
                next_iter ! 0 animal ! nl <<
                {iter 2 =}
                    {8 1 animal ! nl <<}
                    {fnord}
                ifte}
            11 iter - 1 -
            times}
            {fnord}
        ifte
        "But I don't know why she swallowed the fly\nPerhaps she'll die\n\n" <<}
    animals len
    times})

(next_iter {10 iter - })
(this_iter {next_iter ! 1 -})

(animal { <- <- animals -> ith -> ith})

-- There are 10 animals
(animals
   (("horse"    "She's dead of course...\n")
    ("donkey"   "It was rather wonkey! To swallow a")
    ("cow"      "I don't know how she swallowed a")
    ("goat"     "She just opened her throat! And swallowed the")
    ("pig"      "Her mouth was so big, to swallow a")
    ("dog"      "What a hog! To swallow a")
    ("cat"      "Fancy that! She swallowed a")
    ("bird"     "Quite absurd to swallow a")
    ("spider"   "That wriggled and jiggled and tickled inside her")
    ("fly"      " "))))


@echo off
setlocal enabledelayedexpansion

	%== An "ugly" pseudo-array ===%
set pseudo=^
fly/@^
spider/That_wiggled_and_jiggled_and_tickled_inside_her,@^
bird/How_absurd,_to_swallow_a_bird,@^
cat/Imagine_that._She_swallowed_a_cat,@^
dog/What_a_hog_to_swallow_a_dog,@^
goat/She_just_opened_her_throat_and_swallowed_that_goat,@^
cow/I_don't_know_how_she_swallowed_that_cow,@^
horse/She's_dead_of_course...

	%== Counting and seperating... ===%
set str=!pseudo!
:count
if "!str!"=="" goto print_song
for /f "tokens=1,* delims=@" %%A in ("!str!") do (
	set /a cnt+=1
	for /f "tokens=1,2 delims=/" %%C in ("%%A") do (
		set animal!cnt!=%%C
		set comment!cnt!=%%D
	)
	set str=%%B
)
goto count

	%== Print the song ===%
:print_song
for /l %%i in (1,1,!cnt!) do (
	echo There was an old lady who swallowed a !animal%%i!.
	if not "!comment%%i!"=="" echo !comment%%i:_= !
	if %%i equ !cnt! goto done

	for /l %%j in (%%i,-1,2) do (
		set/a prev=%%j-1
		call set prev_animal=%%animal!prev!%%
		echo She swallowed the !animal%%j! to catch the !prev_animal!.
	)
	echo I don't know why she swallowed the fly.
	echo Perhaps she'll die.
	echo.
)
:done
pause>nul&exit/b 0


(subscriptrange, size, fofl):
Integration_Gauss: procedure options (main);

  declare (n, k) fixed binary;
  declare r(*,*) float (18) controlled;
  declare (z, a, b, exact) float (18);

  do n = 1 to 20;
    a = -3; b = 3;
    if allocation(r) > 0 then free r;
    allocate r(2, n); r = 0;
    call gaussquad(n, r);
    z = (b-a)/2 * sum(r(2,*) * exp((a+b)/2+r(1,*)*(b-a)/2));
    exact = exp(3.0q0)-exp(-3.0q0);
    put skip edit (n, z, z-exact) (f(5), f(25,16), e(15,2));
  end;

gaussquad: procedure(n, r);
/*declare n fixed binary, r(2, n) float (18);*/
  declare n fixed binary, r(2, *) float (18);/* corrected */
  declare pi float (18) value (4*atan(1.0q0));
  declare (x, f, df, dx) float (18);
  declare (i, iter, L) fixed binary;
  declare (p0(*), p1(*), tmp(*), tmp2(*)) float (18) controlled;

  allocate p0(1) initial (1);
  allocate p1(2) initial (1, 0);

  do k = 2 to n;
     allocate tmp(hbound(p1)+1); do L = 1 to hbound(p1); tmp(L) = p1(L); end; tmp(L) = 0;
     allocate tmp2(hbound(p0)+2); tmp2(1), tmp2(2) = 0;
     do L = 1 to hbound(p0); tmp2(L+2) = p0(L); end;
     tmp = ((2*k-1)*tmp - (k-1)*tmp2)/k;
     free p0; allocate p0(hbound(p1)); p0 = p1;
     free p1; allocate p1(hbound(tmp)); p1 = tmp;
     free tmp, tmp2;
  end;
  do i = 1 to n;
    x = cos(pi*(i-0.25q0)/(n+0.5q0));
    do iter = 1 to 10;
      f = p1(1); df = 0;
      do k = 2 to hbound(p1);
        df = f + x*df;
        f  = p1(k) + x * f;
      end;
      dx =  f / df;
      x = x - dx;
      if abs(dx) < 10*epsilon(dx) then leave;
    end;
    r(1,i) = x;
    r(2,i) = 2/((1-x**2)*df**2);
  end;
  end gaussquad;
end Integration_Gauss;


from numpy import *

##################################################################
# Recursive generation of the Legendre polynomial of order n
def Legendre(n,x):
	x=array(x)
	if (n==0):
		return x*0+1.0
	elif (n==1):
		return x
	else:
		return ((2.0*n-1.0)*x*Legendre(n-1,x)-(n-1)*Legendre(n-2,x))/n

##################################################################
# Derivative of the Legendre polynomials
def DLegendre(n,x):
	x=array(x)
	if (n==0):
		return x*0
	elif (n==1):
		return x*0+1.0
	else:
		return (n/(x**2-1.0))*(x*Legendre(n,x)-Legendre(n-1,x))
##################################################################
# Roots of the polynomial obtained using Newton-Raphson method
def LegendreRoots(polyorder,tolerance=1e-20):
	if polyorder<2:
		err=1 # bad polyorder no roots can be found
	else:
		roots=[]
		# The polynomials are alternately even and odd functions. So we evaluate only half the number of roots.
		for i in range(1,int(polyorder)/2 +1):
			x=cos(pi*(i-0.25)/(polyorder+0.5))
			error=10*tolerance
		        iters=0
		        while (error>tolerance) and (iters<1000):
		                dx=-Legendre(polyorder,x)/DLegendre(polyorder,x)
		                x=x+dx
		                iters=iters+1
		                error=abs(dx)
			roots.append(x)
		# Use symmetry to get the other roots
		roots=array(roots)
		if polyorder%2==0:
			roots=concatenate( (-1.0*roots, roots[::-1]) )
		else:
			roots=concatenate( (-1.0*roots, [0.0], roots[::-1]) )
		err=0 # successfully determined roots
	return [roots, err]
##################################################################
# Weight coefficients
def GaussLegendreWeights(polyorder):
	W=[]
	[xis,err]=LegendreRoots(polyorder)
	if err==0:
		W=2.0/( (1.0-xis**2)*(DLegendre(polyorder,xis)**2) )
		err=0
	else:
		err=1 # could not determine roots - so no weights
	return [W, xis, err]
##################################################################
# The integral value
# func 		: the integrand
# a, b 		: lower and upper limits of the integral
# polyorder 	: order of the Legendre polynomial to be used
#
def GaussLegendreQuadrature(func, polyorder, a, b):
	[Ws,xs, err]= GaussLegendreWeights(polyorder)
	if err==0:
		ans=(b-a)*0.5*sum( Ws*func( (b-a)*0.5*xs+ (b+a)*0.5 ) )
	else:
		# (in case of error)
		err=1
		ans=None
	return [ans,err]
##################################################################
# The integrand - change as required
def func(x):
	return exp(x)
##################################################################
#

order=5
[Ws,xs,err]=GaussLegendreWeights(order)
if err==0:
	print "Order    : ", order
	print "Roots    : ", xs
	print "Weights  : ", Ws
else:
	print "Roots/Weights evaluation failed"

# Integrating the function
[ans,err]=GaussLegendreQuadrature(func , order, -3,3)
if err==0:
	print "Integral : ", ans
else:
	print "Integral evaluation failed"


REM >oldlady
DIM swallowings$(6, 1)
swallowings$() = "fly", "+why", "spider", "That wriggled and wiggled and tickled inside her", "bird", ":How absurd", "cat", ":Fancy that", "dog", ":What a hog", "cow", "+how", "horse", "She's dead, of course"
FOR i% = 0 TO 6
  PRINT "There was an old lady who swallowed a "; swallowings$(i%, 0); "..."
  PROC_comment_on_swallowing(swallowings$(i%, 0), swallowings$(i%, 1))
  IF i% > 0 AND i% < 6 THEN
    FOR j% = i% TO 1 STEP -1
      PRINT "She swallowed the "; swallowings$(j%, 0); " to catch the "; swallowings$(j% - 1, 0); ","
    NEXT
    PROC_comment_on_swallowing(swallowings$(0, 0), swallowings$(0, 1))
  ENDIF
  PRINT
NEXT
END
:
DEF PROC_comment_on_swallowing(animal$, observation$)
CASE LEFT$(observation$, 1) OF
WHEN "+":
  PRINT "I don't know "; MID$(observation$, 2); " she swallowed a "; animal$;
  IF animal$ = "fly" THEN PRINT " -- perhaps she'll die";
  PRINT "!"
WHEN ":"
  PRINT MID$(observation$, 2); ", to swallow a "; animal$; "!"
OTHERWISE
  PRINT observation$; "!"
ENDCASE
ENDPROC


get "libhdr"

let animal(n) =
    n=0 -> "fly",   n=1 -> "spider",    n=2 -> "bird",
    n=3 -> "cat",   n=4 -> "dog",       n=5 -> "goat",
    n=6 -> "cow",   n=7 -> "horse",     valof finish

let line(n) =
    n=0 -> "I don't know why she swallowed that fly,*NPerhaps she'll die.*N",
    n=1 -> "That wiggled and jiggled and tickled inside her",
    n=2 -> "How absurd to swallow a bird",
    n=3 -> "Imagine that, she swallowed a cat!",
    n=4 -> "What a hog to swallow a dog",
    n=5 -> "She just opened her throat and swallowed that goat",
    n=6 -> "I don't know how she swallowed that cow",
    n=7 -> "She's dead, of course.",
    valof finish

let verse(n) be
$(  writef("There was an old lady who swallowed a %S,*N", animal(n))
    writef("%S*N", line(n))

    unless n=7 for i=n to 1 by -1
    $(  writef("She swallowed the %S to catch the %S,*N",
                    animal(i), animal(i-1))
        if i <= 2 do writef("%S*N", line(i-1))
    $)
$)

let start() be for n=0 to 7 do verse(n)


055*46*146*1->00p 36268>5\:4\:2v >\#%"O"/#:3#:+#< g48*- >1-:!#v_\1+::"O"%\"O"/v
>-#2:#\8#1`#:|#-1:-1\7_^#`g00:+<>\#%"O"/#::$#<3#$+g48*-v^\,+*+ 55!:*!!-"|":g+3<
             >$ 36 26 58 49 81 36 26 10 \1-:#^\_^#:-1\+<[email protected]#:>#<$<
DI know an old lady who swallowed a F.|I don't know why she swallowed the 8.|Pe
rhaps she'll die.||5.|She swallowed the / to catch the $fly0. To swallow a 'spi
derS.|That wriggled and jiggled and tickled inside her%Bird/.|Quite absurd$Cat-
.|Fancy that$Dog-.|What a hog$Pig7.|Her mouth was so big%Goat=.|She just opened
 her throat$Cow3.|I don't know how'Donkey6.|It was rather wonky&Horse:.|She's d
ead, of course!|


(define (LegendreP n x)
  (let compute ([n n] [Pn-1 x] [Pn-2 1])
    (case n
      [(0) Pn-2]
      [(1) Pn-1]
      [else (compute (- n 1)
                     (/ (- (* (- (* 2 n) 1) x Pn-1)
                           (* (- n 1) Pn-2)) n)
                     Pn-1)])))

(define (LegendreP′ n x)
  (* (/ n (- (* x x) 1))
     (- (* x (LegendreP n x))
        (LegendreP (- n 1) x))))


multi legendre-pair(    1 , $x) { $x, 1 }
multi legendre-pair(Int $n, $x) {
    my ($m1, $m2) = legendre-pair($n - 1, $x);
    my \u = 1 - 1 / $n;
    (1 + u) * $x * $m1 - u * $m2, $m1;
}

multi legendre(    0 , $ ) { 1 }
multi legendre(Int $n, $x) { legendre-pair($n, $x)[0] }

multi legendre-prime(    0 , $ ) { 0 }
multi legendre-prime(    1 , $ ) { 1 }
multi legendre-prime(Int $n, $x) {
    my ($m0, $m1) = legendre-pair($n, $x);
    ($m1 - $x * $m0) * $n / (1 - $x**2);
}

sub approximate-legendre-root(Int $n, Int $k) {
    # Approximation due to Francesco Tricomi
    my \t = (4*$k - 1) / (4*$n + 2);
    (1 - ($n - 1) / (8 * $n**3)) * cos(pi * t);
}

sub newton-raphson(&f, &f-prime, $r is copy, :$eps = 2e-16) {
    while abs(my \dr = - f($r) / f-prime($r)) >= $eps {
        $r += dr;
    }
    $r;
}

sub legendre-root(Int $n, Int $k) {
    newton-raphson(&legendre.assuming($n), &legendre-prime.assuming($n),
                   approximate-legendre-root($n, $k));
}

sub weight(Int $n, $r) { 2 / ((1 - $r**2) * legendre-prime($n, $r)**2) }

sub nodes(Int $n) {
    flat gather {
        take 0 => weight($n, 0) if $n !%% 2;
        for 1 .. $n div 2 {
            my $r = legendre-root($n, $_);
            my $w = weight($n, $r);
            take $r => $w, -$r => $w;
        }
    }
}

sub quadrature(Int $n, &f, $a, $b, :@nodes = nodes($n)) {
    sub scale($x) { ($x * ($b - $a) + $a + $b) / 2 }
    ($b - $a) / 2 * [+] @nodes.map: { .value * f(scale(.key)) }
}

say "Gauss-Legendre $_.fmt('%2d')-point quadrature ∫₋₃⁺³ exp(x) dx ≈ ",
         quadrature($_, &exp, -3, +3) for flat 5 .. 10, 20;


#include <stdio.h>
static char const *animals[] = {
    "fly",
    "spider",
    "bird",
    "cat",
    "dog",
    "goat",
    "cow",
    "horse"
};
static char const *verses[]  = {
    "I don't know why she swallowed that fly.\nPerhaps she'll die\n",
    "That wiggled and jiggled and tickled inside her",
    "How absurd, to swallow a bird",
    "Imagine that. She swallowed a cat",
    "What a hog to swallow a dog",
    "She just opened her throat and swallowed that goat",
    "I don't know how she swallowed that cow",
    "She's dead of course"
};

#define LEN(ARR) (sizeof ARR / sizeof *ARR)

int main(void)
{
    for (size_t i = 0; i < LEN(animals); i++) {
        printf("There was an old lady who swallowed a %s\n%s\n", animals[i], verses[i]);
        for (size_t j = i; j > 0 && i < LEN(animals) - 1; j--) {
            printf("She swallowed the %s to catch the %s\n", animals[j], animals[j-1]);
            if (j == 1) {
                printf("%s\n", verses[0]);
            }
        }
    }
}


using System;

namespace OldLady
{
    internal class Program
    {
        private const string reason = "She swallowed the {0} to catch the {1}";
        private static readonly string[] creatures = {"fly", "spider", "bird", "cat", "dog", "goat", "cow", "horse"};

        private static readonly string[] comments =
        {
            "I don't know why she swallowed that fly.\nPerhaps she'll die\n",
            "That wiggled and jiggled and tickled inside her",
            "How absurd, to swallow a bird",
            "Imagine that. She swallowed a cat",
            "What a hog to swallow a dog",
            "She just opened her throat and swallowed that goat",
            "I don't know how she swallowed that cow",
            "She's dead of course"
        };

        private static void Main()
        {
            int max = creatures.Length;
            for (int i = 0; i < max; i++)
            {
                Console.WriteLine("There was an old lady who swallowed a {0}", creatures[i]);
                Console.WriteLine(comments[i]);
                for (int j = i; j > 0 && i < max - 1; j--)
                {
                    Console.WriteLine(reason, creatures[j], creatures[j - 1]);
                    if (j == 1)
                    {
                        Console.WriteLine(comments[j - 1]);
                    }
                }
            }
            Console.Read();
        }
    }
}


#include <iostream>

const char *CREATURES[] = { "fly", "spider", "bird", "cat", "dog", "goat", "cow", "horse" };
const char *COMMENTS[] = {
    "I don't know why she swallowed that fly.\nPerhaps she'll die\n",
    "That wiggled and jiggled and tickled inside her",
    "How absurd, to swallow a bird",
    "Imagine that. She swallowed a cat",
    "What a hog to swallow a dog",
    "She just opened her throat and swallowed that goat",
    "I don't know how she swallowed that cow",
    "She's dead of course"
};

int main() {
    auto max = sizeof(CREATURES) / sizeof(char*);
    for (size_t i = 0; i < max; ++i) {
        std::cout << "There was an old lady who swallowed a " << CREATURES[i] << '\n';
        std::cout << COMMENTS[i] << '\n';
        for (int j = i; j > 0 && i < max - 1; --j) {
            std::cout << "She swallowed the " << CREATURES[j] << " to catch the " << CREATURES[j - 1] << '\n';
            if (j == 1)
                std::cout << COMMENTS[j - 1] << '\n';
        }
    }

    return 0;
}


import scala.math.{Pi, cos, exp}

object GaussLegendreQuadrature extends App {
  private val N = 5

  private def legeInte(a: Double, b: Double): Double = {
    val (c1, c2) = ((b - a) / 2, (b + a) / 2)
    val tuples: IndexedSeq[(Double, Double)] = {
      val lcoef = {
        val lcoef = Array.ofDim[Double](N + 1, N + 1)

        lcoef(0)(0) = 1
        lcoef(1)(1) = 1
        for (i <- 2 to N) {
          lcoef(i)(0) = -(i - 1) * lcoef(i - 2)(0) / i
          for (j <- 1 to i) lcoef(i)(j) =
            ((2 * i - 1) * lcoef(i - 1)(j - 1) - (i - 1) * lcoef(i - 2)(j)) / i
        }
        lcoef
      }

      def legeEval(n: Int, x: Double): Double =
        lcoef(n).take(n).foldRight(lcoef(n)(n))((o, s) => s * x + o)

      def legeDiff(n: Int, x: Double): Double =
        n * (x * legeEval(n, x) - legeEval(n - 1, x)) / (x * x - 1)

      @scala.annotation.tailrec
      def convergention(x0: Double, x1: Double): Double = {
        if (x0 == x1) x1
        else convergention(x1, x1 - legeEval(N, x1) / legeDiff(N, x1))
      }

      for {i <- 0 until 5
           x = convergention(0.0, cos(Pi * (i + 1 - 0.25) / (N + 0.5)))
           x1 = legeDiff(N, x)
           } yield (x, 2 / ((1 - x * x) * x1 * x1))
    }

    println(s"Roots: ${tuples.map(el => f" ${el._1}%10.6f").mkString}")
    println(s"Weight:${tuples.map(el => f" ${el._2}%10.6f").mkString}")

    c1 * tuples.map { case (lroot, weight) => weight * exp(c1 * lroot + c2) }.sum
  }

  println(f"Integrating exp(x) over [-3, 3]:\n\t${legeInte(-3, 3)}%10.8f,")
  println(f"compared to actual%n\t${exp(3) - exp(-3)}%10.8f")

}


old_lady = cluster is swallow
    rep = null

    own animals: array[string] := array[string]$[
        "fly", "spider", "bird", "cat",
        "dog", "goat", "cow", "horse"
    ]

    own lines: array[string] := array[string]$[
        "I don't know why she swallowed that fly.\nPerhaps she'll die.\n",
        "That wiggled and jiggled and tickled inside her",
        "How absurd to swallow a bird",
        "Imagine that, she swallowed a cat!",
        "What a hog to swallow a dog",
        "She just opened her throat and swallowed that goat",
        "I don't know how she swallowed that cow",
        "She's dead, of course."
    ]

    verse = proc (s: stream, n: int)
        stream$putl(s, "There was an old lady who swallowed a " || animals[n])
        stream$putl(s, lines[n])

        if n=8 then return end
        for i: int in int$from_to_by(n, 2, -1) do
            stream$putl(s, "She swallowed the " || animals[i]
                        || " to catch the " || animals[i-1])
            if i <= 3 then stream$putl(s, lines[i-1]) end
        end
    end verse

    swallow = proc (s: stream)
        for i: int in int$from_to(1, 8) do
            verse(s, i)
        end
    end swallow
end old_lady

start_up = proc ()
    old_lady$swallow(stream$primary_output())
end start_up


        IDENTIFICATION DIVISION.
        PROGRAM-ID. OLD-LADY.

        DATA DIVISION.
        WORKING-STORAGE SECTION.

        01  LYRICS.
            03  THERE-WAS       PIC X(38) VALUE
            "There was an old lady who swallowed a ".
            03  SHE-SWALLOWED   PIC X(18) VALUE "She swallowed the ".
            03  TO-CATCH        PIC X(14) VALUE " to catch the ".
        01  ANIMALS.
            03  FLY.
                05  NAME        PIC X(6) VALUE "fly".
                05  VERSE       PIC X(60) VALUE
            "I don't know why she swallowed a fly. Perhaps she'll die.".
            03  SPIDER.
                05  NAME        PIC X(6) VALUE "spider".
                05  VERSE       PIC X(60) VALUE
            "That wiggled and jiggled and tickled inside her.".
            03  BIRD.
                05  NAME        PIC X(6) VALUE "bird".
                05  VERSE       PIC X(60) VALUE
            "How absurd, to swallow a bird.".
            03  CAT.
                05  NAME        PIC X(6) VALUE "cat".
                05  VERSE       PIC X(60) VALUE
            "Imagine that, she swallowed a cat.".
            03  DOG.
                05  NAME        PIC X(6) VALUE "dog".
                05  VERSE       PIC X(60) VALUE
            "What a hog, to swallow a dog.".
            03  GOAT.
                05  NAME        PIC X(6) VALUE "goat".
                05  VERSE       PIC X(60) VALUE
            "She just opened her throat and swallowed that goat.".
            03  COW.
                05  NAME        PIC X(6) VALUE "cow".
                05  VERSE       PIC X(60) VALUE
            "I don't know how she swallowed that cow.".
            03  HORSE.
                05  NAME        PIC X(6) VALUE "horse".
                05  VERSE       PIC X(60) VALUE
            "She's dead, of course.".
        01  ANIMAL-ARRAY REDEFINES ANIMALS.
            03  ANIMAL OCCURS 8 TIMES.
                05  NAME        PIC X(6).
                05  VERSE       PIC X(60).
        01  MISC.
            03  LINE-OUT        PIC X(80).
            03  A-IDX           PIC 9(2).
            03  S-IDX           PIC 9(2).

        PROCEDURE DIVISION.
        MAIN SECTION.
            PERFORM DO-ANIMAL
                VARYING A-IDX FROM 1 BY 1 UNTIL A-IDX > 8.
            STOP RUN.

        DO-ANIMAL SECTION.
            MOVE SPACES TO LINE-OUT.
            STRING
                THERE-WAS DELIMITED BY SIZE,
                NAME OF ANIMAL(A-IDX) DELIMITED BY SPACE,
                ","
                INTO LINE-OUT
            END-STRING.
            DISPLAY LINE-OUT.
            IF A-IDX > 1 THEN
                DISPLAY VERSE OF ANIMAL(A-IDX)
            END-IF.
            IF A-IDX = 8 THEN
                EXIT SECTION
            END-IF.
            PERFORM DO-SWALLOW
                VARYING S-IDX FROM A-IDX BY -1 UNTIL S-IDX = 1.
            DISPLAY VERSE OF ANIMAL(1).
            DISPLAY SPACES.

        DO-SWALLOW SECTION.
            MOVE SPACES TO LINE-OUT.
            STRING
                SHE-SWALLOWED DELIMITED BY SIZE,
                NAME OF ANIMAL(S-IDX) DELIMITED BY SPACE,
                TO-CATCH DELIMITED BY SIZE,
                NAME OF ANIMAL(S-IDX - 1) DELIMITED BY SPACE
                INTO LINE-OUT
            END-STRING.
            DISPLAY LINE-OUT.


func legendre_pair((1), x) { (x, 1) }
func legendre_pair( n,  x) {
    var (m1, m2) = legendre_pair(n - 1, x)
    var u = (1 - 1/n)
    ((1 + u)*x*m1 - u*m2, m1)
}

func legendre((0), _) { 1 }
func legendre( n,  x) { [legendre_pair(n, x)][0] }

func legendre_prime({ .is_zero }, _) { 0 }
func legendre_prime({ .is_one  }, _) { 1 }

func legendre_prime(n, x) {
    var (m0, m1) = legendre_pair(n, x)
    (m1 - x*m0) * n / (1 - x**2)
}

func approximate_legendre_root(n, k) {
    # Approximation due to Francesco Tricomi
    var t = ((4*k - 1) / (4*n + 2))
    (1 - ((n - 1)/(8 * n**3))) * cos(Num.pi * t)
}

func newton_raphson(f, f_prime, r, eps = 2e-16) {
    loop {
        var dr = (-f(r) / f_prime(r))
        dr.abs >= eps || break
        r += dr
    }
    return r
}

func legendre_root(n, k) {
    newton_raphson(legendre.method(:call, n), legendre_prime.method(:call, n),
                   approximate_legendre_root(n, k))
}

func weight(n, r) { 2 / ((1 - r**2) * legendre_prime(n, r)**2) }

func nodes(n) {
    gather {
        take(Pair(0, weight(n, 0))) if n.is_odd
        { |i|
            var r = legendre_root(n, i)
            var w = weight(n, r)
            take(Pair(r, w), Pair(-r, w))
        }.each(1 .. (n >> 1))
    }
}

func quadrature(n, f, a, b, nds = nodes(n)) {
    func scale(x) { (x*(b - a) + a + b) / 2 }
    (b - a) / 2 * nds.sum { .second * f(scale(.first)) }
}

[(5..10)..., 20].each { |i|
    printf("Gauss-Legendre %2d-point quadrature ∫₋₃⁺³ exp(x) dx ≈ %.15f\n",
        i, quadrature(i, {.exp}, -3, +3))
}


1 rem rosetta code
2 rem old lady who swallowed a fly
5 print chr$(147);chr$(14)
10 dim a$(10),ex$(10),mu$(8,3):a=1
15 for i=1 to 8:read a$(i),ex$(i):next i
20 for c=1 to 8
30   print chr$(147):print "     Old Lady Who Swallowed A Fly     ":print
40   print "I know an old lady who swallowed"
45   print "  a ";a$(c):gosub 200
50   for bc=c to 1 step -1
55     if bc=c or bc<=2 then print ex$(bc):gosub 200
57     if bc=8 then for t=1 to 1500:next
60     if bc>1 then print "She swallowed a "a$(bc)" to catch the "a$(bc-1)";"
61     gosub 200
65   next bc
70   print "   ... Perhaps she'll die!"
75   get k$:if k$="q" then end
77   if k$>"0" and k$<"9" then c=asc(k$)-49
80   print:for t=1 to 1000:next t
90 next c
100 end

200 for t=1 to 500:next t:return:rem generic delay

1000 rem lyrics
1010 data "fly","I don't know why she swallowed a fly..."
1020 data "spider","That wriggled and jiggled and tickled     inside her!"
1030 data "bird","How absurd to swallow a bird!"
1040 data "cat","Imagine that! She swallowed a cat!"
1050 data "dog","What a hog, to swallow a dog!"
1060 data "goat","She just opened her throat and swallowed  a goat!"
1070 data "cow","I don't know how she swallowed a cow!"
1080 data "horse","...She died, of course!"


package require Tcl 8.5
package require math::special
package require math::polynomials
package require math::constants
math::constants::constants pi

# Computes the initial guess for the root i of a n-order Legendre polynomial
proc guess {n i} {
    global pi
    expr { cos($pi * ($i - 0.25) / ($n + 0.5)) }
}

# Computes and evaluates the n-order Legendre polynomial at the point x
proc legpoly {n x} {
    math::polynomials::evalPolyn [math::special::legendre $n] $x
}

# Computes and evaluates the derivative of an n-order Legendre polynomial at point x
proc legdiff {n x} {
    expr {$n / ($x**2 - 1) * ($x * [legpoly $n $x] - [legpoly [incr n -1] $x])}
}

# Computes the n nodes for an n-point quadrature rule. (i.e. n roots of a n-order polynomial)
proc nodes n {
    set x [lrepeat $n 0.0]
    for {set i 0} {$i < $n} {incr i} {
	set val [guess $n [expr {$i + 1}]]
	foreach . {1 2 3 4 5} {
	    set val [expr {$val - [legpoly $n $val] / [legdiff $n $val]}]
	}
	lset x $i $val
    }
    return $x
}

# Computes the weight for an n-order polynomial at the point (node) x
proc legwts {n x} {
    expr {2.0 / (1 - $x**2) / [legdiff $n $x]**2}
}

# Takes a array of nodes x and computes an array of corresponding weights w
proc weights x {
    set n [llength $x]
    set w {}
    foreach xi $x {
	lappend w [legwts $n $xi]
    }
    return $w
}

# Integrates a lambda term f with a n-point Gauss-Legendre quadrature rule over the interval [a,b]
proc gausslegendreintegrate {f n a b} {
    set x [nodes $n]
    set w [weights $x]
    set rangesize2 [expr {($b - $a)/2}]
    set rangesum2 [expr {($a + $b)/2}]
    set sum 0.0
    foreach xi $x wi $w {
	set y [expr {$rangesize2*$xi + $rangesum2}]
	set sum [expr {$sum + $wi*[apply $f $y]}]
    }
    expr {$sum * $rangesize2}
}


(defun verse  (what remark &optional always die) (list what remark always die))
(defun what   (verse) (first verse))
(defun remark (verse) (second verse))
(defun always (verse) (third verse))
(defun die    (verse) (fourth verse))

(defun ssa (what remark &optional always die )
    (verse what (format nil "~a she swallowed a ~a!" remark what always die)))
(defun tsa (what remark &optional always die)
    (verse what (format nil "~a, to swallow a ~a!" remark what)))
(defun asa (what remark &optional always die)
    (verse what (format nil "~a, and swallowed a ~a!" remark what)))

(let ((verses (list
        (verse "fly" "I don't know why she swallowed the fly" T)
        (verse "spider" "That wriggled and jiggled and tickled inside her" T)
        (tsa   "bird" "Now how absurd")
        (tsa   "cat" "Now fancy that")
        (tsa   "dog" "what a hog")
        (asa   "goat" "She just opened her throat")
        (ssa   "cow" "I don't know how")
        (verse "horse" "She's dead, of course!" T T))))

  (loop for verse in verses for i from 0 doing
    (let ((it (what verse)))
      (format t "I know an old lady who swallowed a ~a~%" it)
      (format t "~a~%" (remark verse))
      (if (not (die verse)) (progn
        (if (> i 0)
          (loop for j from (1- i) downto 0 doing
            (let* ((v (nth j verses)))
              (format t "She swallowed the ~a to catch the ~a~%" it (what v))
              (setf it (what v))
              (if (always v)
                (format t "~a~a~%" (if (= j 0) "But " "") (remark v))))))
        (format t "Perhaps she'll die. ~%~%"))))))


#import std
#import nat

legendre = # takes n to the pair of functions (P_n,P'_n), where P_n is the Legendre polynomial of order n

~&?\(1E0!,0E0!)! -+
   ^|/~& //mp..vid^ mp..sub\1E0+ mp..sqr,
   ~~ "c". ~&\1E0; ~&\"c"; ~&ar^?\0E0! mp..add^/[email protected] ^|R/~& ^|\~&t ^/~&l mp..mul,
   @iiXNX ~&rZ->r @l ^/^|(~&tt+ [email protected]+ successor,~&) both~&g&&~&+ -+
      ~* mp..zero_p?/~& (&&~&r ~&EZ+ ~~ mp..prec)^/~& ^(~&,..shr\8); mp..equ^|(~&,..gro\8)->l @r ^/~& ..shr\8,
      ^(~&rl,mp..mul*lrrPD)^/[email protected] -+
         ^(~&l,mp..sub*+ zipp0E0^|\~& :/0E0)+ ~&rrt->lhthPX ^(
            ^lrNCC\~&lh mp..vid^*D/[email protected] -+
               mp..sub*+ zipp0E0^|\~& :/0E0,
               mp..mul~*brlD^|bbI/~&hthPX @l ..nat2mp~~+ predecessor~~NiCiX+-,
            @r ^|/successor predecessor),
         ^|(mp..grow/1E0; @iNC ^lrNCC\~& :/0E0,~&/2)+-+-+-

nodes = # takes precision and order (p,n) to a list of nodes and weights <(x_1,w_1)..(x_n,w_n)>

-+
   ^H(
      @lrr *+ ^/~&+ mp..div/( ..nat2mp 2)++ mp..mul^/(mp..sqr; //mp..sub ..nat2mp 1)+ mp..sqr+,
      mp..shr^*DrlXS/~&ll ^|H\~& *+ @NiX+ ->l^|(~&lZ!|+ not+ //mp..eq,@r+ ^/~&+ mp..sub^/~&+ mp..div^)),
   ^/^|(~&,legendre) mp..cos*+ mp..mul^*D(
      mp..div^|/[email protected] mp..add/5E-1+ ..nat2mp,
      @r mp..bus/*2.5E-1+ ..nat2mp*+ nrange/1)+-

integral = # takes precision and order (p,n) to a function taking a function and interval (f,(a,b))

("p","n"). -+
   mp..shrink^/~& difference\"p"+ mp..prec,
   mp..mul^|/~& mp..add:-0E0+ * mp..mul^/~&rr ^H/~&ll mp..add^\~&lrr [email protected],
   ^(~&rl,-*nodes("p","n"))^|/~& mp..vid~~G/2E0+ ^/mp..bus mp..add+-


import "/fmt" for Fmt

var N = 5

var lroots = List.filled(N, 0)
var weight = List.filled(N, 0)

var lcoef  = List.filled(N+1, null)
for (i in 0..N) lcoef[i] = List.filled(N + 1, 0)

var legeCoef = Fn.new {
    lcoef[0][0] = lcoef[1][1] = 1
    for (n in 2..N) {
        lcoef[n][0] = -(n-1) * lcoef[n -2][0] / n
        for (i in 1..n) {
            lcoef[n][i] = ((2*n - 1) * lcoef[n-1][i-1] - (n - 1) * lcoef[n-2][i]) / n
        }
    }
}

var legeEval = Fn.new { |n, x| (n..1).reduce(lcoef[n][n]) { |s, i| s*x + lcoef[n][i-1] } }

var legeDiff = Fn.new { |n, x|
    return n * (x * legeEval.call(n, x) - legeEval.call(n-1, x)) / (x*x - 1)
}

var legeRoots = Fn.new {
    var x = 0
    var x1 = 0
    for (i in 1..N) {
        x = (Num.pi * (i - 0.25) / (N + 0.5)).cos
        while (true) {
            x1 = x
            x = x - legeEval.call(N, x) / legeDiff.call(N, x)
            if (x == x1) break
        }
        lroots[i-1] = x
        x1 = legeDiff.call(N, x)
        weight[i-1] = 2 / ((1 - x*x) * x1 * x1)
    }
}

var legeIntegrate = Fn.new { |f, a, b|
    var c1 = (b - a) / 2
    var c2 = (b + a) / 2
    var sum = 0
    for (i in 0...N) sum = sum + weight[i] * f.call(c1*lroots[i] + c2)
    return c1 * sum
}

legeCoef.call()
legeRoots.call()
System.write("Roots: ")
for (i in 0...N) Fmt.write(" $f", lroots[i])
System.write("\nWeight:")
for (i in 0...N) Fmt.write(" $f", weight[i])

var f = Fn.new { |x| x.exp }
var actual = 3.exp - (-3).exp
Fmt.print("\nIntegrating exp(x) over [-3, 3]:\n\t$10.8f,\n" +
    "compared to actual\n\t$10.8f", legeIntegrate.call(f, -3, 3), actual)


include "cowgol.coh";

var animals: [uint8][] := {
    "fly", "spider", "bird", "cat", "dog", "goat", "cow", "horse"
};

var verses: [uint8][] := {
    "I don't know why she swallowed that fly - Perhaps she'll die.\n",
    "That wiggled and jiggled and tickled inside her!",
    "How absurd, to swallow a bird",
    "Imagine that! She swallowed a cat!",
    "What a hog to swallow a dog",
    "She just opened her throat and swallowed that goat",
    "I don't know how she swallowed that cow",
    "She's dead, of course."
};

var i: uint8 := 0;
while i < @sizeof animals loop
    print("There was an old lady who swallowed a ");
    print(animals[i]);
    print(",\n");
    print(verses[i]);
    print_nl();

    var j: uint8 := i;
    while j > 0 and i < @sizeof animals-1 loop
        print("She swallowed the ");
        print(animals[j]);
        print(" to catch the ");
        print(animals[j-1]);
        print(",\n");
        if j <= 2 then
            print(verses[j-1]);
            print_nl();
        end if;
        j := j - 1;
    end loop;

    i := i + 1;
end loop;


import core.stdc.stdio;

immutable data = [
"_ha _c _e _p,/Quite absurd_f_p;_`cat,/Fancy that_fcat;_j`dog,/What a hog"~
"_fdog;_l`pig,/Her mouth_qso big_fpig;_d_r,/She just opened her throat_f_"~
"r;_icow,/_mhow she_ga cow;_k_o,/It_qrather wonky_f_o;_a_o_bcow,_khorse.."~
"./She's dead, of course!/","_a_p_b_e ","/S_t "," to catch the ","fly,/Bu"~
"t _mwhy s_t fly,/Perhaps she'll die!//_ha","_apig_bdog,_l`","spider,/Tha"~
"t wr_nj_ntickled inside her;_aspider_b_c",", to_s a ","_sed ","There_qan"~
" old lady who_g","_a_r_bpig,_d","_acat_b_p,_","_acow_b_r,_i","_adog_bcat"~
",_j","I don't know ","iggled and ","donkey","bird"," was ","goat"," swal"~
"low","he_gthe"];

bool oldLady(in string part, bool s=false) nothrow @nogc {
    foreach (immutable ch; part) {
        if (s)
            s = oldLady(data[ch - '_'], false);
        else if (ch == '_')
            s = true;
        else
            putchar(ch == '/' ? '\n' : ch);
    }

    return s;
}

void main() {
    data[0].oldLady;
}


fcn legendrePair(n,x){ //-->(float,float)
   if(n==1) return(x,1.0);
   m1,m2:=legendrePair(n-1,x);
   u:=1.0 - 1.0/n;
   return( (u + 1)*x*m1 - u*m2, m1);
}
fcn legendre(n,x){ //-->float
   if(n==0) return(0.0);
   legendrePair(n,x)[0]
}
fcn legendrePrime(n,x){ //-->float
   if(n==0) return(0.0);
   if(n==1) return(1.0);
   m0,m1:=legendrePair(n,x);
   (m1 - m0*x)*n/(1.0 - x*x);
}
fcn approximateLegendreRoot(n,k){ # Approximation due to Francesco Tricomi
   t:=(4.0*k - 1)/(4.0*n + 2);
   (1.0 - (n - 1)/(8*n*n*n))*((0.0).pi*t).cos();
}
fcn newtonRaphson(f,fPrime,r,eps=2.0e-16){
   while(not (dr:=-f(r)/fPrime(r)).closeTo(0.0,eps)){ r+=dr }
   r;
}
fcn legendreRoot(n,k){
   newtonRaphson(legendre.fp(n),legendrePrime.fp(n),
                 approximateLegendreRoot(n,k));
}
fcn weight(n,r){
   lp:=legendrePrime(n,r);
   2.0/((1.0 - r*r)*lp*lp)
}
fcn nodes(n){ //-->( (r,weight), (r,w), ...) length n
   sink:=n.isOdd and L(T(0.0,weight(n,0))) or List;
   (1).pump(n/2,sink,'wrap(m){
      r:=legendreRoot(n,m);
      w:=weight(n,r);
      return( Void.Write,T(r,w),T(-r,w) )
   })
}
fcn quadrature(n,f,a,b,nds=Void){
    if(not nds) nds=nodes(n);
    scale:='wrap(x){ (x*(b - a) + a + b) / 2 };
    nds.reduce('wrap(p,[(r,w)]){ p + w*f(scale(r)) },0.0) * (b - a)/2
}


proc nonrec animal(byte n) *char:
    case n
        incase 0: "fly"
        incase 1: "spider"
        incase 2: "bird"
        incase 3: "cat"
        incase 4: "dog"
        incase 5: "goat"
        incase 6: "cow"
        incase 7: "horse"
    esac
corp

proc nonrec line(byte n) *char:
    case n
        incase 0: "I don't know why she swallowed that fly,\r\n"
                  "Perhaps she'll die.\r\n"
        incase 1: "That wiggled and jiggled and tickled inside her,"
        incase 2: "How absurd to swallow a bird,"
        incase 3: "Imagined that, she swallowed a cat,"
        incase 4: "What a hog to swallow a dog,"
        incase 5: "She just opened her throat and swallowed that goat,"
        incase 6: "I don't know how she swallowed that cow,"
        incase 7: "She's dead, of course."
    esac
corp

proc nonrec verse(byte n) void:
    byte a;
    writeln("There was an old lady who swallowed a ", animal(n), ", ");
    writeln(line(n));

    if n/=7 then
        for a from n downto 1 do
            writeln("She swallowed the ", animal(a),
                    " to catch the ", animal(a-1), ", ");
            if a <= 2 then writeln(line(a-1)) fi
        od
    fi
corp

proc nonrec main() void:
    byte n;
    for n from 0 upto 7 do verse(n) od
corp


import extensions;

const Creatures = new string[]{"fly", "spider", "bird", "cat", "dog", "goat", "cow", "horse"};
const Comments = new string[]
{
            "I don't know why she swallowed that fly"$10"Perhaps she'll die",
            "That wiggled and jiggled and tickled inside her",
            "How absurd, to swallow a bird",
            "Imagine that. She swallowed a cat",
            "What a hog to swallow a dog",
            "She just opened her throat and swallowed that goat",
            "I don't know how she swallowed that cow",
            "She's dead of course"
};

public program()
{
    for(int i := 0, i < Creatures.Length, i += 1)
    {
        console
            .printLineFormatted("There was an old lady who swallowed a {0}",Creatures[i])
            .printLine(Comments[i]);

        if(i != 0 && i != Creatures.Length - 1)
        {
            for(int j := i, j > 0, j -= 1)
            {
                console.printLineFormatted("She swallowed the {0} to catch the {1}",Creatures[j],Creatures[j - 1])
            };

            console.writeLine(Comments[0])
        };

        console.writeLine()
    }
}


defmodule Old_lady do
  @descriptions [
    fly:    "I don't know why S",
    spider: "That wriggled and jiggled and tickled inside her.",
    bird:   "Quite absurd T",
    cat:    "Fancy that, S",
    dog:    "What a hog, S",
    goat:   "She opened her throat T",
    cow:    "I don't know how S",
    horse:  "She's dead, of course.",
  ]

  def swallowed do
    {descriptions, animals} = setup(@descriptions)
    Enum.each(Enum.with_index(animals), fn {animal, idx} ->
      IO.puts "There was an old lady who swallowed a #{animal}."
      IO.puts descriptions[animal]
      if animal == :horse, do: exit(:normal)
      if idx > 0 do
        Enum.each(idx..1, fn i ->
          IO.puts "She swallowed the #{Enum.at(animals,i)} to catch the #{Enum.at(animals,i-1)}."
          case Enum.at(animals,i-1) do
            :spider -> IO.puts descriptions[:spider]
            :fly -> IO.puts descriptions[:fly]
            _ -> :ok
          end
        end)
      end
      IO.puts "Perhaps she'll die.\n"
    end)
  end

  def setup(descriptions) do
    animals = Keyword.keys(descriptions)
    descs = Enum.reduce(animals, descriptions, fn animal, acc ->
              Keyword.update!(acc, animal, fn d ->
                case String.last(d) do
                  "S" -> String.replace(d, ~r/S$/, "she swallowed a #{animal}.")
                  "T" -> String.replace(d, ~r/T$/, "to swallow a #{animal}.")
                  _   -> d
                end
              end)
            end)
    {descs, animals}
  end
end

Old_lady.swallowed


USING: base85 compression.zlib ;

"c%1E4%WlIU5WMphn^P`UexSD=s^-?Jk$NVE7-Gs=fQ9_`T}Y~ggi4hvMSb{SX}vpQXJ;^Yqok7%xd(0
mjR3>[email protected]$1#sAzsbTkHfHerT%K*K_NT><Cl4r<3ZyEa}o#KN}<)twov|[email protected]`BE=GXdzugXdWO
s-E}7At$_Vm9CX{KSX)nUpq1~~%N3WyS`ZLg9$IzcccWRh+KGlek2*-;TR+lUB6EZs0X5<&U()_dvQXE
CJ#gDjv>e5yCRDAFrgX{pAnt$DPGHxt*E9$RMRBPeRcoXvT{6xN%[email protected]{fLM`G}XV^A6Hk!HSBn{YM
ylrFhv&t_M?=}Lzm^6W<+00(I)uM#[email protected];[email protected])zDUk;J&o^8C<;g7LlMIS{^*(al_mjFQv=BG_DyZn
<}rUt#FCDtKB9S`Y4jg+0PuB?Qt-&(11p?caq^S=1C`$D1fa<y6|YD*77a{4949T_-MVet;6abaEn"

base85> 3215 <compressed> uncompress >string print


: string, ( c-addr u -- ) \ store string at HERE , with a count
  dup c, here swap dup allot move ;

\ doubly linked list: (0|prev, 0|next, aside?, cstr animal; cstr aside)
\ aside? is true if the aside is always displayed.
variable swallowed
variable first
: >next ( swallow-addr -- swallow-addr' )
  cell+ @ ;
: >aside? ( swallow-addr -- f )
  2 cells + @ ;
: >animal ( swallow-addr -- c-addr u )
  3 cells + count ;
: >aside ( swallow-addr -- c-addr u )
  >animal + count ;

: swallow ( "animal" -- )
  align swallowed @ if here swallowed @ cell+ ! else here first ! then
  here swallowed @ , swallowed !
  0 , 0 , parse-word string, ; \ data structure still needs the aside
: always ( -- )  \ set aside? of last-defined swallow to true
  swallowed @ 2 cells + on ;
: aside ( "aside" -- )
  0 parse string, ;

swallow fly always aside But I don't know why she swallowed the fly,
swallow spider always aside That wriggled and jiggled and tickled inside her;
swallow bird aside Quite absurd, she swallowed the bird;
swallow cat aside Fancy that, she swallowed the cat;
swallow dog aside What a hog, she swallowed the dog;
swallow pig aside Her mouth was so big, she swallowed the pig;
swallow goat aside She just opened her throat, she swallowed the goat;
swallow cow aside I don't know how, she swallowed the cow;
swallow donkey aside It was rather wonky, she swallowed the donkey;

: ?aside ( swallow-addr -- )  \ print aside if aside? is true
  dup >aside? if >aside cr type else drop then ;

: reasons ( swallow-addr -- )  \ print reasons she swallowed something
  begin dup @ while
    dup cr ." She swallowed the " >animal type ."  to catch the "
    @ dup >animal type ." ," dup ?aside
  repeat drop ;

: verse ( swallow-addr -- )
  cr ." There was an old lady who swallowed a " dup >animal type ." ,"
  dup >aside cr type
  reasons
  cr ." Perhaps she'll die!" ;

: song ( -- )
  first @ begin dup verse cr >next dup 0= until drop
  cr ." There was an old lady who swallowed a horse..."
  cr ." She's dead, of course!" ;


program fly
  !A program to print the "Old lady swallowed a fly" poem
  implicit none

  character(len=52), dimension(0:8,2) :: line
  integer :: i,j
  !Define Lines of Poem
  line(1,1) = 'fly'
  line(2,1) = 'spider'
  line(3,1) = 'bird'
  line(4,1) = 'cat'
  line(5,1) = 'dog'
  line(6,1) = 'goat'
  line(7,1) = 'cow'
  line(8,1) = 'horse'
  line(0,2) = "Perhaps she'll die."
  line(1,2) = "I don't know why she swallowed that fly."
  line(2,2) = "That wiggled and jiggled and tickled inside her."
  line(3,2) = "How absurd to swallow a bird."
  line(4,2) = "Imagine that. She swallowed a cat."
  line(5,2) = "What a hog to swallow a dog."
  line(6,2) = "She just opened her throat and swallowed that goat."
  line(7,2) = "I don't know how she swallowed that cow."
  line(8,2) = "She's dead of course."

  !List each verse
  verses:do i = 1,8
     write(*,*) 'There was an old lady who swallowed a '//trim(line(i,1))//"."
     write(*,*) trim(line(i,2))
     !List things swallowed
     swallowed:do j = i,2,-1
        write(*,*) "She swallowed the "//trim(line(j,1))//" to catch the "//trim(line(j-1,1))//","
     end do swallowed
     write(*,*)  trim(line(0,2))
     write(*,*)
  end do verses

end program fly


dim as string lyrics(0 to 7, 0 to 1) = {_
    { "fly", "I don't know why she swallowed a fly - Perhaps she'll die!" },_
    { "spider", "That wriggled and jiggled and tickled inside her!" },_
    { "bird", "How absurd to swallow a bird!" },_
    { "cat", "Imagine that! She swallowed a cat!" },_
    { "dog", "What a hog, to swallow a dog!" },_
    { "goat", "She just opened her throat and swallowed a goat!" },_
    { "cow", "I don't know how she swallowed a cow."},_
    { "horse", "She's dead of course!" } }

for verse as ubyte = 0 to 7
    for countdown as byte = verse to 0 step -1
        if countdown = verse then
            print "There was an old lady who swallowed a "; lyrics(verse, 0);"."
            print lyrics(verse, 1)
            if verse = 7 then end
        end if
        if countdown > 0 then print "She swallowed the ";lyrics(countdown, 0);_
               " to catch the ";lyrics(countdown-1, 0);","
        if countdown = 2 or countdown = 1 then print lyrics(countdown-1, 1)
    next countdown
    print
next verse


(* A mixture of the lyrics found in Wikipedia and the Ada version
   in Rosetta Code. It formats the lyrics like the Wikipedia one  *)
program OldLady;

uses
  SysUtils;

const
  MaxLadies = 9; //Number of iterations and array items
  Animals: array[1..MaxLadies + 1] of shortstring = (  //Add one for the song's end
    'fly',
    'spider',
    'bird',
    'cat',
    'dog',
    'pig',
    'goat',
    'cow',
    'donkey',
    'horse'
    );

  Verse1 = 'There was an old lady who swallowed a %s;';
  //Verse 2 variations
  Verse2Var1 = '   %s'; //Doubles as a spacing formatter
  Verse2Var2 = '   %s to swallow a %s;';
  Verse2Var3 = '   %s and swallowed a %s';
  Verse2Var4 = '   %s she swallowed a %s';
  Verse3 = '   She swallowed the %s to catch the %s;';
  VerseEnd = 'I don''t know why she swallowed a fly - perhaps she''ll die!';
  SongEnd = '   ...She''s dead of course!';

  SwallowResult: array[1..MaxLadies] of shortstring = (
    VerseEnd,
    'That wiggled and jiggled and tickled inside her!',
    'Quite absurd',
    'Fancy that',
    'What a hog,',
    'Her mouth was so big',
    'She just opened her throat',
    'I don''t know how',
    'It was rather wonky'
    );

  procedure PrintSong;
  var
    i, j: byte;
    SwallowStr: shortstring;

  begin
    for i := 1 to MaxLadies do
    begin
      WriteLn(Format(Verse1, [Animals[i]]));
      case i of
        1..2: SwallowStr := Verse2Var1;
        3..5: SwallowStr := Verse2Var2;
        6, 8..9: SwallowStr := Verse2Var4;
        else
          SwallowStr := Verse2Var3;
      end;
      WriteLn(Format(SwallowStr, [SwallowResult[i], Animals[i]]));
      if i >= 2 then
      begin
        for j := i downto 2 do
        begin
          WriteLn(Format(Verse3, [Animals[j], Animals[j - 1]]));
          if (j - 1 = 2) and (i >= 3) then
            WriteLn(Format(Verse2Var1, [SwallowResult[2]]));
        end;
        if j >= 2 then
          WriteLn(Format(Verse2Var1, [VerseEnd]));
      end;
    end;
    WriteLn(Format(Verse1, [Animals[MaxLadies + 1]]));
    WriteLn(SongEnd);
  end;

begin
  PrintSong;
end.


module OldLady where

import Data.List

-- Once means the phrase is only printed in the verse about that animal.
-- Every means the phrase is printed for every verse.  It is used for "fly",
-- and could optionally be used for "spider", in the version of the song where
-- "wriggled and jiggled..." is repeated every verse.
-- Die is only used for the horse, and means the chain of animals won't be
-- included in the verse.
data AnimalAction = Once | Every | Die

animals = [("horse", Die, "She's dead, of course!"),
           ("donkey", Once, "It was rather wonky. To swallow a donkey."),
           ("cow", Once, "I don't know how. To swallow a cow."),
           ("goat", Once, "She just opened her throat. To swallow a goat."),
           ("pig", Once, "Her mouth was so big. To swallow a pig."),
           ("dog", Once, "What a hog. To swallow a dog."),
           ("cat", Once, "Fancy that. To swallow a cat."),
           ("bird", Once, "Quite absurd. To swallow a bird."),
           ("spider", Once, "That wriggled and jiggled and tickled inside her."),
           ("fly", Every, "I don't know why she swallowed the fly.")]

verse :: [(String, AnimalAction, String)] -> [String]
verse ((anim, act, phrase):restAnims) =
  let lns = ["I know an old lady who swallowed a " ++ anim ++ ".", phrase]
  in case act of Die -> lns
                 _ -> lns ++ verse' restAnims anim

verse' :: [(String, AnimalAction, String)] -> String -> [String]
verse' [] _ = ["Perhaps she'll die."]
verse' ((anim, act, phrase):restAnims) prevAnim =
  let why = "She swallowed the " ++ prevAnim ++ " to catch the " ++ anim ++ "."
      lns = case act of Every -> [why, phrase]
                        _ -> [why]
  in lns ++ verse' restAnims anim

song :: [String]
song = concatMap verse $ tail $ reverse $ tails animals

main = putStr $ unlines song


package main

import "fmt"

var name, lyric, animals = 0, 1, [][]string{
	{"fly", "I don't know why she swallowed a fly. Perhaps she'll die."},
	{"spider", "That wiggled and jiggled and tickled inside her."},
	{"bird", "How absurd, to swallow a bird."},
	{"cat", "Imagine that, she swallowed a cat."},
	{"dog", "What a hog, to swallow a dog."},
	{"goat", "She just opened her throat and swallowed that goat."},
	{"cow", "I don't know how she swallowed that cow."},
	{"horse", "She's dead, of course."},
}

func main() {
	for i, animal := range animals {
		fmt.Printf("There was an old lady who swallowed a %s,\n",
			animal[name])

		if i > 0 {
			fmt.Println(animal[lyric])
		}

		// Swallowing the last animal signals her death, cutting the
		//  lyrics short.
		if i+1 == len(animals) {
			break
		}

		for ; i > 0; i-- {
			fmt.Printf("She swallowed the %s to catch the %s,\n",
				animals[i][name], animals[i-1][name])
		}

		fmt.Println(animals[0][lyric] + "\n")
	}
}


import Data.List (tails)

animals :: [String]
animals =
  [ "fly.\nI don't know why she swallowed a fly.\nPerhaps she'll die.\n"
  , "spider.\nThat wiggled and jiggled and tickled inside her."
  , "bird.\t\nHow absurd, to swallow a bird."
  , "cat.\t\nImagine that. She swallowed a cat."
  , "dog.\t\nWhat a hog to swallow a dog."
  , "goat.\t\nShe just opened her throat and swallowed a goat."
  , "cow.\nI don't know how she swallowed a cow."
  , "horse.\nShe's dead, of course."
  ]

beginnings :: [String]
beginnings = ("There was an old lady who swallowed a " ++) <$> animals

lastVerse :: [String]
lastVerse =
  reverse
    [ "She swallowed the " ++
     takeWhile (/= '.') y ++ " to catch the " ++ takeWhile (/= '\t') x
    | (x:y:_:_) <- tails animals ]

main :: IO ()
main =
  putStr $
  concatMap unlines $
  zipWith (:) beginnings $ reverse $ ([] :) (tails lastVerse)


procedure main()  #:  There Was An Old Lady Lyrics

verse := table()   # arglists for printf - [1] long asides and [2] terse joiners
verse["bird"]   := [["%s,\nQuite absurd, %s %s;\n",1,2,1],["%s,\n",1]]
verse["cat"]    := [["%s,\nFancy that, %s %s;\n",1,2,1],["%s,\n",1]]
verse["dog"]    := [["%s,\nWhat a hog, %s %s;\n",1,2,1],["%s,\n",1]]
verse["pig"]    := [["%s,\nHer mouth was so big, %s %s;\n",1,2,1],["%s,\n",1]]
verse["goat"]   := [["%s,\nShe just opened her throat, %s %s;\n",1,2,1],["%s,\n",1]]
verse["cow"]    := [["%s,\nI don't know how, %s %s;\n",1,2,1],["%s,\n",1]]
verse["donkey"] := [["%s,\nIt was rather wonky, %s %s;\n",1,2,1],["%s,\n",1]]

                   # just long versions of these
verse["fly"]    := [["%s,\nBut I don't know why %s %s,\nPerhaps she'll die!\n\n",1,2,1]]
verse["spider"] := [["%s,\nThat wriggled and jiggled and tickled inside her;\n",1]]
verse["horse"]  := [["%s...\nShe's dead, of course!\n",1]]

every (f := verse[k := key(verse)][1|2])[i := 1 to *f] do   # fix every printf args
   f[i] := case f[i] of { 1 : k ; 2 : "she swallowed the"; default : f[i]}

zoofilo := []
"fly,spider,bird,cat,dog,pig,goat,cow,donkey,horse," ?   # order
   while push(zoofilo,tab(find(","))) & move(1) do {
      printf("There was an old lady who swallowed a ")
      every critter := !zoofilo do {
         printf!verse[critter,(critter == (zoofilo[1] | "spider" | "fly"),1)|2]
         if critter == "horse" then stop()               # dead
         printf("She swallowed the %s to catch the ","fly" ~== critter)
         }
      }
end

link printf


T=:''
e=:3 :'T=:T,y,LF'
E=:[email protected],&'.'
O=:'I know an old lady who swallowed a '[email protected],]
I=:e bind('I don''t know why she swallowed the fly.',LF,'Perhaps she''ll die.',LF)
I O 'fly'
O P=:'spider'
E 'That wriggled and jiggled and tickled inside her'
I E A=:'She swallowed the spider to catch the fly'
N=:4 :0
  O x
  E y,'. To swallow a ',x
  I E A=:'She swallowed the ',x,' to catch the ',P,'.',LF,A
  P=:x
)
'Bird'N'Quite absurd'
'Cat'N'Fancy that'
'Dog'N'What a hog'
'Pig'N'Her mouth was so big'
'Goat'N'She just opened her throat'
'Cow'N'I don''t know how'
'Donkey'N'It was rather wonky'
O'Horse'
e'She''s dead, of course!'


public class OldLadySwallowedAFly {

    final static String[] data = {
        "_ha _c _e _p,/Quite absurd_f_p;_`cat,/Fancy that_fcat;_j`dog,/What a hog"
        + "_fdog;_l`pig,/Her mouth_qso big_fpig;_d_r,/She just opened her throat_f_"
        + "r;_icow,/_mhow she_ga cow;_k_o,/It_qrather wonky_f_o;_a_o_bcow,_khorse.."
        + "./She's dead, of course!/", "_a_p_b_e ", "/S_t ", " to catch the ", "fly,/Bu"
        + "t _mwhy s_t fly,/Perhaps she'll die!//_ha", "_apig_bdog,_l`", "spider,/Tha"
        + "t wr_nj_ntickled inside her;_aspider_b_c", ", to_s a ", "_sed ", "There_qan"
        + " old lady who_g", "_a_r_bpig,_d", "_acat_b_p,_", "_acow_b_r,_i", "_adog_bcat"
        + ",_j", "I don't know ", "iggled and ", "donkey", "bird", " was ", "goat", " swal"
        + "low", "he_gthe"};

    static boolean oldLady(String part, boolean s) {
        for (char c : part.toCharArray()) {
            if (s)
                s = oldLady(data[c - '_'], false);
            else if (c == '_')
                s = true;
            else
                System.out.print(c == '/' ? '\n' : c);
        }
        return s;
    }

    public static void main(String[] args) {
        oldLady(data[0], false);
    }
}


using CodecZlib

b64 = b"""eNrtVE1rwzAMvedXaKdeRn7ENrb21rHCzmrs1m49K9gOJv9+cko/HBcGg0LHcpOfnq2np0QL
    2FuKgBbICDAoeoiKwEc0hqIUgLAxfV0tQJCdhQM7qh68kheswKeBt5ROYetTemYMCC3rii//
    WMS3WkhXVyuFAaLT261JuBWwu4iDbvYp1tYzHVS68VEIObwFgaDB0KizuFs38aSdqKv3TgcJ
    uPYdn2B1opwIpeKE53qPftxRd88Y6uoVbdPzWxznrQ3ZUi3DudQ/bcELbevqM32iCIrj3IIh
    W6plOJf6L6xaajZjzqW/qAsKIvITBGs9Nm3glboZzkVP5l6Y+0bHLnedD0CttIyrpEU5Kv7N
    Mz3XkPBc/TSN3yxGiqMiipHRekycK0ZwMhM8jerGC9zuZaoTho3kMKSfJjLaF8v8wLzmXMqM
    zJvGew/jnZPzclA08yAkikegDTTUMfzwDXBcwoE="""
println(String(transcode(ZlibDecompressor(), base64decode(b64))))


// version 1.1.3

val animals = listOf("fly", "spider", "bird", "cat","dog", "goat", "cow", "horse")

val phrases = listOf(
    "",
    "That wriggled and jiggled and tickled inside her",
    "How absurd to swallow a bird",
    "Fancy that to swallow a cat",
    "What a hog, to swallow a dog",
    "She just opened her throat and swallowed a goat",
    "I don't know how she swallowed a cow",
    "\n  ...She's dead of course"
)

fun sing() {
    for (i in 0..7) {
       println("There was an old lady who swallowed a ${animals[i]};")
       if (i > 0) println("${phrases[i]}!")
       if (i == 7) return
       println()
       if (i > 0) {
           for (j in i downTo 1) {
               print("  She swallowed the ${animals[j]} to catch the ${animals[j - 1]}")
               println(if (j < 3) ";" else ",")
               if (j == 2) println("  ${phrases[1]}!")
           }
       }
       println("  I don't know why she swallowed a fly - Perhaps she'll die!\n")
    }
}

fun main(args: Array<String>) {
    sing()
}


{def A {A.new fly spider bird cat dog goat cow horse}}
-> A

{def H
 {H.new
   fly    I don't know why she swallowed that fly{br}Perhaps she'll die |
   spider That wiggled and jiggled and tickled inside her |
   bird   How absurd, to swallow a bird |
   cat    Imagine that. She swallowed a cat |
   dog    What a hog to swallow a dog |
   goat   She just opened her throat and swallowed that goat |
   cow    I don't know how she swallowed that cow |
   horse  She's dead of course
}}
-> H

{def oldlady {lambda {:w} There was an old lady who swallowed a :w}}
-> oldlady

{def swallow {lambda {:a :b} She swallowed the :a to catch the :b}}
-> swallow

Writing

{hr}{oldlady {A.get 0 {A}}}
{H.get {A.get 0 {A}} {H}}

{S.map {lambda {:i}
               {hr}{oldlady {A.get :i {A}}}
               {br}{H.get {A.get :i {A}} {H}}
               {S.map {lambda {:j} {br}* {swallow {A.get :j {A}}
                                                  {A.get {- :j 1} {A}}}}
                      {S.serie :i 1 -1}}
               {br}{H.get {A.get 0 {A}} {H}} }
       {S.serie 1 6}}

{hr}{oldlady {A.get 7 {A}}}
{H.get {A.get 7 {A}} {H}}

displays:

There was an old lady who swallowed a fly
I don't know why she swallowed that fly
Perhaps she'll die

There was an old lady who swallowed a spider
That wiggled and jiggled and tickled inside her
* She swallowed the spider to catch the fly
I don't know why she swallowed that fly
Perhaps she'll die

There was an old lady who swallowed a bird
How absurd, to swallow a bird
* She swallowed the bird to catch the spider
* She swallowed the spider to catch the fly
I don't know why she swallowed that fly
Perhaps she'll die

...

There was an old lady who swallowed a cow
I don't know how she swallowed that cow
* She swallowed the cow to catch the goat
* She swallowed the goat to catch the dog
* She swallowed the dog to catch the cat
* She swallowed the cat to catch the bird
* She swallowed the bird to catch the spider
* She swallowed the spider to catch the fly
I don't know why she swallowed that fly
Perhaps she'll die

There was an old lady who swallowed a horse
She's dead of course


'[RC] Old lady swallowed a fly
'http://rosettacode.org/wiki/Old_lady_swallowed_a_fly
'lyrics
'http://www.timmyabell.com/music/lyrics/ol/oldlady.htm

animalList$="fly spider bird cat dog goat cow horse"
reason$(1)="I don't know why she swallowed the fly,"
reason$(2)="That wriggled and jiggled and tickled inside her."
reason$(3)="How absurd to swallow a bird!"
reason$(4)="Imagine that, to swallow a cat!"
reason$(5)="My, what a hog, to swallow a dog!"
reason$(6)="Just opened her throat and swallowed a goat!"
reason$(7)="I wonder how she swallowed a cow?!"
reason$(8)="She's dead, of course!!"

i=0
while 1
    i=i+1
    animal$ = word$(animalList$, i)
    if animal$ ="" then exit while
    verse$ = "I know an old lady who "
    verse2$ = "swallowed a " +animal$
    print verse$ +verse2$+","
    print reason$(i)
    if i = 8 then end
    '--------------
    animals$=animal$+" "+animals$
    animal2$="*"
    j=1
    while 1
        j=j+1
        animal2$ = word$(animals$, j)
        if animal2$ ="" then exit while
        reason$="She swallowed the "+animal$+" to catch the "+animal2$+","
        animal$ = animal2$
        print reason$
        if animal2$ = "fly" then print reason$(1)
        if animal2$ = "spider" then print reason$(2)
    wend
    '--------------
    print "I guess she'll die."
    print
wend

end


make "data [
; animal inc comment
  [fly    2 [I don't know why she swallowed that fly]]
  [spider 2 [That wriggled and jiggled and tickled inside her]]
  [bird   1 [Quite absurd, to swallow a bird]]
  [cat    1 [How about that, to swallow a cat]]
  [dog    1 [What a hog, to swallow a dog]]
  [pig    1 [Her mouth was so big to swallow a pig]]
  [goat   1 [She just opened her throat to swallow a goat.]]
  [cow    1 [I don't know how she swallowed a cow.]]
  [donkey 1 [It was rather wonky to swallow a donkey]]
  [horse  0 [She's dead, of course!]]
]

foreach :data [
  local "i make "i #
  (local "animal "include "comment)
  (foreach [animal include comment] ? "make)
  print se [There was an old lady who swallowed a] :animal
  print :comment
  if greater? :include 0 [
    if greater? :i 1 [
      repeat difference :i 1 [
        local "j make "j difference :i repcount
        print (se [She swallowed the] (first item sum 1 :j :data)
                  [to catch the] (first item :j :data))
        if greater? item 2 item :j :data 1 [print item 3 item :j :data]
      ]
    ]
    print [Perhaps she'll die]
    print "
  ]
]

bye


animals = {"fly", "spider", "bird", "cat","dog", "goat", "cow", "horse"}
phrases = {
    "",
    "That wriggled and jiggled and tickled inside her",
    "How absurd to swallow a bird",
    "Fancy that to swallow a cat",
    "What a hog, to swallow a dog",
    "She just opened her throat and swallowed a goat",
    "I don't know how she swallowed a cow",
    "  ...She's dead of course"
}

for i=0,7 do
    io.write(string.format("There was an old lady who swallowed a %s\n", animals[i+1]))
    if i>0 then io.write(phrases[i+1]) end
    if i==7 then break end
    if i>0 then
        io.write("\n")
        for j=i,1,-1 do
            io.write(string.format("She swallowed the %s to catch the %s", animals[j+1], animals[j]))
            -- if j<4 then p='.' else p=',' end
            -- io.write(string.format("%s\n", p))
            io.write("\n")
            if j==2 then
                io.write(string.format("%s!\n", phrases[2]))
            end
        end
    end
    io.write("I don't know why she swallowed a fly - Perhaps she'll die!\n\n")
end


            NORMAL MODE IS INTEGER

            INTERNAL FUNCTION(V)
            ENTRY TO VERSE.
            TRANSFER TO VS(V+1)
VS(1)       PRINT COMMENT$ I DON'T KNOW WHY SHE SWALLOWED THAT FLY$
            PRINT COMMENT$ PERHAPS SHE'LL DIE$
            PRINT COMMENT$ $
            FUNCTION RETURN V
VS(2)       PRINT COMMENT
          0      $ THAT WIGGLED AND JIGGLED AND TICKLED INSIDE HER$
            FUNCTION RETURN V
VS(3)       PRINT COMMENT$ HOW ABSURD TO SWALLOW A BIRD!$
            FUNCTION RETURN V
VS(4)       PRINT COMMENT$ IMAGINE THAT - SHE SWALLOWED A CAT!$
            FUNCTION RETURN V
VS(5)       PRINT COMMENT$ WHAT A HOG TO SWALLOW A DOG$
            FUNCTION RETURN V
VS(6)       PRINT COMMENT
          0   $ SHE JUST OPENED HER THROAT AND SWALLOWED THAT GOAT$
            FUNCTION RETURN V
VS(7)       PRINT COMMENT$ I DON'T KNOW HOW SHE SWALLOWED THAT COW$
            FUNCTION RETURN V
VS(8)       PRINT COMMENT$ SHE'S DEAD, OF COURSE.$
            END OF FUNCTION

            VECTOR VALUES ANIMAL =
          0  $FLY$,$SPIDER$,$BIRD$,$CAT$,$DOG$,$GOAT$,$COW$,$HORSE$

            VECTOR VALUES LADY =
          0      $38HTHERE WAS AN OLD LADY WHO SWALLOWED A ,C,1H,*$

            VECTOR VALUES SWALLO =
          0    $18HSHE SWALLOWED THE ,C,S1,13HTO CATCH THE ,C,1H,*$

            THROUGH VERSE, FOR I=0, 1, I.G.7
            PRINT FORMAT LADY, ANIMAL(I)
            VERSE.(I)
            THROUGH VERSE, FOR J=I, -1, J.E.0 .OR. I.GE.7
            PRINT FORMAT SWALLO, ANIMAL(J), ANIMAL(J-1)
VERSE       WHENEVER J.LE.2, VERSE.(J-1)

            END OF PROGRAM


swallowed := ["fly", "spider", "bird", "cat", "dog", "cow", "horse"]:
phrases := ["I don't know why she swallowed a fly, perhaps she'll die!",
		  "That wriggled and wiggled and tiggled inside her.",
		  "How absurd to swallow a bird.",
		  "Fancy that to swallow a cat!",
		  "What a hog, to swallow a dog.",
		  "I don't know how she swallowed a cow.",
		  "She's dead, of course."]:
for i to numelems(swallowed) do
	printf("There was an old lady who swallowed a %s.\n%s\n", swallowed[i], phrases[i]);
	if i > 1 and i < 7 then
		for j from i by -1 to 2 do
			printf("\tShe swallowed the %s to catch the %s.\n", swallowed[j], swallowed[j-1]);
		end do;
		printf("%s\n\n", phrases[1]);
	elif i = 1 then
		printf("\n");
	end if;
end do;


animals = {"fly", "spider", "bird", "cat", "dog", "goat", "cow",
   "horse"};
notes = {"", "That wiggled and jiggled and tickled inside her.\n",
   "How absurd, to swallow a bird.\n",
   "Imagine that. She swallowed a cat.\n",
   "What a hog to swallow a dog.\n",
   "She just opened her throat and swallowed that goat.\n",
   "I don't know how she swallowed that cow.\n",
   "She's dead, of course.",
   "I don't know why she swallowed that fly.\nPerhaps she'll die.\n\n\
"};
Print[StringJoin @@ ("There was an old lady who swallowed a " <>
       animals[[#]] <> ".\n" <> notes[[#]] <>
       If[# == 8, "",
        StringJoin @@ ("She swallowed the " <> animals[[#]] <>
              " to catch the " <> animals[[# - 1]] <> ".\n" & /@
            Range[#, 2, -1]) <> notes[[9]]] & /@ Range[8])];


:- module oldlady.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module list, string.

:- type animal
    --->    horse
    ;       donkey
    ;       cow
    ;       goat
    ;       pig
    ;       dog
    ;       cat
    ;       bird
    ;       spider
    ;       fly.

:- func verse(animal) = string.
verse(horse)    = "She's dead, of course!".
verse(donkey)   = "It was rather wonky. To swallow a donkey.".
verse(cow)      = "I don't know how. To swallow a cow.".
verse(goat)     = "She just opened her throat. To swallow a goat.".
verse(pig)      = "Her mouth was so big. To swallow a pig.".
verse(dog)      = "What a hog. To swallow a dog.".
verse(cat)      = "Fancy that. To swallow a cat.".
verse(bird)     = "Quite absurd. To swallow a bird.".
verse(spider)   = "That wriggled and jiggled and tickled inside her.".
verse(fly)      = "I don't know why she swallowed the fly.".

:- pred tocatch(animal, animal).
:- mode tocatch(in, out) is semidet.
:- mode tocatch(out, in) is semidet.
tocatch(horse, donkey).
tocatch(donkey, cow).
tocatch(cow, goat).
tocatch(goat, pig).
tocatch(pig, dog).
tocatch(dog, cat).
tocatch(cat, bird).
tocatch(bird, spider).
tocatch(spider, fly).

:- pred swallow(animal::in, io::di, io::uo) is det.
swallow(A, !IO) :-
    ( if tocatch(A, B) then
        io.format("She swallowed the %s to catch the %s.\n",
            [s(string(A)), s(string(B))], !IO),
        swallow(B, !IO)
    else
        io.format("%s\nPerhaps she'll die.\n\n", [s(verse(fly))], !IO)
    ).

:- pred swallowed(animal::in, io::di, io::uo) is det.
swallowed(A, !IO) :-
    io.format("I know an old lady who swallowed a %s.\n", [s(string(A))], !IO),
    ( if A = horse then
        io.write_string("She's dead, of course!\n", !IO)
    else if A = fly, tocatch(B, A) then
        swallow(A, !IO),
        swallowed(B, !IO)
    else if tocatch(B, A) then
        io.write_string(verse(A), !IO),
        io.nl(!IO),
        swallow(A, !IO),
        swallowed(B, !IO)
    else
        true
    ).

main(!IO) :-
    swallowed(fly, !IO).


MODULE OldLady;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;

TYPE
    AA = ARRAY[0..7] OF ARRAY[0..7] OF CHAR;
    VA = ARRAY[0..7] OF ARRAY[0..63] OF CHAR;
VAR
    buf : ARRAY[0..127] OF CHAR;
    animals : AA;
    verses : VA;
    i,j : INTEGER;
BEGIN
    FormatString("I don't know why she swallowed that fly.\nPerhaps she'll die\n", buf);

    animals := AA{"fly", "spider", "bird", "cat", "dog", "goat", "cow", "horse"};
    verses := VA{
        "I don't know why she swallowed that fly.",
        "That wiggled and jiggled and tickled inside her",
        "How absurd, to swallow a bird",
        "Imagine that. She swallowed a cat",
        "What a hog to swallow a dog",
        "She just opened her throat and swallowed that goat",
        "I don't know how she swallowed that cow",
        "She's dead of course"
    };

    FOR i:=0 TO 7 DO
        FormatString("There was an old lady who swallowed a %s\n%s\n", buf, animals[i], verses[i]);
        WriteString(buf);
        IF i=0 THEN
            WriteString("Perhaps she'll die");
            WriteLn;
            WriteLn;
        END;
        j := i;
        WHILE (j>0) AND (i<7) DO
            FormatString("She swallowed the %s to catch the %s\n", buf, animals[j], animals[j-1]);
            WriteString(buf);
            IF j=1 THEN
                WriteString(verses[0]);
                WriteLn;
                WriteString("Perhaps she'll die");
                WriteLn;
                WriteLn
            END;
            DEC(j)
        END;
    END;

    ReadChar
END OldLady.


reason          = {"She swallowed the ", " to catch the "}
creatures       = {"fly", "spider", "bird", "cat", "dog", "goat", "cow", "horse"}
comments        = {"I don't know why she swallowed that fly.\nPerhaps she'll die\n",\
                   "That wiggled and jiggled and tickled inside her",\
                   "How absurd, to swallow a bird",\
                   "Imagine that. She swallowed a cat",\
                   "What a hog to swallow a dog",\
                   "She just opened her throat and swallowed that goat",\
                   "I don't know how she swallowed that cow",\
                   "She's dead of course"}

max = len(creatures)
for i in range(0, max - 1)
    println "There was an old lady who swallowed a " + creatures[i]
    println comments[i]
    for (j = i) ((j > 0) && (i < (max - 1))) (j -= 1)
        println reason[0] + creatures[j] + reason[1] + creatures[j - 1]
        if j = 1
            println comments[j - 1]
        end
    end
end

input()


import zip/zlib, base64

const b64 = """
eNrtVE1rwzAMvedXaKdeRn7ENrb21rHCzmrs1m49K9gOJv9+cko/HBcGg0LHcpOfnq2np0QL
2FuKgBbICDAoeoiKwEc0hqIUgLAxfV0tQJCdhQM7qh68kheswKeBt5ROYetTemYMCC3rii//
WMS3WkhXVyuFAaLT261JuBWwu4iDbvYp1tYzHVS68VEIObwFgaDB0KizuFs38aSdqKv3TgcJ
uPYdn2B1opwIpeKE53qPftxRd88Y6uoVbdPzWxznrQ3ZUi3DudQ/bcELbevqM32iCIrj3IIh
W6plOJf6L6xaajZjzqW/qAsKIvITBGs9Nm3glboZzkVP5l6Y+0bHLnedD0CttIyrpEU5Kv7N
Mz3XkPBc/TSN3yxGiqMiipHRekycK0ZwMhM8jerGC9zuZaoTho3kMKSfJjLaF8v8wLzmXMqM
zJvGew/jnZPzclA08yAkikegDTTUMfzwDXBcwoE="""

echo b64.decode.uncompress()


my @animals = (
	"fly",
	"spider/That wriggled and jiggled and tickled inside her.\n",
	"bird//Quite absurd!",
	"cat//Fancy that!",
	"dog//What a hog!",
	"pig//Her mouth was so big!",
	"goat//She just opened her throat!",
	"cow//I don't know how;",
	"donkey//It was rather wonkey!",
	"horse:",
);

my $s = "swallow";
my $e = $s."ed";
my $t = "There was an old lady who $e a ";
my $_ = $t."But I don't know why she $e the fly;\nPerhaps she'll die!\n\n";

my ($a, $b, $c, $d);
while (my $x = shift @animals) {
	s/$c//;
	($a, $b, $c) = split('/', $x);
	$d = " the $a";

	$c =~ s/;/ she $e$d;\n/;
	$c =~ s/!/, to $s$d;\n/;

	s/$t/"$t$a,\n$c".(($b||$c) && "${b}She $e$d to catch the ")/e;

	s/:.*/--\nShe's dead, of course!\n/s;
	print;
}


with javascript_semantics
sequence lines = {"Perhaps she'll die!\n"}, animals = {}

procedure swallow(string animal, second_line, integer permanent_second_line=TRUE)
    printf(1,"There was an old lady who swallowed a %s,\n%s\n",{animal,second_line})
    if length(animals)!=0 then
        lines = prepend(lines,sprintf("She swallowed the %s to catch the %s,\n",{animal,animals[$]}))
    end if
    printf(1,"%s\n",{join(lines,"")})
    if permanent_second_line then
        lines = prepend(lines,second_line&"\n")
    end if
    animals = append(animals,animal)
end procedure

procedure swallow_all(sequence all)
    for i=1 to length(all) do
        string {animal,line2} = all[i]
        swallow(animal, sprintf("%s, %s a %s;",{line2,iff(animal="cow"?"she swallowed":"to swallow"),animal}), FALSE);
    end for
end procedure

swallow("fly", "But I don't know why she swallowed the fly,");
swallow("spider",  "That wriggled and jiggled and tickled inside her;");
swallow_all({{"bird", "Quite absurd"},{"cat", "Fancy that"},{"dog", "What a hog"},
             {"pig", "Her mouth was so big"},{"goat","She just opened her throat"},
             {"cow", "I don't know how"},{"donkey", "It was rather wonky"}})
printf(1, "There was an old lady who swallowed a horse ...\nShe's dead, of course!")


<?php

$swallowed = array(
  array('swallowed' => 'fly.',
        'reason' => "I don't know why she swallowed the fly."),
  array('swallowed' => 'spider,',
        'aside' => "which wiggled and jiggled and tickled inside her.",
        'reason' => "She swallowed the spider to catch the fly"),
  array('swallowed' => 'bird.',
        'aside' => "How absurd! To swallow a bird!",
        'reason' => "She swallowed the bird to catch the spider,"),
  array('swallowed' => 'cat.',
        'aside' => "Imagine that! To swallow a cat!",
        'reason' => "She swallowed the cat to catch the bird."),
  array('swallowed' => 'dog.',
        'aside' => "What a hog! To swallow a dog!",
        'reason' => "She swallowed the dog to catch the cat."),
  array('swallowed' => 'horse',
        'aside' => "She's dead, of course. She swallowed a horse!",
        'reason' => "She swallowed the horse to catch the dog."));

foreach($swallowed as $creature)
{
  print "I knew an old lady who swallowed a " . $creature['swallowed'] . "\n";
  if(array_key_exists('aside', $creature))
    print $creature['aside'] . "\n";

  $reversed = array_reverse($swallowed);
  $history = array_slice($reversed, array_search($creature, $reversed));

  foreach($history as $note)
  {
    print $note['reason'] . "\n";
  }

  if($swallowed[count($swallowed) - 1] == $creature)
    print "But she sure died!\n";
  else
    print "Perhaps she'll die." . "\n\n";
}


(de *Dict
   `(chop
      "_ha _c _e _p,/Quite absurd_f_p;_`cat,/Fancy that_fcat;_j`dog,\
         /What a hog_fdog;_l`pig,/Her mouth_qso big_fpig;_d_r,/She just \
         opened her throat_f_r;_icow,/_mhow she_ga cow;_k_o,/It_qrather \
         wonky_f_o;_a_o_bcow,_khorse.../She's dead, of course!/" )
   `(chop "_a_p_b_e ")
   `(chop "/S_t ")
   `(chop " to catch the ")
   `(chop "fly,/But _mwhy s_t fly,/Perhaps she'll die!//_ha")
   `(chop "_apig_bdog,_l`")
   `(chop "spider,/That wr_nj_ntickled inside her;_aspider_b_c")
   `(chop ", to_s a ")
   `(chop "_sed ")
   `(chop "There_qan old lady who_g")
   `(chop "_a_r_bpig,_d")
   `(chop "_acat_b_p,_")
   `(chop "_acow_b_r,_i")
   `(chop "_adog_bcat,_j")
   `(chop "I don't know ")
   `(chop "iggled and ")
   `(chop "donkey")
   `(chop "bird")
   `(chop " was ")
   `(chop "goat")
   `(chop " swallow")
   `(chop "he_gthe") )

(de oldLady (Lst Flg)
   (loop
      (let C (pop 'Lst)
         (cond
            (Flg
               (setq Flg
                  (oldLady (get *Dict (- (char C) 94))) ) )
            ((= "_" C) (on Flg))
            ((= "/" C) (prinl))
            (T (prin C)) ) )
      (NIL Lst) )
   Flg )

(oldLady (car *Dict))


100H:

/* CP/M CALL */
BDOS: PROCEDURE(FUNC, ARGS);
    DECLARE FUNC BYTE, ARGS ADDRESS;
    GO TO 5;
END BDOS;

/* PRINT STRING */
PRINT: PROCEDURE(STRING);
    DECLARE STRING ADDRESS;
    CALL BDOS(9, STRING);
END PRINT;

DECLARE COMMA$CRLF DATA (',',13,10,'$');
DECLARE CRLF DATA (13,10,'$');

DECLARE ANIMALS (8) ADDRESS;
ANIMALS(0) = .'FLY$';
ANIMALS(1) = .'SPIDER$';
ANIMALS(2) = .'BIRD$';
ANIMALS(3) = .'CAT$';
ANIMALS(4) = .'DOG$';
ANIMALS(5) = .'GOAT$';
ANIMALS(6) = .'COW$';
ANIMALS(7) = .'HORSE$';

DECLARE VERSES (8) ADDRESS;
VERSES(0) = .('I DON''T KNOW WHY SHE SWALLOWED THAT FLY',
              ' - PERHAPS SHE''LL DIE.',10,13,'$');
VERSES(1) = .'THAT WIGGLED AND JIGGLED AND TICKLED INSIDE HER$';
VERSES(2) = .'HOW ABSURD TO SWALLOW A BIRD$';
VERSES(3) = .'IMAGINED THAT - SHE SWALLOWED A CAT$';
VERSES(4) = .'WHAT A HOG TO SWALLOW A DOG$';
VERSES(5) = .'SHE JUST OPENED HER THROAT AND SWALLOWED THAT GOAT$';
VERSES(6) = .'I DON''T KNOW HOW SHE SWALLOWED THAT COW$';
VERSES(7) = .'SHE''S DEAD, OF COURSE.$';

DECLARE (I, J) BYTE;
DO I = 0 TO LAST(VERSES);
    CALL PRINT(.'THERE WAS AN OLD LADY WHO SWALLOWED A $');
    CALL PRINT(ANIMALS(I));
    CALL PRINT(.COMMA$CRLF);
    CALL PRINT(VERSES(I));
    CALL PRINT(.CRLF);

    J = I;
    DO WHILE J > 0 AND I < LAST(ANIMALS);
        CALL PRINT(.'SHE SWALLOWED THE $');
        CALL PRINT(ANIMALS(J));
        CALL PRINT(.' TO CATCH THE $');
        CALL PRINT(ANIMALS(J-1));
        CALL PRINT(.COMMA$CRLF);
        IF J <= 2 THEN DO;
            CALL PRINT(VERSES(J-1));
            CALL PRINT(.CRLF);
        END;
        J = J - 1;
    END;
END;

CALL BDOS(0,0);
EOF


$lines = @(
    'fly/'
    'spider/That wiggled and jiggled and tickled inside her,'
    'bird/How absurd, to swallow a bird,'
    'cat/Imagine that. She swallowed a cat,'
    'dog/What a hog to swallow a dog,'
    'goat/She just opened her throat and swallowed that goat,'
    'cow/I don''t know how she swallowed that cow,'
    'horse/She''s dead of course!'
)

$eatenThings = @()

for($i=0; $i -lt $lines.Count; $i++)
{
    $creature, $comment = $lines[$i].Split("/")
    $eatenThings += $creature

    "I know an old lady who swallowed a $creature,"

    if ($comment) {$comment}
    if ($i -eq ($lines.Count - 1)) {continue}

    for($j=$i; $j -ge 1; $j--)
    {
        "She swallowed the {0} to catch the {1}," -f $eatenThings[$j, ($j-1)]
    }

	"I don't know why she swallowed the fly."
	"Perhaps she'll die."
	""
}


import zlib, base64

b64 = b'''
eNrtVE1rwzAMvedXaKdeRn7ENrb21rHCzmrs1m49K9gOJv9+cko/HBcGg0LHcpOfnq2np0QL
2FuKgBbICDAoeoiKwEc0hqIUgLAxfV0tQJCdhQM7qh68kheswKeBt5ROYetTemYMCC3rii//
WMS3WkhXVyuFAaLT261JuBWwu4iDbvYp1tYzHVS68VEIObwFgaDB0KizuFs38aSdqKv3TgcJ
uPYdn2B1opwIpeKE53qPftxRd88Y6uoVbdPzWxznrQ3ZUi3DudQ/bcELbevqM32iCIrj3IIh
W6plOJf6L6xaajZjzqW/qAsKIvITBGs9Nm3glboZzkVP5l6Y+0bHLnedD0CttIyrpEU5Kv7N
Mz3XkPBc/TSN3yxGiqMiipHRekycK0ZwMhM8jerGC9zuZaoTho3kMKSfJjLaF8v8wLzmXMqM
zJvGew/jnZPzclA08yAkikegDTTUMfzwDXBcwoE='''
print(zlib.decompress(base64.b64decode(b64)).decode("utf-8", "strict"))


animals = list(
  c("fly", "I don't know why she swallowed a fly, perhaps she'll die."),
  c("spider", "It wiggled and jiggled and tickled inside her."),
  c("bird", "How absurd, to swallow a bird."),
  c("cat", "Imagine that, she swallowed a cat."),
  c("dog", "What a hog, to swallow a dog."),
  c("goat", "She just opened her throat and swallowed a goat."),
  c("cow", "I don't know how she swallowed a cow."),
  c("horse", "She's dead, of course.")
)

oldladyalive <- TRUE
oldladysnack <- 1

while(oldladyalive == TRUE) {
  nextmeal <- animals[[oldladysnack]][1]
  nextcomment <- animals[[oldladysnack]][2]
  print(sprintf("There was an old lady who swallowed a %s. %s",nextmeal,nextcomment))

  if(oldladysnack == 8){
    oldladyalive <- FALSE # she ate a horse :(
  } else if(oldladysnack > 1) {
    for(i in oldladysnack:2) {
      print(sprintf("    She swallowed the %s to catch the %s",
              animals[[i]][1], #e.g. spider (to catch the...
              animals[[i-1]][1])) # fly)

    }
    print(animals[[1]][2])
  }
  oldladysnack <- oldladysnack + 1
}


#lang at-exp racket

(define (line . xs) (for-each display xs) (newline))

(let loop ([animals
            '([fly #f]
              [spider "That wriggled and wiggled and tiggled inside her"]
              [bird   "How absurd to swallow a bird"]
              [cat    "Fancy that to swallow a cat"]
              [dog    "What a hog, to swallow a dog"]
              [cow    "I don't know how she swallowed a cow"]
              [horse  "She's dead, of course"])]
           [seen '()])
  (when (pair? animals)
    (match animals
      [(list (list animal desc) more ...)
       @line{There was an old lady that swallowed a @animal,}
       (when desc @line{@|desc|.})
       (when (pair? more)
         (for ([this (cons animal seen)] [that seen])
           @line{She swallowed the @this to catch the @that,})
         @line{I don't know why she swallowed a fly - perhaps she'll die!}
         @line{}
         (loop more (cons animal seen)))])))


my @victims =
    fly    => "  I don't know why S—",
    spider => "  That wriggled and jiggled and tickled inside her.",
    bird   => "  How absurd, T!",
    cat    => "  Fancy that, S!",
    dog    => "  What a hog, T!",
    goat   => "  She just opened her throat, and in walked the goat!",
    cow    => "  I don't know how S!",
    horse  => "  She's dead, of course...";

my @history = "I guess she'll die...\n";

for (flat @victims».kv) -> $victim, $_ is copy {
    say "There was an old lady who swallowed a $victim...";

    s/ «S» /she swallowed the $victim/;
    s/ «T» /to swallow a $victim!/;
    .say;
    last when /dead/;

    @history[0] ~~ s/^X/She swallowed the $victim/;
    .say for @history;
    @history.unshift($_) if @history < 5;
    @history.unshift("X to catch the $victim,");
}


/*REXX program displays  song lyrics  for:   "I Know an Old Lady who Swallowed a Fly".  */
sw= 79                                           /*the width of the terminal screen, -1.*/
@.=;            @.1 = "I don't know why she swallowed a fly,"
                @.2 = "That wriggled and jiggled and tickled inside her.";    @.2.0=.
                @.3 = "How absurd to swallow a bird!"
                @.4 = "Imagine that, to swallow a cat!"
                @.5 = "My, what a hog, to swallow a dog!"
                @.6 = "Just opened her throat and swallowed a goat!"
                @.7 = "I wonder how she swallowed a cow?!"
                @.8 = "She's dead, of course!!"
$ = 'fly spider bird cat dog goat cow horse'
#= words($)                                      /*#:  number of animals to be swallowed*/

  do j=1  for #;        say
  say center('I know an old lady who swallowed a'     word($, j)",",  sw)
  if j\==1  then  say center(@.j, sw)
  if j ==#  then leave                           /*Is this the last verse?   We're done.*/
                      do k=j  to 2  by -1;      km= k-1;              ??= word($, km)','
                      say center('She swallowed the'   word($,k)  "to catch the"   ??, sw)
                      if @.km.0\==''  then say center(@.km, sw)
                      end   /*k*/                /* [↑]  display the lyrics of the song.*/
  say center(@.1, sw)
  say center("I guess she'll die.", sw)
  end   /*j*/                                    /*stick a fork in it,  we're all done. */


descriptions = {
  :fly    => "I don't know why S",
  :spider => "That wriggled and jiggled and tickled inside her.",
  :bird   => "Quite absurd T",
  :cat    => "Fancy that, S",
  :dog    => "What a hog, S",
  :goat   => "She opened her throat T",
  :cow    => "I don't know how S",
  :horse  => "She's dead, of course.",
}
animals = descriptions.keys

animals.each_with_index do |animal, idx|
  puts "There was an old lady who swallowed a #{animal}."

  d = descriptions[animal]
  case d[-1]
  when "S" then d[-1] = "she swallowed a #{animal}."
  when "T" then d[-1] = "to swallow a #{animal}."
  end
  puts d
  break if animal == :horse

  idx.downto(1) do |i|
    puts "She swallowed the #{animals[i]} to catch the #{animals[i-1]}."
    case animals[i-1]
    when :spider, :fly then puts descriptions[animals[i-1]]
    end
  end

  print "Perhaps she'll die.\n\n"
end


enum Action {Once, Every, Die}
use Action::*;

fn main() {
    let animals = [ ("horse" , Die  , "She's dead, of course!")
                  , ("donkey", Once , "It was rather wonky. To swallow a donkey.")
                  , ("cow"   , Once , "I don't know how. To swallow a cow.")
                  , ("goat"  , Once , "She just opened her throat. To swallow a goat.")
                  , ("pig"   , Once , "Her mouth was so big. To swallow a pig.")
                  , ("dog"   , Once , "What a hog. To swallow a dog.")
                  , ("cat"   , Once , "Fancy that. To swallow a cat.")
                  , ("bird"  , Once , "Quite absurd. To swallow a bird.")
                  , ("spider", Once , "That wriggled and jiggled and tickled inside her.")
                  , ("fly"   , Every, "I don't know why she swallowed the fly.")
                  ];

    for (i, a) in animals.iter().enumerate().rev() {
        println!("There was an old lady who swallowed a {}\n{}", a.0, a.2);

        if let Die = a.1 {break}

        for (swallowed, to_catch) in animals[i..].iter().zip(&animals[i+1..]) {
            println!("She swallowed the {} to catch the {}.", swallowed.0, to_catch.0);

            if let Every = to_catch.1 {
                println!("{}", to_catch.2);
            }
        }

        println!("Perhaps she'll die.\n");
    }
}


case class Verse(animal: String, remark: String, die: Boolean = false, always: Boolean = false)

val verses = List(
  Verse("horse", "She’s dead, of course!", die = true),
  Verse("donkey", "It was rather wonky. To swallow a donkey."),
  Verse("cow", "I don’t know how. To swallow a cow."),
  Verse("goat", "She just opened her throat. To swallow a goat."),
  Verse("pig", "Her mouth was so big. To swallow a pig."),
  Verse("dog", "What a hog. To swallow a dog."),
  Verse("cat", "Fancy that. To swallow a cat."),
  Verse("bird", "Quite absurd. To swallow a bird."),
  Verse("spider", "That wriggled and jiggled and tickled inside her."),
  Verse("fly", "I don’t know why she swallowed the fly.", always = true)
)

for (i <- 1 to verses.size; verse = verses takeRight i; starting = verse.head) {
  println(s"There was an old lady who swallowed a ${starting.animal},")
  println(starting.remark)
  if (!starting.die) {
    for (List(it, next) <- verse.sliding(2,1)) {
      println(s"She swallowed the ${it.animal} to catch the ${next.animal},")
      if (next.always) println(next.remark)
    }
    println("Perhaps she’ll die!")
    println
  }
}


$ include "seed7_05.s7i";

const array array string: verses is [] (
    [] ("fly", "I don't know why she swallowed the fly."),
    [] ("spider", "That wriggled and jiggled and tickled inside her."),
    [] ("bird", "Quite absurd. To swallow a bird."),
    [] ("cat", "Fancy that. To swallow a cat."),
    [] ("dog", "What a hog. To swallow a dog."),
    [] ("pig", "Her mouth was so big. To swallow a pig."),
    [] ("goat", "She just opened her throat. To swallow a goat."),
    [] ("cow", "I don't know how. To swallow a cow."),
    [] ("donkey", "It was rather wonky. To swallow a donkey."),
    [] ("horse", "She's dead, of course!"));

const proc: main is func
  local
    var integer: verseNumber is 0;
    var integer: animal is 0;
  begin
    for key verseNumber range verses do
      writeln("There was an old lady who swallowed a " <& verses[verseNumber][1] <& ",");
      writeln(verses[verseNumber][2]);
      if verseNumber <> length(verses) then
        for animal range verseNumber downto 2 do
          writeln("She swallowed the " <& verses[animal][1] <& " to catch the " <& verses[pred(animal)][1] <& ",");
        end for;
        if verseNumber <> 1 then
          writeln(verses[1][2]);
        end if;
        writeln("Perhaps she'll die!");
        writeln;
      end if;
    end for;
  end func;


var victims = [
    :fly:    "  I don't know why S—",
    :spider: "  That wriggled and jiggled and tickled inside her.",
    :bird:   "  How absurd, T!",
    :cat:    "  Fancy that, S!",
    :dog:    "  What a hog, T!",
    :goat:   "  She just opened her throat, and in walked the goat!",
    :cow:    "  I don't know how S!",
    :horse:  "  She's dead, of course...",
];

var history = ["I guess she'll die...\n"];

victims.each { |pair|
    var (victim, verse) = pair...;
    say "There was an old lady who swallowed a #{victim}...";

    verse.sub!(/\bS\b/, "she swallowed the #{victim}");
    verse.sub!(/\bT\b/, "to swallow a #{victim}!");

    say verse;
    verse ~~ /dead/ && break;

    history[0].sub!(/^X/, "She swallowed the #{victim}");
    history.each{.say};
    history.len < 5 && history.unshift(verse);
    history.unshift("X to catch the #{victim},");
};


package require Tcl 8.6

puts [zlib inflate [binary decode base64 "
    7VRNa8MwDL3nV2inXkZ+xDa29taxws5q7NZuPSvYDib/fnJKPxwXBoNCx3KTn56t
    p6dEC9hbioAWyAgwKHqIisBHNIaiFICwMX1dLUCQnYUDO6oevJIXrMCngbeUTmHr
    U3pmDAgt64ov/1jEt1pIV1crhQGi09utSbgVsLuIg272KdbWMx1UuvFRCDm8BYGg
    wdCos7hbN/Gknair904HCbj2HZ9gdaKcCKXihOd6j37cUXfPGOrqFW3T81sc560N
    2VItw7nUP23BC23r6jN9ogiK49yCIVuqZTiX+i+sWmo2Y86lv6gLCiLyEwRrPTZt
    4JW6Gc5FT+ZemPtGxy53nQ9ArbSMq6RFOSr+zTM915DwXP00jd8sRoqjIoqR0XpM
    nCtGcDITPI3qxgvc7mWqE4aN5DCknyYy2hfL/MC85lzKjMybxnsP452T83JQNPMg
    JIpHoA001DH88A0=
"]]