open Common
open Treeconstructor_spec
module Code = Lang_base

let transformAlgorithm mode =
    List.map (function (matcher, cmds) ->
        let rec transformCmds = function
          | [ActAsIfAnythingElse] ->
                (* Expand out the "act as described in the 'anything else' entry" blocks *)
                let (m, c) = List.find (function (Anything, _) -> true | _ -> false) (insertionModeAlgorithm mode) in
                c

          | (ParseError "?")::cs ->
                (ParseError ((string_of_insertion_mode mode) ^ " - " ^ (string_of_token_match matcher))) :: (transformCmds cs)

          | (If (c, a, b))::cs -> (If (c, transformCmds a, transformCmds b))::(transformCmds cs)
          | c::cs -> c::(transformCmds cs)
          | [] -> []
        in
        (matcher, transformCmds cmds)
    ) (insertionModeAlgorithm mode)

let value_to_string = function
  | Const s -> Code.Str s
  | TagName -> Code.Var "token[1]"

let compileMatcher = function
  | Doctype -> Code.Eq (Code.Var "token[0]", Code.Str "DOCTYPE")
  | EndOfFile -> Code.Eq (Code.Var "token", Code.Str "EndOfFile")
  | Character -> Code.Eq (Code.Var "token[0]", Code.Str "Character")
  | CharacterIn cs -> Code.And [Code.Eq (Code.Var "token[0]", Code.Str "Character"); Code.Or (List.map (fun c -> Code.Eq (Code.Var "token[1].charCodeAt(0)", Code.Int c)) cs)]
  | CharacterNotIn cs -> Code.And [Code.Eq (Code.Var "token[0]", Code.Str "Character"); Code.Not (Code.Or (List.map (fun c -> Code.Eq (Code.Var "token[1].charCodeAt(0)", Code.Int c)) cs))]
  | Comment -> Code.Eq (Code.Var "token[0]", Code.Str "Comment")
  | StartTag ts -> Code.And [Code.Eq (Code.Var "token[0]", Code.Str "StartTag"); Code.Or (List.map (fun t -> Code.Eq (Code.Var "token[1]", Code.Str t)) ts)]
  | EndTag ts -> Code.And [Code.Eq (Code.Var "token[0]", Code.Str "EndTag"); Code.Or (List.map (fun t -> Code.Eq (Code.Var "token[1]", Code.Str t)) ts)]
  | AnyStartTag -> Code.Eq (Code.Var "token[0]", Code.Str "StartTag")
  | AnyEndTag -> Code.Eq (Code.Var "token[0]", Code.Str "EndTag")
  | Anything -> Code.Bool true

let compileCondition = function
  | CurrentNodeDoesNotHaveName n -> Code.Not (Code.Call (Code.Method "this.currentNodeHasName", [value_to_string n]))
  | CurrentNodeHasName n -> Code.Call (Code.Method "this.currentNodeHasName", [value_to_string n])
  | FormElementPointerIsNotNull -> Code.Var "this.formElement"
  | GeneratedTokenWasNotIgnored -> Code.Bool true (* XXX *)
  | ListOfActiveContainsA -> Code.Call (Code.Method "this.activeListContainsA", [])
  | NodeBeforeCurrentHasName n -> Code.Call (Code.Method "this.nodeBeforeCurrentHasName", [value_to_string n])
  | NodeInStackIsNot names -> Code.Bool false (* XXX *)
  | NotFirstStartTagToken -> Code.Bool false (* XXX *)
  | NotSecondElementIsBody -> Code.Bool false (* XXX *)
  | ParsingFragment -> Code.Bool false (* XXX *)
  | MoreThanOneNodeAndSecondNotBody -> Code.Bool false (* XXX *)
  | MoreThanTwoNodesOrSecondNotBody -> Code.Bool false (* XXX *)
  | StackHasElementInScope ns -> Code.Call (Code.Method "this.hasElementInScope", [Code.Bool false; Code.Array (List.map value_to_string ns)])
  | StackHasElementInTableScope ns -> Code.Call (Code.Method "this.hasElementInScope", [Code.Bool true; Code.Array (List.map value_to_string ns)])
  | StackNotHasElementInTableScope ns -> Code.Not (Code.Call (Code.Method "this.hasElementInScope", [Code.Bool true; Code.Array (List.map value_to_string ns)]))

let hash_set ns = Code.Hash (List.map (fun n -> (Code.Str n, Code.Bool true)) ns)

let rec compileCommand = function
  | ActAsIfStartTag name -> Code.RawStmt ("this.processToken(['StartTag', '" ^ name ^ "', []], this.insertionMode);")
  | ActAsIfStartTagName name -> Code.RawStmt ("this.processToken(['StartTag', '" ^ name ^ "', token[2]], this.insertionMode);")
  | ActAsIfEndTag name -> Code.RawStmt ("this.processToken(['EndTag', '" ^ name ^ "'], this.insertionMode);")
  | AddMarkerToActiveList -> Code.CallStmt (Code.Method "this.addToActiveList", [Code.Const "null"])
  | AdoptionAgency -> Code.CallStmt (Code.Method "this.adoptionAgency", [Code.Var "token"])
  | AppendCharacterTokensToCurrentNode -> Code.CallStmt (Code.Method "this.appendCharacterToCurrentNode", [Code.Var "token"])
  | AppendCommentTokenToCurrentNode -> Code.CallStmt (Code.Method "this.appendCommentToCurrentNode", [Code.Var "token"])
  | AppendCommentTokenToDocument -> Code.CallStmt (Code.Method "this.appendCommentToDocument", [Code.Var "token"])
  | ApplyEndTag -> Code.CallStmt (Code.Method "this.applyEndTag", [Code.Var "token"])
  | ClearActiveListUpToMarker -> Code.CallStmt (Code.Method "this.clearActiveListUpToMarker", [])
  | ClearStackToContext ns -> Code.CallStmt (Code.Method "this.clearStackToContext", [Code.Array (List.map (fun n -> Code.Str n) ns)])
  | DoDoctypeStuff -> Code.CallStmt (Code.Method "this.doDoctypeStuff", [Code.Var "token"])
  | GenerateImpliedEndTags es -> Code.CallStmt (Code.Method "this.generateImpliedEndTags", [Code.Array (List.map value_to_string es)])
  | If (c, a, b) -> Code.If (compileCondition c, compileCommands a, if b = [] then None else Some (Code.Block (compileCommands b)))
  | InsertElement -> Code.CallStmt (Code.Method "this.insertElement", [Code.Var "token"])
  | InsertElementAndAddToListOfActive -> Code.CallStmt (Code.Method "this.addToActiveList", [Code.Call (Code.Method "this.insertElement", [Code.Var "token"])])
  | InsertElementAndSetHeadElementPointer -> Code.Assign (Code.Var "this.headElement", Code.Call (Code.Method "this.insertElement", [Code.Var "token"]))
  | InsertHTMLElement -> Code.CallStmt (Code.Method "this.insertHTMLElement", [])
  | ParseError e -> Code.CallStmt (Code.Method "this.parseError", [Code.Str e])
  | PopCurrentNodeFromStack -> Code.CallStmt (Code.Method "this.popCurrentNode", [])
  | PopElementsFromStackUntilNo ns -> Code.While (Code.Call (Code.Method "this.hasElementInScope", [Code.Bool false; Code.Array (List.map (fun n -> Code.Str n) ns)]),
        [ Code.CallStmt (Code.Method "this.popCurrentNode", []) ])
  | PopElementsFromStackUntilOneOf ns -> Code.CallStmt (Code.Method "this.popUntilOneOf", [Code.Array (List.map value_to_string ns)])
  | ReconstructActiveFormattingElements -> Code.CallStmt (Code.Method "this.reconstructActiveFormattingElements", [])
  | RemoveThatAElementIfNecessary -> Code.CallStmt (Code.Method "this.removeThatAElement", [])
  | ResetInsertionModeAppropriately -> Code.CallStmt (Code.Method "this.resetInsertionModeAppropriately", [])
  | ReprocessCurrentToken -> Code.CallStmt (Code.Method "this.processToken", [Code.Var "token"; Code.Var "this.insertionMode"])
  | ReprocessAsIf m -> Code.CallStmt (Code.Method "this.reprocessAsIf", [Code.Var "token"; Code.Var ("insertionMode_" ^ string_of_insertion_mode m)])
  | ReprocessWithFosteringAsIf m -> Code.CallStmt (Code.Method "this.reprocessWithFosteringAsIf", [Code.Var "token"; Code.Var ("insertionMode_" ^ string_of_insertion_mode m)])
  | SetInsertionMode m -> Code.CallStmt (Code.Method "this.setInsertionMode", [Code.Var ("insertionMode_" ^ string_of_insertion_mode m)])
  | c -> Code.CallStmt (Code.Method "debug", [Code.Str ("TODO: " ^ string_of_command c)])
and compileCommands cmds =
    (*List.map compileCommand cmds*)
    List.flatten (List.map (fun c -> [ Code.CallStmt (Code.Method "debug", [Code.Str ("# - " ^ string_of_command c)]); compileCommand c ]) cmds)

let rec compileMode m = function
  | (matcher, cmds)::cs -> Some (
        Code.If (
            compileMatcher matcher,
            [ Code.CallStmt (Code.Method "debug", [Code.Str ("# " ^ (string_of_insertion_mode m) ^ " " ^ (string_of_token_match matcher))]) ]
            @ compileCommands cmds,
            compileMode m cs))
  | [] -> None

let codeMainLoop_Switch =
    Code.Switch (Code.Var "mode",
        List.map (fun m ->
            [ Code.Var ("insertionMode_" ^ (string_of_insertion_mode m)) ],
            (match compileMode m (transformAlgorithm m) with Some s -> [s] | None -> [])
            @ [ Code.Break ]
        ) insertionModes
    )

let printJS =
    Lang_js.printStmt (Code.StmtList [
    Code.Enum ("", List.map (fun m -> "insertionMode_" ^ (string_of_insertion_mode m)) insertionModes);
    Code.Newline;
    Code.Assign (Code.Var "TreeConstructor.prototype.IsSpecial", hash_set elementCategorySpecial);
    Code.Assign (Code.Var "TreeConstructor.prototype.IsScoping", hash_set elementCategoryScoping);
    Code.Assign (Code.Var "TreeConstructor.prototype.IsFormatting", hash_set elementCategoryFormatting);
    Code.Newline;
    Code.Assign (Code.Var "TreeConstructor.prototype.processToken", Code.AnonFunction ([("var", "token"); ("var", "mode")], [codeMainLoop_Switch]));
    Code.Newline;
    Code.Assign (Code.Var "TreeConstructor.prototype.run", Code.AnonFunction ([], [
        Code.DeclVar ("var", "token");
        Code.While (Code.Bool true, [
            Code.Assign (Code.LocalVar "token", Code.Var "this.tokenStream[this.tokenStreamPos]");
            Code.If (Code.Not (Code.LocalVar "token"), [ Code.Return None ], None);
            Code.CallStmt (Code.Method "this.processToken", [Code.LocalVar "token"; Code.Var "this.insertionMode"]);
            Code.Assign (Code.Var "this.tokenStreamPos", Code.Add [Code.Var "this.tokenStreamPos"; Code.Int 1]);
        ])
    ]))
    ])

let _ =
    let out = open_out "treeconstructor_auto.js" in
    output_string out printJS; close_out out