NextBASIC

local filename = (...) or error("Usage: "..shell.getRunningProgram().." FILENAME", 0)

local function isStringVar(var)
    return var:sub(#var,#var) == "$"
end

local functions = {
    -- {#params, function}
    int = {1, math.floor},
    rnd = {0, math.random},
    --abs = {1, math.abs},
    --sqr = {1, math.sqrt},
    --exp = {1, math.exp},
    --log = {1, math.log},
    --max = {2, math.max},
    --min = {2, math.min},
    --acos = {1, math.acos},
    --asin = {1, math.asin},
    --atan = {1, math.atan},
    --cos = {1, math.cos},
    --sin = {1, math.sin},
    --tan = {1, math.tan},
    val = {1, tonumber},
    ["str$"] = {1, tostring},
    --["chr$"] = {1, string.char},
    --asc = {1, string.byte},
    len = {1, string.len},
    ["left$"] = {2, function(s, n) return s:sub(1, n) end},
    ["right$"] = {2, function(s, n) return s:sub(s:len() - n + 1) end},
    ["mid$"] = {3, function(s, start, num) return s:sub(start, start+num-1) end},
    ["lower$"] = {1, string.lower},
    ["upper$"] = {1, string.upper},
    ["trim$"] = {1, function(s) return s:gsub("^ +", ""):gsub(" +$", "") end},
    ["space$"] = {1, function(n) return string.rep(" ", n) end},
    instr = {3, function(s, what, start) return string.find(s, what, start, true) or -1 end},

}

local function parse(fn)
    local f = fs.open(fn, "r") or error("Failed to open "..fn, 0)
    local code = f.readAll()
    f.close()

    code = code .. "\n"

    local curLine = 1
    local curChar = 1
    local function updateCurrentPosition(matched)
        for k=1,#matched do
            if matched:sub(k,k) == "\n" then
                curLine = curLine+1
                curChar = 1
            else
                curChar = curChar+1
            end
        end
    end

    local function whereami()
        return "line "..curLine..", position "..curChar
    end

    local pos = 1
    local function accept(pattern)
        local startpos, endpos = code:find("^" .. pattern, pos)
        if not startpos then return nil end

        local matched = code:sub(startpos, endpos)
        pos = endpos + 1
        updateCurrentPosition(matched)
        return matched
    end

    local function mark()
        return {pos, curLine, curChar}
    end
    local function reset(x)
        pos = x[1]
        curLine = x[2]
        curChar = x[3]
    end

    local function skipWhitespace()
        accept(" *")
    end

    local function synerr(message)
        error(message.." at "..whereami()..", just before: "..accept(string.rep(".?", 30)), 0)
    end

    local compiled = {}
    local function emit(inst)
        compiled[#compiled+1] = inst
        --print(textutils.serialize(inst))
    end

    --[[ No, varnames with spaces don't work in this syntax at least
    local function acceptVarName()
        local s = accept(" *[a-zA-Z][a-zA-Z0-9 ]*%$?")
        if not s then return nil end
        s = s:gsub("^ +", ""):gsub(" +$", "") -- trim
        s = s:gsub("  +", " ") -- merge consecutive spaces
        s = s:gsub(" %$", "$") -- no space immediately before $
        return s
    end]]
    local function acceptVarName()
        local s = accept("[a-zA-Z][a-zA-Z0-9]*%$?")
        if s then s = s:lower() end
        return s
    end

    local function acceptSide()
        local s = accept("[lL][eE][fF][tT]") or accept("[rR][iI][gG][hH][tT]") or accept("[tT][oO][pP]") or accept("[bB][oO][tT][tT][oO][mM]") or accept("[fF][rR][oO][nN][tT]") or accept("[bB][aA][cC][kK]")
        if s then s = s:lower() end
        return s
    end

    local function acceptColour()
        if accept("[bB][lL][aA][cC][kK]") then return colours.black end
        if accept("[rR][eE][dD]") then return colours.red end
        if accept("[gG][rR][eE][eE][nN]") then return colours.green end
        if accept("[bB][rR][oO][wW][nN]") then return colours.brown end
        if accept("[bB][lL][uU][eE]") then return colours.blue end
        if accept("[pP][uU][rR][pP][lL][eE]") then return colours.purple end
        if accept("[cC][yY][aA][nN]") then return colours.cyan end
        if accept("[lL][iI][gG][hH][tT] *[gG][rR][eEaA][yY]") then return colours.lightGrey end
        if accept("[gG][rR][eEaA][yY]") then return colours.grey end
        if accept("[pP][iI][nN][kK]") then return colours.pink end
        if accept("[lL][iI][mM][eE]") then return colours.lime end
        if accept("[yY][eE][lL][lL][oO][wW]") then return colours.yellow end
        if accept("[lL][iI][gG][hH][tT] *[bB][lL][uU][eE]") then return colours.lightBlue end
        if accept("[mM][aA][gG][eE][nN][tT][aA]") then return colours.magenta end
        if accept("[oO][rR][aA][nN][gG][eE]") then return colours.orange end
        if accept("[wW][hH][iI][tT][eE]") then return colours.white end
    end

    local function getColourName(c)
        for k,v in pairs(colour) do
            if v == c then return k end
        end
        return "unknown"
    end

    -- allowed operators in precedence order (= means same precedence):
    -- ()
    -- **
    -- * and /
    -- + and -

    -- returns true (ok) or false (no expression) or raises syntax error
    local acceptExpr
    local function acceptExpr4()
        skipWhitespace()
        if accept("\"") then
            local content = accept("[^\"]*")
            if not accept("\"") then synerr("No \" to end string") end
            emit({"string", content})
            return true
        end
        local var = acceptVarName()
        if var then
            if accept("%(") then
                if not functions[var] then
                    synerr("No such function: "..var)
                end
                local p1 = acceptExpr()
                local params
                if not p1 then
                    _= accept("%)") or synerr("Expected ) after "..var.."(")
                    params = 0
                else
                    params = 1
                    while accept(",") do
                        local p = acceptExpr()
                        if not p then synerr("Expected expression after , (in "..var..")") end
                        params = params + 1
                    end
                    _= accept("%)") or synerr("Expected ) after "..var.."( and expression list")
                end
                if params ~= functions[var][1] then
                    synerr("Wrong number of parameters to "..var.." - need "..functions[var][1]..", but you wrote "..params)
                end
                emit({"call", var})
                return true
            else
                emit({"getvar", var})
                return true
            end
        end
        local num = accept("-?[0-9]+")
        if num then
            if accept("%.") then
                local decimal = accept("[0-9]+") or synerr("Expected decimal part after .")
                num = num .. "." .. decimal
            end
            emit({"num", tonumber(num)})
            return true
        end
        return false
    end
    local function acceptExpr3()
        skipWhitespace()
        if not acceptExpr4() then return false end
        skipWhitespace()
        while accept("%*%*") do
            if not acceptExpr4() then return synerr("Expected expression after **") end
            emit({"pow"})
            skipWhitespace()
        end
        return true
    end
    local function acceptExpr2()
        skipWhitespace()
        if not acceptExpr3() then return false end
        while true do
            skipWhitespace()
            if accept("%*") then
                if not acceptExpr3() then synerr("Expected expression after * sign") end
                emit({"mul"})
            elseif accept("/") then
                if not acceptExpr3() then synerr("Expected expression after / sign") end
                emit({"div"})
            else
                return true
            end
        end
    end
    local function acceptExpr1()
        skipWhitespace()
        if not acceptExpr2() then return false end
        while true do
            skipWhitespace()
            if accept("%+") then
                if not acceptExpr2() then synerr("Expected expression after + sign") end
                emit({"add"})
            elseif accept("%-") then
                if not acceptExpr2() then synerr("Expected expression after - sign") end
                emit({"sub"})
            else
                return true
            end
        end
    end
    acceptExpr = acceptExpr1

    local function acceptLabel()
        return accept("%[[^%]\n]+%]")
    end

    -- Condition precedence: ()/comparisons > NOT > AND > OR
    local acceptCondition
    local function acceptCondition3()
        skipWhitespace()
        if accept("%(") then
            if not acceptCondition() or not accept("%)") then synerr("Error understanding condition") end
            return true
        end
        if accept("[nN][oO][tT]") then
            skipWhitespace()
            if not acceptCondition3() then synerr("Expected valid condition after NOT") end
            emit({"not"})
            return true
        end
        if accept("[rR][eE][dD][sS][tT][oO][nN][eE] *[sS][iI][gG][nN][aA][lL]") then
            skipWhitespace()
            local side = acceptSide() or synerr("Expected side after REDSTONE SIGNAL")
            skipWhitespace()
            local col = acceptColour()
            skipWhitespace()
            if col then
                emit({"io-bundled-in", side, col})
            else
                emit({"io-redstone-in", side})
            end
            return true
        end
        local e = acceptExpr()
        if e then
            skipWhitespace()
            local operator = accept("=") or accept(">=") or accept("<=") or accept("<>") or accept("<") or accept(">") or synerr("Error understanding condition (invalid comparison operator?)")
            if not acceptExpr() then synerr("Expected valid expression after "..operator.." (need something to compare with)") end
            emit({operator})
            return true
        end
        return false
    end
    local function acceptCondition2()
        skipWhitespace()
        if not acceptCondition3() then return false end
        skipWhitespace()
        while accept("[aA][nN][dD]") do
            skipWhitespace()
            if not acceptCondition3() then synerr("Expected condition after AND") end
            emit({"and"})
        end
        return true
    end
    local function acceptCondition1()
        skipWhitespace()
        if not acceptCondition2() then return false end
        skipWhitespace()
        while accept("[oO][rR]") do
            skipWhitespace()
            if not acceptCondition2() then synerr("Expected condition after OR") end
            emit({"or"})
        end
        return true
    end
    acceptCondition = acceptCondition1

    local function acceptStatement()
        skipWhitespace()
        if accept("[lL][eE][tT]") then
            skipWhitespace()
            local var = acceptVarName() or synerr("Expected variable name after LET")
            skipWhitespace()
            _= accept("=") or synerr("Expected = after LET "..var)
            skipWhitespace()
            _= acceptExpr() or synerr("Expected valid expression after LET "..var.." =")
            emit({"setvar", var})
        elseif accept("[pP][rR][iI][nN][tT]") then
            skipWhitespace()
            local overrideNewline = false
            if accept("\n") then
            else
                while acceptExpr() do
                    overrideNewline = false
                    if accept(";") then
                        emit({"print"})
                        overrideNewline = true
                    elseif accept(",") then
                        emit({"print-with-comma"})
                        overrideNewline = true
                    else
                        emit({"print"})
                        break
                    end
                end
            end
            if not overrideNewline then
                emit({"print-newline"})
            end
            return true
        elseif accept("[iI][nN][pP][uU][tT]") then
            skipWhitespace()
            local var = acceptVarName() or synerr("There must be a valid variable name after INPUT, and nothing else.")
            emit({isStringVar(var) and "input-string" or "input-number", var})
        elseif accept("[iI][fF]") then
            _= acceptCondition() or synerr("There must be a valid condition after IF, followed by THEN.")
            skipWhitespace()
            _= accept("[tT][hH][eE][nN]") or synerr("There must be a valid condition after IF, followed by THEN.")
            emit({"if"})
            _= acceptStatement() or synerr("There must be a statement after THEN.")
            emit({"endif"})
            return true
        elseif accept("[gG][oO][tT][oO]") then
            skipWhitespace()
            local m = mark()
            local label = acceptLabel() or synerr("Expected label after GOTO")
            emit({"goto", label, m})
        elseif accept("[cC][lL][sS]") then
            emit({"cls"})
        elseif accept("[sS][eE][tT] *[rR][eE][dD][sS][tT][oO][nN][eE] *[sS][iI][gG][nN][aA][lL]") then
            skipWhitespace()
            local side = acceptSide() or synerr("There must be a valid side after SET REDSTONE SIGNAL")
            skipWhitespace()
            local colour = acceptColour()
            skipWhitespace()
            local onoff
            if accept("[oO][nN]") then
                onoff = true
            elseif accept("[oO][fF][fF]") then
                onoff = false
            else
                synerr("After SET REDSTONE SIGNAL "..side:upper()..(colour and " "..getColourName(colour):upper() or "").." must be ON or OFF.")
            end
            if colour then
                emit({onoff and "io-bundled-on" or "io-bundled-off", side, colour})
            else
                emit({"io-redstone", side, onoff})
            end
        elseif accept("[wW][aA][iI][tT]") then
            skipWhitespace()
            if accept("[fF][oO][rR]") then
                skipWhitespace()
                if accept("[rR][eE][dD][sS][tT][oO][nN][eE] *[sS][iI][gG][nN][aA][lL]") then
                    skipWhitespace()
                    if accept("[cC][hH][aA][nN][gG][eE]") then
                        emit({"io-redstone-wait-any"})
                    else
                        local side = acceptSide() or synerr("There must be a valid side after WAIT FOR REDSTONE SIGNAL")
                        skipWhitespace()
                        local colour = acceptColour()
                        skipWhitespace()
                        local onoff
                        if accept("[oO][nN]") then
                            onoff = true
                        elseif accept("[oO][fF][fF]") then
                            onoff = false
                        else
                            synerr("After WAIT FOR REDSTONE SIGNAL "..side:upper()..(colour and " "..getColourName(colour):upper() or "").." must be ON or OFF.")
                        end
                        if colour then
                            emit({"io-bundled-wait", side, colour, onoff})
                        else
                            emit({"io-redstone-wait", side, onoff})
                        end
                    end
                else
                    synerr("I don't know how to wait for that.")
                end
            else
                _= acceptExpr() or synerr("Expected expression or FOR after WAIT")
                skipWhitespace()
                if accept("[sS][eE][cC][oO][nN][dD][sS]?") then
                    emit({"wait-seconds"})
                else
                    synerr("Expected SECOND or SECONDS after WAIT expression")
                end
            end
        else
            return false
        end

        if accept("\n") then
            return true
        elseif accept(":") then
            acceptStatement()
            return true
        else
            synerr("I got confused")
        end
    end

    local seenLabels = {}

    while pos < #code do
        local m = mark()
        local label = acceptLabel()
        if label then
            emit({"label", label})
            if seenLabels[label] then
                reset(m)
                synerr("You can't have two labels with the same name ("+label+")")
            else
                seenLabels[label] = true
            end
            _= accept("\n") or synerr("There can't be anything after a label on the same line")
        elseif accept("\n") then
        elseif accept("[rR][eE][mM][^\n]*") then
        elseif acceptStatement() then
        else
            synerr("I got confused")
        end
    end

    -- resolve labels
    local labels = {}
    for pos,line in ipairs(compiled) do
        if line[1] == "label" then
            labels[line[2]] = pos
        end
    end
    for pos,line in ipairs(compiled) do
        if line[1] == "goto" then
            local lname = line[2]
            line[2] = labels[lname]
            if not line[2] then
                reset(line[3])
                synerr("No such label: "..lname)
            end
            line[3] = nil
        end
    end

    return compiled
end

local parsed = parse(filename)


local function runerr(msg)
    error(msg, 0)
end

local function interr(msg, level)
    error("Internal error: "..msg, (level or 1) + 1)
end

local stack = {}
local function push(val)
    stack[#stack+1] = val
end
local function pop()
    local v = stack[#stack]
    if v == nil then interr("empty operand stack", 2) end
    stack[#stack] = nil
    return v
end


local function checkvartype(varname, object)
    if isStringVar(varname) then
        if type(object) ~= "string" then
            runerr("Can't assign "..type(object).." to string variable "..varname)
        end
    else
        if type(object) ~= "number" then
            runerr("Can't assign "..type(object).." to number varaible "..varname)
        end
    end
end

local realvars = {}
local vars = setmetatable({}, {
    __index = function(t, n)
        return realvars[n] or (isStringVar(n) and "" or 0)
    end,
    __newindex = function(t, n, v)
        checkvartype(n, v)
        realvars[n] = v
    end
})

local programCounter = 1

local function exec(line)
    local cmd = line[1]
    if cmd == "label" then
        -- nothing to do
    elseif cmd == "num" or cmd == "string" then
        push(line[2])
    elseif cmd == "setvar" then
        vars[line[2]] = pop()
    elseif cmd == "print" then
        write(pop())
    elseif cmd == "print-with-comma" then
        write(pop())
        write(" ")
    elseif cmd == "print-newline" then
        write("\n")
    elseif cmd == "input-number" then
        local value = tonumber(read())
        while not value do
            write("Not a number, try again: ")
            value = tonumber(read())
        end
        vars[line[2]] = value
    elseif cmd == "input-string" then
        vars[line[2]] = read()
    elseif cmd == "getvar" then
        push(vars[line[2]])
    elseif cmd == "add" then
        local b = pop()
        local a = pop()
        if type(a) == "number" and type(b) == "number" then
            push(a+b)
        else
            push(tostring(a)..tostring(b))
        end
    elseif cmd == "sub" then
        local b = pop()
        local a = pop()
        if type(a) ~= "number" or type(b) ~= "number" then runerr("Not a number") end
        push(a - b)
    elseif cmd == "mul" then
        local b = pop()
        local a = pop()
        if type(a) ~= "number" or type(b) ~= "number" then runerr("Not a number") end
        push(a * b)
    elseif cmd == "div" then
        local b = pop()
        local a = pop()
        if type(a) ~= "number" or type(b) ~= "number" then runerr("Not a number") end
        push(a / b)
    elseif cmd == "pow" then
        local b = pop()
        local a = pop()
        if type(a) ~= "number" or type(b) ~= "number" then runerr("Not a number") end
        push(a ^ b)
    elseif cmd == "and" then
        local a, b = pop(), pop()
        if type(a) ~= "boolean" then interr("condition resulted in "..type(a)..": "..tostring(a)) end
        if type(b) ~= "boolean" then interr("condition resulted in "..type(b)..": "..tostring(b)) end
        push(a and b)
    elseif cmd == "or" then
        local a, b = pop(), pop()
        if type(a) ~= "boolean" then interr("condition resulted in "..type(a)..": "..tostring(a)) end
        if type(b) ~= "boolean" then interr("condition resulted in "..type(b)..": "..tostring(b)) end
        push(a or b)
    elseif cmd == "not" then
        local a = pop()
        if type(a) ~= "boolean" then interr("condition resulted in "..type(a)..": "..tostring(a)) end
        push(not a)
    elseif cmd == "call" then
        local params = {}
        local npar = functions[line[2]][1]
        local func = functions[line[2]][2]
        for k = 1, npar do
            params[npar+1-k] = pop()
        end
        push(func(unpack(params)))
    elseif cmd == "<" then
        local b = pop()
        push(pop() < b)
    elseif cmd == ">" then
        local b = pop()
        push(pop() > b)
    elseif cmd == "<=" then
        local b = pop()
        push(pop() <= b)
    elseif cmd == ">=" then
        local b = pop()
        push(pop() >= b)
    elseif cmd == "=" then
        local b = pop()
        push(pop() == b)
    elseif cmd == "<>" then
        local b = pop()
        push(pop() ~= b)
    elseif cmd == "if" then
        local s = pop()
        if type(s) ~= "boolean" then interr("condition resulted in "..type(s)..": "..tostring(s)) end
        if not s then
            -- skip to matching endif
            local level = 1
            programCounter = programCounter + 1
            while programCounter <= #parsed and level > 0 do
                if parsed[programCounter][1] == "if" then
                    level = level + 1
                elseif parsed[programCounter][1] == "endif" then
                    level = level - 1
                end
                programCounter = programCounter + 1
            end
            programCounter = programCounter - 1
            if level ~= 0 then interr("no matching endif") end
        end
    elseif cmd == "goto" then
        programCounter = line[2] - 1
    elseif cmd == "cls" then
        term.clear()
        term.setCursorPos(1, 1)
    elseif cmd == "endif" then
        -- do nothing
    elseif cmd == "io-bundled-on" then
        rs.setBundledOutput(line[2], colours.combine(rs.getBundledOutput(line[2]), line[3]))
    elseif cmd == "io-bundled-off" then
        rs.setBundledOutput(line[2], colours.subtract(rs.getBundledOutput(line[2]), line[3]))
    elseif cmd == "io-redstone" then
        rs.setOutput(line[2], line[3])
    elseif cmd == "wait-seconds" then
        local n = pop()
        if type(n) ~= "number" then runerr("Expected number in WAIT command") end
        sleep(n)
    elseif cmd == "io-bundled-in" then
        push(colours.test(rs.getBundledInput(line[2]), line[3]))
    elseif cmd == "io-redstone-in" then
        push(rs.getInput(line[2]) and true or false)
    elseif cmd == "io-redstone-wait" then
        while rs.getInput(line[2]) ~= line[3] do
            os.pullEvent("redstone")
        end
    elseif cmd == "io-redstone-wait-any" then
        os.pullEvent("redstone")
    elseif cmd == "io-bundled-wait" then
        while colours.test(rs.getBundledInput(line[2]), line[3]) ~= line[4] do
            os.pullEvent("redstone")
        end
    else
        interr("unsupported: "..cmd)
    end
end

--f = fs.open("temp", "w")
--for _,v in ipairs(parsed) do f.writeLine(textutils.serialize(v)) end
--f.close()

while programCounter <= #parsed do
    exec(parsed[programCounter])
    programCounter = programCounter + 1
end