module Parser

    // Définition de type

    // Définition d'un jeu d'instruction
    module Types =
        type token =
            | None
            | Operator of int
            | Memory of int
            | IO of bool
            | Loop of tokens
            // Types optimisés
            | ToZero
            | ToZeroByLeft

        and tokens = list<token>

        type parsedTokens<'a> = 'a * tokens

        // Exceptions pour le parsing
        exception LoopStagnation of string

    // Définition du parser
    module Exec =
        // Défini la valeur du constructeur prenant un entier en fonction d'un booléen
        let calcul (x : bool) : int = if x then 1 else -1
        // Analyse formelle et groupée du code
        let parsing (code : string) : Types.tokens =
            let rec parse (code : list<char>) (acc : Types.tokens) (lastOp : Types.token) : Types.parsedTokens<list<char>> =
                match code with
                | ('+'|'-') as operation :: tail ->
                    let currOp = Types.Operator (calcul (operation = '+'))
                    match (currOp, lastOp) with
                    | (Types.Operator x, Types.Operator y) ->
                        parse tail acc (Types.Operator (x + y))
                    | (Types.Operator x, Types.None) ->
                        parse tail acc (Types.Operator x)
                    | _ -> parse tail (lastOp :: acc) currOp
                | ('>'|'<') as memory :: tail ->
                    let currOp = Types.Memory (calcul (memory = '>'))
                    match (currOp, lastOp) with
                    | (Types.Memory x, Types.Memory y) ->
                        parse tail acc (Types.Memory (x + y))
                    | (Types.Operator x, Types.None) ->
                        parse tail acc (Types.Memory x)
                    | _ -> parse tail (lastOp :: acc) currOp
                | ('.'|',') as io :: tail ->
                    match lastOp with
                    | Types.None -> parse tail ((Types.IO (io = '.')) :: acc) Types.None
                    | _ -> parse tail ((Types.IO (io = '.')) :: lastOp :: acc) Types.None
                | '[' :: tail ->
                    let (returned, eval) = parse tail [] Types.None
                    parse returned (Types.Loop eval :: lastOp :: acc) Types.None
                | ']' :: tail ->
                    match lastOp with
                    | Types.None -> (tail, List.rev acc)
                    | _ -> (tail, List.rev (lastOp :: acc))
                | [] ->
                    match lastOp with
                    | Types.None -> ([], List.rev acc)
                    | _ -> ([], List.rev (lastOp :: acc))
                | _ :: tail -> parse tail acc lastOp
            let codeList = List.ofArray (code.ToCharArray())
            let (nil, parsed) = parse codeList [] Types.None
            parsed

        // Purge du code et des opérateurs/mémoires vides
        let purge (code : Types.tokens) : Types.parsedTokens<bool> =
            let rec purge code (acc : Types.tokens) (flag : bool) =
                match code with
                | (Types.Operator 0 | Types.Memory 0 | Types.None) :: tail -> purge tail acc true
                | (Types.Loop [] | Types.Loop [Types.Operator 0] | Types.Loop [Types.Memory 0]) :: tail ->
                    raise (Types.LoopStagnation "Infinite Loop")
                | Types.Loop codeLoop :: tail ->
                    let (flagLoop, eval) = purge codeLoop [] false
                    purge tail (Types.Loop eval :: acc) (if flagLoop then true else flag)
                |  xs :: tail -> purge tail (xs :: acc) flag
                | [] -> (flag, List.rev acc)
            purge code [] false

        // factorisation du code déjà parsé
        let factorize (code : Types.tokens) : Types.tokens =
            let rec factorize code (acc : Types.tokens) (lastOp : Types.token) =
                match (code, lastOp) with
                | (Types.Loop [Types.None] :: tail, _) -> raise (Types.LoopStagnation "Infinite Loop")
                | (Types.Loop [] :: tail, _) -> raise (Types.LoopStagnation "Infinite Loop")
                | (Types.Loop xs :: tail, Types.None) ->
                    let eval = factorize xs [] Types.None
                    factorize tail (Types.Loop eval :: acc) Types.None
                | (Types.IO flag :: tail, Types.None) -> factorize tail acc (Types.IO flag)
                | (Types.IO flag :: tail, (_ as currOp)) -> factorize tail (currOp :: acc) (Types.IO flag)
                | ((_ as currOp) :: tail, Types.None) -> factorize tail acc currOp
                | (Types.Operator x :: tail, Types.Operator y) -> factorize tail acc (Types.Operator (x+y))
                | (Types.Memory x :: tail, Types.Memory y) -> factorize tail acc (Types.Memory (x+y))
                | (op :: tail, last) -> factorize tail (last :: acc) op
                | ([], Types.None) -> List.rev acc
                | ([], (_ as currOp)) -> List.rev (currOp :: acc)
            factorize code [] Types.None

        // Purification d'une séquence Brainfuck
        let rec purify (code : Types.tokens) : Types.tokens =
            let (flag, newCode) = purge code
            if(flag) then purify (factorize newCode) else newCode

        // Optimisation d'une séquence
        let optimize (code : Types.tokens) : Types.tokens =
            let rec optimize code (acc : Types.tokens) =
                match code with
                | Types.Loop [Types.Operator xs] :: tail when xs = -1 ->
                    optimize tail (Types.ToZero :: acc)
                | Types.Loop [Types.Memory(1); Types.Operator(1);Types.Memory(-1);Types.Operator(-1)] :: tail ->
                    optimize tail (Types.ToZeroByLeft :: acc)
                | Types.Loop xs :: tail ->
                    let eval = optimize xs []
                    optimize tail (Types.Loop eval :: acc)
                | head :: tail -> optimize tail (head :: acc)
                | [] -> List.rev acc
            optimize code []

        // Routine principale
        let parse (code : string) : Types.tokens =
            let parsedCode = parsing code
            let pureCode = purify parsedCode
            let optimization = optimize pureCode
            optimization