app "false" packages { pf: "platform" } imports [pf.Task.{ Task }, pf.Stdout, pf.Stdin, Context.{ Context }, Variable.{ Variable }] provides [main] to pf # 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 constraints: # 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 to 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 pieces 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 -> Task.loop ctx interpretCtxLoop interpretCtxLoop : Context -> Task [Step Context, Done Context] InterpreterErrors interpretCtxLoop = \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 } Task.succeed (Step { popCtx & scopes: List.set ctx.scopes last newScope }) else newScope = { scope & whileInfo: Some { state: InBody, body, cond } } Task.succeed (Step { 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 } } Task.succeed (Step { 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) Task.succeed (Step 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 (Done dropCtx) else Task.succeed (Step dropCtx) InComment -> result <- Task.attempt (Context.getChar ctx) when result is Ok (T val newCtx) -> if val == 0x7D then # `}` end of comment Task.succeed (Step { newCtx & state: Executing }) else Task.succeed (Step { 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) Task.succeed (Step { 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) Task.succeed (Step 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) Task.succeed (Step { newCtx & state: Executing }) Err _ -> Task.fail BadUtf8 else Task.succeed (Step { 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 `[` Task.succeed (Step { 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 Task.succeed (Step (Context.pushStack { newCtx & state: Executing } (Lambda bytes))) else # end of nested lambda Task.succeed (Step { newCtx & state: InLambda (depth - 1) (List.append bytes val) }) else Task.succeed (Step { 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 -> Task.succeed (Step 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 Task.succeed (Step newCtx) Ok (T x _) -> data = Num.toStr (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) -> Task.succeed (Step (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.divTruncChecked 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 (Num.toStr (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 = Num.toStr (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