import std.stdio;

int countDivisors(int n) {
    if (n < 2) {
        return 1;
    }
    int count = 2; // 1 and n
    for (int i = 2; i <= n/2; ++i) {
        if (n % i == 0) {
            ++count;
        }
    }
    return count;
}

void main() {
    int maxDiv, count;
    writeln("The first 20 anti-primes are:");
    for (int n = 1; count < 20; ++n) {
        int d = countDivisors(n);
        if (d > maxDiv) {
            write(n, ' ');
            maxDiv = d;
            count++;
        }
    }
    writeln;
}


defmodule AntiPrimes do
	def divcount(n) when is_integer(n), do: divcount(n, 1, 0)

	def divcount(n, d, count) when d * d > n, do: count
	def divcount(n, d, count) do
		divs = case rem(n, d) do
			0 ->
				case n - d * d do
					0 -> 1
					_ -> 2
				end
			_ -> 0
		end
		divcount(n, d + 1, count + divs)
	end

	def antiprimes(n), do: antiprimes(n, 1, 0, [])

	def antiprimes(0, _, _, l), do: Enum.reverse(l)
	def antiprimes(n, m, max, l) do
		count = divcount(m)
		case count > max do
			true -> antiprimes(n-1, m+1, count, [m|l])
			false -> antiprimes(n, m+1, max, l)
		end
	end

	def main() do
		:io.format("The first 20 anti-primes are ~w~n", [antiprimes(20)])
	end
end


divcount(N) -> divcount(N, 1, 0).

divcount(N, D, Count) when D*D > N -> Count;
divcount(N, D, Count) ->
    Divs = case N rem D of
        0 ->
            case N - D*D of
                0 -> 1;
                _ -> 2
            end;
        _ -> 0
    end,
    divcount(N, D + 1, Count + Divs).

antiprimes(N) -> antiprimes(N, 1, 0, []).

antiprimes(0, _, _, L) -> lists:reverse(L);
antiprimes(N, M, Max, L) ->
    Count = divcount(M),
    case Count > Max of
        true  -> antiprimes(N-1, M+1, Count, [M|L]);
        false -> antiprimes(N, M+1, Max, L)
    end.

main(_) ->
    io:format("The first 20 anti-primes are ~w~n", [antiprimes(20)]).


// Find Antı-Primes. Nigel Galloway: Secember 10th., 2018
let  N=200000000000000000000000000I
let fI,_=Seq.scan(fun (_,g) e->(e,e*g)) (2I,4I) (primes|>Seq.skip 1|>Seq.map bigint)|>Seq.takeWhile(fun(_,n)->n<N)|>List.ofSeq|>List.unzip
let fG g=Seq.unfold(fun ((n,i,e) as z)->Some(z,(n+1,i+1,(e*g)))) (1,2,g)|>Seq.takeWhile(fun(_,_,n)->n<N)
let fE n i=n|>Seq.collect(fun(n,e,g)->Seq.map(fun(a,c,b)->(a,c*e,g*b)) (i|>Seq.takeWhile(fun(g,_,_)->g<=n)) |> Seq.takeWhile(fun(_,_,n)->n<N))
let fL,_=Seq.concat(Seq.scan(fun n g->fE n (fG g)) (seq[(2147483647,1,1I)]) fI)|>List.ofSeq|>List.sortBy(fun(_,_,n)->n)|>List.fold(fun ((a,b) as z) (_,n,g)->if n>b then ((n,g)::a,n) else z) ([],0)


USING: assocs formatting kernel locals make math
math.primes.factors sequences.extras ;
IN: rosetta-code.anti-primes

<PRIVATE

: count-divisors ( n -- m )
    dup 1 = [ group-factors values [ 1 + ] map-product ] unless ;

: (n-anti-primes) ( md n count -- ?md' n' ?count' )
    dup 0 >
    [| max-div! n count! |
        n count-divisors :> d
        d max-div > [ d max-div! n , count 1 - count! ] when
        max-div n dup 60 >= 20 1 ? + count (n-anti-primes)
    ] when ;

PRIVATE>

: n-anti-primes ( n -- seq )
    [ 0 1 ] dip [ (n-anti-primes) 3drop ] { } make ;

: anti-primes-demo ( -- )
    20 n-anti-primes "First 20 anti-primes:\n%[%d, %]\n" printf ;

MAIN: anti-primes-demo


include ./factors.fs

: max-count ( n1 n2 -- n f )
    \ n is max(n1, factor-count n2); if n is new maximum then f = true.
    \
    count-factors 2dup <
    if   nip true
    else drop false
    then ;

: .anti-primes ( n -- )
    0 1 rot  \ stack: max, candidate, count
    begin
        >r dup >r max-count
        if   r> dup . r> 1-
        else r> r>
        then swap 1+ swap
    dup 0= until drop 2drop ;

." The first 20 anti-primes are: " 20 .anti-primes cr
bye


program anti_primes
    use iso_fortran_env, only: output_unit
    implicit none

    integer :: n, d, maxDiv, pCount

    write(output_unit,*) "The first 20 anti-primes are:"
    n = 1
    maxDiv = 0
    pCount = 0
    do
        if (pCount >= 20) exit

        d = countDivisors(n)
        if (d > maxDiv) then
            write(output_unit,'(I0,x)', advance="no") n
            maxDiv = d
            pCount = pCount + 1
        end if
        n = n + 1
    end do
    write(output_unit,*)
contains
    pure function countDivisors(n)
        integer, intent(in) :: n
        integer             :: countDivisors
        integer             :: i

        countDivisors = 1
        if (n < 2) return
        countDivisors = 2
        do i = 2, n/2
            if (modulo(n, i) == 0) countDivisors = countDivisors + 1
        end do
    end function countDivisors
end program anti_primes


' convertido desde Ada
Declare Function count_divisors(n As Integer) As Integer

Dim As Integer max_divisors, divisors, results(1 To 20), candidate, j
candidate = 1

Function count_divisors(n As Integer) As Integer
    Dim As Integer i, count = 1
    For i = 1 To n/2
        If (n Mod i) = 0 Then count += 1
    Next i
    count_divisors = count
End Function

Print "Los primeros 20 anti-primos son:"
For j = 1 To 20
    Do
        divisors = count_divisors(Candidate)
        If max_divisors < divisors Then
            Results(j) = Candidate
            max_divisors = divisors
            Exit Do
        End If
        Candidate += 1
    Loop
Next j
For j = 1 To 20
    Print Results(j);
Next j
Print
Sleep


package main

import "fmt"

func countDivisors(n int) int {
    if n < 2 {
        return 1
    }
    count := 2 // 1 and n
    for i := 2; i <= n/2; i++ {
        if n%i == 0 {
            count++
        }
    }
    return count
}

func main() {
    fmt.Println("The first 20 anti-primes are:")
    maxDiv := 0
    count := 0
    for n := 1; count < 20; n++ {
        d := countDivisors(n)
        if d > maxDiv {
            fmt.Printf("%d ", n)
            maxDiv = d
            count++
        }
    }
    fmt.Println()
}


def getAntiPrimes(def limit = 10) {
    def antiPrimes = []
    def candidate = 1L
    def maxFactors = 0

    while (antiPrimes.size() < limit) {
        def factors = factorize(candidate)
        if (factors.size() > maxFactors) {
            maxFactors = factors.size()
            antiPrimes << candidate
        }
        candidate++
    }
    antiPrimes
}


10 C = -999
20 N = N + 1
30 GOSUB 60
40 IF T = 20 THEN END
50 GOTO 20
60 D = 0
70 FOR F = 1 TO INT(N/2)
80 IF N MOD F = 0 THEN D = D + 1
90 NEXT F
100 IF D > C THEN GOSUB 120
110 RETURN
120 C = D
130 T = T + 1
140 PRINT N
150 RETURN


import Data.List (find, group)
import Data.Maybe (fromJust)

firstPrimeFactor :: Int -> Int
firstPrimeFactor n = head $ filter ((0 ==) . mod n) [2 .. n]

allPrimeFactors :: Int -> [Int]
allPrimeFactors 1 = []
allPrimeFactors n =
  let first = firstPrimeFactor n
  in first : allPrimeFactors (n `div` first)

factorCount :: Int -> Int
factorCount 1 = 1
factorCount n = product ((succ . length) <$> group (allPrimeFactors n))

divisorCount :: Int -> (Int, Int)
divisorCount = (,) <*> factorCount

hcnNext :: (Int, Int) -> (Int, Int)
hcnNext (num, factors) =
  fromJust $ find ((> factors) . snd) (divisorCount <$> [num ..])

hcnSequence :: [Int]
hcnSequence = fst <$> iterate hcnNext (1, 1)

main :: IO ()
main = print $ take 20 hcnSequence


   NB. factor count is the product of the incremented powers of prime factors
   factor_count =: [: */ [: >: _&q:

   NB. N are the integers 1 to 10000
   NB. FC are the corresponding factor counts
   FC =: factor_count&> N=: >: i. 10000

   NB. take from the integers N{~
   NB. the indexes of truth   I.
   NB. the vector which doesn't equal itself when rotated by one position  (~: _1&|.)
   NB. where that vector is the maximum over all prefixes of the factor counts  >./\FC
   N{~I.(~: _1&|.)>./\FC
1 2 4 6 12 24 36 48 60 120 180 240 360 720 840 1260 1680 2520 5040 7560


public class Antiprime {

    static int countDivisors(int n) {
        if (n < 2) return 1;
        int count = 2; // 1 and n
        for (int i = 2; i <= n/2; ++i) {
            if (n%i == 0) ++count;
        }
        return count;
    }

    public static void main(String[] args) {
        int maxDiv = 0, count = 0;
        System.out.println("The first 20 anti-primes are:");
        for (int n = 1; count < 20; ++n) {
            int d = countDivisors(n);
            if (d > maxDiv) {
                System.out.printf("%d ", n);
                maxDiv = d;
                count++;
            }
        }
        System.out.println();
    }
}


function factors(n) {
  var factors = [];
  for (var i = 1; i <= n; i++) {
    if (n % i == 0) {
      factors.push(i);
    }
  }
  return factors;
}

function generateAntiprimes(n) {
  var antiprimes = [];
  var maxFactors = 0;
  for (var i = 1; antiprimes.length < n; i++) {
    var ifactors = factors(i);
    if (ifactors.length > maxFactors) {
      antiprimes.push(i);
      maxFactors = ifactors.length;
    }
  }
  return antiprimes;
}

function go() {
  var number = document.getElementById("n").value;
  document.body.removeChild(document.getElementById("result-list"));
  document.body.appendChild(showList(generateAntiprimes(number)));
}

function showList(array) {
  var list = document.createElement("ul");
  list.id = "result-list";
  for (var i = 0; i < array.length; i++) {
    var item = document.createElement("li");
    item.appendChild(document.createTextNode(array[i]));
    list.appendChild(item);
  }
  return list;
}


# Compute the number of divisors, without calling sqrt
def ndivisors:
  def sum(s): reduce s as $x (null; .+$x);
  if . == 1 then 1
  else . as $n
  | sum( label $out
         | range(1; $n) as $i
         | ($i * $i) as $i2
         | if $i2 > $n then break $out
           else if $i2 == $n
                then 1
                elif ($n % $i) == 0
                then 2
                else empty
                end
           end)
  end;

# Emit the antiprimes as a stream
def antiprimes:
  1,
  foreach range(2; infinite; 2) as $i ({maxfactors: 1};
    .emit = null
    | ($i | ndivisors) as $nfactors
    | if $nfactors > .maxfactors
      then .emit = $i
      | .maxfactors = $nfactors
      else .
      end;
      select(.emit).emit);

"The first 20 anti-primes are:", limit(20; antiprimes)


using Primes, Combinatorics

function antiprimes(N, maxn = 2000000)
    antip = [1]  # special case: 1 is antiprime
    count = 1
    maxfactors = 1
    for i in 2:2:maxn # antiprimes > 2 should be even
        lenfac = length(unique(sort(collect(combinations(factor(Vector, i)))))) + 1
        if lenfac > maxfactors
            push!(antip, i)
            if length(antip) >= N
                return antip
            end
            maxfactors = lenfac
        end
    end
    antip
end

println("The first 20 anti-primes are:\n", antiprimes(20))
println("The first 40 anti-primes are:\n", antiprimes(40))


// Version 1.3.10

fun countDivisors(n: Int): Int {
    if (n < 2) return 1;
    var count = 2 // 1 and n
    for (i in 2..n / 2) {
        if (n % i == 0) count++
    }
    return count;
}

fun main(args: Array<String>) {
    println("The first 20 anti-primes are:")
    var maxDiv = 0
    var count = 0
    var n = 1
    while (count < 20) {
        val d = countDivisors(n)
        if (d > maxDiv) {
            print("$n ")
            maxDiv = d
            count++
        }
        n++
    }
    println()
}


-- First 20 antiprimes.

function count_factors(number)
	local count = 0
	for attempt = 1, number do
		local remainder = number % attempt
		if remainder == 0 then
			count = count + 1
		end
	end
	return count
end

function antiprimes(goal)
	local list, number, mostFactors = {}, 1, 0
	while #list < goal do
		local factors = count_factors(number)
		if factors > mostFactors then
			table.insert(list, number)
			mostFactors = factors
		end
		number = number + 1
	end
	return list
end

function recite(list)
	for index, item in ipairs(list) do
		print(item)
	end
end

print("The first 20 antiprimes:")
recite(antiprimes(20))
print("Done.")


antiprimes := proc(n)
local ap, i, max_divisors, num_divisors;
max_divisors := 0;
ap := [];

for i from 1 while numelems(ap) < n do
    num_divisors := numelems(NumberTheory:-Divisors(i));
    if num_divisors > max_divisors then
       ap := [op(ap), i];
       max_divisors := num_divisors;
    end if;
end do;

return ap;
end proc:
antiprimes(20);


sigma = DivisorSigma[0, #] &;
currentmax = -\[Infinity];
res = {};
Do[
 s = sigma[v];
 If[s > currentmax,
  AppendTo[res, v];
  currentmax = s;
  ];
 If[Length[res] >= 25, Break[]]
 ,
 {v, \[Infinity]}
 ]
res


MODULE Antiprimes;
FROM InOut IMPORT WriteCard, WriteLn;

CONST Amount = 20;
VAR max, seen, n, f: CARDINAL;

PROCEDURE factors(n: CARDINAL): CARDINAL;
    VAR facs, div: CARDINAL;
BEGIN
    IF n<2 THEN RETURN 1; END;
    facs := 2;
    FOR div := 2 TO n DIV 2 DO
        IF n MOD div = 0 THEN
            INC(facs);
        END;
    END;
    RETURN facs;
END factors;

BEGIN
    max := 0;
    seen := 0;
    n := 1;
    WHILE seen < Amount DO
        f := factors(n);
        IF f > max THEN
            WriteCard(n,5);
            max := f;
            INC(seen);
            IF seen MOD 10 = 0 THEN WriteLn(); END;
        END;
        INC(n);
    END;
END Antiprimes.


def countDivisors(n)
	if (n < 2)
		return 1
	end
	count = 2
	for i in range(2, int(n/2))
		if (n % i) = 0
			count += 1
		end
	end
	return count
end

maxDiv = 0
count = 0
println "The first 20 anti-primes are:"

for (n = 1) (count < 20) (n += 1)
	d = countDivisors(n)
	if d > maxDiv
		print format("%d ", n)
		maxDiv = d
		count += 1
	end
end
println


# First 20 antiprimes

proc countDivisors(n: int): int =
    if n < 2:
        return 1
    var count = 2
    for i in countup(2, (n / 2).toInt()):
        if n %% i == 0:
            count += 1
    return count

proc antiPrimes(n: int) =
    echo("The first ", n, " anti-primes:")
    var maxDiv = 0
    var count = 0
    var i = 1
    while count < n:
        let d = countDivisors(i)
        if d > maxDiv:
            echo(i)
            maxDiv = d
            count += 1
        i += 1

antiPrimes(20)


class AntiPrimes {
  function : Main(args : String[]) ~ Nil {
    maxDiv := 0; count := 0;
    "The first 20 anti-primes are:"->PrintLine();
    for(n := 1; count < 20; ++n;) {
      d := CountDivisors(n);
      if(d > maxDiv) {
        "{$n} "->Print();
        maxDiv := d;
        count++;
      };
    };
    '\n'->Print();
  }

  function : native : CountDivisors(n : Int) ~ Int {
    if (n < 2) { return 1; };
    count := 2;
    for(i := 2; i <= n/2; ++i;) {
      if(n%i = 0) { ++count; };
    };
    return count;
  }
}


program AntiPrimes;
{$IFdef FPC}
  {$MOde Delphi}
{$IFEND}
function getFactorCnt(n:NativeUint):NativeUint;
var
  divi,quot,pot,lmt : NativeUint;
begin
  result := 1;
  divi  := 1;
  lmt := trunc(sqrt(n));
  while divi < n do
  Begin
    inc(divi);
    pot := 0;
    repeat
      quot := n div divi;
      if n <> quot*divi then
        BREAK;
      n := quot;
      inc(pot);
    until false;
    result := result*(1+pot);
    //IF n= prime leave now
    if divi > lmt then
      BREAK;
  end;
end;

var
  i,Count,FacCnt,lastCnt: NativeUint;
begin
  count := 0;
  lastCnt := 0;
  i := 1;
  repeat
    FacCnt := getFactorCnt(i);
    if  lastCnt < FacCnt then
    Begin
      write(i,'(',FacCnt,'),');
      lastCnt:= FacCnt;
      inc(Count);
      if count = 12 then
        Writeln;
    end;
    inc(i);
  until Count >= 20;
  writeln;
end.


countfactors(n)={
    my(count(m)= prod(i=1,#factor(m)~,factor(m)[i,2]+1));
    v=vector(n);
    v[1]=1;
    for(x=2,n,
        v[x]=v[x-1]+1;
        while(count(v[x-1])>=count(v[x]),v[x]++));
return(v)}
countfactors(20)


use ntheory qw(divisors);

my @anti_primes;

for (my ($k, $m) = (1, 0) ; @anti_primes < 20 ; ++$k) {
    my $sigma0 = divisors($k);

    if ($sigma0 > $m) {
        $m = $sigma0;
        push @anti_primes, $k;
    }
}

printf("%s\n", join(' ', @anti_primes));


with javascript_semantics
integer n=1, maxd = -1
sequence res = {}
while length(res)<20 do
    integer lf = length(factors(n,1))
    if lf>maxd then
        res &= n
        maxd = lf
    end if
    n += iff(n>1?2:1)
end while
printf(1,"The first 20 anti-primes are: %V\n",{res})


0 var count
0 var n
0 var max_divisors

"The first 20 anti-primes are:" print nl

def count_divisors
    dup 2 < if
        drop
        1
    else
        2
        swap 1 over 2 / 2 tolist
        for
            over swap mod not if swap 1 + swap endif
        endfor
        drop
    endif
enddef

true
while
    count 20 < dup if
        n 1 + var n
        n count_divisors
        dup max_divisors > if
            n print " " print
            var max_divisors
            count 1 + var count
        else
            drop
        endif
    endif
endwhile

nl
msec print


count_divisors(1) = 1.

count_divisors(N) = Count, N >= 2 =>
    Count = 2,
    foreach (I in 2..N/2)
        if (N mod I == 0) then
            Count := Count + 1
        end
    end.

main =>
    println("The first 20 anti-primes are:"),
    MaxDiv = 0,
    Count = 0,
    N = 1,
    while (Count < 20)
        D := count_divisors(N),
        if (D > MaxDiv) then
            printf("%d ", N),
            MaxDiv := D,
            Count := Count + 1
        end,
        N := N + 1
    end,
    nl.


(de factors (N)
   (let C 1
      (when (>= N 2)
         (inc 'C)
         (for (I 2 (>= (/ N 2) I) (inc I))
            (and (=0 (% N I)) (inc 'C)) ) )
      C ) )
(de anti (X)
   (let (M 0  I 0  N 0)
      (make
         (while (> X I)
            (inc 'N)
            (let R (factors N)
               (when (> R M)
                  (link N)
                  (setq M R)
                  (inc 'I) ) ) ) ) ) )
(println (anti 20))


C :n=1
  :max=0
  :seen=0

*number
U :*count
T (c>max):#n
C (c>max):seen=seen+1
C (c>max):max=c
  :n=n+1
J (seen<20):*number
E :

*count
C (n=1):c=1
E (n=1):
C :c=2
  :i=2
*cnloop
E (i>n/2):
C (i*(n/i)=n):c=c+1
  :i=i+1
J :*cnloop


antiprimes: procedure options(main);

    /* count the factors of a number */
    countFactors: procedure(n) returns(fixed);
        declare (n, i, count) fixed;
        if n<2 then return(1);
        count = 1;
        do i=1 to n/2;
            if mod(n,i) = 0 then count = count + 1;
        end;
        return(count);
    end countFactors;

    declare maxFactors fixed static init (0);
    declare seen fixed static init (0);
    declare n fixed;
    declare factors fixed;

    do n=1 repeat(n+1) while(seen < 20);
        factors = countFactors(n);
        if factors > maxFactors then do;
            put edit(n) (F(5));
            maxFactors = factors;
            seen = seen + 1;
            if mod(seen,15) = 0 then put skip;
        end;
    end;
end antiprimes;


100H:
/* CP/M CALLS */
BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;

/* PRINT A NUMBER */
PRINT$NUMBER: PROCEDURE (N);
    DECLARE S (7) BYTE INITIAL ('..... $');
    DECLARE (N, P) ADDRESS, C BASED P BYTE;
    P = .S(5);
DIGIT:
    P = P - 1;
    C = N MOD 10 + '0';
    N = N / 10;
    IF N > 0 THEN GO TO DIGIT;
    CALL PRINT(P);
END PRINT$NUMBER;

/* COUNT THE FACTORS OF A NUMBER */
COUNT$FACTORS: PROCEDURE (N) ADDRESS;
    DECLARE (N, I, COUNT) ADDRESS;
    IF N<2 THEN RETURN 1;
    COUNT = 1;
    DO I=1 TO N/2;
        IF N MOD I = 0 THEN COUNT = COUNT + 1;
    END;
    RETURN COUNT;
END COUNT$FACTORS;

DECLARE MAX$FACTORS ADDRESS INITIAL (0);
DECLARE SEEN BYTE INITIAL (0);
DECLARE N ADDRESS INITIAL (1);
DECLARE FACTORS ADDRESS;

DO WHILE SEEN < 20;
    FACTORS = COUNT$FACTORS(N);
    IF FACTORS > MAX$FACTORS THEN DO;
        CALL PRINT$NUMBER(N);
        MAX$FACTORS = FACTORS;
        SEEN = SEEN + 1;
    END;
    N = N + 1;
END;
CALL EXIT;
EOF


void setup() {
  int most_factors = 0;
  IntList anti_primes = new IntList();
  int n = 1;
  while (anti_primes.size() < 20) {
    int counter = 1;
    for (int i = 1; i <= n / 2; i++) {
      if (n % i == 0) {
        counter++;
      }
    }
    if (counter > most_factors) {
      anti_primes.append(n);
      most_factors = counter;
    }
    n++;
  }
  for (int num : anti_primes) {
    print(num + " ");
  }
}


divcount(N, Count) :- divcount(N, 1, 0, Count).

divcount(N, D, C, C) :- D*D > N, !.
divcount(N, D, C, Count) :-
    succ(D, D2),
    divs(N, D, A), plus(A, C, C2),
    divcount(N, D2, C2, Count).

divs(N, D, 0) :- N mod D =\= 0, !.
divs(N, D, 1) :- D*D =:= N, !.
divs(_, _, 2).

antiprimes(N, L) :- antiprimes(N, 1, 0, [], L).

antiprimes(0, _, _, L, R) :- reverse(L, R), !.
antiprimes(N, M, Max, L, R) :-
    divcount(M, Count),
    succ(M, M2),
    (Count > Max
        -> succ(N0, N), antiprimes(N0, M2, Count, [M|L], R)
         ; antiprimes(N, M2, Max, L, R)).

main :-
    antiprimes(20, X),
    write("The first twenty anti-primes are "), write(X), nl,
    halt.

?- main.


Procedure.i cntDiv(n.i)
  Define.i i, count
  If n < 2 : ProcedureReturn 1 : EndIf
  count = 2 : i = 2
  While i <= n / 2
    If n % i = 0 : count + 1 : EndIf
    i + 1
  Wend
  ProcedureReturn count
EndProcedure

; - - - MAIN - - -
Define.i n = 1, d, maxDiv = 0, count = 0
If OpenConsole("")
  PrintN("The first 20 anti-primes are: ")
  While count < 20
    d = cntDiv(n)
    If d > maxDiv
      Print(Str(n) + " ")
      maxDiv = d : count + 1
    EndIf
    n + 1
  Wend
  PrintN("")
  Input()
EndIf
End 0


from itertools import chain, count, cycle, islice, accumulate

def factors(n):
    def prime_powers(n):
        for c in accumulate(chain([2, 1, 2], cycle([2,4]))):
            if c*c > n: break
            if n%c: continue
            d,p = (), c
            while not n%c:
                n,p,d = n//c, p*c, d+(p,)
            yield d
        if n > 1: yield n,

    r = [1]
    for e in prime_powers(n):
        r += [a*b for a in r for b in e]
    return r

def antiprimes():
    mx = 0
    yield 1
    for c in count(2,2):
        if c >= 58: break
        ln = len(factors(c))
        if ln > mx:
            yield c
            mx = ln
    for c in count(60,30):
        ln = len(factors(c))
        if ln > mx:
            yield c
            mx = ln

if __name__ == '__main__':
    print(*islice(antiprimes(), 40)))


  0 temp put
  [] 0
  [ 1+ dup factors size
    dup temp share > iff
      [ temp replace
        dup dip join ]
    else drop
    over size 20 = until ]
  temp release
  drop echo


# Antiprimes

max_divisors <- 0

findFactors <- function(x){
  myseq <- seq(x)
  myseq[(x %% myseq) == 0]
}

antiprimes <- vector()
x <- 1
n <- 1
while(length(antiprimes) < 20){
  y <- findFactors(x)
  if (length(y) > max_divisors){
    antiprimes <- c(antiprimes, x)
    max_divisors <- length(y)
    n <- n + 1
  }
  x <- x + 1
}

antiprimes


#lang racket

(require racket/generator
         math/number-theory)

(define (get-divisors n)
  (apply * (map (λ (factor) (add1 (second factor))) (factorize n))))

(define antiprimes
  (in-generator
   (for/fold ([prev 0]) ([i (in-naturals 1)])
     (define divisors (get-divisors i))
     (when (> divisors prev) (yield i))
     (max prev divisors))))

(for/list ([i (in-range 20)] [antiprime antiprimes]) antiprime)


sub propdiv (\x) {
    my @l = 1 if x > 1;
    (2 .. x.sqrt.floor).map: -> \d {
        unless x % d { @l.push: d; my \y = x div d; @l.push: y if y != d }
    }
    @l
}

my $last = 0;

my @anti-primes = lazy 1, |(|(2..59), 60, *+60 … *).grep: -> $c {
    my \mx = +propdiv($c);
    next if mx <= $last;
    $last = mx;
    $c
}

my $upto = 5e5;

put "First 20 anti-primes:\n{ @anti-primes[^20] }";

put "\nCount of anti-primes <= $upto: {[email protected][^(@anti-primes.first: * > $upto, :k)]}";


Red []
inc: func ['v] [set v 1 + get v]    ;; shortcut function for n: n + 1

n: 0  found: 0 max_div: 0
print "the first 20 anti-primes are:"
while  [ inc n] [
 nDiv: 1      ;; count n / n extra
 if n > 1 [ repeat div n / 2 [ if n % div = 0  [inc nDiv] ] ]
 if nDiv > max_div [
    max_div: nDiv
    prin [n ""]
    if 20 <= inc found [halt]
 ]
]


/*REXX program finds and displays  N  number of anti─primes or highly─composite numbers.*/
parse arg N .                                    /*obtain optional argument from the CL.*/
if N=='' | N==","  then N= 20                    /*Not specified?  Then use the default.*/
maxD= 0                                          /*the maximum number of divisors so far*/
say '─index─ ──anti─prime──'                     /*display a title for the numbers shown*/
#= 0                                             /*the count of anti─primes found  "  " */
     do once=1  for 1
        do i=1  for 59                           /*step through possible numbers by twos*/
        d= #divs(i);  if d<=maxD  then iterate   /*get # divisors;  Is too small?  Skip.*/
        #= # + 1;     maxD= d                    /*found an anti─prime #;  set new minD.*/
        say center(#, 7)  right(i, 10)           /*display the index and the anti─prime.*/
        if #>=N  then leave once                 /*if we have enough anti─primes, done. */
        end   /*i*/

        do j=60  by 20                           /*step through possible numbers by 20. */
        d= #divs(j);  if d<=maxD  then iterate   /*get # divisors;  Is too small?  Skip.*/
        #= # + 1;     maxD= d                    /*found an anti─prime #;  set new minD.*/
        say center(#, 7)  right(j, 10)           /*display the index and the anti─prime.*/
        if #>=N  then leave                      /*if we have enough anti─primes, done. */
        end   /*j*/
     end      /*once*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
#divs: procedure; parse arg x 1 y                /*X and Y:  both set from 1st argument.*/
       if x<3   then return x                    /*handle special cases for one and two.*/
       if x==4  then return 3                    /*   "      "      "    " four.        */
       if x<6   then return 2                    /*   "      "      "    " three or five*/
       odd= x // 2                               /*check if   X   is  odd  or not.      */
       if odd  then      #= 1                    /*Odd?   Assume  Pdivisors  count of 1.*/
               else do;  #= 3;     y= x % 2      /*Even?     "        "        "    " 3.*/
                    end                          /* [↑]   start with known num of Pdivs.*/

                  do k=3  for x%2-3  by 1+odd  while k<y  /*for odd numbers, skip evens.*/
                  if x//k==0  then do;  #= # + 2 /*if no remainder, then found a divisor*/
                                        y= x % k /*bump  #  Pdivs,  calculate limit  Y. */
                                        if k>=y  then do; #= # - 1; leave; end  /*limit?*/
                                   end                         /*                   ___ */
                              else if k*k>x  then leave        /*only divide up to √ x  */
                  end   /*k*/                    /* [↑]  this form of DO loop is faster.*/
       return #+1                                /*bump "proper divisors" to "divisors".*/


# Project : Anti-primes

see "working..." + nl
see "wait for done..." + nl + nl
see "the first 20 anti-primes are:" + nl + nl
maxDivisor = 0
num = 0
n = 0
result = list(20)
while num < 20
      n = n + 1
      div = factors(n)
      if (div > maxDivisor)
         maxDivisor = div
         num = num + 1
         result[num] = n
      ok
end
see "["
for n = 1 to len(result)
    if n < len(result)
       see string(result[n]) + ","
    else
       see string(result[n]) + "]" + nl + nl
    ok
next
see "done..." + nl

func factors(an)
     ansum = 2
     if an < 2
        return(1)
     ok
     for nr = 2 to an/2
         if an%nr = 0
            ansum = ansum+1
         ok
     next
     return ansum


require 'prime'

def num_divisors(n)
  n.prime_division.inject(1){|prod, (_p,n)| prod *= (n + 1) }
end

anti_primes = Enumerator.new do |y| # y is the yielder
  max = 0
  y << 1                            # yield 1
  2.step(nil,2) do |candidate|      # nil is taken as Infinity
     num = num_divisors(candidate)
     if  num > max
       y << candidate               # yield the candidate
       max = num
     end
  end
end

puts anti_primes.take(20).join(" ")


fn count_divisors(n: u64) -> usize {
    if n < 2 {
        return 1;
    }
    2 + (2..=(n / 2)).filter(|i| n % i == 0).count()
}

fn main() {
    println!("The first 20 anti-primes are:");
    (1..)
        .scan(0, |max, n| {
            let d = count_divisors(n);
            Some(if d > *max {
                *max = d;
                Some(n)
            } else {
                None
            })
        })
        .flatten()
        .take(20)
        .for_each(|n| print!("{} ", n));
    println!();
}


def factorCount(num: Int): Int = Iterator.range(1, num/2 + 1).count(num%_ == 0) + 1
def antiPrimes: LazyList[Int] = LazyList.iterate((1: Int, 1: Int)){case (n, facs) => Iterator.from(n + 1).map(i => (i, factorCount(i))).dropWhile(_._2 <= facs).next}.map(_._1)


$ include "seed7_05.s7i";

const func integer: countDivisors (in integer: number) is func
  result
    var integer: count is 1;
  local
    var integer: num is 0;
  begin
    for num range 1 to number div 2 do
      if number rem num = 0 then
        incr(count);
      end if;
    end for;
  end func;

const proc: main is func
  local
    var integer: maxDiv is 0;
    var integer: count is 0;
    var integer: number is 1;
    var integer: divisors is 1;
  begin
    writeln("The first 20 anti-primes are:");
    while count < 20 do
      divisors := countDivisors(number);
      if divisors > maxDiv then
        write(number <& " ");
        maxDiv := divisors;
        incr(count);
      end if;
      incr(number);
    end while;
    writeln;
  end func;


say with (0) {|max|
    1..Inf -> lazy.grep { (.sigma0 > max) && (max = .sigma0) }.first(20)
}


extension BinaryInteger {
  @inlinable
  public func countDivisors() -> Int {
    var workingN = self
    var count = 1

    while workingN & 1 == 0 {
      workingN >>= 1

      count += 1
    }

    var d = Self(3)

    while d * d <= workingN {
      var (quo, rem) = workingN.quotientAndRemainder(dividingBy: d)

      if rem == 0 {
        var dc = 0

        while rem == 0 {
          dc += count
          workingN = quo

          (quo, rem) = workingN.quotientAndRemainder(dividingBy: d)
        }

        count += dc
      }

      d += 2
    }

    return workingN != 1 ? count * 2 : count
  }
}

var antiPrimes = [Int]()
var maxDivs = 0

for n in 1... {
  guard antiPrimes.count < 20 else {
    break
  }

  let divs = n.countDivisors()

  if maxDivs < divs {
    maxDivs = divs
    antiPrimes.append(n)
  }
}

print("First 20 anti-primes are \(Array(antiPrimes))")


proc countDivisors {n} {
  if {$n < 2} {return 1}
  set count 2
  set n2 [expr $n / 2]
  for {set i 2} {$i <= $n2} {incr i} {
    if {[expr $n % $i] == 0} {incr count}
  }
  return $count
}

# main
set maxDiv 0
set count 0

puts "The first 20 anti-primes are:"
for {set n 1} {$count < 20} {incr n} {
  set d [countDivisors $n]
  if {$d > $maxDiv} {
    puts $n
    set maxDiv $d
    incr count
  }
}


100 LET A=0
101 LET N=1
102 LET H=0
103 PRINT "The first 20 anti-primes are:"
105 GOSUB 150
106 LET H=F
107 LET A=A+1
108 PRINT N
109 LET N=N+1
110 IF A<20 THEN GOTO 105
111 END
150 GOSUB 200
151 IF F>H THEN RETURN
152 LET N=N+1
153 GOTO 150
200 LET F=0
201 LET C=1
205 IF N/C*C=N THEN LET F=F+1
206 LET C=C+1
207 IF C<=N THEN GOTO 205
208 RETURN


#lang transd

MainModule: {
    countDivs: (λ n Int() ret_ Int()
        (= ret_ 2)
        (for i in Range(2 (to-Int (/ (to-Double n) 2) 1)) do
            (if (not (mod n i)) (+= ret_ 1)))
        (ret ret_)
    ),

    _start: (λ max 0 tmp 0 N 1 i 2
        (textout 1 " ")
        (while (< N 20)
            (= tmp (countDivs i))
            (if (> tmp max)
                (textout i " ") (= max tmp) (+= N 1))
            (+= i 1)
    ))
}


int count_divisors(int n) {
  if (n < 2) return 1;
  var count = 2;
  for (int i = 2; i <= n/2; ++i)
    if (n%i == 0) ++count;
  return count;
}
void main() {
  var max_div = 0;
  var count = 0;
  stdout.printf("The first 20 anti-primes are:\n");
  for (int n = 1; count < 20; ++n) {
    var d = count_divisors(n);
    if (d > max_div) {
      stdout.printf("%d ", n);
      max_div = d;
      count++;
    }
  }
  stdout.printf("\n");
}


Private Function factors(n As Integer) As Collection
    Dim f As New Collection
    For i = 1 To Sqr(n)
        If n Mod i = 0 Then
            f.Add i
            If n / i <> i Then f.Add n / i
        End If
    Next i
    f.Add n
    Set factors = f
End Function
Public Sub anti_primes()
    Dim n As Integer, maxd As Integer
    Dim res As New Collection, lenght As Integer
    Dim lf As Integer
    n = 1: maxd = -1
    Length = 0
    Do While res.count < 20
        lf = factors(n).count
        If lf > maxd Then
            res.Add n
            maxd = lf
        End If
        n = n + IIf(n > 1, 2, 1)
    Loop
    Debug.Print "The first 20 anti-primes are:";
    For Each x In res
        Debug.Print x;
    Next x
End Sub


Module Module1

    Function CountDivisors(n As Integer) As Integer
        If n < 2 Then
            Return 1
        End If
        Dim count = 2 '1 and n
        For i = 2 To n \ 2
            If n Mod i = 0 Then
                count += 1
            End If
        Next
        Return count
    End Function

    Sub Main()
        Dim maxDiv, count As Integer
        Console.WriteLine("The first 20 anti-primes are:")

        Dim n = 1
        While count < 20
            Dim d = CountDivisors(n)

            If d > maxDiv Then
                Console.Write("{0} ", n)
                maxDiv = d
                count += 1
            End If
            n += 1
        End While

        Console.WriteLine()
    End Sub

End Module


fn count_divisors(n int) int {
    if n < 2 {
        return 1
    }
    mut count := 2 // 1 and n
    for i := 2; i <= n/2; i++ {
        if n%i == 0 {
            count++
        }
    }
    return count
}

fn main() {
    println("The first 20 anti-primes are:")
    mut max_div := 0
    mut count := 0
    for n := 1; count < 20; n++ {
        d := count_divisors(n)
        if d > max_div {
            print("$n ")
            max_div = d
            count++
        }
    }
    println('')
}


import "/math" for Int

System.print("The first 20 anti-primes are:")
var maxDiv = 0
var count = 0
var n = 1
while (count < 20) {
    var d = Int.divisors(n).count
    if (d > maxDiv) {
       System.write("%(n) ")
       maxDiv = d
       count = count + 1
    }
    n = n + 1
}
System.print()


int Counter, Num, Cnt, Div, Max;
[Counter:= 0;
Max:= 0;
Num:= 1;
loop    [Cnt:= 0;
        Div:= 1;
        repeat  if rem(Num/Div) = 0 then Cnt:= Cnt+1;
                Div:= Div+1;
        until   Div > Num;
        if Cnt > Max then
                [IntOut(0, Num);  ChOut(0, ^ );
                Max:= Cnt;
                Counter:= Counter+1;
                if Counter >= 20 then quit;
                ];
        Num:= Num+1;
        ];
]


print "The first 20 anti-primes are:"

while (count < 20)
    n = n + 1
    d = count_divisors(n)
    if d > max_divisors then
        print n;
        max_divisors = d
        count = count + 1
    end if
wend
print

sub count_divisors(n)
    local count, i

    if n < 2 return 1

    count = 2
    for i = 2 to n/2
      if not(mod(n,  i)) count = count + 1
    next
    return count
end sub


fcn properDivsN(n) //--> count of proper divisors. 1-->1, wrong but OK here
   { [1.. (n + 1)/2 + 1].reduce('wrap(p,i){ p + (n%i==0 and n!=i) }) }
fcn antiPrimes{		// -->iterator
   Walker.chain([2..59],[60..*,30]).tweak(fcn(c,rlast){
      last,mx := rlast.value, properDivsN(c);
      if(mx<=last) return(Void.Skip);
      rlast.set(mx);
      c
   }.fp1(Ref(0))).push(1);	// 1 has no proper divisors
}


T Symbol
   String id
   Int lbp
   Int nud_bp
   Int led_bp
   (ASTNode -> ASTNode) nud
   ((ASTNode, ASTNode) -> ASTNode) led

   F set_nud_bp(nud_bp, nud)
      .nud_bp = nud_bp
      .nud = nud

   F set_led_bp(led_bp, led)
      .led_bp = led_bp
      .led = led

T ASTNode
   Symbol& symbol
   Int value
   ASTNode? first_child
   ASTNode? second_child

   F eval()
      S .symbol.id
         ‘(number)’
            R .value
         ‘+’
            R .first_child.eval() + .second_child.eval()
         ‘-’
            R I .second_child == N {-.first_child.eval()} E .first_child.eval() - .second_child.eval()
         ‘*’
            R .first_child.eval() * .second_child.eval()
         ‘/’
            R .first_child.eval() / .second_child.eval()
         ‘(’
            R .first_child.eval()
         E
            assert(0B)
            R 0

[String = Symbol] symbol_table
[String] tokens
V tokeni = -1
ASTNode token_node

F advance(sid = ‘’)
   I sid != ‘’
      assert(:token_node.symbol.id == sid)
   :tokeni++
   :token_node = ASTNode()
   I :tokeni == :tokens.len
      :token_node.symbol = :symbol_table[‘(end)’]
      R
   V token = :tokens[:tokeni]
   :token_node.symbol = :symbol_table[I token.is_digit() {‘(number)’} E token]
   I token.is_digit()
      :token_node.value = Int(token)

F expression(rbp = 0)
   ASTNode t = move(:token_node)
   advance()
   V left = t.symbol.nud(move(t))
   L rbp < :token_node.symbol.lbp
      t = move(:token_node)
      advance()
      left = t.symbol.led(t, move(left))
   R left

F parse(expr_str) -> ASTNode
   :tokens = re:‘\s*(\d+|.)’.find_strings(expr_str)
   :tokeni = -1
   advance()
   R expression()

F symbol(id, bp = 0) -> &
   I !(id C :symbol_table)
      V s = Symbol()
      s.id = id
      s.lbp = bp
      :symbol_table[id] = s
   R :symbol_table[id]

F infix(id, bp)
   F led(ASTNode self, ASTNode left)
      self.first_child = left
      self.second_child = expression(self.symbol.led_bp)
      R self
   symbol(id, bp).set_led_bp(bp, led)

F prefix(id, bp)
   F nud(ASTNode self)
      self.first_child = expression(self.symbol.nud_bp)
      R self
   symbol(id).set_nud_bp(bp, nud)

infix(‘+’, 1)
infix(‘-’, 1)
infix(‘*’, 2)
infix(‘/’, 2)
prefix(‘-’, 3)

F nud(ASTNode self)
   R self
symbol(‘(number)’).nud = nud
symbol(‘(end)’)

F nud_parens(ASTNode self)
   V expr = expression()
   advance(‘)’)
   R expr
symbol(‘(’).nud = nud_parens
symbol(‘)’)

L(expr_str) [‘-2 / 2 + 4 + 3 * 2’,
             ‘2 * (3 + (4 * 5 + (6 * 7) * 8) - 9) * 10’]
   print(expr_str‘ = ’parse(expr_str).eval())


INT base=10;
MODE FIXED = LONG REAL; # numbers in the format 9,999.999 #

#IF build abstract syntax tree and then EVAL tree #
MODE AST = UNION(NODE, FIXED);
MODE NUM = REF AST;
MODE NODE = STRUCT(NUM a, PROC (FIXED,FIXED)FIXED op, NUM b);

OP EVAL = (NUM ast)FIXED:(
  CASE ast IN
    (FIXED num): num,
    (NODE fork): (op OF fork)(EVAL( a OF fork), EVAL (b OF fork))
  ESAC
);

OP + = (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED a,b)FIXED:a+b, b) );
OP - = (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED a,b)FIXED:a-b, b) );
OP * = (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED a,b)FIXED:a*b, b) );
OP / = (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED a,b)FIXED:a/b, b) );
OP **= (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED a,b)FIXED:a**b, b) );

#ELSE simply use REAL arithmetic with no abstract syntax tree at all # CO
MODE NUM = FIXED, AST = FIXED;
OP EVAL = (FIXED num)FIXED: num;
#FI# END CO

MODE LEX = PROC (TOK)NUM;
MODE MONADIC =PROC (NUM)NUM;
MODE DIADIC = PROC (NUM,NUM)NUM;

MODE TOK = CHAR;
MODE ACTION = UNION(STACKACTION, LEX, MONADIC, DIADIC);
MODE OPVAL = STRUCT(INT prio, ACTION action);
MODE OPITEM = STRUCT(TOK token, OPVAL opval);

[256]STACKITEM stack;
MODE STACKITEM = STRUCT(NUM value, OPVAL op);
MODE STACKACTION = PROC (REF STACKITEM)VOID;

PROC begin = (REF STACKITEM top)VOID: prio OF op OF top -:= +10;
PROC end = (REF STACKITEM top)VOID: prio OF op OF top -:= -10;

OP ** = (COMPL a,b)COMPL: complex exp(complex ln(a)*b);

[8]OPITEM op list :=(
#  OP  PRIO ACTION #
  ("^", (8, (NUM a,b)NUM: a**b)),
  ("*", (7, (NUM a,b)NUM: a*b)),
  ("/", (7, (NUM a,b)NUM: a/b)),
  ("+", (6, (NUM a,b)NUM: a+b)),
  ("-", (6, (NUM a,b)NUM: a-b)),
  ("(",(+10, begin)),
  (")",(-10, end)),
  ("?", (9, LEX:SKIP))
);

PROC op dict = (TOK op)REF OPVAL:(
# This can be unrolled to increase performance #
  REF OPITEM candidate;
  FOR i TO UPB op list WHILE
    candidate := op list[i];
# WHILE # op /= token OF candidate DO
    SKIP
  OD;
  opval OF candidate
);

PROC build ast = (STRING expr)NUM:(

  INT top:=0;

  PROC compress ast stack = (INT prio, NUM in value)NUM:(
    NUM out value := in value;
    FOR loc FROM top BY -1 TO 1 WHILE
      REF STACKITEM stack top := stack[loc];
  # WHILE # ( top >= LWB stack | prio <= prio OF op OF stack top | FALSE ) DO
      top := loc - 1;
      out value :=
        CASE action OF op OF stack top IN
          (MONADIC op): op(value OF stack top), # not implemented #
          (DIADIC op): op(value OF stack top,out value)
        ESAC
    OD;
    out value
  );

  NUM value := NIL;
  FIXED num value;
  INT decimal places;

  FOR i TO UPB expr DO
    TOK token = expr[i];
    REF OPVAL this op := op dict(token);
    CASE action OF this op IN
      (STACKACTION action):(
        IF prio OF thisop = -10 THEN
          value := compress ast stack(0, value)
        FI;
        IF top >= LWB stack THEN
          action(stack[top])
        FI
      ),
      (LEX):( # a crude lexer #
        SHORT INT digit = ABS token - ABS "0";
        IF 0<= digit AND digit < base THEN
          IF NUM(value) IS NIL THEN # first digit #
            decimal places := 0;
            value := HEAP AST := num value := digit
          ELSE
            NUM(value) := num value := IF decimal places = 0
              THEN
                num value * base + digit
              ELSE
                decimal places *:= base;
                num value + digit / decimal places
              FI
          FI
        ELIF token = "." THEN
          decimal places := 1
        ELSE
          SKIP # and ignore spaces and any unrecognised characters #
        FI
      ),
      (MONADIC): SKIP, # not implemented #
      (DIADIC):(
        value := compress ast stack(prio OF this op, value);
        IF top=UPB stack THEN index error FI;
        stack[top+:=1]:=STACKITEM(value, this op);
        value:=NIL
      )
    ESAC
  OD;
  compress ast stack(-max int, value)
);

test:(
   printf(($" euler's number is about: "g(-long real width,long real width-2)l$,
     EVAL build ast("1+1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+1/15)/14)/13)/12)/11)/10)/9)/8)/7)/6)/5)/4)/3)/2")));
  SKIP EXIT
  index error:
    printf(("Stack over flow"))
)


/*
hand coded recursive descent parser
expr	: term ( ( PLUS | MINUS )  term )* ;
term	: factor ( ( MULT | DIV ) factor )* ;
factor	: NUMBER | '(' expr ')';
*/

calcLexer := makeCalcLexer()
string := "((3+4)*(7*9)+3)+4"
tokens := tokenize(string, calcLexer)
msgbox % printTokens(tokens)
ast := expr()
msgbox % printTree(ast)
msgbox % expression := evalTree(ast)
filedelete expression.ahk
fileappend, % "msgbox % " expression, expression.ahk
run, expression.ahk
return

expr()
{
  global tokens
  ast := object(1, "expr")
  if node := term()
    ast._Insert(node)
  loop
  {
    if peek("PLUS") or peek("MINUS")
    {
      op := getsym()
      newop := object(1, op.type, 2, op.value)
      node := term()
      ast._Insert(newop)
      ast._Insert(node)
    }
    Else
      Break
  }
  return ast
}

term()
{
  global tokens
  tree := object(1, "term")
  if node := factor()
    tree._Insert(node)
  loop
  {
    if  peek("MULT") or peek("DIV")
    {
      op := getsym()
      newop := object(1, op.type, 2, op.value)
      node := factor()
      tree._Insert(newop)
      tree._Insert(node)
    }
    else
      Break
  }
  return tree
}

factor()
{
  global tokens
  if peek("NUMBER")
  {
    token := getsym()
    tree := object(1, token.type, 2, token.value)
    return tree
  }
  else if  peek("OPEN")
  {
    getsym()
    tree := expr()
    if  peek("CLOSE")
    {
      getsym()
      return tree
    }
    else
      error("miss closing parentheses ")
  }
  else
    error("no factor found")
}

peek(type, n=1)
{
global tokens
  if (tokens[n, "type"] == type)
  return 1
}

getsym(n=1)
{
global tokens
return token := tokens._Remove(n)
}

error(msg)
{
global tokens
msgbox % msg " at:`n" printToken(tokens[1])
}

printTree(ast)
{
if !ast
return

n := 0
  loop
  {
  n += 1
    if !node := ast[n]
      break
    if !isobject(node)
      treeString .= node
    else
      treeString .= printTree(node)
  }
  return ("(" treeString ")" )
}

evalTree(ast)
{
if !ast
return

n := 1
  loop
  {
  n += 1
    if !node := ast[n]
      break
    if !isobject(node)
      treeString .= node
    else
      treeString .= evalTree(node)
  }
if (n == 3)
return treeString
  return ("(" treeString ")" )
}

#include calclex.ahk


      Expr$ = "1 + 2 * (3 + (4 * 5 + 6 * 7 * 8) - 9) / 10"
      PRINT "Input = " Expr$
      AST$ = FNast(Expr$)
      PRINT "AST =   " AST$
      PRINT "Value = " ;EVAL(AST$)
      END

      DEF FNast(RETURN in$)
      LOCAL ast$, oper$
      REPEAT
        ast$ += FNast1(in$)
        WHILE ASC(in$)=32 in$ = MID$(in$,2) : ENDWHILE
        oper$ = LEFT$(in$,1)
        IF oper$="+" OR oper$="-" THEN
          ast$ += oper$
          in$ = MID$(in$,2)
        ELSE
          EXIT REPEAT
        ENDIF
      UNTIL FALSE
      = "(" + ast$ + ")"

      DEF FNast1(RETURN in$)
      LOCAL ast$, oper$
      REPEAT
        ast$ += FNast2(in$)
        WHILE ASC(in$)=32 in$ = MID$(in$,2) : ENDWHILE
        oper$ = LEFT$(in$,1)
        IF oper$="*" OR oper$="/" THEN
          ast$ += oper$
          in$ = MID$(in$,2)
        ELSE
          EXIT REPEAT
        ENDIF
      UNTIL FALSE
      = "(" + ast$ + ")"

      DEF FNast2(RETURN in$)
      LOCAL ast$
      WHILE ASC(in$)=32 in$ = MID$(in$,2) : ENDWHILE
      IF ASC(in$)<>40 THEN = FNnumber(in$)
      in$ = MID$(in$,2)
      ast$ = FNast(in$)
      in$ = MID$(in$,2)
      = ast$

      DEF FNnumber(RETURN in$)
      LOCAL ch$, num$
      REPEAT
        ch$ = LEFT$(in$,1)
        IF INSTR("0123456789.", ch$) THEN
          num$ += ch$
          in$ = MID$(in$,2)
        ELSE
          EXIT REPEAT
        ENDIF
      UNTIL FALSE
      = num$


 #include <boost/spirit.hpp>
 #include <boost/spirit/tree/ast.hpp>
 #include <string>
 #include <cassert>
 #include <iostream>
 #include <istream>
 #include <ostream>

 using boost::spirit::rule;
 using boost::spirit::parser_tag;
 using boost::spirit::ch_p;
 using boost::spirit::real_p;

 using boost::spirit::tree_node;
 using boost::spirit::node_val_data;

 // The grammar
 struct parser: public boost::spirit::grammar<parser>
 {
   enum rule_ids { addsub_id, multdiv_id, value_id, real_id };

   struct set_value
   {
     set_value(parser const& p): self(p) {}
     void operator()(tree_node<node_val_data<std::string::iterator,
                                             double> >& node,
                     std::string::iterator begin,
                     std::string::iterator end) const
     {
       node.value.value(self.tmp);
     }
     parser const& self;
   };

   mutable double tmp;

   template<typename Scanner> struct definition
   {
     rule<Scanner, parser_tag<addsub_id> > addsub;
     rule<Scanner, parser_tag<multdiv_id> > multdiv;
     rule<Scanner, parser_tag<value_id> > value;
     rule<Scanner, parser_tag<real_id> > real;

     definition(parser const& self)
     {
       using namespace boost::spirit;
       addsub = multdiv
         >> *((root_node_d[ch_p('+')] | root_node_d[ch_p('-')]) >> multdiv);
       multdiv = value
         >> *((root_node_d[ch_p('*')] | root_node_d[ch_p('/')]) >> value);
       value = real | inner_node_d[('(' >> addsub >> ')')];
       real = leaf_node_d[access_node_d[real_p[assign_a(self.tmp)]][set_value(self)]];
     }

     rule<Scanner, parser_tag<addsub_id> > const& start() const
     {
       return addsub;
     }
   };
 };

 template<typename TreeIter>
 double evaluate(TreeIter const& i)
 {
   double op1, op2;
   switch (i->value.id().to_long())
   {
   case parser::real_id:
     return i->value.value();
   case parser::value_id:
   case parser::addsub_id:
   case parser::multdiv_id:
     op1 = evaluate(i->children.begin());
     op2 = evaluate(i->children.begin()+1);
     switch(*i->value.begin())
     {
     case '+':
       return op1 + op2;
     case '-':
       return op1 - op2;
     case '*':
       return op1 * op2;
     case '/':
       return op1 / op2;
     default:
       assert(!"Should not happen");
     }
   default:
     assert(!"Should not happen");
   }
   return 0;
 }

 // the read/eval/write loop
 int main()
 {
   parser eval;
   std::string line;
   while (std::cout << "Expression: "
          && std::getline(std::cin, line)
          && !line.empty())
   {
     typedef boost::spirit::node_val_data_factory<double> factory_t;
     boost::spirit::tree_parse_info<std::string::iterator, factory_t> info =
       boost::spirit::ast_parse<factory_t>(line.begin(), line.end(),
                                           eval, boost::spirit::space_p);
     if (info.full)
     {
       std::cout << "Result: " << evaluate(info.trees.begin()) << std::endl;
     }
     else
     {
       std::cout << "Error in expression." << std::endl;
     }
   }
 };


F fib(n)
   F f(Int n) -> Int
      I n < 2
         R n
      R @f(n - 1) + @f(n - 2)
   R f(n)

L(i) 0..20
   print(fib(i), end' ‘ ’)


   function Fib (X: in Integer) return Integer is
      function Actual_Fib (N: in Integer) return Integer is
      begin
         if N < 2 then
            return N;
         else
            return Actual_Fib (N-1) + Actual_Fib (N-2);
         end if;
      end Actual_Fib;
   begin
      if X < 0 then
         raise Constraint_Error;
      else
         return Actual_Fib (X);
      end if;
   end Fib;


PROC fibonacci = ( INT x )INT:
     IF x < 0
     THEN
         print( ( "negative parameter to fibonacci", newline ) );
         stop
     ELSE
         PROC actual fibonacci = ( INT n )INT:
             IF n < 2
             THEN
                 n
             ELSE
                 actual fibonacci( n - 1 ) + actual fibonacci( n - 2 )
             FI;
         actual fibonacci( x )
     FI;


(def precedence '{* 0, / 0
		  + 1, - 1})

(defn order-ops
  "((A x B) y C) or (A x (B y C)) depending on precedence of x and y"
  [[A x B y C & more]]
  (let [ret (if (<=  (precedence x)
		     (precedence y))
	      (list (list A x B) y C)
	      (list A x (list B y C)))]
    (if more
      (recur (concat ret more))
      ret)))

(defn add-parens
  "Tree walk to add parens.  All lists are length 3 afterwards."
  [s]
  (clojure.walk/postwalk
   #(if (seq? %)
      (let [c (count %)]
	(cond (even? c) (throw (Exception. "Must be an odd number of forms"))
	      (= c 1) (first %)
	      (= c 3) %
	      (>= c 5) (order-ops %)))
      %)
   s))

(defn make-ast
  "Parse a string into a list of numbers, ops, and lists"
  [s]
  (-> (format "'(%s)" s)
      (.replaceAll , "([*+-/])" " $1 ")
      load-string
      add-parens))

(def ops {'* *
	  '+ +
	  '- -
	  '/ /})

(def eval-ast
     (partial clojure.walk/postwalk
	      #(if (seq? %)
		 (let [[a o b] %]
		   ((ops o) a b))
		 %)))

(defn evaluate [s]
  "Parse and evaluate an infix arithmetic expression"
  (eval-ast (make-ast s)))

user> (evaluate "1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5 - 22/(7 + 2*(3 - 1)) - 1)) + 1")
60


fib←{               ⍝ Outer function
   ⍵<0:⎕SIGNAL 11   ⍝ DOMAIN ERROR if argument < 0
   {                ⍝ Inner (anonymous) function
      ⍵<2:⍵
      (∇⍵-1)+∇⍵-2   ⍝ ∇ = anonymous recursive call
   }⍵               ⍝ Call function in place
}


on fibonacci(n) -- "Anonymous recursion" task.
    -- For the sake of the task, a needlessly anonymous local script object containing a needlessly recursive handler.
    -- The script could easily (and ideally should) be assigned to a local variable.
    script
        property one : 1
        property sequence : {}

        on f(n)
            if (n < 2) then
                set end of my sequence to 0
                if (n is 1) then set end of my sequence to one
            else
                f(n - 1)
                set end of my sequence to (item -2 of my sequence) + (end of my sequence)
            end if
        end f
    end script

    -- Don't insert any additional code here!

    -- Sort out whether the input's positive or negative and tell the object generated above to do the recursive business.
    tell result
        if (n < 0) then
            set its one to -1
            set n to -n
        end if
        f(n)

        return its sequence
    end tell
end fibonacci

fibonacci(15) --> {0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610}
fibonacci(-15) --> {0, -1, -1, -2, -3, -5, -8, -13, -21, -34, -55, -89, -144, -233, -377, -610}


(defun tokenize-stream (stream)
  (labels ((whitespace-p (char)
             (find char #(#\space #\newline #\return #\tab)))
           (consume-whitespace ()
             (loop while (whitespace-p (peek-char nil stream nil #\a))
                   do (read-char stream)))
           (read-integer ()
             (loop while (digit-char-p (peek-char nil stream nil #\space))
                   collect (read-char stream) into digits
                   finally (return (parse-integer (coerce digits 'string))))))
    (consume-whitespace)
    (let* ((c (peek-char nil stream nil nil)))
           (token (case c
                     (nil nil)
                     (#\( :lparen)
                     (#\) :rparen)
                     (#\* '*)
                     (#\/ '/)
                     (#\+ '+)
                     (#\- '-)
                     (otherwise
                       (unless (digit-char-p c)
                         (cerror "Skip it." "Unexpected character ~w." c)
                         (read-char stream)
                         (return-from tokenize-stream
                                      (tokenize-stream stream)))
                       (read-integer)))))
        (unless (or (null token) (integerp token))
          (read-char stream))
        token)))

(defun group-parentheses (tokens &optional (delimited nil))
  (do ((new-tokens '()))
      ((endp tokens)
       (when delimited
         (cerror "Insert it."  "Expected right parenthesis."))
       (values (nreverse new-tokens) '()))
    (let ((token (pop tokens)))
      (case token
        (:lparen
         (multiple-value-bind (group remaining-tokens)
             (group-parentheses tokens t)
           (setf new-tokens (cons group new-tokens)
                 tokens remaining-tokens)))
        (:rparen
         (if (not delimited)
           (cerror "Ignore it." "Unexpected right parenthesis.")
           (return (values (nreverse new-tokens) tokens))))
        (otherwise
         (push token new-tokens))))))

(defun group-operations (expression)
  (flet ((gop (exp) (group-operations exp)))
    (if (integerp expression)
      expression
      (destructuring-bind (a &optional op1 b op2 c &rest others)
                          expression
        (unless (member op1 '(+ - * / nil))
          (error "syntax error: in expr ~a expecting operator, not ~a"
                 expression op1))
        (unless (member op2 '(+ - * / nil))
          (error "syntax error: in expr ~a expecting operator, not ~a"
                 expression op2))
        (cond
         ((not op1) (gop a))
         ((not op2) `(,(gop a) ,op1 ,(gop b)))
         (t (let ((a (gop a)) (b (gop b)) (c (gop c)))
              (if (and (member op1 '(+ -)) (member op2 '(* /)))
                (gop `(,a ,op1 (,b ,op2 ,c) ,@others))
                (gop `((,a ,op1 ,b) ,op2 ,c ,@others))))))))))

(defun infix-to-prefix (expression)
  (if (integerp expression)
    expression
    (destructuring-bind (a op b) expression
      `(,op ,(infix-to-prefix a) ,(infix-to-prefix b)))))

(defun evaluate (string)
  (with-input-from-string (in string)
    (eval
      (infix-to-prefix
        (group-operations
          (group-parentheses
            (loop for token = (tokenize-stream in)
                  until (null token)
                  collect token)))))))


fib: function [x][
    ; Using scoped function fibI inside fib
    fibI: function [n][
        (n<2)? -> n -> add fibI n-2 fibI n-1
    ]
    if x < 0 -> panic "Invalid argument"
    return fibI x
]

loop 0..4 'x [
    print fib x
]


Fib(n) {
	nold1 := 1
	nold2 := 0
	If n < 0
	{
		MsgBox, Positive argument required!
		Return
	}
	Else If n = 0
		Return nold2
	Else If n = 1
		Return nold1
	Fib_Label:
	t := nold2+nold1
	If n > 2
	{
		n--
		nold2:=nold1
		nold1:=t
		GoSub Fib_Label
	}
	Return t
}


import std.stdio, std.string, std.ascii, std.conv, std.array,
       std.exception, std.traits;

struct Stack(T) {
    T[] data;
    alias data this;
    void push(T top) pure nothrow @safe { data ~= top; }

    T pop(bool discard = true)() pure @nogc @safe {
      immutable static exc = new immutable(Exception)("Stack Empty");
      if (data.empty)
        throw exc;
      auto top = data[$ - 1];
      static if (discard)
        data.popBack;
      return top;
    }
}

enum Type {         Num, OBkt, CBkt, Add, Sub, Mul, Div }
immutable opChar = ["#", "(",  ")",  "+", "-", "*", "/"];
immutable opPrec = [ 0,  -9,   -9,    1,   1,   2,   2];

abstract class Visitor { void visit(XP e) pure @safe; }

final class XP {
  immutable Type type;
  immutable string str;
  immutable int pos; // Optional, to display AST struct.
  XP LHS, RHS;

  this(string s=")", int p = -1) pure nothrow @safe {
    str = s;
    pos = p;
    auto localType = Type.Num;
    foreach_reverse (immutable t; [EnumMembers!Type[1 .. $]])
      if (opChar[t] == s)
        localType = t;
    this.type = localType;
  }

  override int opCmp(Object other) pure @safe {
    auto rhs = cast(XP)other;
    enforce(rhs !is null);
    return opPrec[type] - opPrec[rhs.type];
  }

  void accept(Visitor v) pure @safe { v.visit(this); }
}

final class AST {
  XP root;
  Stack!XP opr, num;
  string xpr, token;
  int xpHead, xpTail;

  void joinXP(XP x) pure @safe {
    x.RHS = num.pop;
    x.LHS = num.pop;
    num.push(x);
  }

  string nextToken() pure @safe {
    while (xpHead < xpr.length && xpr[xpHead] == ' ')
      xpHead++; // Skip spc.
    xpTail = xpHead;
    if (xpHead < xpr.length) {
      token = xpr[xpTail .. xpTail + 1];
      switch (token) {
        case "(", ")", "+", "-", "*", "/": // Valid non-number.
          xpTail++;
          return token;
        default: // Should be number.
          if (token[0].isDigit) {
            while (xpTail < xpr.length && xpr[xpTail].isDigit())
              xpTail++;
            return xpr[xpHead .. xpTail];
          } // Else may be error.
      } // End switch.
    }
    if (xpTail < xpr.length)
      throw new Exception("Invalid Char <" ~ xpr[xpTail] ~ ">");
    return null;
  } // End nextToken.

  AST parse(in string s) /*@safe*/ {
    bool expectingOP;
    xpr = s;
    try {
      xpHead = xpTail = 0;
      num = opr = null;
      root = null;
      opr.push(new XP); // CBkt, prevent evaluate null OP precedence.
      while ((token = nextToken) !is null) {
        XP tokenXP = new XP(token, xpHead);
        if (expectingOP) { // Process OP-alike XP.
          switch (token) {
            case ")":
              while (opr.pop!false.type != Type.OBkt)
                joinXP(opr.pop);
              opr.pop;
              expectingOP = true;
              break;
            case "+", "-", "*", "/":
              while (tokenXP <= opr.pop!false)
                joinXP(opr.pop());
              opr.push(tokenXP);
              expectingOP = false;
              break;
            default:
              throw new Exception("Expecting Operator or ), not <"
                                  ~ token ~ ">");
          }
        } else { // Process Num-alike XP.
          switch (token) {
            case "+", "-", "*", "/", ")":
              throw new Exception("Expecting Number or (, not <"
                                  ~ token ~ ">");
            case "(":
              opr.push(tokenXP);
              expectingOP = false;
              break;
            default: // Number.
              num.push(tokenXP);
              expectingOP = true;
          }
        }
        xpHead = xpTail;
      } // End while.

      while (opr.length > 1) // Join pending Op.
        joinXP(opr.pop);
    } catch(Exception e) {
      writefln("%s\n%s\n%s^", e.msg, xpr, " ".replicate(xpHead));
      root = null;
      return this;
    }

    if (num.length != 1) { // Should be one XP left.
      "Parse Error...".writefln;
      root = null;
    } else {
      root = num.pop;
    }
    return this;
  } // End Parse.
}  // End class AST.

// To display AST fancy struct.
void ins(ref char[][] s, in string v, in int p, in int l)
pure nothrow @safe {
  if (l + 1 > s.length)
    s.length++;
  while (s[l].length < p + v.length + 1)
    s[l] ~= " ";
  s[l][p .. p + v.length] = v[];
}

final class CalcVis : Visitor {
  int result, level;
  string resultStr;
  char[][] Tree;

  static void opCall(AST a) @safe {
    if (a && a.root) {
      auto c = new CalcVis;
      a.root.accept(c);
      foreach (immutable i; 1 .. c.Tree.length) { // More fancy.
        bool flipflop = false;
        enum char mk = '.';
        foreach (immutable j; 0 .. c.Tree[i].length) {
          while (j >= c.Tree[i - 1].length)
            c.Tree[i - 1] ~= " ";
          immutable c1 = c.Tree[i][j];
          immutable c2 = c.Tree[i - 1][j];
          if (flipflop && (c1 == ' ') && c2 == ' ')
            c.Tree[i - 1][j] = mk;
          if (c1 != mk && c1 != ' ' &&
              (j == 0 || !isDigit(c.Tree[i][j - 1])))
            flipflop = !flipflop;
        }
      }
      foreach (const t; c.Tree)
        t.writefln;
      writefln("\n%s ==>\n%s = %s", a.xpr, c.resultStr, c.result);
    } else
      "Evalute invalid or null Expression.".writefln;
  }

  // Calc. the value, display AST struct and eval order.
  override void visit(XP xp) @safe {
    ins(Tree, xp.str, xp.pos, level);
    level++;
    if (xp.type == Type.Num) {
      resultStr ~= xp.str;
      result = xp.str.to!int;
    } else {
      resultStr ~= "(";
      xp.LHS.accept(this);
      immutable int lhs = result;
      resultStr ~= opChar[xp.type];
      xp.RHS.accept(this);
      resultStr ~= ")";
      switch (xp.type) {
        case Type.Add: result = lhs + result; break;
        case Type.Sub: result = lhs - result; break;
        case Type.Mul: result = lhs * result; break;
        case Type.Div: result = lhs / result; break;
        default: throw new Exception("Invalid type");
      }
    }
    level--;
  }
}

void main(string[] args) /*@safe*/ {
  immutable exp0 = "1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5" ~
                   " - 22/(7 + 2*(3 - 1)) - 1)) + 1";
  immutable exp = (args.length > 1) ? args[1 .. $].join(' ') : exp0;
  new AST().parse(exp).CalcVis; // Should be 60.
}


ConsoleWrite(Fibonacci(10) & @CRLF)						; ## USAGE EXAMPLE
ConsoleWrite(Fibonacci(20) & @CRLF)						; ## USAGE EXAMPLE
ConsoleWrite(Fibonacci(30))						        ; ## USAGE EXAMPLE

Func Fibonacci($number)

	If $number < 0 Then Return "Invalid argument" 				; No negative numbers

	If $number < 2 Then 							; If $number equals 0 or 1
		Return $number  						; then return that $number
	Else									; Else $number equals 2 or more
		Return Fibonacci($number - 1) + Fibonacci($number - 2) 		; FIBONACCI!
	EndIf

EndFunc


#include "axiom"
Z ==> Integer;
fib(x:Z):Z == {
	x <= 0 => error "argument outside of range";
	f(n:Z,v1:Z,v2:Z):Z == if n<2 then v2 else f(n-1,v2,v1+v2);
	f(x,1,1);
}


type Expr = Bin(op, Expr left, Expr right) or Literal(Float val)
    with Lookup

type Token(val, Char kind) with Lookup
func Token.ToString() => this.val.ToString()

func tokenize(str) {
    func isSep(c) =>
        c is '+' or '-' or '*' or '/' or ' ' or '\t' or '\n' or '\r' or '(' or ')' or '\0'

    var idx = -1
    let len = str.Length()
    let tokens = []

    func next() {
        idx += 1
        return '\0' when idx >= len
        str[idx]
    }

    while true {
        let c = next()

        match c {
            '\0' => { break },
            '+' => tokens.Add(Token(c, '+')),
            '-' => tokens.Add(Token(c, '-')),
            '*' => tokens.Add(Token(c, '*')),
            '/'  => tokens.Add(Token(c, '/')),
            '(' => tokens.Add(Token(c, '(')),
            ')' => tokens.Add(Token(c, ')')),
            _ => {
                let i = idx
                while !isSep(next()) { }
                idx -= 1
                tokens.Add(Token(Float.Parse(str[i..idx]), 'F'))
            }
        }
    }

    tokens
}

func parse(tokens) {
    var idx = -1
    let len = tokens.Length()
    let eol = Token(val: nil, kind: 'E')
    func pop() {
        idx += 1
        return eol when idx == len
        tokens[idx]
    }
    func peek() {
        let t = pop()
        idx -=1
        t
    }
    func expect(kind) {
        peek().kind == kind
    }
    var add_or_sub1

    func literal() {
        return false when !expect('F')
        Expr.Literal(pop().val)
    }

    func group() {
        return false when !expect('(')
        pop()
        var ret = add_or_sub1()
        throw "Invalid group" when !expect(')')
        pop()
        ret
    }

    func mul_or_div() {
        var fst = group()
        fst = literal() when !fst
        return fst when !expect('*') && !expect('/')
        let op = pop().val
        var snd = group()
        snd = literal() when !snd
        Expr.Bin(op, fst, snd)
    }

    func add_or_sub() {
        let fst = mul_or_div()
        return fst when !expect('+') && !expect('-')
        let op = pop().val
        let snd = mul_or_div()
        Expr.Bin(op, fst, snd)
    }
    add_or_sub1 = add_or_sub

    add_or_sub()
}

func exec(ast) {
    match ast {
        Bin(op, left, right) => {
            return exec(left) + exec(right) when op == '+'
            return exec(left) - exec(right) when op == '-'
            return exec(left) * exec(right) when op == '*'
            return exec(left) / exec(right) when op == '/'
        },
        Literal(value) => value
    }
}

func eval(str) {
    let tokens = tokenize(str)
    let ast = parse(tokens)
    exec(ast)
}

print( eval("(1+33.23)*7") )
print( eval("1+33.23*7") )


DEF FN  fib(x) = FIB(x)

'============================
FUNCTION  FIB(int n) TYPE int
'============================

    IF n < 2 THEN
        PRINT n

    ELSE
        n1 = 0
        n2 = 1
        FOR i = 1 TO n
            sum = n1 + n2
            n1 = n2
            n2 = sum
        NEXT
        PRINT n1
    END IF
END FUNCTION

'--- less than 2
FIB(0)
FIB(1)

'--- greater than or equal to 2
FIB(2)
FIB(3)
FIB(4)
FIB(5)
FIB(6)
FIB(7)
FIB(8)
FIB(9)

'--- using an alias
'fib(9)


print Fibonacci(20)
print Fibonacci(30)
print Fibonacci(-10)
print Fibonacci(10)
end

function Fibonacci(num)
	if num < 0 then
		print "Invalid argument: ";
		return num
	end if

	if num < 2 then
		return num
	else
		return Fibonacci(num - 1) + Fibonacci(num - 2)
	end If
end function


def eParser := <elang:syntax.makeEParser>
def LiteralExpr := <elang:evm.makeLiteralExpr>.asType()
def arithEvaluate(expr :String) {
  def ast := eParser(expr)

  def evalAST(ast) {
    return switch (ast) {
      match e`@a + @b` { evalAST(a) + evalAST(b) }
      match e`@a - @b` { evalAST(a) - evalAST(b) }
      match e`@a * @b` { evalAST(a) * evalAST(b) }
      match e`@a / @b` { evalAST(a) / evalAST(b) }
      match e`[email protected]` { -(evalAST(a)) }
      match l :LiteralExpr { l.getValue() }
    }
  }

  return evalAST(ast)
}


import system'routines;
import extensions;
import extensions'text;

class Token
{
    object theValue;

    rprop int Level;

    constructor new(int level)
    {
        theValue := new StringWriter();
        Level := level + 9;
    }

    append(ch)
    {
        theValue.write(ch)
    }

    Number = theValue.toReal();
}

class Node
{
    prop object Left;
    prop object Right;
    rprop int Level;

    constructor new(int level)
    {
        Level := level
    }
}

class SummaryNode : Node
{
    constructor new(int level)
        <= new(level + 1);

    Number = Left.Number + Right.Number;
}

class DifferenceNode : Node
{
    constructor new(int level)
        <= new(level + 1);

    Number = Left.Number - Right.Number;
}

class ProductNode : Node
{
    constructor new(int level)
        <= new(level + 2);

    Number = Left.Number * Right.Number;
}

class FractionNode : Node
{
    constructor new(int level)
        <= new(level + 2);

    Number = Left.Number / Right.Number;
}

class Expression
{
    rprop int Level;
    prop object Top;

    constructor new(int level)
    {
        Level := level
    }

    Right
    {
        get() = Top;

        set(object node)
        {
            Top := node
        }
    }

    get Number() => Top;
}

singleton operatorState
{
    eval(ch)
    {
        ch =>
            $40 {      // (
                ^ __target.newBracket().gotoStarting()
            }
            : {
                ^ __target.newToken().append(ch).gotoToken()
            }
    }
}

singleton tokenState
{
    eval(ch)
    {
        ch =>
            $41 {      // )
                ^ __target.closeBracket().gotoToken()
            }
            $42 {      // *
                ^ __target.newProduct().gotoOperator()
            }
            $43 {      // +
                ^ __target.newSummary().gotoOperator()
            }
            $45 {      // -
                ^ __target.newDifference().gotoOperator()
            }
            $47 {      // /
                ^ __target.newFraction().gotoOperator()
            }
            : {
                ^ __target.append:ch
            }
    }
}

singleton startState
{
    eval(ch)
    {
        ch =>
            $40 {      // (
                ^ __target.newBracket().gotoStarting()
            }
            $45 { // -
                ^ __target.newToken().append("0").newDifference().gotoOperator()
            }
            : {
                ^ __target.newToken().append:ch.gotoToken()
            }
    }
}

class Scope
{
    object theState;
    int    theLevel;
    object theParser;
    object theToken;
    object theExpression;

    constructor new(parser)
    {
        theState := startState;
        theLevel := 0;
        theExpression := Expression.new(0);
        theParser := parser
    }

    newToken()
    {
        theToken := theParser.appendToken(theExpression, theLevel)
    }

    newSummary()
    {
        theToken := nil;

        theParser.appendSummary(theExpression, theLevel)
    }

    newDifference()
    {
        theToken := nil;

        theParser.appendDifference(theExpression, theLevel)
    }

    newProduct()
    {
        theToken := nil;

        theParser.appendProduct(theExpression, theLevel)
    }

    newFraction()
    {
        theToken := nil;

        theParser.appendFraction(theExpression, theLevel)
    }

    newBracket()
    {
        theToken := nil;

        theLevel := theLevel + 10;

        theParser.appendSubexpression(theExpression, theLevel)
    }

    closeBracket()
    {
        if (theLevel < 10)
            { InvalidArgumentException.new:"Invalid expression".raise() };

        theLevel := theLevel - 10
    }

    append(ch)
    {
        if(ch >= $48 && ch < $58)
        {
            theToken.append:ch
        }
        else
        {
            InvalidArgumentException.new:"Invalid expression".raise()
        }
    }

    append(string s)
    {
        s.forEach:(ch){ self.append:ch }
    }

    gotoStarting()
    {
        theState := startState
    }

    gotoToken()
    {
        theState := tokenState
    }

    gotoOperator()
    {
        theState := operatorState
    }

    get Number() => theExpression;

    dispatch() => theState;
}

class Parser
{
    appendToken(object expression, int level)
    {
        var token := Token.new(level);

        expression.Top := self.append(expression.Top, token);

        ^ token
    }

    appendSummary(object expression, int level)
    {
        expression.Top := self.append(expression.Top, SummaryNode.new(level))
    }

    appendDifference(object expression, int level)
    {
        expression.Top := self.append(expression.Top, DifferenceNode.new(level))
    }

    appendProduct(object expression, int level)
    {
        expression.Top := self.append(expression.Top, ProductNode.new(level))
    }

    appendFraction(object expression, int level)
    {
        expression.Top := self.append(expression.Top, FractionNode.new(level))
    }

    appendSubexpression(object expression, int level)
    {
        expression.Top := self.append(expression.Top, Expression.new(level))
    }

    append(lastNode, newNode)
    {
        if(nil == lastNode)
            { ^ newNode };

        if (newNode.Level <= lastNode.Level)
            { newNode.Left := lastNode; ^ newNode };

        var parent := lastNode;
        var current := lastNode.Right;
        while (nil != current && newNode.Level > current.Level)
            { parent := current; current := current.Right };

        if (nil == current)
        {
            parent.Right := newNode
        }
        else
        {
            newNode.Left := current; parent.Right := newNode
        };

        ^ lastNode
    }

    run(text)
    {
        var scope := Scope.new(self);

        text.forEach:(ch){ scope.eval:ch };

        ^ scope.Number
    }
}

public program()
{
    var text := new StringWriter();
    var parser := new Parser();

    while (console.readLine().saveTo(text).Length > 0)
    {
        try
        {
            console.printLine("=",parser.run:text)
        }
        catch(Exception e)
        {
            console.writeLine:"Invalid Expression"
        };

        text.clear()
    }
}


      PRINT FNfib(10)
      END

      DEF FNfib(n%) IF n%<0 THEN ERROR 100, "Must not be negative"
      LOCAL P% : P% = !384 + LEN$!384 + 4 : REM Function pointer
      (n%) IF n%<2 THEN = n% ELSE = FN(^P%)(n%-1) + FN(^P%)(n%-2)


#!/usr/bin/env emacs --script
;; -*- mode: emacs-lisp; lexical-binding: t -*-
;;> ./arithmetic-evaluation '(1 + 2) * 3'

(defun advance ()
  (let ((rtn (buffer-substring-no-properties (point) (match-end 0))))
    (goto-char (match-end 0))
    rtn))

(defvar current-symbol nil)

(defun next-symbol ()
  (when (looking-at "[ \t\n]+")
    (goto-char (match-end 0)))

  (cond
   ((eobp)
    (setq current-symbol 'eof))
   ((looking-at "[0-9]+")
    (setq current-symbol (string-to-number (advance))))
   ((looking-at "[-+*/()]")
    (setq current-symbol (advance)))
   ((looking-at ".")
    (error "Unknown character '%s'" (advance)))))

(defun accept (sym)
  (when (equal sym current-symbol)
    (next-symbol)
    t))

(defun expect (sym)
  (unless (accept sym)
    (error "Expected symbol %s, but found %s" sym current-symbol))
  t)

(defun p-expression ()
  " expression = term  { ('+' | '-') term } . "
  (let ((rtn (p-term)))
    (while (or (equal current-symbol "+") (equal current-symbol "-"))
      (let ((op current-symbol)
            (left rtn))
        (next-symbol)
        (setq rtn (list op left (p-term)))))
    rtn))

(defun p-term ()
  " term = factor  { ('*' | '/') factor } . "
  (let ((rtn (p-factor)))
    (while (or (equal current-symbol "*") (equal current-symbol "/"))
      (let ((op current-symbol)
            (left rtn))
        (next-symbol)
        (setq rtn (list op left (p-factor)))))
    rtn))

(defun p-factor ()
  " factor = constant | variable | '('  expression  ')' . "
  (let (rtn)
    (cond
     ((numberp current-symbol)
      (setq rtn current-symbol)
      (next-symbol))
     ((accept "(")
      (setq rtn (p-expression))
      (expect ")"))
     (t (error "Syntax error")))
    rtn))

(defun ast-build (expression)
  (let (rtn)
    (with-temp-buffer
      (insert expression)
      (goto-char (point-min))
      (next-symbol)
      (setq rtn (p-expression))
      (expect 'eof))
    rtn))

(defun ast-eval (v)
  (pcase v
    ((pred numberp) v)
    (`("+" ,a ,b) (+ (ast-eval a) (ast-eval b)))
    (`("-" ,a ,b) (- (ast-eval a) (ast-eval b)))
    (`("*" ,a ,b) (* (ast-eval a) (ast-eval b)))
    (`("/" ,a ,b) (/ (ast-eval a) (float (ast-eval b))))
    (_ (error "Unknown value %s" v))))

(dolist (arg command-line-args-left)
  (let ((ast (ast-build arg)))
    (princ (format "       ast = %s\n" ast))
    (princ (format "     value = %s\n" (ast-eval ast)))
    (terpri)))
(setq command-line-args-left nil)


#include <stdio.h>

long fib(long x)
{
        long fib_i(long n) { return n < 2 ? n : fib_i(n - 2) + fib_i(n - 1); };
        if (x < 0) {
                printf("Bad argument: fib(%ld)\n", x);
                return -1;
        }
        return fib_i(x);
}

long fib_i(long n) /* just to show the fib_i() inside fib() has no bearing outside it */
{
        printf("This is not the fib you are looking for\n");
        return -1;
}

int main()
{
        long x;
        for (x = -1; x < 4; x ++)
                printf("fib %ld = %ld\n", x, fib(x));

        printf("calling fib_i from outside fib:\n");
        fib_i(3);

        return 0;
}


static int Fib(int n)
{
    if (n < 0) throw new ArgumentException("Must be non negativ", "n");

    Func<int, int> fib = null; // Must be known, before we can assign recursively to it.
    fib = p => p > 1 ? fib(p - 2) + fib(p - 1) : p;
    return fib(n);
}


PROGRAM EVAL

!
! arithmetic expression evaluator
!

!$KEY

LABEL 98,100,110

DIM STACK$[50]

PROCEDURE DISEGNA_STACK
  !$RCODE="LOCATE 3,1"
  !$RCODE="COLOR 0,7"
  PRINT(TAB(35);"S T A C K";TAB(79);)
  !$RCODE="COLOR 7,0"
  FOR TT=1 TO 38 DO
     IF TT>=20 THEN
        !$RCODE="LOCATE 3+TT-19,40"
      ELSE
        !$RCODE="LOCATE 3+TT,1"
     END IF
     IF TT=NS THEN PRINT(">";)  ELSE PRINT(" ";)  END IF
     PRINT(RIGHT$(STR$(TT),2);"³ ";STACK$[TT];"    ")
  END FOR
  REPEAT
   GET(Z$)
  UNTIL LEN(Z$)<>0
END PROCEDURE

PROCEDURE COMPATTA_STACK
   IF NS>1 THEN
      R=1
      WHILE R<NS DO
         IF INSTR(OP_LIST$,STACK$[R])=0 AND INSTR(OP_LIST$,STACK$[R+1])=0 THEN
            FOR R1=R TO NS-1 DO
                STACK$[R1]=STACK$[R1+1]
            END FOR
            NS=NS-1
         END IF
         R=R+1
      END WHILE
   END IF
   DISEGNA_STACK
END PROCEDURE

PROCEDURE CALC_ARITM
     L=NS1
     WHILE L<=NS2 DO
        IF STACK$[L]="^" THEN
            IF L>=NS2 THEN GOTO 100 END IF
            N1#=VAL(STACK$[L-1])  N2#=VAL(STACK$[L+1])  NOP=NOP-1
            IF STACK$[L]="^" THEN
                RI#=N1#^N2#
            END IF
            STACK$[L-1]=STR$(RI#)
            N=L
            WHILE N<=NS2-2 DO
               STACK$[N]=STACK$[N+2]
               N=N+1
            END WHILE
            NS2=NS2-2
            L=NS1-1
        END IF
        L=L+1
     END WHILE

     L=NS1
     WHILE L<=NS2 DO
        IF STACK$[L]="*" OR STACK$[L]="/" THEN
            IF L>=NS2 THEN GOTO 100 END IF
            N1#=VAL(STACK$[L-1])  N2#=VAL(STACK$[L+1])  NOP=NOP-1
            IF STACK$[L]="*" THEN RI#=N1#*N2# ELSE RI#=N1#/N2# END IF
            STACK$[L-1]=STR$(RI#)
            N=L
            WHILE N<=NS2-2 DO
               STACK$[N]=STACK$[N+2]
               N=N+1
            END WHILE
            NS2=NS2-2
            L=NS1-1
        END IF
        L=L+1
     END WHILE

     L=NS1
     WHILE L<=NS2 DO
        IF STACK$[L]="+" OR STACK$[L]="-" THEN
            EXIT IF L>=NS2
            N1#=VAL(STACK$[L-1])  N2#=VAL(STACK$[L+1])  NOP=NOP-1
            IF STACK$[L]="+" THEN RI#=N1#+N2# ELSE RI#=N1#-N2# END IF
            STACK$[L-1]=STR$(RI#)
            N=L
            WHILE N<=NS2-2 DO
               STACK$[N]=STACK$[N+2]
               N=N+1
            END WHILE
            NS2=NS2-2
            L=NS1-1
        END IF
        L=L+1
     END WHILE
100:
     IF NOP<2 THEN   ! operator priority
          DB#=VAL(STACK$[NS1])
       ELSE
          IF NOP<3 THEN
               DB#=VAL(STACK$[NS1+2])
             ELSE
               DB#=VAL(STACK$[NS1+4])
          END IF
     END IF
END PROCEDURE

PROCEDURE SVOLGI_PAR
   NPA=NPA-1
   FOR J=NS TO 1 STEP -1 DO
      EXIT IF STACK$[J]="("
   END FOR
   IF J=0 THEN
       NS1=1  NS2=NS  CALC_ARITM
       NERR=7
     ELSE
       FOR R=J TO NS-1 DO
          STACK$[R]=STACK$[R+1]
       END FOR
       NS1=J  NS2=NS-1  CALC_ARITM
       IF NS1=2 THEN NS1=1  STACK$[1]=STACK$[2] END IF
       NS=NS1
       COMPATTA_STACK
   END IF
END PROCEDURE

BEGIN
     OP_LIST$="+-*/^("
     NOP=0  NPA=0  NS=1  K$=""
     STACK$[1]="@"              ! init stack

     PRINT(CHR$(12);)
     INPUT(LINE,EXPRESSION$)

     FOR W=1 TO LEN(EXPRESSION$) DO
        LOOP
           CODE=ASC(MID$(EXPRESSION$,W,1))
           IF (CODE>=48 AND CODE<=57) OR CODE=46 THEN
                K$=K$+CHR$(CODE)
                W=W+1  IF W>LEN(EXPRESSION$) THEN GOTO 98 END IF
              ELSE
                EXIT IF K$=""
                IF NS>1 OR (NS=1 AND STACK$[1]<>"@") THEN NS=NS+1 END IF
                IF FLAG=0 THEN STACK$[NS]=K$ ELSE STACK$[NS]=STR$(VAL(K$)*FLAG) END IF
                K$=""  FLAG=0
                EXIT
           END IF
        END LOOP
        IF CODE=43 THEN K$="+" END IF
        IF CODE=45 THEN K$="-" END IF
        IF CODE=42 THEN K$="*" END IF
        IF CODE=47 THEN K$="/" END IF
        IF CODE=94 THEN K$="^" END IF

     CASE CODE OF
       43,45,42,47,94->
             IF MID$(EXPRESSION$,W+1,1)="-" THEN FLAG=-1  W=W+1 END IF
             IF INSTR(OP_LIST$,STACK$[NS])<>0 THEN
                 NERR=5
               ELSE
                 NS=NS+1  STACK$[NS]=K$  NOP=NOP+1
                 IF NOP>=2 THEN
                    FOR J=NS TO 1 STEP -1 DO
                       IF STACK$[J]<>"(" THEN
                           CONTINUE FOR
                       END IF
                       IF J<NS-2 THEN
                           EXIT
                         ELSE
                            GOTO 110
                       END IF
                    END FOR
                    NS1=J+1  NS2=NS  CALC_ARITM
                    NS=NS2  STACK$[NS]=K$
                    REGISTRO_X#=VAL(STACK$[NS-1])
                 END IF
             END IF
110:
       END ->

       40->
             IF NS>1 OR (NS=1 AND STACK$[1]<>"@") THEN NS=NS+1 END IF
             STACK$[NS]="("  NPA=NPA+1
             IF MID$(EXPRESSION$,W+1,1)="-" THEN FLAG=-1  W=W+1 END IF
       END ->

       41->
             SVOLGI_PAR
             IF NERR=7 THEN
                  NERR=0  NOP=0  NPA=0  NS=1
               ELSE
                  IF NERR=0 OR NERR=1 THEN
                      DB#=VAL(STACK$[NS])
                      REGISTRO_X#=DB#
                    ELSE
                      NOP=0  NPA=0  NS=1
                  END IF
            END IF
       END ->

       OTHERWISE
            NERR=8
   END CASE
   K$=""
   DISEGNA_STACK
END FOR

98:
   IF K$<>"" THEN
        IF NS>1 OR (NS=1 AND STACK$[1]<>"@") THEN NS=NS+1 END IF
        IF FLAG=0 THEN STACK$[NS]=K$ ELSE STACK$[NS]=STR$(VAL(K$)*FLAG) END IF
   END IF
   DISEGNA_STACK
   IF INSTR(OP_LIST$,STACK$[NS])<>0 THEN
         NERR=6
       ELSE
         WHILE NPA<>0 DO
             SVOLGI_PAR
         END WHILE
         IF NERR<>7 THEN NS1=1  NS2=NS  CALC_ARITM  END IF
    END IF
    NS=1  NOP=0  NPA=0
    !$RCODE="LOCATE 23,1"
    IF NERR>0 THEN PRINT("Internal Error #";NERR)  ELSE PRINT("Value is ";DB#) END IF
END PROGRAM


module AbstractSyntaxTree

type Expression =
  | Int    of int
  | Plus   of Expression * Expression
  | Minus  of Expression * Expression
  | Times  of Expression * Expression
  | Divide of Expression * Expression


double fib(double n)
{
  if(n < 0)
  {
    throw "Invalid argument passed to fib";
  }
  else
  {
    struct actual_fib
    {
        static double calc(double n)
        {
          if(n < 2)
          {
            return n;
          }
          else
          {
            return calc(n-1) + calc(n-2);
          }
        }
    };

    return actual_fib::calc(n);
  }
}


10 -> (@eager) fn n:
  if n:
    n - 1 -> print -> recall


USING: accessors kernel locals math math.parser peg.ebnf ;
IN: rosetta.arith

TUPLE: operator left right ;
TUPLE: add < operator ;   C: <add> add
TUPLE: sub < operator ;   C: <sub> sub
TUPLE: mul < operator ;   C: <mul> mul
TUPLE: div < operator ;   C: <div> div

EBNF: expr-ast
spaces   = [\n\t ]*
digit    = [0-9]
number   = (digit)+                         => [[ string>number ]]

value    =   spaces number:n                => [[ n ]]
           | spaces "(" exp:e spaces ")"    => [[ e ]]

fac      =   fac:a spaces "*" value:b       => [[ a b <mul> ]]
           | fac:a spaces "/" value:b       => [[ a b <div> ]]
           | value

exp      =   exp:a spaces "+" fac:b         => [[ a b <add> ]]
           | exp:a spaces "-" fac:b         => [[ a b <sub> ]]
           | fac

main     = exp:e spaces !(.)                => [[ e ]]
;EBNF

GENERIC: eval-ast ( ast -- result )

M: number eval-ast ;

: recursive-eval ( ast -- left-result right-result )
    [ left>> eval-ast ] [ right>> eval-ast ] bi ;

M: add eval-ast recursive-eval + ;
M: sub eval-ast recursive-eval - ;
M: mul eval-ast recursive-eval * ;
M: div eval-ast recursive-eval / ;

: evaluate ( string -- result )
    expr-ast eval-ast ;


'Arithmetic evaluation
'
'Create a program which parses and evaluates arithmetic expressions.
'
'Requirements
'
'    * An abstract-syntax tree (AST) for the expression must be created from parsing the
'      input.
'    * The AST must be used in evaluation, also, so the input may not be directly evaluated
'      (e.g. by calling eval or a similar language feature.)
'    * The expression will be a string or list of symbols like "(1+3)*7".
'    * The four symbols + - * / must be supported as binary operators with conventional
'      precedence rules.
'    * Precedence-control parentheses must also be supported.
'
'Standard mathematical precedence should be followed:
'
'    Parentheses
'    Multiplication/Division (left to right)
'    Addition/Subtraction (left to right)
'
'  test cases:
'  2*-3--4+-0.25 : returns -2.25
'  1 + 2 * (3 + (4 * 5 + 6 * 7 * 8) - 9) / 10 : returns 71

enum
    false = 0
    true = -1
end enum

enum Symbol
    unknown_sym
    minus_sym
    plus_sym
    lparen_sym
    rparen_sym
    number_sym
    mul_sym
    div_sym
    unary_minus_sym
    unary_plus_sym
    done_sym
    eof_sym
end enum

type Tree
    as Tree ptr leftp, rightp
    op as Symbol
    value as double
end type

dim shared sym as Symbol
dim shared tokenval as double
dim shared usr_input as string

declare function expr(byval p as integer) as Tree ptr

function isdigit(byval ch as string) as long
    return ch <> "" and Asc(ch) >= Asc("0") and Asc(ch) <= Asc("9")
end function

sub error_msg(byval msg as string)
    print msg
    system
end sub

' tokenize the input string
sub getsym()
    do
        if usr_input = "" then
            line input usr_input
            usr_input += chr(10)
        endif
        dim as string ch = mid(usr_input, 1, 1) ' get the next char
        usr_input = mid(usr_input, 2)           ' remove it from input

        sym = unknown_sym
        select case ch
            case " ":     continue do
            case chr(10), "": sym = done_sym: return
            case "+":     sym = plus_sym:     return
            case "-":     sym = minus_sym:    return
            case "*":     sym = mul_sym:      return
            case "/":     sym = div_sym:      return
            case "(":     sym = lparen_sym:   return
            case ")":     sym = rparen_sym:   return
            case else
                if isdigit(ch) then
                    dim s as string = ""
                    dim dot as integer = 0
                    do
                        s += ch
                        if ch = "." then dot += 1
                        ch = mid(usr_input, 1, 1)       ' get the next char
                        usr_input = mid(usr_input, 2)   ' remove it from input
                    loop while isdigit(ch) orelse ch = "."
                    if ch = "." or dot > 1 then error_msg("bogus number")
                    usr_input = ch + usr_input          ' prepend the char to input
                    tokenval = val(s)
                    sym = number_sym
                end if
                return
        end select
    loop
end sub

function make_node(byval op as Symbol, byval leftp as Tree ptr, byval rightp as Tree ptr) as Tree ptr
    dim t as Tree ptr

    t = callocate(len(Tree))
    t->op = op
    t->leftp = leftp
    t->rightp = rightp
    return t
end function

function is_binary(byval op as Symbol) as integer
    select case op
        case mul_sym, div_sym, plus_sym, minus_sym: return true
        case else: return false
    end select
end function

function prec(byval op as Symbol) as integer
    select case op
        case unary_minus_sym, unary_plus_sym:  return 100
        case mul_sym, div_sym:                 return  90
        case plus_sym, minus_sym:              return  80
        case else:                             return   0
    end select
end function

function primary as Tree ptr
    dim t as Tree ptr = 0

    select case sym
        case minus_sym, plus_sym
            dim op as Symbol = sym
            getsym()
            t = expr(prec(unary_minus_sym))
            if op = minus_sym then return make_node(unary_minus_sym, t, 0)
            if op = plus_sym  then return make_node(unary_plus_sym,  t, 0)
        case lparen_sym
            getsym()
            t = expr(0)
            if sym <> rparen_sym then error_msg("expecting rparen")
            getsym()
            return t
        case number_sym
            t = make_node(sym, 0, 0)
            t->value = tokenval
            getsym()
            return t
        case else: error_msg("expecting a primary")
    end select
end function

function expr(byval p as integer) as Tree ptr
    dim t as Tree ptr = primary()

    while is_binary(sym) andalso prec(sym) >= p
        dim t1 as Tree ptr
        dim op as Symbol = sym
        getsym()
        t1 = expr(prec(op) + 1)
        t = make_node(op, t, t1)
    wend
    return t
end function

function eval(byval t as Tree ptr) as double
    if t <> 0 then
        select case t->op
            case minus_sym:       return eval(t->leftp) - eval(t->rightp)
            case plus_sym:        return eval(t->leftp) + eval(t->rightp)
            case mul_sym:         return eval(t->leftp) * eval(t->rightp)
            case div_sym:         return eval(t->leftp) / eval(t->rightp)
            case unary_minus_sym: return -eval(t->leftp)
            case unary_plus_sym:  return  eval(t->leftp)
            case number_sym:      return t->value
            case else:            error_msg("unexpected tree node")
        end select
    end if
    return 0
end function

do
    getsym()
    if sym = eof_sym then exit do
    if sym = done_sym then continue do
    dim t as Tree ptr = expr(0)
    print"> "; eval(t)
    if sym = eof_sym then exit do
    if sym <> done_sym then error_msg("unexpected input")
loop


(defn fib [n]
  (when (neg? n)
    (throw (new IllegalArgumentException "n should be > 0")))
  (loop [n n, v1 1, v2 1]
    (if (< n 2)
      v2
      (recur (dec n) v2 (+ v1 v2)))))


# This is a rather obscure technique to have an anonymous
# function call itself.
fibonacci = (n) ->
  throw "Argument cannot be negative" if n < 0
  do (n) ->
      return n if n <= 1
      arguments.callee(n-2) + arguments.callee(n-1)

# Since it's pretty lightweight to assign an anonymous
# function to a local variable, the idiom below might be
# more preferred.
fibonacci2 = (n) ->
  throw "Argument cannot be negative" if n < 0
  recurse = (n) ->
      return n if n <= 1
      recurse(n-2) + recurse(n-1)
  recurse(n)


enum Op {
    ADD('+', 2),
    SUBTRACT('-', 2),
    MULTIPLY('*', 1),
    DIVIDE('/', 1);

    static {
        ADD.operation = { a, b -> a + b }
        SUBTRACT.operation = { a, b -> a - b }
        MULTIPLY.operation = { a, b -> a * b }
        DIVIDE.operation = { a, b -> a / b }
    }

    final String symbol
    final int precedence
    Closure operation

    private Op(String symbol, int precedence) {
        this.symbol = symbol
        this.precedence = precedence
    }

    String toString() { symbol }

    static Op fromSymbol(String symbol) {
        Op.values().find { it.symbol == symbol }
    }
}

interface Expression {
    Number evaluate();
}

class Constant implements Expression {
    Number value

    Constant (Number value) { this.value = value }

    Constant (String str) {
        try { this.value = str as BigInteger }
        catch (e) { this.value = str as BigDecimal }
    }

    Number evaluate() { value }

    String toString() { "${value}" }
}

class Term implements Expression {
    Op op
    Expression left, right

    Number evaluate() { op.operation(left.evaluate(), right.evaluate()) }

    String toString() { "(${op} ${left} ${right})" }
}

void fail(String msg, Closure cond = {true}) {
    if (cond()) throw new IllegalArgumentException("Cannot parse expression: ${msg}")
}

Expression parse(String expr) {
    def tokens = tokenize(expr)
    def elements = groupByParens(tokens, 0)
    parse(elements)
}

List tokenize(String expr) {
    def tokens = []
    def constStr = ""
    def captureConstant = { i ->
        if (constStr) {
            try { tokens << new Constant(constStr) }
            catch (NumberFormatException e) { fail "Invalid constant '${constStr}' near position ${i}" }
            constStr = ''
        }
    }
    for(def i = 0; i<expr.size(); i++) {
        def c = expr[i]
        def constSign = c in ['+','-'] && constStr.empty && (tokens.empty || tokens[-1] != ')')
        def isConstChar = { it in ['.'] + ('0'..'9') || constSign }
        if (c in ([')'] + Op.values()*.symbol) && !constSign) { captureConstant(i) }
        switch (c) {
            case ~/\s/:               break
            case isConstChar:         constStr += c; break
            case Op.values()*.symbol: tokens << Op.fromSymbol(c); break
            case ['(',')']:           tokens << c; break
            default:                  fail "Invalid character '${c}' at position ${i+1}"
        }
    }
    captureConstant(expr.size())
    tokens
}

List groupByParens(List tokens, int depth) {
    def deepness = depth
    def tokenGroups = []
    for (def i = 0; i < tokens.size(); i++) {
        def token = tokens[i]
        switch (token) {
            case '(':
                fail("'(' too close to end of expression") { i+2 > tokens.size() }
                def subGroup = groupByParens(tokens[i+1..-1], depth+1)
                tokenGroups << subGroup[0..-2]
                i += subGroup[-1] + 1
                break
            case ')':
                fail("Unbalanced parens, found extra ')'") { deepness == 0 }
                tokenGroups << i
                return tokenGroups
            default:
                tokenGroups << token
        }
    }
    fail("Unbalanced parens, unclosed groupings at end of expression") { deepness != 0 }
    def n = tokenGroups.size()
    fail("The operand/operator sequence is wrong") { n%2 == 0 }
    (0..<n).each {
        def i = it
        fail("The operand/operator sequence is wrong") { (i%2 == 0) == (tokenGroups[i] instanceof Op) }
    }
    tokenGroups
}

Expression parse(List elements) {
    while (elements.size() > 1) {
        def n = elements.size()
        fail ("The operand/operator sequence is wrong") { n%2 == 0 }
        def groupLoc = (0..<n).find { i -> elements[i] instanceof List }
        if (groupLoc != null) {
            elements[groupLoc] = parse(elements[groupLoc])
            continue
        }
        def opLoc = (0..<n).find { i -> elements[i] instanceof Op && elements[i].precedence == 1 } \
                        ?: (0..<n).find { i -> elements[i] instanceof Op && elements[i].precedence == 2 }
        if (opLoc != null) {
            fail ("Operator out of sequence") { opLoc%2 == 0 }
            def term = new Term(left:elements[opLoc-1], op:elements[opLoc], right:elements[opLoc+1])
            elements[(opLoc-1)..(opLoc+1)] = [term]
            continue
        }
    }
    return elements[0] instanceof List ? parse(elements[0]) : elements[0]
}


(defmacro alambda (parms &body body)
  `(labels ((self ,parms ,@body))
     #'self))


int fib(in uint arg) pure nothrow @safe @nogc {
    assert(arg >= 0);

    return function uint(in uint n) pure nothrow @safe @nogc {
        static immutable self = &__traits(parent, {});
        return (n < 2) ? n : self(n - 1) + self(n - 2);
    }(arg);
}

void main() {
    import std.stdio;

    39.fib.writeln;
}


define function fib (n)
  when (n < 0)
    error("Can't take fibonacci of negative integer: %d\n", n)
  end;
  local method fib1 (n, a, b)
    if (n = 0)
      a
    else
      fib1(n - 1, b, a + b)
    end
  end;
  fib1(n, 0, 1)
end


Y f:
	labda y:
		labda:
			f y @y
	call dup

labda fib n:
	if <= n 1:
		1
	else:
		fib - n 1
		fib - n 2
		+
Y
set :fibo

for j range 0 10:
	!print fibo j


program AnonymousRecursion;

{$APPTYPE CONSOLE}

uses
  SysUtils;

function Fib(X: Integer): integer;

	function DoFib(N: Integer): Integer;
	begin
	if N < 2 then Result:=N
	else Result:=DoFib(N-1) + DoFib(N-2);
	end;

begin
if X < 0 then raise Exception.Create('Argument < 0')
else Result:=DoFib(X);
end;

var I: integer;

begin
for I:=-1 to 15 do
	begin
	try
	WriteLn(I:3,' - ',Fib(I):3);
	except WriteLn(I,' - Error'); end;
	end;
WriteLn('Hit Any Key');
ReadLn;
end.


{-# LANGUAGE FlexibleContexts #-}

import Text.Parsec
import Text.Parsec.Expr
import Text.Parsec.Combinator
import Data.Functor
import Data.Function (on)

data Exp
  = Num Int
  | Add Exp
        Exp
  | Sub Exp
        Exp
  | Mul Exp
        Exp
  | Div Exp
        Exp

expr
  :: Stream s m Char
  => ParsecT s u m Exp
expr = buildExpressionParser table factor
  where
    table =
      [ [op "*" Mul AssocLeft, op "/" Div AssocLeft]
      , [op "+" Add AssocLeft, op "-" Sub AssocLeft]
      ]
    op s f = Infix (f <$ string s)
    factor = (between `on` char) '(' ')' expr <|> (Num . read <$> many1 digit)

eval
  :: Integral a
  => Exp -> a
eval (Num x) = fromIntegral x
eval (Add a b) = eval a + eval b
eval (Sub a b) = eval a - eval b
eval (Mul a b) = eval a * eval b
eval (Div a b) = eval a `div` eval b

solution
  :: Integral a
  => String -> a
solution = either (const (error "Did not parse")) eval . parse expr ""

main :: IO ()
main = print $ solution "(1+3)*7"


fib n | n < 0 = fail "Negative n"
      | else = fix (\f n -> if n < 2 then n else f (n - 1) + f (n - 2)) n