nomsu/core/control_flow.nom

#..
    This file contains compile-time actions that define basic control flow structures
    like "if" statements and loops.

use "core/metaprogramming.nom"
use "core/text.nom"
use "core/operators.nom"

# No-Op
immediately:
    compile [do nothing] to {statements:""}

# Conditionals
immediately:
    compile [if %condition %if_body] to:
        %if_body <- (%if_body as lua)
        return {..}
            locals: %if_body.locals
            statements:".."
                if \(%condition as lua expr) then
                \(%if_body.statements or "\(%if_body.expr);")
                end
    parse [unless %condition %unless_body] as: if (not %condition) %unless_body

    compile [if %condition %if_body else %else_body, unless %condition %else_body else %if_body] to:
        %if_body <- (%if_body as lua)
        %else_body <- (%else_body as lua)
        lua> ".."
            local \%locals = {unpack(\%if_body.locals or {})};
            for i,loc in ipairs(\%else_body.locals or {}) do table.insert(\%locals, loc); end
            utils.deduplicate(\%locals);
        return {..}
            locals:%locals
            statements:".."
                if \(%condition as lua expr) then
                \(%if_body.statements or "\(%if_body.expr);")
                else
                \(%else_body.statements or "\(%else_body.expr);")
                end

# Conditional expression (ternary operator)
#.. Note: this uses a function instead of "(condition and if_expr or else_expr)"
    because that breaks if %if_expr is falsey, e.g. "x < 5 and false or 99"
immediately
    compile [..]
        %when_true_expr if %condition else %when_false_expr
        %when_true_expr if %condition otherwise %when_false_expr
        %when_false_expr unless %condition else %when_true_expr
        %when_false_expr unless %condition then %when_true_expr
    ..to:
        #.. If %when_true_expr is guaranteed to be truthy, we can use Lua's idiomatic
            equivalent of a conditional expression: (cond and if_true or if_false)
        if: %when_true_expr.type in {Text:yes, List:yes, Dict:yes, Number:yes}
            return {..}
                expr:"(\(%condition as lua expr) and \(%when_true_expr as lua expr) or \(%when_false_expr as lua expr))"
        ..else:
            #.. Otherwise, need to do an anonymous inline function (yuck, too bad lua 
                doesn't have a proper ternary operator!)
                To see why this is necessary consider: (random()<.5 and false or 99)
            return {..}
                expr: ".."
                    (function()
                        if \(%condition as lua expr) then
                            return \(%when_true_expr as lua expr);
                        else
                            return \(%when_false_expr as lua expr);
                        end
                    end)()

# GOTOs
immediately:
    compile [=== %label ===, --- %label ---, *** %label ***] to {..}
        statements:"::label_\(%label as lua identifier)::;"
    compile [go to %label] to {..}
        statements:"goto label_\(%label as lua identifier);"

# Basic loop control
immediately:
    compile [do next] to {statements:"continue;"}
    compile [stop] to {statements:"break;"}

# Helper function
immediately:
    compile [if %tree has subtree %subtree where %condition %body] to:
        %body_lua <- (%body as lua)
        %body_statements <- (%body_lua.statements or "\(%body_lua.expr);")
        return {..}
            locals: %body_lua.locals
            statements:".."
                for \(%subtree as lua expr) in coroutine.wrap(function() nomsu:walk_tree(\(%tree as lua expr)) end) do
                    if Types.is_node(\(%subtree as lua expr)) then
                        if \(%condition as lua expr) then
                            \%body_statements
                            break;
                        end
                    end
                end

# While loops
immediately:
    compile [do next repeat] to {statements:"goto continue_repeat;"}
    compile [stop repeating] to {statements:"goto stop_repeat;"}
    compile [repeat while %condition %body] to
        %body_lua <- (%body as lua)
        %body_statements <- (%body_lua.statements or "\(%body_lua.expr);")
        if %body has subtree % where:
            (%.type = "FunctionCall") and ((%'s stub) is "do next repeat")
        ..: %body_statments +<- "\n::continue_repeat::;"
        %code <- ".."
            while \(%condition as lua expr) do
            \%body_statements
            end --while-loop
        if %body has subtree % where:
            (%.type = "FunctionCall") and ((%'s stub) is "stop repeating")
        ..:
            %code <- ".."
                do -- scope of "stop repeating" label
                \%code
                ::stop_repeat::;
                end -- end of "stop repeating" label scope
        return {statements:%code, locals:%body_lua.locals}
    parse [repeat %body] as: repeat while (yes) %body
    parse [repeat until %condition %body] as: repeat while (not %condition) %body

    compile [..]
        repeat %n times %body
    ..to:
        %body_lua <- (%body as lua)
        %body_statements <- (%body_lua.statements or "\(%body_lua.expr);")
        if %body has subtree % where
            (%.type = "FunctionCall") and ((%'s stub) is "do next repeat")
        ..: %body_statements +<- "\n::continue_repeat::;"
        %code <- ".."
            for i=1,\(%n as lua expr) do
            \%body_statements
            end --numeric for-loop
        if %body has subtree % where:
            (%.type = "FunctionCall") and ((%'s stub) is "stop repeating")
        ..:
            %code <- ".."
                do -- scope of "stop repeating" label
                \%code
                ::stop_repeat::;
                end -- end of "stop repeating" label scope
        return {statements:%code, locals:%body_lua.locals}

# For loop control flow:
immediately:
    compile [stop %var] to {..}
        statements:"goto stop_\(%var as lua identifier);"
    compile [do next %var] to {..}
        statements:"goto continue_\(%var as lua identifier);"

# Numeric range for loops
immediately:
    compile [..]
        for %var from %start to %stop by %step %body
        for %var from %start to %stop via %step %body
    ..to:
        %body_lua <- (%body as lua)
        %body_statements <- (%body_lua.statements or "\(%body_lua.expr);")
        if %body has subtree % where:
            (%.type = "FunctionCall") and
                ((%'s stub) is "do next %") and 
                    %.value.3.value is %var.value
        ..: %body_statements +<- "\n::continue_\(%var as lua identifier)::;"

        # This uses Lua's approach of only allowing loop-scoped variables in a loop
        assume (%var.type is "Var") or barf "Loop expected variable, not: \(%var's source code)"
        %code <- ".."
            for \(%var as lua expr)=\(%start as lua expr),\(%stop as lua expr),\(%step as lua expr) do
            \%body_statements
            end --numeric for-loop

        if %body has subtree % where:
            (%.type = "FunctionCall") and:
                ((%'s stub) is "stop %") and:
                    %.value.2.value is %var.value
        ..:
            %code <- ".."
                do -- scope for stopping for-loop
                    \%code
                    ::stop_\(%var as lua identifier)::;
                end -- end of scope for stopping for-loop

        return {statements:%code, locals:%body_lua.locals}

immediately:
    parse [for %var from %start to %stop %body] as: for %var from %start to %stop via 1 %body
    parse [..]
        for all %start to %stop by %step %body
        for all %start to %stop via %step %body
    ..as: for % from %start to %stop via %step %body
    parse [for all %start to %stop %body] as: for all %start to %stop via 1 %body

# For-each loop (lua's "ipairs()")
immediately:
    compile [for %var in %iterable %body] to:
        %body_lua <- (%body as lua)
        %body_statements <- (%body_lua.statements or "\(%body_lua.expr);")
        if %body has subtree % where:
            (%.type = "FunctionCall") and
                ((%'s stub) is "do next %") and
                    %.value.3.value is %var.value
        ..: %body_statements +<- "\n::continue_\(%var as lua identifier)::;"
        # This uses Lua's approach of only allowing loop-scoped variables in a loop
        assume (%var.type is "Var") or barf "Loop expected variable, not: \(%var's source code)"
        %code <- ".."
            for i,\(%var as lua expr) in ipairs(\(%iterable as lua expr)) do
            \%body_statements
            end --foreach-loop
        if %body has subtree % where:
            (%.type = "FunctionCall") and
                ((%'s stub) is "stop %") and
                    %.value.2.value is %var.value
        ..:
            %code <- ".."
                do -- scope for stopping for-loop
                    \%code
                    ::stop_\(%var as lua identifier)::;
                end -- end of scope for stopping for-loop
        return {statements:%code, locals:%body_lua.locals}

    parse [for all %iterable %body] as: for % in %iterable %body

# Dict iteration (lua's "pairs()")
immediately:
    compile [for %key = %value in %iterable %body] to:
        %body_lua <- (%body as lua)
        %body_statements <- (%body_lua.statements or "\(%body_lua.expr);")
        if %body has subtree % where:
            (%.type = "FunctionCall") and
                ((%'s stub) is "do next %") and
                    %.value.3.value is %key.value
        ..: %body_statements +<- "\n::continue_\(%key as lua identifier)::;"

        if %body has subtree % where:
            (%.type = "FunctionCall") and
                ((%'s stub) is "do next %") and
                    %.value.3.value is %value.value
        ..: %body_statements +<- "\n::continue_\(%value as lua identifier)::;"

        # This uses Lua's approach of only allowing loop-scoped variables in a loop
        assume (%key.type is "Var") or barf "Loop expected variable, not: \(%key's source code)"
        assume (%value.type is "Var") or barf "Loop expected variable, not: \(%value's source code)"
        %code <- ".."
            for \(%key as lua expr),\(%value as lua expr) in pairs(\(%iterable as lua expr)) do
            \%body_statements
            end --foreach-loop
        
        %stop_labels <- ""
        if %body has subtree % where:
            (%.type = "FunctionCall") and
                ((%'s stub) is "stop %") and
                    %.value.2.value is %key.value
        ..: %stop_labels +<- "\n::stop_\(%key as lua identifier)::;"

        if %body has subtree % where:
            (%.type = "FunctionCall") and
                ((%'s stub) is "stop %") and
                    %.value.2.value is %value.value
        ..: %stop_labels +<- "\n::stop_\(%value as lua identifier)::;"

        if: %stop_labels is not ""
            %code <- ".."
                do -- scope for stopping for % = % loop
                    \%code\%stop_labels
                end
        return {statements:%code, locals:%body_lua.locals}

# Switch statement/multi-branch if
immediately:
    compile [when %body] to:
        %code <- ""
        %fallthroughs <- []
        %locals <- []
        %is_first <- (yes)
        %seen_else <- (no)
        for %func_call in %body.value:
            assume (%func_call.type is "FunctionCall") or barf ".."
                Invalid format for 'when' statement. Only '*' blocks are allowed.
            with [..]
                %tokens <- %func_call.value
                %star <- (1st in %tokens)
                %condition <- (2nd in %tokens)
                %action <- (3rd in %tokens)
            ..:
                assume (=lua "\%star and \%star.type == 'Word' and \%star.value == '*'") or barf ".."
                    Invalid format for 'when' statement. Lines must begin with '*'
                assume %condition or barf ".."
                    Invalid format for 'when' statement. Lines must begin with '*' and have a condition or the word "else"
                if: %action is (nil)
                    lua> "table.insert(\%fallthroughs, \(%condition as lua expr));"
                    do next %func_call
                %action <- (%action as lua)
                %action_statements <- (%action.statements or "\(%action.expr);")
                for %local in (%action.locals or []):
                    lua> "table.insert(\%locals, \%local);"

                if: =lua "\%condition.type == 'Word' and \%condition.value == 'else'"
                    assume (not %is_first) or barf "'else' clause cannot be first in 'when % = ?' block"
                    %code +<- ".."
                        
                        else
                        \%action_statements
                    %seen_else <- (yes)
                ..else:
                    assume (not %seen_else) or barf "'else' clause needs to be last in 'when' block"
                    lua> "table.insert(\%fallthroughs, \(%condition as lua expr));"
                    %condition_code <- (%fallthroughs joined with " or ")
                    %code +<- ".."
                        
                        \("if" if %is_first else "elseif") \%condition_code then
                        \%action_statements

                %fallthroughs <- []
                %is_first <- (no)

        assume (%fallthroughs = []) or barf "Unfinished fallthrough conditions in 'when' block"
        if: %code is not ""
            %code +<- "\nend"
        lua> "utils.deduplicate(\%locals);"
        return {statements:%code, locals:%locals}

# Switch statement
immediately:
    compile [when %branch_value = ? %body, when %branch_value is ? %body] to:
        %code <- ""
        %fallthroughs <- []
        %locals <- []
        %is_first <- (yes)
        %seen_else <- (no)
        for %func_call in %body.value:
            assume (%func_call.type is "FunctionCall") or barf ".."
                Invalid format for 'when' statement. Only '*' blocks are allowed.
            %tokens <- %func_call.value
            with [%star<-(1st in %tokens), %condition<-(2nd in %tokens), %action<-(3rd in %tokens)]:
                assume (=lua "\%star and \%star.type == 'Word' and \%star.value == '*'") or barf ".."
                    Invalid format for 'when' statement. Lines must begin with '*'
                assume %condition or barf ".."
                    Invalid format for 'when' statement. Lines must begin with '*' and have a condition or the word "else"
                if: %action is (nil)
                    lua> "table.insert(\%fallthroughs, \(%condition as lua expr))"
                    do next %func_call

                %action <- (%action as lua)
                %action_statements <- (%action.statements or "\(%action.expr);")
                for %local in (%action.locals or []):
                    lua> "table.insert(\%locals, \%local);"

                if: =lua "\%condition.type == 'Word' and \%condition.value == 'else'"
                    assume (not %is_first) or barf "'else' clause cannot be first in 'when % = ?' block"
                    %code +<- ".."

                        else
                            \%action_statements
                        end
                    %seen_else <- (yes)
                ..else:
                    assume (not %seen_else) or barf "'else' clause needs to be last in 'when % = ?' block"
                    lua> "table.insert(\%fallthroughs, \(%condition as lua expr));"
                    for %i = % in %fallthroughs
                        if: (%.type is "Text") or (%.type is "Number")
                            (%i'th in %fallthroughs) <- "branch_value == \%"
                        ..else 
                            (%i'th in %fallthroughs) <- "utils.equivalent(branch_value, \%)"
                    %clause <- (%fallthroughs joined with " or ")
                    %code +<- ".."
                        
                        \("if" if %is_first else "elseif") \%clause then
                        \%action_statements

            %fallthroughs <- []
            %is_first <- (no)
        
        assume (%fallthroughs = []) or barf "Unfinished fallthrough conditions in 'when' block"
        assume (%code is not "") or barf "No body for 'when % = ?' block!"
        unless %seen_else
            %code +<- "\nend"
        %code <- ".."
            do --when % = ?
            local branch_value = \(%branch_value as lua expr);\
            ..\%code
            end --when % = ?
        lua> "utils.deduplicate(\%locals);"
        return {statements:%code, locals:%locals}

# Try/except
immediately:
    compile [..]
        try %action and if it succeeds %success or if it barfs %fallback
        try %action and if it barfs %fallback or if it succeeds %success
    ..to:
        %locals <- []
        %action_lua <- (%action as lua)
        %success_lua <- (%success as lua)
        %fallback_lua <- (%fallback as lua)
        %fallback <- (%fallback as lua)
        for %block in [%action_lua, %success_lua, %fallback_lua]:
            for %local in (%block.locals or []):
                lua> "table.insert(\%locals, \%local);"
        lua> "utils.deduplicate(\%locals);"
        return {..}
            locals: %locals
            statements: ".."
                do
                    local fell_through = false;
                    local ok, ret = pcall(function()
                        \(%action_lua.statements or "\(%action_lua.expr);")
                        fell_through = true;
                    end);
                    if ok then
                        \(%success_lua.statements or "\(%success_lua.expr);")
                    end
                    if not ok then
                        \(%fallback_lua.statements or "\(%fallback_lua.expr);")
                    elseif not fell_through then
                        return ret;
                    end
                end
    parse [try %action] as:
        try %action and if it succeeds: do nothing
        ..or if it barfs: do nothing
    parse [try %action and if it barfs %fallback] as:
        try %action and if it succeeds: do nothing
        ..or if it barfs %fallback
    parse [try %action and if it succeeds %success] as:
        try %action and if it succeeds %success or if it barfs: do nothing

# Do/finally:
immediately:
    compile [do %action] to:
        %action <- (%action as lua)
        return {..}
            locals: %action.locals
            statements: ".."
                do
                    \(%action.statements or "\(%action.expr);")
                end

    compile [do %action then always %final_action] to:
        %action <- (%action as lua)
        %final_action <- (%final_action as lua)
        %locals <- []
        for %sub_locals in [%action.locals, %final_action.locals]:
            for %local in %sub_locals:
                lua> "table.insert(\%locals, \%local);"
        lua> "utils.deduplicate(\%locals);"
        return {..}
            locals: %locals
            statements: ".."
                do
                    local fell_through = false;
                    local ok, ret1 = pcall(function()
                        \(%action.statements or "\(%action.expr);")
                        fell_through = true;
                    end);
                    local ok2, ret2 = pcall(function()
                        \(%final_action.statements or "\(%final_action.expr);")
                    end);
                    if not ok then error(ret1); end
                    if not ok2 then error(ret2); end
                    if not fell_through then
                        return ret1;
                    end
                end