procedure main()                                                #: simple arithmetical parser / evaluator
   write("Usage: Input expression = Abstract Syntax Tree = Value, ^Z to end.")
   repeat {
      writes("Input expression : ")
      if not writes(line := read()) then break
      if map(line) ? { (x := E()) & pos(0) } then
         write(" = ", showAST(x), " = ", evalAST(x))
      else
         write(" rejected")
   }
end

procedure evalAST(X)                                            #: return the evaluated AST
   local x

   if type(X) == "list" then {
      x := evalAST(get(X))
      while x := get(X)(x, evalAST(get(X) | stop("Malformed AST.")))
   }
   return \x | X
end

procedure showAST(X)                                            #: return a string representing the AST
   local x,s

   s := ""
   every x := !X do
      s ||:= if type(x) == "list" then "(" || showAST(x) || ")" else x
   return s
end

########
# When you're writing a big parser, a few utility recognisers are very useful
#
procedure ws()    # skip optional whitespace
   suspend tab(many(' \t')) | ""
end

procedure digits()
   suspend tab(many(&digits))
end

procedure radixNum(r)    # r sets the radix
   static chars
   initial chars := &digits || &lcase
   suspend tab(many(chars[1 +: r]))
end
########

global token
record HansonsDevice(precedence,associativity)

procedure opinfo()
   static O
   initial {
      O := HansonsDevice([], table(&null))                         # parsing table
      put(O.precedence, ["+", "-"], ["*", "/", "%"], ["^"])        # Lowest to Highest precedence
      every O.associativity[!!O.precedence] := 1                   # default to 1 for LEFT associativity
      O.associativity["^"] := 0                                    # RIGHT associativity
   }
   return O
end

procedure E(k)                                                  #: Expression
   local lex, pL
   static opT
   initial opT := opinfo()

   /k := 1
   lex := []
   if not (pL := opT.precedence[k]) then                        # this op at this level?
      put(lex, F())
   else {
      put(lex, E(k + 1))
      while ws() & put(lex, token := =!pL) do
         put(lex, E(k + opT.associativity[token]))
   }
   suspend if *lex = 1 then lex[1] else lex                     # strip useless []
end

procedure F()                                                   #: Factor
   suspend ws() & (    # skip optional whitespace, and ...
      (="+" & F())              |          # unary + and a Factor, or ...
      (="-" || V())             |          # unary - and a Value, or ...
      (="-" & [-1, "*", F()])   |          # unary - and a Factor, or ...
     2(="(", E(), ws(), =")")   |          # parenthesized subexpression, or ...
       V()                                 # just a value
   )
end

procedure V()                                                   #: Value
   local r
   suspend ws() & numeric(    # skip optional whitespace, and ...
       =(r := 1 to 36) || ="r" || radixNum(r)             |     # N-based number, or ...
       digits() || (="." || digits() | "") || exponent()        # plain number with optional fraction
   )
end

procedure exponent()
   suspend tab(any('eE')) || =("+" | "-" | "") || digits() | ""
end


import extensions;

fib(n)
{
    if (n < 0)
        { InvalidArgumentException.raise() };

    ^ (n)
        {
            if (n > 1)
            {
                ^ this self(n - 2) + (this self(n - 1))
            }
            else
            {
                ^ n
            }
        }(n)
}

public program()
{
    for (int i := -1, i <= 10, i += 1)
    {
        console.print("fib(",i,")=");
        try
        {
            console.printLine(fib(i))
        }
        catch(Exception e)
        {
            console.printLine:"invalid"
        }
    };

    console.readChar()
}


fib = fn f -> (
      fn x -> if x == 0, do: 0, else: (if x == 1, do: 1, else: f.(x - 1) + f.(x - 2))	end
	)
end

y = fn x -> (
    fn f -> f.(f)
  end).(
    fn g -> x.(fn z ->(g.(g)).(z) end)
  end)
end

IO.inspect y.(&(fib.(&1))).(40)


-module( anonymous_recursion ).
-export( [fib/1, fib_internal/1] ).

fib( N ) when N >= 0 ->
	fib( N, 1, 0 ).

fib_internal( N ) when N >= 0 ->
	Fun = fun (_F, 0, _Next, Acc ) -> Acc;
		(F, N, Next, Acc) -> F( F, N - 1, Acc+Next, Next )
		end,
	Fun( Fun, N, 1, 0 ).

fib( 0, _Next, Acc ) -> Acc;
fib( N, Next, Acc ) -> fib( N - 1, Acc+Next, Next ).


parse=:parse_parser_
eval=:monad define
  'gerund structure'=:y
  [email protected]
)

coclass 'parser'
classify=: '$()*/+-'&(((>:@#@[ # 2:) #: 2 ^ i.)&;:)

rules=: ''
patterns=: ,"0 assert 1

addrule=: dyad define
   rules=: rules,;:x
   patterns=: patterns,+./@classify"1 y
)

'Term'   addrule '$()',   '0',     '+-',: '0'
'Factor' addrule '$()+-', '0',     '*/',: '0'
'Parens' addrule '(',    '*/+-0', ')',:  ')*/+-0$'
rules=: rules,;:'Move'

buildTree=: monad define
  words=: ;:'$',y
  queue=: classify '$',y
  stack=: classify '$$$$'
  tokens=: ]&.>i.#words
  tree=: ''
  while.(#queue)+.6<#stack do.
    rule=: rules {~ i.&1 patterns (*./"1)@:(+./"1) .(*."1)4{.stack
    rule`:6''
  end.
  'syntax' assert 1 0 1 1 1 1 -: {:"1 stack
  gerund=: literal&.> (<,'%') (I. words=<,'/')} words
  gerund;1{tree
)

literal=:monad define ::]
  ".'t=.',y
  5!:1<'t'
)

Term=: Factor=: monad define
  stack=: ({.stack),(classify '0'),4}.stack
  tree=: ({.tree),(<1 2 3{tree),4}.tree
)

Parens=: monad define
  stack=: (1{stack),3}.stack
  tree=: (1{tree),3}.tree
)

Move=: monad define
  'syntax' assert 0<#queue
  stack=: ({:queue),stack
  queue=: }:queue
  tree=: ({:tokens),tree
  tokens=: }:tokens
)

parse=:monad define
  tmp=: conew 'parser'
  r=: buildTree__tmp y
  coerase tmp
  r
)


let fib = function
    | n when n < 0 -> None
    | n -> let rec fib2 = function
               | 0 | 1 -> 1
               | n -> fib2 (n-1) + fib2 (n-2)
            in Some (fib2 n)


USING: kernel math ;
IN: rosettacode.fibonacci.ar

: fib ( n -- m )
    dup 0 < [ "fib of negative" throw ] when
    [
        ! If n < 2, then drop q, else find q(n - 1) + q(n - 2).
        [ dup 2 < ] dip swap [ drop ] [
            [ [ 1 - ] dip dup call ]
            [ [ 2 - ] dip dup call ] 2bi +
        ] if
    ] dup call( n q -- m ) ;


function fib(x)
   if x < 0
      raise ParamError(description|"Negative argument invalid", extra|"Fibbonacci sequence is undefined for negative numbers")
   else
      return (function(y)
         if y == 0
            return 0
         elif y == 1
            return 1
         else
            return fself(y-1) + fself(y-2)
         end
      end)(x)
   end
end

try
>fib(2)
>fib(3)
>fib(4)
>fib(-1)
catch in e
> e
end


import java.util.Stack;

public class ArithmeticEvaluation {

    public interface Expression {
        BigRational eval();
    }

    public enum Parentheses {LEFT}

    public enum BinaryOperator {
        ADD('+', 1),
        SUB('-', 1),
        MUL('*', 2),
        DIV('/', 2);

        public final char symbol;
        public final int precedence;

        BinaryOperator(char symbol, int precedence) {
            this.symbol = symbol;
            this.precedence = precedence;
        }

        public BigRational eval(BigRational leftValue, BigRational rightValue) {
            switch (this) {
                case ADD:
                    return leftValue.add(rightValue);
                case SUB:
                    return leftValue.subtract(rightValue);
                case MUL:
                    return leftValue.multiply(rightValue);
                case DIV:
                    return leftValue.divide(rightValue);
            }
            throw new IllegalStateException();
        }

        public static BinaryOperator forSymbol(char symbol) {
            for (BinaryOperator operator : values()) {
                if (operator.symbol == symbol) {
                    return operator;
                }
            }
            throw new IllegalArgumentException(String.valueOf(symbol));
        }
    }

    public static class Number implements Expression {
        private final BigRational number;

        public Number(BigRational number) {
            this.number = number;
        }

        @Override
        public BigRational eval() {
            return number;
        }

        @Override
        public String toString() {
            return number.toString();
        }
    }

    public static class BinaryExpression implements Expression {
        public final Expression leftOperand;
        public final BinaryOperator operator;
        public final Expression rightOperand;

        public BinaryExpression(Expression leftOperand, BinaryOperator operator, Expression rightOperand) {
            this.leftOperand = leftOperand;
            this.operator = operator;
            this.rightOperand = rightOperand;
        }

        @Override
        public BigRational eval() {
            BigRational leftValue = leftOperand.eval();
            BigRational rightValue = rightOperand.eval();
            return operator.eval(leftValue, rightValue);
        }

        @Override
        public String toString() {
            return "(" + leftOperand + " " + operator.symbol + " " + rightOperand + ")";
        }
    }

    private static void createNewOperand(BinaryOperator operator, Stack<Expression> operands) {
        Expression rightOperand = operands.pop();
        Expression leftOperand = operands.pop();
        operands.push(new BinaryExpression(leftOperand, operator, rightOperand));
    }

    public static Expression parse(String input) {
        int curIndex = 0;
        boolean afterOperand = false;
        Stack<Expression> operands = new Stack<>();
        Stack<Object> operators = new Stack<>();
        while (curIndex < input.length()) {
            int startIndex = curIndex;
            char c = input.charAt(curIndex++);

            if (Character.isWhitespace(c))
                continue;

            if (afterOperand) {
                if (c == ')') {
                    Object operator;
                    while (!operators.isEmpty() && ((operator = operators.pop()) != Parentheses.LEFT))
                        createNewOperand((BinaryOperator) operator, operands);
                    continue;
                }
                afterOperand = false;
                BinaryOperator operator = BinaryOperator.forSymbol(c);
                while (!operators.isEmpty() && (operators.peek() != Parentheses.LEFT) && (((BinaryOperator) operators.peek()).precedence >= operator.precedence))
                    createNewOperand((BinaryOperator) operators.pop(), operands);
                operators.push(operator);
                continue;
            }

            if (c == '(') {
                operators.push(Parentheses.LEFT);
                continue;
            }

            afterOperand = true;
            while (curIndex < input.length()) {
                c = input.charAt(curIndex);
                if (((c < '0') || (c > '9')) && (c != '.'))
                    break;
                curIndex++;
            }
            operands.push(new Number(BigRational.valueOf(input.substring(startIndex, curIndex))));
        }

        while (!operators.isEmpty()) {
            Object operator = operators.pop();
            if (operator == Parentheses.LEFT)
                throw new IllegalArgumentException();
            createNewOperand((BinaryOperator) operator, operands);
        }

        Expression expression = operands.pop();
        if (!operands.isEmpty())
            throw new IllegalArgumentException();
        return expression;
    }

    public static void main(String[] args) {
        String[] testExpressions = {
                "2+3",
                "2+3/4",
                "2*3-4",
                "2*(3+4)+5/6",
                "2 * (3 + (4 * 5 + (6 * 7) * 8) - 9) * 10",
                "2*-3--4+-.25"};
        for (String testExpression : testExpressions) {
            Expression expression = parse(testExpression);
            System.out.printf("Input: \"%s\", AST: \"%s\", value=%s%n", testExpression, expression, expression.eval());
        }
    }
}


#APPTYPE CONSOLE

FUNCTION Fibonacci(n)
	IF n < 0 THEN
		RETURN "Nuts!"
	ELSE
		RETURN Fib(n)
	END IF
	FUNCTION Fib(m)
		IF m < 2 THEN
			Fib = m
		ELSE
			Fib = Fib(m - 1) + Fib(m - 2)
		END IF
	END FUNCTION
END FUNCTION

PRINT Fibonacci(-1.5)
PRINT Fibonacci(1.5)
PRINT Fibonacci(13.666)

PAUSE


function evalArithmeticExp(s) {
  s = s.replace(/\s/g,'').replace(/^\+/,'');
  var rePara = /\([^\(\)]*\)/;
  var exp = s.match(rePara);

  while (exp = s.match(rePara)) {
    s = s.replace(exp[0], evalExp(exp[0]));
  }
  return evalExp(s);

  function evalExp(s) {
    s = s.replace(/[\(\)]/g,'');
    var reMD = /\d+\.?\d*\s*[\*\/]\s*[+-]?\d+\.?\d*/;
    var reM = /\*/;
    var reAS = /-?\d+\.?\d*\s*[\+-]\s*[+-]?\d+\.?\d*/;
    var reA  = /\d\+/;
    var exp;

    while (exp = s.match(reMD)) {
      s = exp[0].match(reM)? s.replace(exp[0], multiply(exp[0])) : s.replace(exp[0], divide(exp[0]));
    }

    while (exp = s.match(reAS)) {
      s = exp[0].match(reA)? s.replace(exp[0], add(exp[0])) : s.replace(exp[0], subtract(exp[0]));
    }

    return '' + s;

    function multiply(s, b) {
      b = s.split('*');
      return b[0] * b[1];
    }

    function divide(s, b) {
      b = s.split('/');
      return b[0] / b[1];
    }

    function add(s, b) {
      s = s.replace(/^\+/,'').replace(/\++/,'+');
      b = s.split('+');
      return Number(b[0]) + Number(b[1]);
    }

    function subtract(s, b) {
      s = s.replace(/\+-|-\+/g,'-');

      if (s.match(/--/)) {
        return add(s.replace(/--/,'+'));
      }
      b = s.split('-');
      return b.length == 3? -1 * b[1] - b[2] : b[0] - b[1];
    }
  }
}


:noname ( n -- n' )
  dup 2 < ?exit
  1- dup recurse swap 1- recurse + ; ( xt )

: fib ( +n -- n' )
  dup 0< abort" Negative numbers don't exist."
  [ ( xt from the :NONAME above ) compile, ] ;


integer function fib(n)
  integer, intent(in) :: n
  if (n < 0 ) then
    write (*,*) 'Bad argument: fib(',n,')'
    stop
  else
    fib = purefib(n)
  end if
contains
  recursive pure integer function purefib(n) result(f)
    integer, intent(in) :: n
    if (n < 2 ) then
      f = n
    else
      f = purefib(n-1) + purefib(n-2)
    end if
  end function purefib
end function fib


def star(E): (E | star(E)) // .;
def plus(E): E | (plus(E) // . );
def optional(E): E // .;
def amp(E): . as $in | E | $in;
def neg(E): select( [E] == [] );


/* Arithmetic evaluation, in Jsish */
function evalArithmeticExp(s) {
    s = s.replace(/\s/g,'').replace(/^\+/,'');
    var rePara = /\([^\(\)]*\)/;
    var exp;

    function evalExp(s) {
        s = s.replace(/[\(\)]/g,'');
        var reMD = /[0-9]+\.?[0-9]*\s*[\*\/]\s*[+-]?[0-9]+\.?[0-9]*/;
        var reM = /\*/;
        var reAS = /-?[0-9]+\.?[0-9]*\s*[\+-]\s*[+-]?[0-9]+\.?[0-9]*/;
        var reA    = /[0-9]\+/;
        var exp;

        function multiply(s, b=0) {
            b = s.split('*');
            return b[0] * b[1];
        }

        function divide(s, b=0) {
            b = s.split('/');
            return b[0] / b[1];
        }

        function add(s, b=0) {
            s = s.replace(/^\+/,'').replace(/\++/,'+');
            b = s.split('+');
            return Number(b[0]) + Number(b[1]);
        }

        function subtract(s, b=0) {
            s = s.replace(/\+-|-\+/g,'-');

            if (s.match(/--/)) {
                return add(s.replace(/--/,'+'));
            }
            b = s.split('-');
            return b.length == 3 ? -1 * b[1] - b[2] : b[0] - b[1];
        }

        while (exp = s.match(reMD)) {
            s = exp[0].match(reM) ? s.replace(exp[0], multiply(exp[0]).toString()) : s.replace(exp[0], divide(exp[0]).toString());
        }

        while (exp = s.match(reAS)) {
            s = exp[0].match(reA)? s.replace(exp[0], add(exp[0]).toString()) : s.replace(exp[0], subtract(exp[0]).toString());
        }

        return '' + s;
    }

    while (exp = s.match(rePara)) {
        s = s.replace(exp[0], evalExp(exp[0]));
    }

    return evalExp(s);
}

if (Interp.conf('unitTest')) {
;    evalArithmeticExp('2+3');
;    evalArithmeticExp('2+3/4');
;    evalArithmeticExp('2*3-4');
;    evalArithmeticExp('2*(3+4)+5/6');
;    evalArithmeticExp('2 * (3 + (4 * 5 + (6 * 7) * 8) - 9) * 10');
;    evalArithmeticExp('2*-3--4+-0.25');
}

/*
=!EXPECTSTART!=
evalArithmeticExp('2+3') ==> 5
evalArithmeticExp('2+3/4') ==> 2.75
evalArithmeticExp('2*3-4') ==> 2
evalArithmeticExp('2*(3+4)+5/6') ==> 14.8333333333333
evalArithmeticExp('2 * (3 + (4 * 5 + (6 * 7) * 8) - 9) * 10') ==> 7000
evalArithmeticExp('2*-3--4+-0.25') ==> -2.25
=!EXPECTEND!=
*/


' FB 1.05.0 Win64

#Lang "fblite"

Option Gosub  '' enables Gosub to be used

' Using gosub to simulate a nested function
Function fib(n As UInteger) As UInteger
  Gosub nestedFib
  Exit Function

  nestedFib:
  fib = IIf(n < 2, n, fib(n - 1) + fib(n - 2))
  Return
End Function

' This function simulates (rather messily) gosub by using 2 gotos and would therefore work
' even in the default dialect
Function fib2(n As UInteger) As UInteger
  Goto nestedFib

  exitFib:
  Exit Function

  nestedFib:
  fib2 = IIf(n < 2, n, fib2(n - 1) + fib2(n - 2))
  Goto exitFib
End Function

For i As Integer = 1 To 12
  Print fib(i); " ";
Next

Print

For j As Integer = 1 To 12
  Print fib2(j); " ";
Next

Print
Print "Press any key to quit"
Sleep


package main

import "fmt"

func main() {
    for _, n := range []int{0, 1, 2, 3, 4, 5, 10, 40, -1} {
        f, ok := arFib(n)
        if ok {
            fmt.Printf("fib %d = %d\n", n, f)
        } else {
            fmt.Println("fib undefined for negative numbers")
        }
    }
}

func arFib(n int) (int, bool) {
    switch {
    case n < 0:
        return 0, false
    case n < 2:
        return n, true
    }
    return yc(func(recurse fn) fn {
        return func(left, term1, term2 int) int {
            if left == 0 {
                return term1+term2
            }
            return recurse(left-1, term1+term2, term1)
        }
    })(n-2, 1, 0), true
}

type fn func(int, int, int) int
type ff func(fn) fn
type fx func(fx) fn

func yc(f ff) fn {
    return func(x fx) fn {
        return x(x)
    }(func(x fx) fn {
        return f(func(a1, a2, a3 int) int {
            return x(x)(a1, a2, a3)
        })
    })
}


julia> expr="2 * (3 -1) + 2 * 5"
"2 * (3 -1) + 2 * 5"

julia> parsed = parse(expr) #Julia provides low-level access to language parser for AST/Expr creation
:(+(*(2,-(3,1)),*(2,5)))

julia> t = typeof(parsed)
Expr

julia> names(t) #shows type fields
(:head,:args,:typ)

julia> parsed.args #Inspect our 'Expr' type innards
3-element Any Array:
 :+
 :(*(2,-(3,1)))
 :(*(2,5))

julia> typeof(parsed.args[2]) #'Expr' types can nest
Expr

julia> parsed.args[2].args
3-element Any Array:
  :*
 2
  :(-(3,1))

julia> parsed.args[2].args[3].args #Will nest until lowest level of AST
3-element Any Array:
  :-
 3
 1

julia> eval(parsed)
14

julia> eval(parse("1 - 5 * 2 / 20 + 1"))
1.5

julia> eval(parse("2 * (3 + ((5) / (7 - 11)))"))
3.5


// version 1.2.10

/* if string is empty, returns zero */
fun String.toDoubleOrZero() = this.toDoubleOrNull() ?: 0.0

fun multiply(s: String): String {
    val b = s.split('*').map { it.toDoubleOrZero() }
    return (b[0] * b[1]).toString()
}

fun divide(s: String): String {
    val b = s.split('/').map { it.toDoubleOrZero() }
    return (b[0] / b[1]).toString()
}

fun add(s: String): String {
    var t = s.replace(Regex("""^\+"""), "").replace(Regex("""\++"""), "+")
    val b = t.split('+').map { it.toDoubleOrZero() }
    return (b[0] + b[1]).toString()
}

fun subtract(s: String): String {
    var t = s.replace(Regex("""(\+-|-\+)"""), "-")
    if ("--" in t) return add(t.replace("--", "+"))
    val b = t.split('-').map { it.toDoubleOrZero() }
    return (if (b.size == 3) -b[1] - b[2] else b[0] - b[1]).toString()
}

fun evalExp(s: String): String {
    var t = s.replace(Regex("""[()]"""), "")
    val reMD = Regex("""\d+\.?\d*\s*[*/]\s*[+-]?\d+\.?\d*""")
    val reM  = Regex( """\*""")
    val reAS = Regex("""-?\d+\.?\d*\s*[+-]\s*[+-]?\d+\.?\d*""")
    val reA  = Regex("""\d\+""")

    while (true) {
        val match = reMD.find(t)
        if (match == null) break
        val exp = match.value
        val match2 = reM.find(exp)
        t = if (match2 != null)
                t.replace(exp, multiply(exp))
            else
                t.replace(exp, divide(exp))
    }

    while (true) {
        val match = reAS.find(t)
        if (match == null) break
        val exp = match.value
        val match2 = reA.find(exp)
        t = if (match2 != null)
                t.replace(exp, add(exp))
            else
                t.replace(exp, subtract(exp))
    }

    return t
}

fun evalArithmeticExp(s: String): Double {
    var t = s.replace(Regex("""\s"""), "").replace("""^\+""", "")
    val rePara = Regex("""\([^()]*\)""")
    while(true) {
        val match = rePara.find(t)
        if (match == null) break
        val exp = match.value
        t = t.replace(exp, evalExp(exp))
    }
    return evalExp(t).toDoubleOrZero()
}

fun main(arsg: Array<String>) {
    listOf(
        "2+3",
        "2+3/4",
        "2*3-4",
        "2*(3+4)+5/6",
        "2 * (3 + (4 * 5 + (6 * 7) * 8) - 9) * 10",
        "2*-3--4+-0.25",
         "-4 - 3",
         "((((2))))+ 3 * 5",
         "1 + 2 * (3 + (4 * 5 + 6 * 7 * 8) - 9) / 10",
         "1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5 - 22/(7 + 2*(3 - 1)) - 1)) + 1"
    ).forEach { println("$it = ${evalArithmeticExp(it)}") }
}


'[RC] Arithmetic evaluation.bas
'Buld the tree (with linked nodes, in array 'cause LB has no pointers)
'applying shunting yard algorythm.
'Then evaluate tree

global stack$   'operator/brakets stack
stack$=""

maxStack = 100
dim stack(maxStack) 'nodes stack
global SP 'stack pointer
SP = 0

'-------------------
global maxNode,curFree
global FirstOp,SecondOp,isNumber,NodeCont
global opList$
opList$ = "+-*/^"

maxNode=100
FirstOp=1   'pointers to other nodes; 0 means no pointer
SecondOp=2
isNumber=3  'like, 1 is number, 0 is operator
NodeCont=4  'number if isNumber; or mid$("+-*/^", i, 1) for 1..5 operator

dim node(NodeCont, maxNode)
'will be used from 1, 0 plays null pointer (no link)

curFree=1   'first free node
'-------------------

in$ = " 1 + 2 ^ 3 * 4 - 12 / 6 "
print "Input: "
print in$

'read tokens
token$ = "#"
while 1
    i=i+1
    token$ = word$(in$, i)
    if token$ = "" then i=i-1: exit while

    select case
    case token$ = "("
        'If the token is a left parenthesis, then push it onto the stack.
        call stack.push token$

    case token$ = ")"
        'If the token is a right parenthesis:
        'Until the token at the top of the stack is a left parenthesis, pop operators off the stack onto the output queue.
        'Pop the left parenthesis from the stack, but not onto the output queue.
        'If the stack runs out without finding a left parenthesis, then there are mismatched parentheses.
        while stack.peek$() <> "("
            'if stack is empty
            if stack$="" then print "Error: no matching '(' for token ";i: end
            'add operator node to tree
            child2=node.pop()
            child1=node.pop()
            call node.push addOpNode(child1,child2,stack.pop$())
        wend
        discard$=stack.pop$()   'discard "("

    case isOperator(token$)
        'If the token is an operator, o1, then:
        'while there is an operator token, o2, at the top of the stack, and
        'either o1 is left-associative and its precedence is equal to that of o2,
        'or o1 has precedence less than that of o2,
        '   pop o2 off the stack, onto the output queue;
        'push o1 onto the stack
        op1$=token$
        while(isOperator(stack.peek$()))
            op2$=stack.peek$()
            if (op2$<>"^" and precedence(op1$) = precedence(op2$)) _
                OR (precedence(op1$) < precedence(op2$)) then
                '"^" is the only right-associative operator
                'add operator node to tree
                child2=node.pop()
                child1=node.pop()
                call node.push addOpNode(child1,child2,stack.pop$())
            else
                exit while
            end if
        wend
        call stack.push op1$

    case else   'number
    'actually, wrohg operator could end up here, like say %
        'If the token is a number, then
        'add leaf node to tree (number)
        call node.push addNumNode(val(token$))
    end select

wend

'When there are no more tokens to read:
'While there are still operator tokens in the stack:
'   If the operator token on the top of the stack is a parenthesis, then there are mismatched parentheses.
'   Pop the operator onto the output queue.
while stack$<>""
    if stack.peek$() = "(" then print "no matching ')'": end
    'add operator node to tree
    child2=node.pop()
    child1=node.pop()
    call node.push addOpNode(child1,child2,stack.pop$())
wend

root = node.pop()
'call dumpNodes
print "Tree:"
call drawTree root, 1, 0, 3
locate 1, 10
print "Result: ";evaluate(root)

end

'------------------------------------------
function isOperator(op$)
    isOperator = instr(opList$, op$)<>0 AND len(op$)=1
end function

function precedence(op$)
    if isOperator(op$) then
        precedence = 1 _
            + (instr("+-*/^", op$)<>0) _
            + (instr("*/^", op$)<>0) _
            + (instr("^", op$)<>0)
    end if
end function

'------------------------------------------
sub stack.push s$
    stack$=s$+"|"+stack$
end sub

function stack.pop$()
    'it does return empty on empty stack or queue
    stack.pop$=word$(stack$,1,"|")
    stack$=mid$(stack$,instr(stack$,"|")+1)
end function

function stack.peek$()
    'it does return empty on empty stack or queue
    stack.peek$=word$(stack$,1,"|")
end function

'---------------------------------------
sub node.push s
    stack(SP)=s
    SP=SP+1
end sub

function node.pop()
    'it does return -999999 on empty stack
    if SP<1 then pop=-999999: exit function
    SP=SP-1
    node.pop=stack(SP)
end function

'=======================================
sub dumpNodes
    for i = 1 to curFree-1
        print i,
        for j = 1 to 4
            print node(j, i),
        next
        print
    next
    print
end sub

function evaluate(node)
    if node=0 then exit function
    if node(isNumber, node) then
        evaluate = node(NodeCont, node)
        exit function
    end if
    'else operator
    op1 = evaluate(node(FirstOp, node))
    op2 = evaluate(node(SecondOp, node))
    select case node(NodeCont, node)    'opList$, "+-*/^"
    case 1
        evaluate = op1+op2
    case 2
        evaluate = op1-op2
    case 3
        evaluate = op1*op2
    case 4
        evaluate = op1/op2
    case 5
        evaluate = op1^op2
    end select
end function

sub drawTree node, level, leftRight, offsetY
    if node=0 then exit sub
    call drawTree node(FirstOp, node), level+1, leftRight-1/2^level, offsetY

    'print node
    'count on 80 char maiwin
    x = 40*(1+leftRight)
    y = level+offsetY
    locate x, y
    'print  x, y,">";
    if node(isNumber, node) then
        print node(NodeCont, node)
    else
        print  mid$(opList$, node(NodeCont, node),1)
    end if

    call drawTree node(SecondOp, node), level+1, leftRight+1/2^level, offsetY
end sub

function addNumNode(num)
'returns new node
    newNode=curFree
    curFree=curFree+1
    node(isNumber,newNode)=1
    node(NodeCont,newNode)=num

    addNumNode = newNode
end function

function addOpNode(firstChild, secondChild, op$)
'returns new node
'FirstOrSecond ignored if parent is 0
    newNode=curFree
    curFree=curFree+1
    node(isNumber,newNode)=0
    node(NodeCont,newNode)=instr(opList$, op$)

    node(FirstOp,newNode)=firstChild
    node(SecondOp,newNode)=secondChild

    addOpNode = newNode
end function


def fib = {
    assert it > -1
    {i -> i < 2 ? i : {j -> owner.call(j)}(i-1) + {k -> owner.call(k)}(i-2)}(it)
}


fib :: Integer -> Maybe Integer
fib n
  | n < 0 = Nothing
  | otherwise = Just $ real n
              where real 0 = 1
                    real 1 = 1
                    real n = real (n-1) + real (n-2)


require"lpeg"

P, R, C, S, V = lpeg.P, lpeg.R, lpeg.C, lpeg.S, lpeg.V

--matches arithmetic expressions and returns a syntax tree
expression = P{"expr";
ws = P" "^0,
number = C(R"09"^1) * V"ws",
lp = "(" * V"ws",
rp = ")" * V"ws",
sym = C(S"+-*/") * V"ws",
more = (V"sym" * V"expr")^0,
expr = V"number" * V"more" + V"lp" * lpeg.Ct(V"expr" * V"more") * V"rp" * V"more"}

--evaluates a tree
function eval(expr)
  --empty
  if type(expr) == "string" or type(expr) == "number" then return expr + 0 end

  --arithmetic functions
  tb = {["+"] = function(a,b) return eval(a) + eval(b) end,
		["-"] = function(a,b) return eval(a) - eval(b) end,
		["*"] = function(a,b) return eval(a) * eval(b) end,
		["/"] = function(a,b) return eval(a) / eval(b) end}

  --you could add ^ or other operators to this pretty easily
  for i, v in ipairs{"*/", "+-"} do
    for s, u in ipairs(expr) do
	  local k = type(u) == "string" and C(S(v)):match(u)
	  if k then
	    expr[s-1] = tb[k](expr[s-1],expr[s+1])
	    table.remove(expr, s)
	    table.remove(expr, s)
	  end
	end
  end
  return expr[1]
end

print(eval{expression:match(io.read())})


procedure main(A)
   every write("fib(",a := numeric(!A),")=",fib(a))
end

procedure fib(n)
   local  source, i
   static cache
   initial {
      cache := table()
      cache[0] := 0
      cache[1] := 1
      }
   if type(n) == "integer" & n >= 0 then
      return n @ makeProc {{
         i := @(source := &source)                                          # 1
         /cache[i] := ((i-1)@makeProc(^&current)+(i-2)@makeProc(^&current)) # 2
         cache[i] @ source                                                  # 3
         }}
end

procedure makeProc(A)
   A := if type(A) == "list" then A[1]
   return (@A, A)                    # prime and return
end


fib := method(x,
    if(x < 0, Exception raise("Negative argument not allowed!"))
    fib2 := method(n,
        if(n < 2, n, fib2(n-1) + fib2(n-2))
    )
    fib2(x floor)
)


y=100
Module CheckEval {
      A$="1 + 2 * (3 + (4 * 5 + 6 * 7 * 8) - 9) / 10"
      Print Eval(A$)
      x=10
      Print Eval("x+5")=x+5
      Print Eval("A$=A$")=True
      Try {
            Print Eval("y")  ' error: y is uknown here
      }
}
Call CheckEval


(*parsing:*)
parse[string_] :=
 Module[{e},
  StringCases[string,
     "+" | "-" | "*" | "/" | "(" | ")" |
      DigitCharacter ..] //. {a_String?DigitQ :>
      e[[email protected]], {x___, PatternSequence["(", a_e, ")"],
       y___} :> {x, a,
       y}, {x :
        PatternSequence[] |
         PatternSequence[___, "(" | "+" | "-" | "*" | "/"],
       PatternSequence[op : "+" | "-", a_e], y___} :> {x, e[op, a],
       y}, {x :
        PatternSequence[] | PatternSequence[___, "(" | "+" | "-"],
       PatternSequence[a_e, op : "*" | "/", b_e], y___} :> {x,
       e[op, a, b],
       y}, {x :
        PatternSequence[] | PatternSequence[___, "(" | "+" | "-"],
       PatternSequence[a_e, b_e], y___} :> {x, e["*", a, b],
       y}, {x : PatternSequence[] | PatternSequence[___, "("],
       PatternSequence[a_e, op : "+" | "-", b_e],
       y : PatternSequence[] |
         PatternSequence[")" | "+" | "-", ___]} :> {x, e[op, a, b],
       y}} //. {e -> List, {a_Integer} :> a, {a_List} :> a}]

(*evaluation*)
evaluate[a_Integer] := a;
evaluate[{"+", a_}] := evaluate[a];
evaluate[{"-", a_}] := -evaluate[a];
evaluate[{"+", a_, b_}] := evaluate[a] + evaluate[b];
evaluate[{"-", a_, b_}] := evaluate[a] - evaluate[b];
evaluate[{"*", a_, b_}] := evaluate[a]*evaluate[b];
evaluate[{"/", a_, b_}] := evaluate[a]/evaluate[b];
evaluate[string_String] := evaluate[parse[string]]


100 PROGRAM "Fibonacc.bas"
110 FOR I=0 TO 10
120   PRINT FIB(I);
130 NEXT
140 DEF FIB(K)
150   SELECT CASE K
160   CASE IS<0
170     PRINT "Negative parameter to Fibonacci.":STOP
180   CASE 0
190     LET FIB=0
200   CASE 1
210     LET FIB=1
220   CASE ELSE
230     LET FIB=FIB(K-1)+FIB(K-2)
240   END SELECT
250 END DEF


public static long fib(int n) {
    if (n < 0)
        throw new IllegalArgumentException("n can not be a negative number");

    return new Object() {
        private long fibInner(int n) {
            return (n < 2) ? n : (fibInner(n - 1) + fibInner(n - 2));
        }
    }.fibInner(n);
}


Expr = {}
Expr.eval = 0

BinaryExpr = new Expr
BinaryExpr.eval = function()
	if self.op == "+" then return self.lhs.eval + self.rhs.eval
	if self.op == "-" then return self.lhs.eval - self.rhs.eval
	if self.op == "*" then return self.lhs.eval * self.rhs.eval
	if self.op == "/" then return self.lhs.eval / self.rhs.eval
end function
binop = function(lhs, op, rhs)
	e = new BinaryExpr
	e.lhs = lhs
	e.op = op
	e.rhs = rhs
	return e
end function

parseAtom = function(inp)
	tok = inp.pull
	if tok >= "0" and tok <= "9" then
		e = new Expr
		e.eval = val(tok)
		while inp and inp[0] >= "0" and inp[0] <= "9"
			e.eval = e.eval * 10 + val(inp.pull)
		end while
	else if tok == "(" then
		e = parseAddSub(inp)
		inp.pull // swallow closing ")"
		return e
	else
		print "Unexpected token: " + tok
		exit
	end if
	return e
end function

parseMultDiv = function(inp)
	next = @parseAtom
	e = next(inp)
	while inp and (inp[0] == "*" or inp[0] == "/")
		e = binop(e, inp.pull, next(inp))
	end while
	return e
end function

parseAddSub = function(inp)
	next = @parseMultDiv
	e = next(inp)
	while inp and (inp[0] == "+" or inp[0] == "-")
		e = binop(e, inp.pull, next(inp))
	end while
	return e
end function

while true
	s = input("Enter expression: ").replace(" ","")
	if not s then break
	inp = split(s, "")
	ast = parseAddSub(inp)
	print ast.eval
end while


import strutils
import os

#--
# Lexer
#--

type
  TokenKind = enum
    tokNumber
    tokPlus = "+", tokMinus = "-", tokStar = "*", tokSlash = "/"
    tokLPar, tokRPar
    tokEnd
  Token = object
    case kind: TokenKind
    of tokNumber: value: float
    else: discard

proc lex(input: string): seq[Token] =
  # Here we go through the entire input string and collect all the tokens into
  # a sequence.
  var pos = 0
  while pos < input.len:
    case input[pos]
    of '0'..'9':
      # Digits consist of three parts: the integer part, the delimiting decimal
      # point, and the decimal part.
      var numStr = ""
      while pos < input.len and input[pos] in Digits:
        numStr.add(input[pos])
        inc(pos)
      if pos < input.len and input[pos] == '.':
        numStr.add('.')
        inc(pos)
        while pos < input.len and input[pos] in Digits:
          numStr.add(input[pos])
          inc(pos)
      result.add(Token(kind: tokNumber, value: numStr.parseFloat()))
    of '+': inc(pos); result.add(Token(kind: tokPlus))
    of '-': inc(pos); result.add(Token(kind: tokMinus))
    of '*': inc(pos); result.add(Token(kind: tokStar))
    of '/': inc(pos); result.add(Token(kind: tokSlash))
    of '(': inc(pos); result.add(Token(kind: tokLPar))
    of ')': inc(pos); result.add(Token(kind: tokRPar))
    of ' ': inc(pos)
    else: raise newException(ArithmeticError,
                             "Unexpected character '" & input[pos] & '\'')
  # We append an 'end' token to the end of our token sequence, to mark where the
  # sequence ends.
  result.add(Token(kind: tokEnd))

#--
# Parser
#--

type
  ExprKind = enum
    exprNumber
    exprBinary
  Expr = ref object
    case kind: ExprKind
    of exprNumber: value: float
    of exprBinary:
      left, right: Expr
      operator: TokenKind

proc `$`(ex: Expr): string =
  # This proc returns a lisp representation of the expression.
  case ex.kind
  of exprNumber: $ex.value
  of exprBinary: '(' & $ex.operator & ' ' & $ex.left & ' ' & $ex.right & ')'

var
  # The input to the program is provided via command line parameters.
  tokens = lex(commandLineParams().join(" "))
  pos = 0

# This table stores the precedence level of each infix operator. For tokens
# this does not apply to, the precedence is set to 0.
const Precedence: array[low(TokenKind)..high(TokenKind), int] = [
  tokNumber: 0,
  tokPlus: 1,
  tokMinus: 1,
  tokStar: 2,
  tokSlash: 2,
  tokLPar: 0,
  tokRPar: 0,
  tokEnd: 0
]

# We use a Pratt parser, so the two primary components are the prefix part, and
# the infix part. We start with a prefix token, and when we're done, we continue
# with an infix token.

proc parse(prec = 0): Expr

proc parseNumber(token: Token): Expr =
  result = Expr(kind: exprNumber, value: token.value)

proc parseParen(token: Token): Expr =
  result = parse()
  if tokens[pos].kind != tokRPar:
    raise newException(ArithmeticError, "Unbalanced parenthesis")
  inc(pos)

proc parseBinary(left: Expr, token: Token): Expr =
  result = Expr(kind: exprBinary, left: left, right: parse(),
                operator: token.kind)

proc parsePrefix(token: Token): Expr =
  case token.kind
  of tokNumber: result = parseNumber(token)
  of tokLPar: result = parseParen(token)
  else: discard

proc parseInfix(left: Expr, token: Token): Expr =
  case token.kind
  of tokPlus, tokMinus, tokStar, tokSlash: result = parseBinary(left, token)
  else: discard

proc parse(prec = 0): Expr =
  # This procedure is the heart of a Pratt parser, it puts the whole expression
  # together into one abstract syntax tree, properly dealing with precedence.
  var token = tokens[pos]
  inc(pos)
  result = parsePrefix(token)
  while prec < Precedence[tokens[pos].kind]:
    token = tokens[pos]
    if token.kind == tokEnd:
      # When we hit the end token, we're done.
      break
    inc(pos)
    result = parseInfix(result, token)

let ast = parse()

proc `==`(ex: Expr): float =
  # This proc recursively evaluates the given expression.
  result =
    case ex.kind
    of exprNumber: ex.value
    of exprBinary:
      case ex.operator
      of tokPlus: ==ex.left + ==ex.right
      of tokMinus: ==ex.left - ==ex.right
      of tokStar: ==ex.left * ==ex.right
      of tokSlash: ==ex.left / ==ex.right
      else: 0.0

# In the end, we print out the result.
echo ==ast


function fibo(n) {
  if (n < 0) { throw "Argument cannot be negative"; }

  return (function(n) {
    return (n < 2) ? 1 : arguments.callee(n-1) + arguments.callee(n-2);
  })(n);
}


fib == [small] [] [pred dup pred] [+] binrec;


type expression =
  | Const of float
  | Sum  of expression * expression   (* e1 + e2 *)
  | Diff of expression * expression   (* e1 - e2 *)
  | Prod of expression * expression   (* e1 * e2 *)
  | Quot of expression * expression   (* e1 / e2 *)

let rec eval = function
  | Const c -> c
  | Sum (f, g) -> eval f +. eval g
  | Diff(f, g) -> eval f -. eval g
  | Prod(f, g) -> eval f *. eval g
  | Quot(f, g) -> eval f /. eval g

open Genlex

let lexer = make_lexer ["("; ")"; "+"; "-"; "*"; "/"]

let rec parse_expr = parser
     [< e1 = parse_mult; e = parse_more_adds e1 >] -> e
 and parse_more_adds e1 = parser
     [< 'Kwd "+"; e2 = parse_mult; e = parse_more_adds (Sum(e1, e2)) >] -> e
   | [< 'Kwd "-"; e2 = parse_mult; e = parse_more_adds (Diff(e1, e2)) >] -> e
   | [< >] -> e1
 and parse_mult = parser
     [< e1 = parse_simple; e = parse_more_mults e1 >] -> e
 and parse_more_mults e1 = parser
     [< 'Kwd "*"; e2 = parse_simple; e = parse_more_mults (Prod(e1, e2)) >] -> e
   | [< 'Kwd "/"; e2 = parse_simple; e = parse_more_mults (Quot(e1, e2)) >] -> e
   | [< >] -> e1
 and parse_simple = parser
   | [< 'Int i >] -> Const(float i)
   | [< 'Float f >] -> Const f
   | [< 'Kwd "("; e = parse_expr; 'Kwd ")" >] -> e

let parse_expression = parser [< e = parse_expr; _ = Stream.empty >] -> e

let read_expression s = parse_expression(lexer(Stream.of_string s))


function fib(n)
    if n < 0
        throw(ArgumentError("negative arguments not allowed"))
    end
    aux(m) = m < 2 ? one(m) : aux(m-1) + aux(m-2)
    aux(n)
end


include ..\Utilitys.tlhy

:fib %f !f
    %fr
    [ %n !n
        $n 2 <
        ( [$n]
          [$n 1 - $fr eval $n 2 - $fr eval +] )
        if
    ] !fr

    $f 0 <
    ( ["Error: number is negative"]
      [$f true $fr if] )
    if
;

25 fib ?
msec ?
"End " input


expressions = .array~of("2+3", "2+3/4", "2*3-4", "2*(3+4)+5/6", "2 * (3 + (4 * 5 + (6 * 7) * 8) - 9) * 10", "2*-3--4+-.25")
loop input over expressions
    expression = createExpression(input)
    if expression \= .nil then
        say 'Expression "'input'" parses to "'expression~string'" and evaluates to "'expression~evaluate'"'
end

-- create an executable expression from the input, printing out any
-- errors if they are raised.
::routine createExpression
  use arg inputString
--  signal on syntax
  return .ExpressionParser~parseExpression(inputString)

syntax:
   condition = condition('o')
   say condition~errorText
   say condition~message
   return .nil

-- a base class for tree nodes in the tree
-- all nodes return some sort of value.  This can be constant,
-- or the result of additional evaluations
::class evaluatornode
-- all evaluation is done here
::method evaluate abstract

-- node for numeric values in the tree
::class constant
::method init
  expose value
  use arg value

::method evaluate
  expose value
  return value

::method string
  expose value
  return value

-- node for a parenthetical group on the tree
::class parens
::method init
  expose subexpression
  use arg subexpression

::method evaluate
  expose subexpression
  return subexpression~evaluate

::method string
  expose subexpression
  return "("subexpression~string")"

-- base class for binary operators
::class binaryoperator
::method init
  expose left right
  -- the left and right sides are set after the left and right sides have
  -- been resolved.
  left = .nil
  right = .nil

-- base operation
::method evaluate
  expose left right
  return self~operation(left~evaluate, right~evaluate)

-- the actual operation of the node
::method operation abstract
::method symbol abstract
::method precedence abstract

-- display an operator as a string value
::method string
  expose left right
  return '('left~string self~symbol right~string')'

::attribute left
::attribute right

::class addoperator subclass binaryoperator
::method operation
  use arg left, right
  return left + right

::method symbol
  return "+"

::method precedence
  return 1

::class subtractoperator subclass binaryoperator
::method operation
  use arg left, right
  return left - right

::method symbol
  return "-"

::method precedence
  return 1

::class multiplyoperator subclass binaryoperator
::method operation
  use arg left, right
  return left * right

::method symbol
  return "*"

::method precedence
  return 2

::class divideoperator subclass binaryoperator
::method operation
  use arg left, right
  return left / right

::method symbol
  return "/"

::method precedence
  return 2

-- a class to parse the expression and build an evaluation tree
::class expressionParser
-- create a resolved operand from an operator instance and the top
-- two entries on the operand stack.
::method createNewOperand class
  use strict arg operator, operands
  -- the operands are a stack, so they are in inverse order current
  operator~right = operands~pull
  operator~left = operands~pull
  -- this goes on the top of the stack now
  operands~push(operator)

::method parseExpression class
  use strict arg inputString
  -- stacks for managing the operands and pending operators
  operands = .queue~new
  operators = .queue~new
  -- this flags what sort of item we expect to find at the current
  -- location
  afterOperand = .false

  loop currentIndex = 1 to inputString~length
      char = inputString~subChar(currentIndex)
      -- skip over whitespace
      if char == ' ' then iterate currentIndex
      -- If the last thing we parsed was an operand, then
      -- we expect to see either a closing paren or an
      -- operator to appear here
      if afterOperand then do
          if char == ')' then do
              loop while \operators~isempty
                  operator = operators~pull
                  -- if we find the opening paren, replace the
                  -- top operand with a paren group wrapper
                  -- and stop popping items
                  if operator == '(' then do
                     operands~push(.parens~new(operands~pull))
                     leave
                  end
                  -- collapse the operator stack a bit
                  self~createNewOperand(operator, operands)
              end
              -- done with this character
              iterate currentIndex
          end
          afterOperand = .false
          operator = .nil
          if char == "+" then operator = .addoperator~new
          else if char == "-" then operator = .subtractoperator~new
          else if char == "*" then operator = .multiplyoperator~new
          else if char == "/" then operator = .divideoperator~new
          if operator \= .nil then do
              loop while \operators~isEmpty
                  top = operators~peek
                  -- start of a paren group stops the popping
                  if top == '(' then leave
                  -- or the top operator has a lower precedence
                  if top~precedence < operator~precedence then leave
                  -- process this pending one
                  self~createNewOperand(operators~pull, operands)
              end
              -- this new operator is now top of the stack
              operators~push(operator)
              -- and back to the top
              iterate currentIndex
          end
          raise syntax 98.900 array("Invalid expression character" char)
      end
      -- if we've hit an open paren, add this to the operator stack
      -- as a phony operator
      if char == '(' then do
          operators~push('(')
          iterate currentIndex
      end
      -- not an operator, so we have an operand of some type
      afterOperand = .true
      startindex = currentIndex
      -- allow a leading minus sign on this
      if inputString~subchar(currentIndex) == '-' then
          currentIndex += 1
      -- now scan for the end of numbers
      loop while currentIndex <= inputString~length
          -- exit for any non-numeric value
          if \inputString~matchChar(currentIndex, "0123456789.") then leave
          currentIndex += 1
      end
      -- extract the string value
      operand = inputString~substr(startIndex, currentIndex - startIndex)
      if \operand~datatype('Number') then
          raise syntax 98.900 array("Invalid numeric operand '"operand"'")
      -- back this up to the last valid character
      currentIndex -= 1
      -- add this to the operand stack as a tree element that returns a constant
      operands~push(.constant~new(operand))
  end

  loop while \operators~isEmpty
      operator = operators~pull
      if operator == '(' then
          raise syntax 98.900 array("Missing closing ')' in expression")
      self~createNewOperand(operator, operands)
  end
  -- our entire expression should be the top of the expression tree
  expression = operands~pull
  if \operands~isEmpty then
      raise syntax 98.900 array("Invalid expression")
  return expression


fun fib(n: Int): Int {
   require(n >= 0)
   fun fib1(k: Int, a: Int, b: Int): Int =
       if (k == 0) a else fib1(k - 1, b, a + b)
   return fib1(n, 0, 1)
}

fun main(args: Array<String>) {
    for (i in 0..20) print("${fib(i)} ")
    println()
}


declare

  fun {Expr X0 ?X}
     choice
        [L _ R] = {Do [Term &+ Expr] X0 ?X} in add(L R)
     [] [L _ R] = {Do [Term &- Expr] X0 ?X} in sub(L R)
     [] {Term X0 X}
     end
  end

  fun {Term X0 ?X}
     choice
        [L _ R] = {Do [Factor &* Term] X0 ?X} in mul(L R)
     [] [L _ R] = {Do [Factor &/ Term] X0 ?X} in 'div'(L R)
     [] {Factor X0 X}
     end
  end

  fun {Factor X0 ?X}
     choice {Parens Expr X0 X}
     [] {Number X0 X}
     end
  end

  fun {Number X0 X}
     Ds = {Many1 Digit X0 X}
  in
     num(Ds)
  end

  fun {Digit X0 ?X}
     D|!X = X0
  in
     D = choice &0 [] &1 [] &2 [] &3 [] &4 [] &5 [] &6 [] &7 [] &8 [] &9 end
  end

  fun {Many1 Rule X0 ?X}
     choice [{Rule X0 X}]
     [] X1 in {Rule X0 X1}|{Many1 Rule X1 X}
     end
  end

  fun {Parens Rule X0 ?X}
     [_ R _] = {Do [&( Rule &)] X0 X}
  in
     R
  end

  fun {Do Rules X0 ?X}
     Res#Xn = {FoldL Rules
               fun {$ Res#Xi Rule}
                  if {Char.is Rule} then
                     !Rule|X2 = Xi
                  in
                     (Rule|Res) # X2
                  elseif {Procedure.is Rule} then
                     X2 in
                     ({Rule Xi X2}|Res) # X2
                  end
               end
               nil#X0}
  in
     X = Xn
     {Reverse Res}
  end

  %% Returns a singleton list if an AST was found or nil otherwise.
  fun {Parse S}
     {SearchOne fun {$} {Expr S nil} end}
  end

  fun {Eval X}
     case X of
        num(Ds)    then {String.toInt Ds}
     [] add(L R)   then {Eval L} + {Eval R}
     [] sub(L R)   then {Eval L} - {Eval R}
     [] mul(L R)   then {Eval L} * {Eval R}
     [] 'div'(L R) then {Eval L} div {Eval R}
     end
  end

  [AST] = {Parse "((11+15)*15)*2-(3)*4*1"}

in

  {Inspector.configure widgetShowStrings true}
  {Inspect AST}
  {Inspect {Eval AST}}


1) defining a quasi-recursive function combined with a simple Ω-combinator:
{def fibo {lambda {:n}
 {{{lambda {:f} {:f :f}}
  {lambda {:f :n :a :b}
   {if {< :n 0}
    then the number must be positive!
    else {if {<  :n 1}
    then :a
    else {:f :f {- :n 1} {+ :a :b} :a}}}}} :n 1 0}}}
-> fibo

2) testing:
{fibo -1} -> the number must be positive!
{fibo 0} -> 1
{fibo 8} -> 34
{fibo 1000} -> 7.0330367711422765e+208
{S.map fibo {S.serie 1 20}}
-> 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946

We could also avoid any name and write an IIFE

{{lambda {:n}
 {{{lambda {:f} {:f :f}}
  {lambda {:f :n :a :b}
   {if {< :n 0}
    then the number must be positive!
    else {if {<  :n 1}
    then :a
    else {:f :f {- :n 1} {+ :a :b} :a}}}}} :n 1 0}}
 8}
-> 34


on fib (n)
  if n<0 then return _player.alert("negative arguments not allowed")

  -- create instance of unnamed class in memory only (does not pollute namespace)
  m = new(#script)
  r = RETURN
  m.scriptText = "on fib (me,n)"&r&"if n<2 then return n"&r&"return me.fib(n-1)+me.fib(n-2)"&r&"end"
  aux = m.script.new()
  m.erase()

  return aux.fib(n)
end


sub ev
# Evaluates an arithmetic expression like "(1+3)*7" and returns
# its value.
 {my $exp = shift;
  # Delete all meaningless characters. (Scientific notation,
  # infinity, and not-a-number aren't supported.)
  $exp =~ tr {0-9.+-/*()} {}cd;
  return ev_ast(astize($exp));}

 {my $balanced_paren_regex;
  $balanced_paren_regex = qr
     {\( ( [^()]+ | (??{$balanced_paren_regex}) )+ \)}x;
  # ??{ ... } interpolates lazily (only when necessary),
  # permitting recursion to arbitrary depths.

  sub astize
  # Constructs an abstract syntax tree by recursively
  # transforming textual arithmetic expressions into array
  # references of the form [operator, left oprand, right oprand].
   {my $exp = shift;
    # If $exp is just a number, return it as-is.
    $exp =~ /[^0-9.]/ or return $exp;
    # If parentheses surround the entire expression, get rid of
    # them.
    $exp = substr($exp, 1, -1)
        while $exp =~ /\A($balanced_paren_regex)\z/;
    # Replace stuff in parentheses with placeholders.
    my @paren_contents;
    $exp =~ s {($balanced_paren_regex)}
              {push(@paren_contents, $1);
               "[p$#paren_contents]"}eg;
    # Scan for operators in order of increasing precedence,
    # preferring the rightmost.
    $exp =~ m{(.+) ([+-]) (.+)}x or
        $exp =~ m{(.+) ([*/]) (.+)}x or
        # The expression must've been malformed somehow.
        # (Note that unary minus isn't supported.)
        die "Eh?: [$exp]\n";
    my ($op, $lo, $ro) = ($2, $1, $3);
    # Restore the parenthetical expressions.
    s {\[p(\d+)\]} {($paren_contents[$1])}eg
        foreach $lo, $ro;
    # And recurse.
    return [$op, astize($lo), astize($ro)];}}

 {my %ops =
     ('+' => sub {$_[0] + $_[1]},
      '-' => sub {$_[0] - $_[1]},
      '*' => sub {$_[0] * $_[1]},
      '/' => sub {$_[0] / $_[1]});

  sub ev_ast
  # Evaluates an abstract syntax tree of the form returned by
  # &astize.
   {my $ast = shift;
    # If $ast is just a number, return it as-is.
    ref $ast or return $ast;
    # Otherwise, recurse.
    my ($op, @operands) = @$ast;
    $_ = ev_ast($_) foreach @operands;
    return $ops{$op}->(@operands);}}


HAI 1.3

HOW IZ I fib YR x
    DIFFRINT x AN BIGGR OF x AN 0, O RLY?
        YA RLY, FOUND YR "ERROR"
    OIC

    HOW IZ I fib_i YR n
        DIFFRINT n AN BIGGR OF n AN 2, O RLY?
            YA RLY, FOUND YR n
        OIC

        FOUND YR SUM OF...
        I IZ fib_i YR DIFF OF n AN 2 MKAY AN...
        I IZ fib_i YR DIFF OF n AN 1 MKAY
    IF U SAY SO

    FOUND YR I IZ fib_i YR x MKAY
IF U SAY SO

HOW IZ I fib_i YR n
    VISIBLE "SRY U CANT HAS FIBS DIS TIEM"
IF U SAY SO

IM IN YR fibber UPPIN YR i TIL BOTH SAEM i AN 5
    I HAS A i ITZ DIFF OF i AN 1
    VISIBLE "fib(:{i}) = " I IZ fib YR i MKAY
IM OUTTA YR fibber

I IZ fib_i YR 3 MKAY

KTHXBYE


local function Y(x) return (function (f) return f(f) end)(function(y) return x(function(z) return y(y)(z) end) end) end

return Y(function(fibs)
  return function(n)
    return n < 2 and 1 or fibs(n - 1) + fibs(n - 2)
  end
end)


A$={{ Module "Fibonacci" : Read X  :If X<0 then {Error {X<0}} Else  Fib=Lambda (x)->if(x>1->fib(x-1)+fib(x-2), x) : =fib(x)}}
Try Ok {
      Print Function(A$, -12)
}
If Error or Not Ok Then Print Error$
Print Function(A$, 12)=144 ' true


Fib := proc( n :: nonnegint )
        proc( k )
                option  remember; # automatically memoise
                if k = 0 then
                        0
                elif k = 1 then
                        1
                else
                        # Recurse, anonymously
                        thisproc( k - 1 ) + thisproc( k - 2 )
                end
        end( n )
end proc:


-- demo\rosetta\Arithmetic_evaluation.exw
with javascript_semantics

sequence opstack = {}       -- atom elements are literals,
                            -- sequence elements are subexpressions
                            -- on completion length(opstack) should be 1
object token

constant op_p_p = 1         --  1: expressions stored as op,p1,p2
    --   p_op_p             --  0: expressions stored as p1,op,p2
    --   p_p_op             -- -1: expressions stored as p1,p2,op

object op = 0   -- 0 if none, else "+", "-", "*", "/", "^", "%", or "u-"

string s        -- the expression being parsed
integer ch
integer sidx

procedure err(string msg)
    printf(1,"%s\n%s^ %s\n\nPressEnter...",{s,repeat(' ',sidx-1),msg})
    {} = wait_key()
    abort(0)
end procedure

procedure nxtch(object msg="eof")
    sidx += 1
    if sidx>length(s) then
        if string(msg) then err(msg) end if
        ch = -1
    else
        ch = s[sidx]
    end if
end procedure

procedure skipspaces()
    while find(ch,{' ','\t','\r','\n'})!=0 do nxtch(0) end while
end procedure

procedure get_token()
atom n, fraction
integer dec
    skipspaces()
    if ch=-1 then token = "eof" return end if
    if ch>='0' and ch<='9' then
        n = ch-'0'
        while 1 do
            nxtch(0)
            if ch<'0' or ch>'9' then exit end if
            n = n*10+ch-'0'
        end while
        if ch='.' then
            dec = 1
            fraction = 0
            while 1 do
                nxtch(0)
                if ch<'0' or ch>'9' then exit end if
                fraction = fraction*10 + ch-'0'
                dec *= 10
            end while
            n += fraction/dec
        end if
--      if find(ch,"eE") then   -- you get the idea
--      end if
        token = n
        return
    end if
    if find(ch,"+-/*()^%")=0 then err("syntax error") end if
    token = s[sidx..sidx]
    nxtch(0)
    return
end procedure

procedure Match(string t)
    if token!=t then err(t&" expected") end if
    get_token()
end procedure

procedure PopFactor()
    object p1, p2 = opstack[$]
    if op="u-" then
        p1 = 0
    else
        opstack = opstack[1..$-1]
        p1 = opstack[$]
    end if
    if op_p_p=1 then
        opstack[$] = {op,p1,p2}  -- op_p_p
    elsif op_p_p=0 then
        opstack[$] = {p1,op,p2}  -- p_op_p
    else -- -1
        opstack[$] = {p1,p2,op}  -- p_p_op
    end if
    op = 0
end procedure

procedure PushFactor(atom t)
    if op!=0 then PopFactor() end if
    opstack = append(opstack,t)
end procedure

procedure PushOp(string t)
    if op!=0 then PopFactor() end if
    op = t
end procedure

forward procedure Expr(integer p)

procedure Factor()
    if atom(token) then
        PushFactor(token)
        if ch!=-1 then
            get_token()
        end if
    elsif token="+" then -- (ignore)
        nxtch()
        Factor()
    elsif token="-" then
        get_token()
--      Factor()
        Expr(3) -- makes "-3^2" yield -9 (ie -(3^2)) not 9 (ie (-3)^2).
        if op!=0 then PopFactor() end if
        if integer(opstack[$]) then
            opstack[$] = -opstack[$]
        else
            PushOp("u-")
        end if
    elsif token="(" then
        get_token()
        Expr(0)
        Match(")")
    else
        err("syntax error")
    end if
end procedure

constant {operators,
          precedence,
          associativity} = columnize({{"^",3,0},
                                      {"%",2,1},
                                      {"*",2,1},
                                      {"/",2,1},
                                      {"+",1,1},
                                      {"-",1,1},
                                      $})

procedure Expr(integer p)
--
-- Parse an expression, using precedence climbing.
--
-- p is the precedence level we should parse to, eg/ie
--      4: Factor only (may as well just call Factor)
--      3: "" and ^
--      2: "" and *,/,%
--      1: "" and +,-
--      0: full expression (effectively the same as 1)
--  obviously, parentheses override any setting of p.
--
integer k, thisp
    Factor()
    while 1 do
        k = find(token,operators) -- *,/,+,-
        if k=0 then exit end if
        thisp = precedence[k]
        if thisp<p then exit end if
        get_token()
        Expr(thisp+associativity[k])
        PushOp(operators[k])
    end while
end procedure

function evaluate(object s)
object lhs, rhs
string op
    if atom(s) then
        return s
    end if
    if op_p_p=1 then            -- op_p_p
        {op,lhs,rhs} = s
    elsif op_p_p=0 then         -- p_op_p
        {lhs,op,rhs} = s
    else -- -1                  -- p_p_op
        {lhs,rhs,op} = s
    end if
    if sequence(lhs) then lhs = evaluate(lhs) end if
    if sequence(rhs) then rhs = evaluate(rhs) end if
    if op="+" then
        return lhs+rhs
    elsif op="-" then
        return lhs-rhs
    elsif op="*" then
        return lhs*rhs
    elsif op="/" then
        return lhs/rhs
    elsif op="^" then
        return power(lhs,rhs)
    elsif op="%" then
        return remainder(lhs,rhs)
    elsif op="u-" then
        return -rhs
    else
        ?9/0
    end if
end function

s = "3+4+5+6*7/1*5^2^3"     -- 16406262
sidx = 0
nxtch()
get_token()
Expr(0)
if op!=0 then PopFactor() end if
if length(opstack)!=1 then err("some error") end if
printf(1,"expression: \"%s\"\n",{s})
puts(1,"AST (flat): ")
?opstack[1]
puts(1,"AST (tree):\n")
ppEx(opstack[1],{pp_Nest,9999})
puts(1,"result: ")
?evaluate(opstack[1])
{} = wait_key()


function v = fibonacci(n)
assert(n >= 0)
v = fibonacci(n,0,1);

    % nested function
    function a = fibonacci(n,a,b)
        if n ~= 0
            a = fibonacci(n-1,b,a+b);
        end
    end
end


using System;
using System.Console;

module Fib
{
    Fib(n : long) : long
    {
        def fib(m : long)
        {
            |0 => 1
            |1 => 1
            |_ => fib(m - 1) + fib(m - 2)
        }

        match(n)
        {
            |n when (n < 0) => throw ArgumentException("Fib() not defined on negative numbers")
            |_ => fib(n)
        }
    }

    Main() : void
    {
        foreach (i in [-2 .. 10])
        {
            try {WriteLine("{0}", Fib(i));}
            catch {|e is ArgumentException => WriteLine(e.Message)}
        }
    }
}


# Using scoped function fibI inside fib
proc fib(x: int): int =
  proc fibI(n: int): int =
    if n < 2: n else: fibI(n-2) + fibI(n-1)
  if x < 0:
    raise newException(ValueError, "Invalid argument")
  return fibI(x)

for i in 0..4:
  echo fib(i)

# fibI(10) # undeclared identifier 'fibI'


main =>
    print("Enter an expression: "),
    Str = read_line(),
    Exp = parse_term(Str),
    Res is Exp,
    printf("Result = %w\n", Res).


(de ast (Str)
   (let *L (str Str "")
      (aggregate) ) )

(de aggregate ()
   (let X (product)
      (while (member (car *L) '("+" "-"))
         (setq X (list (intern (pop '*L)) X (product))) )
      X ) )

(de product ()
   (let X (term)
      (while (member (car *L) '("*" "/"))
         (setq X (list (intern (pop '*L)) X (term))) )
      X ) )

(de term ()
   (let X (pop '*L)
      (cond
         ((num? X) X)
         ((= "+" X) (term))
         ((= "-" X) (list '- (term)))
         ((= "(" X) (prog1 (aggregate) (pop '*L)))) ) )


#import <Foundation/Foundation.h>

@interface AnonymousRecursion : NSObject { }
- (NSNumber *)fibonacci:(NSNumber *)n;
@end

@implementation AnonymousRecursion
- (NSNumber *)fibonacci:(NSNumber *)n {
  int i = [n intValue];
  if (i < 0)
    @throw [NSException exceptionWithName:NSInvalidArgumentException
                                 reason:@"fibonacci: no negative numbers"
                               userInfo:nil];
  int result;
  if (i < 2)
    result = 1;
  else
    result = [[self performSelector:_cmd withObject:@(i-1)] intValue]
           + [[self performSelector:_cmd withObject:@(i-2)] intValue];
  return @(result);
}
@end

int main (int argc, const char *argv[]) {
  @autoreleasepool {

    AnonymousRecursion *dummy = [[AnonymousRecursion alloc] init];
    NSLog(@"%@", [dummy fibonacci:@8]);

  }
  return 0;
}


let fib n =
  let rec real = function
      0 -> 1
    | 1 -> 1
    | n -> real (n-1) + real (n-2)
  in
  if n < 0 then
    None
  else
    Some (real n)


/* Scanner routines */
/* Uncomment the following to parse data from standard input

vars itemrep;
incharitem(charin) -> itemrep;

*/

;;; Current symbol
vars sym;

define get_sym();
    itemrep() -> sym;
enddefine;

define expect(x);
    lvars x;
    if x /= sym then
        printf(x, 'Error, expected %p\n');
        mishap(sym, 1, 'Example parser error');
    endif;
    get_sym();
enddefine;

lconstant res_list = [( ) + * ];

lconstant reserved = newproperty(
  maplist(res_list, procedure(x); [^x ^(true)]; endprocedure),
    20, false, "perm");

/*
  Parser for arithmetic expressions
*/
/*
expr: term
   | expr "+" term
   | expr "-" term
   ;
*/

define do_expr() -> result;
    lvars result = do_term(), op;
    while sym = "+" or sym = "-" do
        sym -> op;
        get_sym();
        [^op ^result ^(do_term())] -> result;
    endwhile;
enddefine;

/*
term: factor
   | term "*" factor
   | term "/" factor
   ;
*/

define do_term() -> result;
    lvars result = do_factor(), op;
    while sym = "*" or sym = "/" do
        sym -> op;
        get_sym();
        [^op ^result ^(do_factor())] -> result;
    endwhile;
enddefine;

/*
factor: word
   | constant
   | "(" expr ")"
   ;
*/

define do_factor() -> result;
    if sym = "(" then
        get_sym();
        do_expr() -> result;
        expect(")");
    elseif isinteger(sym) or isbiginteger(sym) then
        sym -> result;
        get_sym();
    else
        if reserved(sym) then
            printf(sym, 'unexpected symbol %p\n');
            mishap(sym, 1, 'Example parser syntax error');
        endif;
        sym -> result;
        get_sym();
    endif;
enddefine;

/* Expression evaluator, returns false on error (currently only
   division by 0 */

define arith_eval(expr);
    lvars op, arg1, arg2;
    if not(expr) then
        return(expr);
    endif;
    if isinteger(expr) or isbiginteger(expr) then
        return(expr);
    endif;
    expr(1) -> op;
    arith_eval(expr(2)) -> arg1;
    arith_eval(expr(3)) -> arg2;
    if not(arg1) or not(arg2) then
        return(false);
    endif;
    if op = "+" then
        return(arg1 + arg2);
    elseif op = "-" then
        return(arg1 - arg2);
    elseif op = "*" then
        return(arg1 * arg2);
    elseif op = "/" then
        if arg2 = 0 then
            return(false);
        else
            return(arg1 div arg2);
        endif;
    else
        printf('Internal error\n');
        return(false);
    endif;
enddefine;

/* Given list, create item repeater.  Input list is stored in a
   closure are traversed when new item is requested. */

define listitemrep(lst);
    procedure();
        lvars item;
        if lst = [] then
            termin;
        else
            front(lst) -> item;
            back(lst) -> lst;
            item;
         endif;
     endprocedure;
enddefine;

/* Initialise scanner */

listitemrep([(3 + 50) * 7 - 100 / 10]) -> itemrep;

get_sym();

;;; Test it
arith_eval(do_expr()) =>


% Lexer
 numeric(X) :- 48 =< X, X =< 57.
 not_numeric(X) :- 48 > X ; X > 57.

 lex1([], []).
 lex1([40|Xs], ['('|Ys]) :- lex1(Xs, Ys).
 lex1([41|Xs], [')'|Ys]) :- lex1(Xs, Ys).
 lex1([43|Xs], ['+'|Ys]) :- lex1(Xs, Ys).
 lex1([45|Xs], ['-'|Ys]) :- lex1(Xs, Ys).
 lex1([42|Xs], ['*'|Ys]) :- lex1(Xs, Ys).
 lex1([47|Xs], ['/'|Ys]) :- lex1(Xs, Ys).
 lex1([X|Xs], [N|Ys]) :- numeric(X), N is X - 48, lex1(Xs, Ys).

 lex2([], []).
 lex2([X], [X]).
 lex2([Xa,Xb|Xs], [Xa|Ys]) :- atom(Xa), lex2([Xb|Xs], Ys).
 lex2([Xa,Xb|Xs], [Xa|Ys]) :- number(Xa), atom(Xb), lex2([Xb|Xs], Ys).
 lex2([Xa,Xb|Xs], [Y|Ys]) :- number(Xa), number(Xb), N is Xa * 10 + Xb, lex2([N|Xs], [Y|Ys]).

 % Parser
 oper(1, *, X, Y, X * Y). oper(1, /, X, Y, X / Y).
 oper(2, +, X, Y, X + Y). oper(2, -, X, Y, X - Y).

 num(D) --> [D], {number(D)}.

 expr(0, Z) --> num(Z).
 expr(0, Z) --> {Z = (X)}, ['('], expr(2, X), [')'].

 expr(N, Z) --> {succ(N0, N)}, {oper(N, Op, X, Y, Z)}, expr(N0, X), [Op], expr(N, Y).
 expr(N, Z) --> {succ(N0, N)}, expr(N0, Z).

 parse(Tokens, Expr) :- expr(2, Expr, Tokens, []).

 % Evaluator
 evaluate(E, E) :- number(E).
 evaluate(A + B, E) :- evaluate(A, Ae), evaluate(B, Be), E is Ae + Be.
 evaluate(A - B, E) :- evaluate(A, Ae), evaluate(B, Be), E is Ae - Be.
 evaluate(A * B, E) :- evaluate(A, Ae), evaluate(B, Be), E is Ae * Be.
 evaluate(A / B, E) :- evaluate(A, Ae), evaluate(B, Be), E is Ae / Be.

 % Solution
 calculator(String, Value) :-
    string_codes(String, Codes),
    lex1(Codes, Tokens1),
    lex2(Tokens1, Tokens2),
    parse(Tokens2, Expression),
    evaluate(Expression, Value).

 % Example use
 % calculator("(3+50)*7-9", X).


(define (fibonacci n)
   (if (> 0 n)
      "error: negative argument."
      (let loop ((a 1) (b 0) (count n))
         (if (= count 0)
            b
            (loop (+ a b) a (- count 1))))))

(print
   (map fibonacci '(1 2 3 4 5 6 7 8 9 10)))


function fiboRatio() as double
    function fibo( double i, j ) as double
        if j > 2e12 then return j / i
        return fibo j, i + j
    end function
    return fibo 1, 1
end function

print fiboRatio


import operator

class AstNode(object):
   def __init__( self, opr, left, right ):
      self.opr = opr
      self.l = left
      self.r = right

   def eval(self):
      return self.opr(self.l.eval(), self.r.eval())

class LeafNode(object):
   def __init__( self, valStrg ):
      self.v = int(valStrg)

   def eval(self):
      return self.v

class Yaccer(object):
   def __init__(self):
      self.operstak = []
      self.nodestak =[]
      self.__dict__.update(self.state1)

   def v1( self, valStrg ):
      # Value String
      self.nodestak.append( LeafNode(valStrg))
      self.__dict__.update(self.state2)
      #print 'push', valStrg

   def o2( self, operchar ):
      # Operator character or open paren in state1
      def openParen(a,b):
         return 0		# function should not be called

      opDict= { '+': ( operator.add, 2, 2 ),
         '-': (operator.sub, 2, 2 ),
         '*': (operator.mul, 3, 3 ),
         '/': (operator.div, 3, 3 ),
         '^': ( pow,         4, 5 ),  # right associative exponentiation for grins
         '(': ( openParen,   0, 8 )
         }
      operPrecidence = opDict[operchar][2]
      self.redeuce(operPrecidence)

      self.operstak.append(opDict[operchar])
      self.__dict__.update(self.state1)
      # print 'pushop', operchar

   def syntaxErr(self, char ):
      # Open Parenthesis
      print 'parse error - near operator "%s"' %char

   def pc2( self,operchar ):
      # Close Parenthesis
      # reduce node until matching open paren found
      self.redeuce( 1 )
      if len(self.operstak)>0:
         self.operstak.pop()		# pop off open parenthesis
      else:
         print 'Error - no open parenthesis matches close parens.'
      self.__dict__.update(self.state2)

   def end(self):
      self.redeuce(0)
      return self.nodestak.pop()

   def redeuce(self, precidence):
      while len(self.operstak)>0:
         tailOper = self.operstak[-1]
         if tailOper[1] < precidence: break

         tailOper = self.operstak.pop()
         vrgt = self.nodestak.pop()
         vlft= self.nodestak.pop()
         self.nodestak.append( AstNode(tailOper[0], vlft, vrgt))
         # print 'reduce'

   state1 = { 'v': v1, 'o':syntaxErr, 'po':o2, 'pc':syntaxErr }
   state2 = { 'v': syntaxErr, 'o':o2, 'po':syntaxErr, 'pc':pc2 }

def Lex( exprssn, p ):
   bgn = None
   cp = -1
   for c in exprssn:
      cp += 1
      if c in '+-/*^()':         # throw in exponentiation (^)for grins
         if bgn is not None:
            p.v(p, exprssn[bgn:cp])
            bgn = None
         if c=='(': p.po(p, c)
         elif c==')':p.pc(p, c)
         else: p.o(p, c)
      elif c in ' \t':
         if bgn is not None:
            p.v(p, exprssn[bgn:cp])
            bgn = None
      elif c in '0123456789':
         if bgn is None:
            bgn = cp
      else:
         print 'Invalid character in expression'
         if bgn is not None:
            p.v(p, exprssn[bgn:cp])
            bgn = None

   if bgn is not None:
      p.v(p, exprssn[bgn:cp+1])
      bgn = None
   return p.end()

expr = raw_input("Expression:")
astTree = Lex( expr, Yaccer())
print expr, '=',astTree.eval()


program AnonymousRecursion;

function Fib(X: Integer): integer;

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

begin
if X < 0 then Fib:=X
else Fib:=DoFib(X);
end;

var I,V: integer;

begin
for I:=-1 to 15 do
	begin
	V:=Fib(I);
	Write(I:3,' - ',V:3);
	if V<0 then Write(' - Error');
	WriteLn;
	end;
WriteLn('Hit Any Key');
ReadLn;
end.


#lang racket

(require parser-tools/yacc
         parser-tools/lex
         (prefix-in ~ parser-tools/lex-sre))

(define-tokens value-tokens (NUM))
(define-empty-tokens op-tokens (OPEN CLOSE + - * / EOF NEG))

(define lex
  (lexer [(eof) 'EOF]
         [whitespace (lex input-port)]
         [(~or "+" "-" "*" "/") (string->symbol lexeme)]
         ["(" 'OPEN]
         [")" 'CLOSE]
         [(~: (~+ numeric) (~? (~: #\. (~* numeric))))
          (token-NUM (string->number lexeme))]))

(define parse
  (parser [start E] [end EOF]
          [tokens value-tokens op-tokens]
          [error void]
          [precs (left - +) (left * /) (left NEG)]
          [grammar (E [(NUM) $1]
                      [(E + E) (+ $1 $3)]
                      [(E - E) (- $1 $3)]
                      [(E * E) (* $1 $3)]
                      [(E / E) (/ $1 $3)]
                      [(- E) (prec NEG) (- $2)]
                      [(OPEN E CLOSE) $2])]))

(define (calc str)
  (define i (open-input-string str))
  (displayln (parse (λ () (lex i)))))

(calc "(1 + 2 * 3) - (1+2)*-3")


sub ev (Str $s --> Numeric) {

    grammar expr {
        token TOP { ^ <sum> $ }
        token sum { <product> (('+' || '-') <product>)* }
        token product { <factor> (('*' || '/') <factor>)* }
        token factor { <unary_minus>? [ <parens> || <literal> ] }
        token unary_minus { '-' }
        token parens { '(' <sum> ')' }
        token literal { \d+ ['.' \d+]? || '.' \d+ }
    }

    my sub minus ($b) { $b ?? -1 !! +1 }

    my sub sum ($x) {
        [+] flat product($x<product>), map
            { minus($^y[0] eq '-') * product $^y<product> },
            |($x[0] or [])
    }

    my sub product ($x) {
        [*] flat factor($x<factor>), map
            { factor($^y<factor>) ** minus($^y[0] eq '/') },
            |($x[0] or [])
    }

    my sub factor ($x) {
        minus($x<unary_minus>) * ($x<parens>
          ?? sum $x<parens><sum>
          !! $x<literal>)
    }

    expr.parse([~] split /\s+/, $s);
    $/ or fail 'No parse.';
    sum $/<sum>;

}

# Testing:

say ev '5';                                    #   5
say ev '1 + 2 - 3 * 4 / 5';                    #   0.6
say ev '1 + 5*3.4 - .5  -4 / -2 * (3+4) -6';   #  25.5
say ev '((11+15)*15)* 2 + (3) * -4 *1';        # 768


sub recur (&@) {
    my $f = shift;
    local *recurse = $f;
    $f->(@_);
}

sub fibo {
    my $n = shift;
    $n < 0 and die 'Negative argument';
    recur {
        my $m = shift;
        $m < 3 ? 1 : recurse($m - 1) + recurse($m - 2);
    } $n;
}


without js -- (no class yet)
class Fib
    private function fib_i(integer n)
        return iff(n<2?n:this.fib_i(n-1)+this.fib_i(n-2))
    end function
    public function fib(integer n)
        if n<0 then throw("constraint error") end if
        return this.fib_i(n)
    end function
end class
Fib f = new()

function fib_i(integer i)
    return sprintf("this is not the fib_i(%d) you are looking for\n",i)
end function

?f.fib(10)
--?f.fib_i(10)  -- illegal
?fib_i(10)


/*REXX program  evaluates an  infix─type arithmetic expression  and displays the result.*/
nchars = '0123456789.eEdDqQ'                     /*possible parts of a number,  sans  ± */
e='***error***';    $=" ";     doubleOps= '&|*/';      z=       /*handy─dandy variables.*/
parse arg x 1 ox1;    if x=''  then call serr "no input was specified."
x=space(x);   L=length(x);     x=translate(x, '()()', "[]{}")
j=0
     do forever;    j=j+1;     if j>L  then leave;    _=substr(x, j, 1);   _2=getX()
     newT=pos(_,' ()[]{}^÷')\==0;  if newT  then do;  z=z _ $;  iterate;   end
     possDouble=pos(_,doubleOps)\==0             /*is    _   a possible double operator?*/
     if possDouble  then do                      /* "  this  "     "       "       "    */
                         if _2==_  then do       /*yupper, it's one of a double operator*/
                                        _=_ || _ /*create and use a double char operator*/
                                        x=overlay($, x, Nj)      /*blank out 2nd symbol.*/
                                        end
                         z=z _ $;  iterate
                         end
     if _=='+' | _=="-"  then do;  p_=word(z, max(1,words(z)))   /*last  Z  token.      */
                                   if p_=='('   then z=z 0       /*handle a unary ±     */
                                   z=z _ $;     iterate
                              end
     lets=0;  sigs=0;  #=_

            do j=j+1  to L;   _=substr(x,j,1)                    /*build a valid number.*/
            if lets==1 & sigs==0 then if _=='+' | _=="-"  then do;  sigs=1
                                                                    #=# || _
                                                                    iterate
                                                               end
            if pos(_,nchars)==0  then leave
            lets=lets+datatype(_,'M')            /*keep track of the number of exponents*/
            #=# || translate(_,'EEEEE', "eDdQq") /*keep building the number.            */
            end   /*j*/
     j=j-1
     if \datatype(#,'N')  then call  serr  "invalid number: "     #
     z=z # $
     end   /*forever*/

_=word(z,1);      if _=='+' | _=="-"  then z=0 z /*handle the unary cases.              */
x='(' space(z) ")";    tokens=words(x)           /*force stacking for the expression.   */
  do i=1  for tokens;  @.i=word(x,i);  end /*i*/ /*assign input tokens.                 */
L=max(20,length(x))                              /*use 20 for the minimum display width.*/
op= ')(-+/*^';    Rop=substr(op,3);     p.=;     s.=;     n=length(op);    epr=;    stack=

  do i=1  for n;  _=substr(op,i,1);     s._=(i+1)%2;     p._=s._ + (i==n);      end  /*i*/
                                                 /* [↑]  assign the operator priorities.*/
  do #=1  for tokens;   [email protected].#                    /*process each token from the  @. list.*/
  if ?=='**'      then ?="^"                     /*convert to REXX-type exponentiation. */
     select                                      /*@.#  is:   (   operator   )   operand*/
     when ?=='('  then stack="(" stack
     when isOp(?) then do                        /*is the token an operator ?           */
                       !=word(stack,1)           /*get token from stack.*/
                         do  while !\==')' & s.!>=p.?;  epr=epr !            /*addition.*/
                         stack=subword(stack, 2)                  /*del token from stack*/
                         !=       word(stack, 1)                  /*get token from stack*/
                         end   /*while*/
                       stack=? stack                              /*add token  to  stack*/
                       end
     when ?==')' then do;   !=word(stack, 1)                      /*get token from stack*/
                         do  while !\=='(';             epr=epr ! /*append to expression*/
                         stack=subword(stack, 2)                  /*del token from stack*/
                         !=       word(stack, 1)                  /*get token from stack*/
                        end   /*while*/
                      stack=subword(stack, 2)                     /*del token from stack*/
                      end
    otherwise  epr=epr ?                                          /*add operand to  epr.*/
    end   /*select*/
  end     /*#*/

epr=space(epr stack);     tokens=words(epr);     x=epr;     z=;     stack=
  do i=1  for tokens; @.i=word(epr,i);  end /*i*/                 /*assign input tokens.*/
Dop='/ // % ÷';           Bop="& | &&"           /*division   operands; binary operands.*/
Aop='- + * ^ **' Dop Bop; Lop=Aop "||"           /*arithmetic operands; legal  operands.*/

  do #=1  for tokens;   [email protected].#;   ??=?            /*process each token from   @.  list.  */
  w=words(stack);  b=word(stack, max(1, w  ) )   /*stack count;  the last entry.        */
                   a=word(stack, max(1, w-1) )   /*stack's  "first"  operand.           */
  division  =wordpos(?, Dop)\==0                 /*flag:  doing a division operation.   */
  arith     =wordpos(?, Aop)\==0                 /*flag:  doing arithmetic operation.   */
  bitOp     =wordpos(?, Bop)\==0                 /*flag:  doing binary mathematics.     */
  if datatype(?, 'N')  then do; stack=stack ?;                iterate; end
  if wordpos(?,Lop)==0 then do;  z=e  "illegal operator:" ?;        leave; end
  if w<2               then do;  z=e  "illegal epr expression.";    leave; end
  if ?=='^'            then ??="**"              /*REXXify   ^ ──► **   (make it legal).*/
  if ?=='÷'            then ??="/"               /*REXXify   ÷ ──► /    (make it legal).*/
  if division  &  b=0  then do;  z=e  "division by zero"        b;  leave; end
  if bitOp & \isBit(a) then do;  z=e  "token isn't logical: "   a;  leave; end
  if bitOp & \isBit(b) then do;  z=e  "token isn't logical: "   b;  leave; end
             select                              /*perform an arithmetic operation.     */
             when ??=='+'             then y = a +  b
             when ??=='-'             then y = a -  b
             when ??=='*'             then y = a *  b
             when ??=='/' | ??=="÷"   then y = a /  b
             when ??=='//'            then y = a // b
             when ??=='%'             then y = a %  b
             when ??=='^' | ??=="**"  then y = a ** b
             when ??=='||'            then y = a || b
             otherwise              z=e 'invalid operator:' ?;         leave
             end   /*select*/
  if datatype(y, 'W')   then y=y/1               /*normalize the number with  ÷  by  1. */
  _=subword(stack, 1, w-2);  stack=_ y           /*rebuild the stack with the answer.   */
  end   /*#*/

if word(z, 1)==e  then stack=                    /*handle the special case of errors.   */
z=space(z stack)                                 /*append any residual entries.         */
say 'answer──►'   z                              /*display the answer  (result).        */
parse source upper . how .                       /*invoked via  C.L.  or REXX program ? */
if how=='COMMAND' | \datatype(z, 'W')  then exit /*stick a fork in it,  we're all done. */
return z                                         /*return  Z ──► invoker  (the RESULT). */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isBit: return arg(1)==0 | arg(1) == 1            /*returns  1  if 1st argument is binary*/
isOp:  return pos(arg(1), rOp) \== 0             /*is argument 1 a  "real"  operator?   */
serr:  say;   say e arg(1);   say;   exit 13     /*issue an error message with some text*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
getX:            do Nj=j+1  to length(x);   _n=substr(x, Nj, 1);    if _n==$  then iterate
                 return  substr(x, Nj, 1)        /* [↑]  ignore any blanks in expression*/
                 end   /*Nj*/
       return $                                  /*reached end-of-tokens,  return $.    */


<?php
function fib($n) {
    if ($n < 0)
        throw new Exception('Negative numbers not allowed');
    $f = function($n) { // This function must be called using call_user_func() only
        if ($n < 2)
            return 1;
        else {
            $g = debug_backtrace()[1]['args'][0];
            return call_user_func($g, $n-1) + call_user_func($g, $n-2);
        }
    };
    return call_user_func($f, $n);
}
echo fib(8), "\n";
?>


(de fibo (N)
   (if (lt0 N)
      (quit "Illegal argument" N) )
   (recur (N)
      (if (> 2 N)
         1
         (+ (recurse (dec N)) (recurse (- N 2))) ) ) )


$op_priority = {"+" => 0, "-" => 0, "*" => 1, "/" => 1}

class TreeNode
  OP_FUNCTION = {
    "+" => lambda {|x, y| x + y},
    "-" => lambda {|x, y| x - y},
    "*" => lambda {|x, y| x * y},
    "/" => lambda {|x, y| x / y}}
  attr_accessor :info, :left, :right

  def initialize(info)
    @info = info
  end

  def leaf?
    @left.nil? and @right.nil?
  end

  def to_s(order)
    if leaf?
      @info
    else
      left_s, right_s = @left.to_s(order), @right.to_s(order)

      strs = case order
             when :prefix  then [@info, left_s, right_s]
             when :infix   then [left_s, @info, right_s]
             when :postfix then [left_s, right_s, @info]
             else               []
             end

      "(" + strs.join(" ") + ")"
    end
  end

  def eval
    if !leaf? and operator?(@info)
      OP_FUNCTION[@info].call(@left.eval, @right.eval)
    else
      @info.to_f
    end
  end
end

def tokenize(exp)
  exp
    .gsub('(', ' ( ')
    .gsub(')', ' ) ')
    .gsub('+', ' + ')
    .gsub('-', ' - ')
    .gsub('*', ' * ')
    .gsub('/', ' / ')
    .split(' ')
end

def operator?(token)
  $op_priority.has_key?(token)
end

def pop_connect_push(op_stack, node_stack)
  temp = op_stack.pop
  temp.right = node_stack.pop
  temp.left = node_stack.pop
  node_stack.push(temp)
end

def infix_exp_to_tree(exp)
  tokens = tokenize(exp)
  op_stack, node_stack = [], []

  tokens.each do |token|
    if operator?(token)
      # clear stack of higher priority operators
      until (op_stack.empty? or
             op_stack.last.info == "(" or
             $op_priority[op_stack.last.info] < $op_priority[token])
        pop_connect_push(op_stack, node_stack)
      end

      op_stack.push(TreeNode.new(token))
    elsif token == "("
      op_stack.push(TreeNode.new(token))
    elsif token == ")"
      while op_stack.last.info != "("
        pop_connect_push(op_stack, node_stack)
      end

      # throw away the '('
      op_stack.pop
    else
      node_stack.push(TreeNode.new(token))
    end
  end

  until op_stack.empty?
    pop_connect_push(op_stack, node_stack)
  end

  node_stack.last
end


% primitive recursion
/pfact {
  {1} {*} primrec}.

%linear recursion
/lfact {
   {dup 0 eq}
   {pop 1}
   {dup pred}
   {*}
   linrec}.

% general recursion
/gfact {
    {0 eq}
    {succ}
    {dup pred}
    {i *}
    genrec}.

% binary recursion
/fib {
    {2 lt} {} {pred dup pred} {+} binrec}.


:- use_module(lambda).

fib(N, _F) :-
	N < 0, !,
	write('fib is undefined for negative numbers.'), nl.

fib(N, F) :-
    % code of Fibonacci
    PF     = \Nb^R^Rr1^(Nb < 2 ->
			  R = Nb
                        ;
			  N1 is Nb - 1,
			  N2 is Nb - 2,
			  call(Rr1,N1,R1,Rr1),
			  call(Rr1,N2,R2,Rr1),
			  R is R1 + R2
			),

    % The Y combinator.

    Pred = PF +\Nb2^F2^call(PF,Nb2,F2,PF),

    call(Pred,N,F).


//! Simple calculator parser and evaluator

/// Binary operator
#[derive(Debug)]
pub enum Operator {
    Add,
    Substract,
    Multiply,
    Divide
}

/// A node in the tree
#[derive(Debug)]
pub enum Node {
    Value(f64),
    SubNode(Box<Node>),
    Binary(Operator, Box<Node>,Box<Node>),
}

/// parse a string into a node
pub fn parse(txt :&str) -> Option<Node> {
    let chars = txt.chars().filter(|c| *c != ' ').collect();
    parse_expression(&chars, 0).map(|(_,n)| n)
}

/// parse an expression into a node, keeping track of the position in the character vector
fn parse_expression(chars: &Vec<char>, pos: usize) -> Option<(usize,Node)> {
    match parse_start(chars, pos) {
        Some((new_pos, first)) => {
            match parse_operator(chars, new_pos) {
                Some((new_pos2,op)) => {
                    if let Some((new_pos3, second)) = parse_expression(chars, new_pos2) {
                        Some((new_pos3, combine(op, first, second)))
                    } else {
                        None
                    }
                },
                None => Some((new_pos,first)),
            }
        },
        None => None,
    }
}

/// combine nodes to respect associativity rules
fn combine(op: Operator, first: Node, second: Node) -> Node {
    match second {
        Node::Binary(op2,v21,v22) => if precedence(&op)>=precedence(&op2) {
            Node::Binary(op2,Box::new(combine(op,first,*v21)),v22)
        } else {
            Node::Binary(op,Box::new(first),Box::new(Node::Binary(op2,v21,v22)))
        },
        _ => Node::Binary(op,Box::new(first),Box::new(second)),
    }
}

/// a precedence rank for operators
fn precedence(op: &Operator) -> usize {
    match op{
        Operator::Multiply | Operator::Divide => 2,
        _ => 1
    }
}

/// try to parse from the start of an expression (either a parenthesis or a value)
fn parse_start(chars: &Vec<char>, pos: usize) -> Option<(usize,Node)> {
    match start_parenthesis(chars, pos){
        Some (new_pos) => {
            let r = parse_expression(chars, new_pos);
            end_parenthesis(chars, r)
        },
        None => parse_value(chars, pos),
    }
}

/// match a starting parentheseis
fn start_parenthesis(chars: &Vec<char>, pos: usize) -> Option<usize>{
    if pos<chars.len() && chars[pos] == '(' {
        Some(pos+1)
    } else {
        None
    }
}

/// match an end parenthesis, if successful will create a sub node contained the wrapped expression
fn end_parenthesis(chars: &Vec<char>, wrapped :Option<(usize,Node)>) -> Option<(usize,Node)>{
    match wrapped {
        Some((pos, node)) => if pos<chars.len() && chars[pos] == ')' {
                Some((pos+1,Node::SubNode(Box::new(node))))
            } else {
                None
            },
        None => None,
    }
}

/// parse a value: an decimal with an optional minus sign
fn parse_value(chars: &Vec<char>, pos: usize) -> Option<(usize,Node)>{
    let mut new_pos = pos;
    if new_pos<chars.len() && chars[new_pos] == '-' {
        new_pos = new_pos+1;
    }
    while new_pos<chars.len() && (chars[new_pos]=='.' || (chars[new_pos] >= '0' && chars[new_pos] <= '9')) {
        new_pos = new_pos+1;
    }
    if new_pos>pos {
        if let Ok(v) = dbg!(chars[pos..new_pos].iter().collect::<String>()).parse() {
            Some((new_pos,Node::Value(v)))
        } else {
            None
        }
    } else {
        None
    }

}

/// parse an operator
fn parse_operator(chars: &Vec<char>, pos: usize) -> Option<(usize,Operator)> {
    if pos<chars.len() {
        let ops_with_char = vec!(('+',Operator::Add),('-',Operator::Substract),('*',Operator::Multiply),('/',Operator::Divide));
        for (ch,op) in ops_with_char {
            if chars[pos] == ch {
                return Some((pos+1, op));
            }
        }
    }
    None
}

/// eval a string
pub fn eval(txt :&str) -> f64 {
    match parse(txt) {
        Some(t) => eval_term(&t),
        None => panic!("Cannot parse {}",txt),
    }

}

/// eval a term, recursively
fn eval_term(t: &Node) -> f64 {
    match t {
        Node::Value(v) => *v,
        Node::SubNode(t) => eval_term(t),
        Node::Binary(Operator::Add,t1,t2) => eval_term(t1) + eval_term(t2),
        Node::Binary(Operator::Substract,t1,t2) => eval_term(t1) - eval_term(t2),
        Node::Binary(Operator::Multiply,t1,t2) => eval_term(t1) * eval_term(t2),
        Node::Binary(Operator::Divide,t1,t2) => eval_term(t1) / eval_term(t2),
    }
}

#[cfg(test)]
mod tests {
    use super::*;

    #[test]
    fn test_eval(){
        assert_eq!(2.0,eval("2"));
        assert_eq!(4.0,eval("2+2"));
        assert_eq!(11.0/4.0, eval("2+3/4"));
        assert_eq!(2.0, eval("2*3-4"));
        assert_eq!(3.0, eval("1+2*3-4"));
        assert_eq!(89.0/6.0, eval("2*(3+4)+5/6"));
        assert_eq!(14.0, eval("2 * (3 -1) + 2 * 5"));
        assert_eq!(7000.0, eval("2 * (3 + (4 * 5 + (6 * 7) * 8) - 9) * 10"));
        assert_eq!(-9.0/4.0, eval("2*-3--4+-.25"));
        assert_eq!(1.5, eval("1 - 5 * 2 / 20 + 1"));
        assert_eq!(3.5, eval("2 * (3 + ((5) / (7 - 11)))"));

    }
}


package org.rosetta.arithmetic_evaluator.scala

object ArithmeticParser extends scala.util.parsing.combinator.RegexParsers {

  def readExpression(input: String) : Option[()=>Int] = {
    parseAll(expr, input) match {
      case Success(result, _) =>
        Some(result)
      case other =>
        println(other)
        None
    }
  }

  private def expr : Parser[()=>Int] = {
    (term<~"+")~expr ^^ { case l~r => () => l() + r() } |
    (term<~"-")~expr ^^ { case l~r => () => l() - r() } |
    term
  }

  private def term : Parser[()=>Int] = {
    (factor<~"*")~term ^^ { case l~r => () => l() * r() } |
    (factor<~"/")~term ^^ { case l~r => () => l() / r() } |
    factor
  }

  private def factor : Parser[()=>Int] = {
    "("~>expr<~")" |
    "\\d+".r ^^ { x => () => x.toInt } |
    failure("Expected a value")
  }
}

object Main {
  def main(args: Array[String]) {
    println("""Please input the expressions. Type "q" to quit.""")
    var input: String = ""

    do {
      input = readLine("> ")
      if (input != "q") {
        ArithmeticParser.readExpression(input).foreach(f => println(f()))
      }
    } while (input != "q")
  }
}


>>> Y = lambda f: (lambda x: x(x))(lambda y: f(lambda *args: y(y)(*args)))
>>> fib = lambda f: lambda n: None if n < 0 else (0 if n == 0 else (1 if n == 1 else f(n-1) + f(n-2)))
>>> [ Y(fib)(i) for i in range(-2, 10) ]
[None, None, 0, 1, 1, 2, 3, 5, 8, 13, 21, 34]


DECLARE FUNCTION Fibonacci! (num!)

PRINT Fibonacci(20)
PRINT Fibonacci(30)
PRINT Fibonacci(-10)
PRINT Fibonacci(10)
END

FUNCTION Fibonacci (num)
  IF num < 0 THEN
    PRINT "Invalid argument: ";
    Fibonacci = num
  END IF

  IF num < 2 THEN
    Fibonacci = num
  ELSE
    Fibonacci = Fibonacci(num - 1) + Fibonacci(num - 2)
  END IF
END FUNCTION


(import (scheme base)
        (scheme char)
        (scheme cxr)
        (scheme write)
        (srfi 1 lists))

;; convert a string into a list of tokens
(define (string->tokens str)
  (define (next-token chars)
    (cond ((member (car chars) (list #\+ #\- #\* #\/) char=?)
           (values (cdr chars)
                   (cdr (assq (car chars) ; convert char for op into op procedure, using a look up list
                              (list (cons #\+ +) (cons #\- -) (cons #\* *) (cons #\/ /))))))
          ((member (car chars) (list #\( #\)) char=?)
           (values (cdr chars)
                   (if (char=? (car chars) #\()
                     'open
                     'close)))
          (else ; read a multi-digit positive integer
            (let loop ((rem chars)
                       (res 0))
              (if (and (not (null? rem))
                       (char-numeric? (car rem)))
                (loop (cdr rem)
                      (+ (* res 10)
                         (- (char->integer (car rem))
                            (char->integer #\0))))
                (values rem
                        res))))))
  ;
  (let loop ((chars (remove char-whitespace? (string->list str)))
             (tokens '()))
    (if (null? chars)
      (reverse tokens)
      (let-values (((remaining-chars token) (next-token chars)))
                  (loop remaining-chars
                        (cons token tokens))))))

;; turn list of tokens into an AST
;; -- using recursive descent parsing to obey laws of precedence
(define (parse tokens)
  (define (parse-factor tokens)
    (if (number? (car tokens))
      (values (car tokens) (cdr tokens))
      (let-values (((expr rem) (parse-expr (cdr tokens))))
                  (values expr (cdr rem)))))
  (define (parse-term tokens)
    (let-values (((left-expr rem) (parse-factor tokens)))
                (if (and (not (null? rem))
                         (member (car rem) (list * /)))
                  (let-values (((right-expr remr) (parse-term (cdr rem))))
                              (values (list (car rem) left-expr right-expr)
                                      remr))
                  (values left-expr rem))))
  (define (parse-part tokens)
    (let-values (((left-expr rem) (parse-term tokens)))
                (if (and (not (null? rem))
                         (member (car rem) (list + -)))
                  (let-values (((right-expr remr) (parse-part (cdr rem))))
                              (values (list (car rem) left-expr right-expr)
                                      remr))
                  (values left-expr rem))))
  (define (parse-expr tokens)
    (let-values (((expr rem) (parse-part tokens)))
                (values expr rem)))
  ;
  (let-values (((expr rem) (parse-expr tokens)))
                (if (null? rem)
                  expr
                  (error "Misformed expression"))))

;; evaluate the AST, returning a number
(define (eval-expression ast)
  (cond ((number? ast)
         ast)
        ((member (car ast) (list + - * /))
         ((car ast)
          (eval-expression (cadr ast))
          (eval-expression (caddr ast))))
        (else
          (error "Misformed expression"))))

;; parse and evaluate the given string
(define (interpret str)
  (eval-expression (parse (string->tokens str))))

;; running some examples
(for-each
  (lambda (str)
    (display
      (string-append str
                     " => "
                     (number->string (interpret str))))
    (newline))
  '("1 + 2" "20+4*5" "1/2+5*(6-3)" "(1+3)/4-1" "(1 - 5) * 2 / (20 + 1)"))


[ dup 0 < iff
  $ "negative argument passed to fibonacci"
  fail
  [ dup  2 < if done
    dup  1 - recurse
    swap 2 - recurse + ] ]         is fibonacci ( n --> n )


fib2 <- function(n) {
  (n >= 0) || stop("bad argument")
  ( function(n) if (n <= 1) 1 else Recall(n-1)+Recall(n-2) )(n)
}


func evalArithmeticExp(s) {

    func evalExp(s) {

        func operate(s, op) {
           s.split(op).map{|c| Number(c) }.reduce(op)
        }

        func add(s) {
            operate(s.sub(/^\+/,'').sub(/\++/,'+'), '+')
        }

        func subtract(s) {
            s.gsub!(/(\+-|-\+)/,'-')

            if (s ~~ /--/) {
                return(add(s.sub(/--/,'+')))
            }

            var b = s.split('-')
            b.len == 3 ? (-1*Number(b[1]) - Number(b[2]))
                       : operate(s, '-')
        }

        s.gsub!(/[()]/,'').gsub!(/-\+/, '-')

        var reM  = /\*/
        var reMD = %r"(\d+\.?\d*\s*[*/]\s*[+-]?\d+\.?\d*)"

        var reA  = /\d\+/
        var reAS = /(-?\d+\.?\d*\s*[+-]\s*[+-]?\d+\.?\d*)/

        while (var match = reMD.match(s)) {
            match[0] ~~ reM
                ? s.sub!(reMD, operate(match[0], '*').to_s)
                : s.sub!(reMD, operate(match[0], '/').to_s)
        }

        while (var match = reAS.match(s)) {
            match[0] ~~ reA
                ? s.sub!(reAS,      add(match[0]).to_s)
                : s.sub!(reAS, subtract(match[0]).to_s)
        }

        return s
    }

    var rePara = /(\([^\(\)]*\))/
    s.split!.join!('').sub!(/^\+/,'')

    while (var match = s.match(rePara)) {
        s.sub!(rePara, evalExp(match[0]))
    }

    return Number(evalExp(s))
}


#lang racket

;; Natural -> Natural
;; Calculate factorial
(define (fact n)
  (define (fact-helper n acc)
    (if (= n 0)
        acc
        (fact-helper (sub1 n) (* n acc))))
  (unless (exact-nonnegative-integer? n)
    (raise-argument-error 'fact "natural" n))
  (fact-helper n 1))

;; Unit tests, works in v5.3 and newer
(module+ test
  (require rackunit)
  (check-equal? (fact 0) 1)
  (check-equal? (fact 5) 120))


fib: func [n /f][ do f: func [m] [ either m < 2 [m][(f m - 1) + f m - 2]] n]