roc/examples/false-interpreter/False.roc

#!/usr/bin/env roc
app "false"
    packages { base: "platform" }
    imports [ base.Task.{ Task }, base.Stdout, base.Stdin, Context.{ Context }, Variable.{ Variable } ]
    provides [ main ] to base

# An interpreter for the False programming language: https://strlen.com/false-language/
# This is just a silly example to test this variety of program.
# In general think of this as a program that parses a number of files and prints some output.
# It has some extra contraints:
# 1) The input files are considered too large to just read in at once. Instead it is read via buffer or line.
# 2) The output is also considered too large to generate in memory. It must be printed as we go via buffer or line.

# I think one of the biggest issues with this implementation is that it doesn't return the the platform frequently enough.
# What I mean by that is we build a chain of all Tasks period and return that to the host.
# In something like the elm architecture you return a single step with one Task.
# The huge difference here is when it comes to things like stack overflows.
# In an imperative language, a few of these peices would be in while loops and it would basically never overflow.
# This implementation is easy to overflow, either make the input long enough or make a false while loop run long enough.
# I assume all of the Task.awaits are the cause of this, but I am not 100% sure.

InterpreterErrors : [ BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, MaxInputNumber, NoLambdaOnStack, NoNumberOnStack, NoVariableOnStack, NoScope, OutOfBounds, UnexpectedEndOfData ]

main : Str -> Task {} []
main = \filename ->
    interpretFile filename
        |> Task.onFail (\StringErr e -> Stdout.line "Ran into problem:\n\(e)\n")
    

interpretFile : Str -> Task {} [ StringErr Str ]
interpretFile = \filename ->
    ctx <- Context.with filename
    result <- Task.attempt (interpretCtx ctx)
    when result is
        Ok _ ->
            Task.succeed {}
        Err BadUtf8 ->
            Task.fail (StringErr "Failed to convert string from Utf8 bytes")
        Err DivByZero ->
            Task.fail (StringErr "Division by zero")
        Err EmptyStack ->
            Task.fail (StringErr "Tried to pop a value off of the stack when it was empty")
        Err InvalidBooleanValue ->
            Task.fail (StringErr "Ran into an invalid boolean that was neither false (0) or true (-1)")
        Err (InvalidChar char) ->
            Task.fail (StringErr "Ran into an invalid character with ascii code: \(char)")
        Err MaxInputNumber ->
            Task.fail (StringErr "Like the original false compiler, the max input number is 320,000")
        Err NoLambdaOnStack ->
            Task.fail (StringErr "Tried to run a lambda when no lambda was on the stack")
        Err NoNumberOnStack ->
            Task.fail (StringErr "Tried to run a number when no number was on the stack")
        Err NoVariableOnStack ->
            Task.fail (StringErr "Tried to load a variable when no variable was on the stack")
        Err NoScope ->
            Task.fail (StringErr "Tried to run code when not in any scope")
        Err OutOfBounds ->
            Task.fail (StringErr "Tried to load from an offset that was outside of the stack")
        Err UnexpectedEndOfData ->
            Task.fail (StringErr "Hit end of data while still parsing something")

isDigit : U8 -> Bool
isDigit = \char ->
    char >= 0x30 # `0`
    && char <= 0x39 # `0`

isWhitespace : U8 -> Bool
isWhitespace = \char ->
    char == 0xA # new line
    || char == 0xB # carriage return
    || char == 0x20 # space
    || char == 0x9 # tab

interpretCtx : Context -> Task Context InterpreterErrors
interpretCtx = \ctx ->
    when ctx.state is
        Executing if Context.inWhileScope ctx ->
            # Deal with the current while loop potentially looping.
            last = ((List.len ctx.scopes) - 1)
            when List.get ctx.scopes last is
                Ok scope ->
                    when scope.whileInfo is
                        Some ({state: InCond, body, cond}) ->
                            # Just ran condition. Check the top of stack to see if body should run.
                            when popNumber ctx is
                                Ok (T popCtx n) ->
                                    if n == 0 then
                                        newScope = {scope & whileInfo: None}
                                        interpretCtx {popCtx & scopes: List.set ctx.scopes last newScope}
                                    else
                                        newScope = {scope & whileInfo: Some {state: InBody, body, cond}}
                                        interpretCtx {popCtx & scopes: List.append (List.set ctx.scopes last newScope) {data: None, buf: body, index: 0, whileInfo: None}}
                                Err e -> Task.fail e
                        Some ({state: InBody, body, cond}) ->
                            # Just rand the body. Run the condition again.
                            newScope = {scope & whileInfo: Some {state: InCond, body, cond}}
                            interpretCtx {ctx & scopes: List.append (List.set ctx.scopes last newScope) {data: None, buf: cond, index: 0, whileInfo: None}}
                        None ->
                            Task.fail NoScope
                Err OutOfBounds ->
                    Task.fail NoScope
        Executing ->
            # {} <- Task.await (Stdout.line (Context.toStr ctx))
            result <- Task.attempt (Context.getChar ctx)
            when result is
                Ok (T val newCtx) ->
                    execCtx <- Task.await (stepExecCtx newCtx val)
                    interpretCtx execCtx
                Err NoScope ->
                    Task.fail NoScope
                Err EndOfData ->
                    # Computation complete for this scope.
                    # Drop a scope.
                    dropCtx = {ctx & scopes: List.dropAt ctx.scopes (List.len ctx.scopes - 1) }
                    # If no scopes left, all execution complete.
                    if List.isEmpty dropCtx.scopes then
                        Task.succeed dropCtx
                    else
                        interpretCtx dropCtx
        InComment ->
            result <- Task.attempt (Context.getChar ctx)
            when result is
                Ok (T val newCtx) ->
                    if val == 0x7D then # `}` end of comment
                        interpretCtx {newCtx & state: Executing}
                    else
                        interpretCtx {newCtx & state: InComment}
                Err NoScope ->
                    Task.fail NoScope
                Err EndOfData ->
                    Task.fail UnexpectedEndOfData
        InNumber accum ->
            result <- Task.attempt (Context.getChar ctx)
            when result is
                Ok (T val newCtx) ->
                    if isDigit val then # still in the number
                        # i32 multiplication is kinda broken because it implicitly seems to want to upcast to i64.
                        # so like should be (i32, i32) -> i32, but seems to be (i32, i32) -> i64
                        # so this is make i64 mul by 10 then convert back to i32. 
                        nextAccum = (10 * Num.intCast accum) + (Num.intCast (val - 0x30))
                        interpretCtx {newCtx & state: InNumber (Num.intCast nextAccum) }
                    else
                        # outside of number now, this needs to be executed.
                        pushCtx = Context.pushStack newCtx (Number accum)
                        execCtx <- Task.await (stepExecCtx {pushCtx & state: Executing} val)
                        interpretCtx execCtx
                Err NoScope ->
                    Task.fail NoScope
                Err EndOfData ->
                    Task.fail UnexpectedEndOfData
        InString bytes ->
            result <- Task.attempt (Context.getChar ctx)
            when result is
                Ok (T val newCtx) ->
                    if val == 0x22 then # `"` end of string
                        when Str.fromUtf8 bytes is
                            Ok str ->
                                {} <- Task.await (Stdout.raw str)
                                interpretCtx {newCtx & state: Executing}
                            Err _ ->
                                Task.fail BadUtf8
                    else
                        interpretCtx {newCtx & state: InString (List.append bytes val)}
                Err NoScope ->
                    Task.fail NoScope
                Err EndOfData ->
                    Task.fail UnexpectedEndOfData
        InLambda depth bytes ->
            result <- Task.attempt (Context.getChar ctx)
            when result is
                Ok (T val newCtx) ->
                    if val == 0x5B then # start of a nested lambda `[`
                        interpretCtx {newCtx & state: InLambda (depth + 1) (List.append bytes val)}
                    else if val == 0x5D then # `]` end of current lambda
                        if depth == 0 then # end of all lambdas
                            interpretCtx (Context.pushStack {newCtx & state: Executing} (Lambda bytes))
                        else # end of nested lambda
                            interpretCtx {newCtx & state: InLambda (depth - 1) (List.append bytes val)}
                    else
                        interpretCtx {newCtx & state: InLambda depth (List.append bytes val)}
                Err NoScope ->
                    Task.fail NoScope
                Err EndOfData ->
                    Task.fail UnexpectedEndOfData
        InSpecialChar ->
            result <- Task.attempt (Context.getChar {ctx & state: Executing})
            when result is
                Ok (T 0xB8 newCtx) ->
                    result2 =
                        (T popCtx index) <- Result.after (popNumber newCtx)
                        # I think Num.abs is too restrictive, it should be able to produce a natural number, but it seem to be restricted to signed numbers.
                        size = (List.len popCtx.stack) - 1
                        offset = (Num.intCast size) - index
                        if offset >= 0 then
                            stackVal <- Result.after (List.get popCtx.stack (Num.intCast offset))
                            Ok (Context.pushStack popCtx stackVal)
                        else
                            Err OutOfBounds
                    when result2 is
                        Ok a -> interpretCtx a
                        Err e -> Task.fail e
                Ok (T 0x9F newCtx) ->
                    # This is supposed to flush io buffers. We don't buffer, so it does nothing
                    interpretCtx newCtx
                Ok (T x _) ->
                    data = Str.fromInt (Num.intCast x)
                    Task.fail (InvalidChar data)
                Err NoScope ->
                    Task.fail NoScope
                Err EndOfData ->
                    Task.fail UnexpectedEndOfData
        LoadChar ->
            result <- Task.attempt (Context.getChar {ctx & state: Executing})
            when result is
                Ok (T x newCtx) ->
                    interpretCtx (Context.pushStack newCtx (Number (Num.intCast x)))
                Err NoScope ->
                    Task.fail NoScope
                Err EndOfData ->
                    Task.fail UnexpectedEndOfData

# If it weren't for reading stdin or writing to stdout, this could return a result.
stepExecCtx : Context, U8 -> Task Context InterpreterErrors
stepExecCtx = \ctx, char ->
    when char is 
        0x21 -> # `!` execute lambda 
            Task.fromResult (
                (T popCtx bytes) <- Result.after (popLambda ctx)
                Ok {popCtx & scopes: List.append popCtx.scopes {data: None, buf: bytes, index: 0, whileInfo: None}}
                )
        0x3F -> # `?` if
            Task.fromResult (
                (T popCtx1 bytes) <- Result.after (popLambda ctx)
                (T popCtx2 n1) <- Result.after (popNumber popCtx1)
                if n1 == 0 then
                    Ok popCtx2
                else
                    Ok {popCtx2 & scopes: List.append popCtx2.scopes {data: None, buf: bytes, index: 0, whileInfo: None}}
                )
        0x23 -> # `#` while
            Task.fromResult (
                (T popCtx1 body) <- Result.after (popLambda ctx)
                (T popCtx2 cond) <- Result.after (popLambda popCtx1)
                last = ((List.len popCtx2.scopes) - 1)
                when List.get popCtx2.scopes last is
                    Ok scope ->
                        # set the current scope to be in a while loop.
                        scopes = List.set popCtx2.scopes last {scope & whileInfo: Some {cond: cond, body: body, state: InCond} }
                        # push a scope to execute the condition.
                        Ok {popCtx2 & scopes: List.append scopes {data: None, buf: cond, index: 0, whileInfo: None}}
                    Err OutOfBounds ->
                        Err NoScope
                )
        0x24 -> # `$` dup
            # Switching this to List.last and changing the error to ListWasEmpty leads to a compiler bug.
            # Complains about the types eq not matching.
            when List.get ctx.stack ((List.len ctx.stack) - 1) is
                Ok dupItem ->
                    Task.succeed (Context.pushStack ctx dupItem)
                Err OutOfBounds ->
                    Task.fail EmptyStack
        0x25 -> # `%` drop
            when Context.popStack ctx is
                # Dropping with an empty stack, all results here are fine
                Ok (T popCtx _) ->
                    Task.succeed popCtx
                Err _ ->
                    Task.succeed ctx
        0x5C -> # `\` swap
            result2 =
                (T popCtx1 n1) <- Result.after (Context.popStack ctx)
                (T popCtx2 n2) <- Result.after (Context.popStack popCtx1)
                Ok (Context.pushStack (Context.pushStack popCtx2 n1) n2)
            when result2 is
                Ok a -> Task.succeed a
                # Being explicit with error type is required to stop the need to propogate the error parameters to Context.popStack
                Err EmptyStack -> Task.fail EmptyStack
        0x40 -> # `@` rot
            result2 =
                (T popCtx1 n1) <- Result.after (Context.popStack ctx)
                (T popCtx2 n2) <- Result.after (Context.popStack popCtx1)
                (T popCtx3 n3) <- Result.after (Context.popStack popCtx2)
                Ok (Context.pushStack (Context.pushStack (Context.pushStack popCtx3 n2) n1) n3)
            when result2 is
                Ok a -> Task.succeed a
                # Being explicit with error type is required to stop the need to propogate the error parameters to Context.popStack
                Err EmptyStack -> Task.fail EmptyStack
        0xC3 -> # `ø` pick or `ß` flush
            # these are actually 2 bytes, 0xC3 0xB8 or  0xC3 0x9F
            # requires special parsing
            Task.succeed {ctx & state: InSpecialChar}
        0x4F -> # `O` also treat this as pick for easier script writing
            Task.fromResult (
                (T popCtx index) <- Result.after (popNumber ctx)
                # I think Num.abs is too restrictive, it should be able to produce a natural number, but it seem to be restricted to signed numbers.
                size = (List.len popCtx.stack) - 1
                offset = (Num.intCast size) - index
                if offset >= 0 then
                    stackVal <- Result.after (List.get popCtx.stack (Num.intCast offset))
                    Ok (Context.pushStack popCtx stackVal)
                else
                    Err OutOfBounds
                )
        0x42 -> # `B` also treat this as flush for easier script writing
            # This is supposed to flush io buffers. We don't buffer, so it does nothing
            Task.succeed ctx
        0x27 -> # `'` load next char
            Task.succeed {ctx & state: LoadChar}
        0x2B -> # `+` add
            Task.fromResult (binaryOp ctx Num.addWrap)
        0x2D -> # `-` sub
            Task.fromResult (binaryOp ctx Num.subWrap)
        0x2A -> # `*` mul
            Task.fromResult (binaryOp ctx Num.mulWrap)
        0x2F -> # `/` div
            # Due to possible division by zero error, this must be handled specially.
            Task.fromResult (
                (T popCtx1 numR) <- Result.after (popNumber ctx)
                (T popCtx2 numL) <- Result.after (popNumber popCtx1)
                res <- Result.after (Num.divFloor numL numR)
                Ok (Context.pushStack popCtx2 (Number res))
                )
        0x26 -> # `&` bitwise and
            Task.fromResult (binaryOp ctx Num.bitwiseAnd)
        0x7C -> # `|` bitwise or
            Task.fromResult (binaryOp ctx Num.bitwiseOr)
        0x3D -> # `=` equals
            Task.fromResult
                (a, b <- binaryOp ctx
                    if a == b then
                        -1
                    else
                        0
                )
        0x3E -> # `>` greater than
            Task.fromResult
                (a, b <- binaryOp ctx
                    if a > b then
                        -1
                    else
                        0
                )
        0x5F -> # `_` negate
            Task.fromResult (unaryOp ctx Num.neg)
        0x7E -> # `~` bitwise not
            Task.fromResult (unaryOp ctx (\x -> Num.bitwiseXor x -1)) # xor with -1 should be bitwise not
        0x2C -> # `,` write char
            when popNumber ctx is
                Ok (T popCtx num) ->
                    when Str.fromUtf8 [Num.intCast num] is
                        Ok str ->
                            {} <- Task.await (Stdout.raw str)
                            Task.succeed popCtx
                        Err _ ->
                            Task.fail BadUtf8
                Err e ->
                    Task.fail e
        0x2E -> # `.` write int
            when popNumber ctx is
                Ok (T popCtx num) ->
                    {} <- Task.await (Stdout.raw (Str.fromInt (Num.intCast num)))
                    Task.succeed popCtx
                Err e ->
                    Task.fail e
        0x5E -> # `^` read char as int
            in <- Task.await Stdin.char
            if in == 255 then # max char sent on EOF. Change to -1
                Task.succeed (Context.pushStack ctx (Number -1))
            else
                Task.succeed (Context.pushStack ctx (Number (Num.intCast in)))
        0x3A -> # `:` store to variable
            Task.fromResult (
                (T popCtx1 var) <- Result.after (popVariable ctx)
                # The Result.mapErr on the next line maps from EmptyStack in Context.roc to the full InterpreterErrors union here.
                (T popCtx2 n1) <- Result.after (Result.mapErr (Context.popStack popCtx1) (\(EmptyStack) -> EmptyStack))
                Ok {popCtx2 & vars: List.set popCtx2.vars (Variable.toIndex var) n1}
                )
        0x3B -> # `;` load from variable
            Task.fromResult (
                (T popCtx var) <- Result.after (popVariable ctx)
                elem <- Result.after (List.get popCtx.vars (Variable.toIndex var))
                Ok (Context.pushStack popCtx elem)
                )
        0x22 -> # `"` string start
            Task.succeed {ctx & state: InString []}
        0x5B -> # `"` string start
            Task.succeed {ctx & state: InLambda 0 []}
        0x7B -> # `{` comment start
            Task.succeed {ctx & state: InComment}
        x if isDigit x -> # number start
            Task.succeed {ctx & state: InNumber (Num.intCast (x - 0x30))}
        x if isWhitespace x -> Task.succeed ctx
        x ->
            when (Variable.fromUtf8 x) is # letters are variable names
                Ok var ->
                    Task.succeed (Context.pushStack ctx (Var var))
                Err _ ->
                    data = Str.fromInt (Num.intCast x)
                    Task.fail (InvalidChar data)

unaryOp: Context, (I32 -> I32) -> Result Context InterpreterErrors
unaryOp = \ctx, op ->
    (T popCtx num) <- Result.after (popNumber ctx)
    Ok (Context.pushStack popCtx (Number (op num)))

binaryOp: Context, (I32, I32 -> I32) -> Result Context InterpreterErrors
binaryOp = \ctx, op ->
    (T popCtx1 numR) <- Result.after (popNumber ctx)
    (T popCtx2 numL) <- Result.after (popNumber popCtx1)
    Ok (Context.pushStack popCtx2 (Number (op numL numR)))


popNumber: Context -> Result [T Context I32] InterpreterErrors
popNumber = \ctx ->
    when Context.popStack ctx is
        Ok (T popCtx (Number num)) ->
            Ok (T popCtx num)
        Ok _ ->
            Err (NoNumberOnStack)
        Err EmptyStack ->
            Err EmptyStack

popLambda: Context -> Result [T Context (List U8)] InterpreterErrors
popLambda = \ctx ->
    when Context.popStack ctx is
        Ok (T popCtx (Lambda bytes)) ->
            Ok (T popCtx bytes)
        Ok _ ->
            Err NoLambdaOnStack
        Err EmptyStack ->
            Err EmptyStack

popVariable: Context -> Result [T Context Variable] InterpreterErrors
popVariable = \ctx ->
    when Context.popStack ctx is
        Ok (T popCtx (Var var)) ->
            Ok (T popCtx var)
        Ok _ ->
            Err NoVariableOnStack
        Err EmptyStack ->
            Err EmptyStack