open System
open System.Numerics

//// Tokenizer

type Token =
    | Open | Close
    | Number of string
    | String of string
    | Symbol of string

let tokenize source =
    let rec token acc = function
        | ')' :: _ as t -> acc, t                           // closing paren terminates
        | w :: t when Char.IsWhiteSpace(w) -> acc, t        // whitespace terminates
        | [] -> acc, []                                     // end of list terminates
        | c :: t -> token (acc + (c.ToString())) t          // otherwise accumulate chars

    let rec stringToken acc = function
        | '"' :: t -> acc, t                                // closing quote terminates
        | c   :: t -> stringToken (acc + c.ToString()) t    // otherwise accumulate characters
        | _ -> failwith "Malformed string."

    let rec tokenize2 acc = function
        | w :: t when Char.IsWhiteSpace(w) -> tokenize2 acc t   // skip whitespace

        | '(' :: t -> tokenize2 (Open :: acc) t
        | ')' :: t -> tokenize2 (Close :: acc) t

        | '"' :: t ->                                       // start of string
            let s, t2 = stringToken "" t
            tokenize2 (Token.String(s) :: acc) t2

        | '-' :: d :: t when Char.IsDigit(d) ->             // start of negative number
            let n, t2 = token ("-" + d.ToString()) t
            tokenize2 (Token.Number(n) :: acc) t2

        | '+' :: d :: t | d :: t when Char.IsDigit(d) ->    // start of positive number
            let n, t2 = token (d.ToString()) t
            tokenize2 (Token.Number(n) :: acc) t2

        | s :: t ->                                         // otherwise start of symbol
            let s, t2 = token (s.ToString()) t
            tokenize2 (Token.Symbol(s) :: acc) t2

        | [] -> List.rev acc                                // end of list terminates

    tokenize2 [] source


//// Parser

type Expression =
    | Number of BigInteger
    | String of string
    | Symbol of string
    | List of Expression list
    | Function of (Expression list -> Expression)
    | Special of (Expression list -> Expression)

let parse source =
    let map = function
        | Token.Number(n) -> Expression.Number(BigInteger.Parse(n))
        | Token.String(s) -> Expression.String(s)
        | Token.Symbol(s) -> Expression.Symbol(s)
        | _ -> failwith "Syntax error."

    let rec parse2 acc = function
        | Open :: t ->
            let e, t2 = parse2 [] t
            parse2 (List(e) :: acc) t2
        | Close :: t -> (List.rev acc), t
        | h :: t -> parse2 ((map h) :: acc) t
        | [] -> (List.rev acc), []

    let result, _ = parse2 [] (tokenize source)
    result


//// Printer

let rec print = function
    | List(list) -> "(" + String.Join(" ", (List.map print list)) + ")"
    | String(s) ->
        let escape = String.collect (function '"' -> "\\\"" | c -> c.ToString()) // escape quotes
        "\"" + (escape s) + "\""
    | Symbol(s) -> s
    | Number(n) -> n.ToString()
    | Function(_) | Special(_) -> "Function"


//// Primitives, Eval/Apply

let Multiply args =
    let prod a = function
        | Number(b) -> a * b
        | _ -> failwith "Malformed multiplication argument."
    Number(List.fold prod 1I args)

let Sum args =
    let add a = function
        | Number(b) -> a + b
        | _ -> failwith "Malformed addition argument."
    Number(List.fold add 0I args)

let Subtract = function
    | [Number(n)] -> Number(-n) // (- a) == –a
    | Number(n) :: ns ->        // (- a b c) == a - b – c,  we can't fold because the first needs to be positive
        let sub a = function Number(b) -> a - b | _ -> failwith "Malformed subtraction argument."
        Number(List.fold sub n ns)
    | _ -> failwith "Malformed subtraction."

let rec If = function
    | [condition; t; f] ->
        match eval condition with
        | List([]) | String("") -> eval f // empty list or empty string is false
        | Number(n) when n = 0I -> eval f // zero is false
        | _ -> eval t // everything else is true
    | _ -> failwith "Malformed 'if'."

and environment =
    Map.ofList [
        "*", Function(Multiply)
        "+", Function(Sum)
        "-", Function(Subtract)
        "if", Special(If)]

and eval expression =
    match expression with
    | Number(_) as lit -> lit
    | String(_) as lit -> lit
    | Symbol(s) -> environment.[s]
    | List([]) -> List([])
    | List(h :: t) ->
        match eval h with
        | Function(f) -> apply f t
        | Special(f) -> f t
        | _ -> failwith "Malformed expression."
    | _ -> failwith "Malformed expression."

and apply fn args = fn (List.map eval args)


//// REPL

let rep = List.ofSeq >> parse >> List.head >> eval >> print

let rec repl output =
    printf "%s\n> " output
    try Console.ReadLine() |> rep |> repl
    with ex -> repl ex.Message


//// Test

let case source expected =
    try
        let output = rep source
        if output = expected then
            printf "TEST PASSED\n"
        else
            printf "TEST FAILED: %s (Expected: %s, Actual: %s)\n" source expected output
    with _ -> printf "TEST CRASHED: %s\n" source

case "1" "1"                        // numbers
case "+1" "1"                       // explicit positive numbers
case "-1" "-1"                      // negative numbers
case "\"hello\"" "\"hello\""        // strings
case "(*)" "1"                      // multiplication
case "(* 2 3)" "6"                  // multiplication
case "(* 2 3 4)" "24"               // multiplication
case "(-)" "0"                      // strange subtraction case
case "(- 10)" "-10"                 // negation
case "(- 10 2)" "8"                 // subtraction
case "(- 10 2 3)" "5"               // subtraction
case "(if (* 0 1) 10 20)" "20"      // if true
case "(if (* 1 1) 10 20)" "10"      // if false
case "(if (* 1 1) 10 bomb)" "10"    // if (special form)
case "(* 1234567890987654321 1234567890987654321)" "1524157877457704723228166437789971041" // bigint math

repl ""