update false platform to purity inference

This commit is contained in:
Brendan Hansknecht 2024-12-13 21:34:03 -08:00
parent 14a338e15b
commit f51061b200
No known key found for this signature in database
GPG key ID: 0EA784685083E75B
9 changed files with 291 additions and 380 deletions

View file

@ -1,4 +1,4 @@
module [Context, Data, with, getChar, Option, pushStack, popStack, toStr, inWhileScope] module [Context, Data, with!, getChar!, Option, pushStack, popStack, toStr, inWhileScope]
import pf.File import pf.File
import Variable exposing [Variable] import Variable exposing [Variable]
@ -20,13 +20,13 @@ pushStack = \ctx, data ->
# I think an open tag union should just work here. # I think an open tag union should just work here.
# Instead at a call sites, I need to match on the error and then return the same error. # Instead at a call sites, I need to match on the error and then return the same error.
# Otherwise it hits unreachable code in ir.rs # Otherwise it hits unreachable code in ir.rs
popStack : Context -> Result [T Context Data] [EmptyStack] popStack : Context -> Result (Context, Data) [EmptyStack]
popStack = \ctx -> popStack = \ctx ->
when List.last ctx.stack is when List.last ctx.stack is
Ok val -> Ok val ->
poppedCtx = { ctx & stack: List.dropAt ctx.stack (List.len ctx.stack - 1) } poppedCtx = { ctx & stack: List.dropAt ctx.stack (List.len ctx.stack - 1) }
Ok (T poppedCtx val) Ok (poppedCtx, val)
Err ListWasEmpty -> Err ListWasEmpty ->
Err EmptyStack Err EmptyStack
@ -58,30 +58,30 @@ toStr = \{ scopes, stack, state, vars } ->
"\n============\nDepth: $(depth)\nState: $(stateStr)\nStack: [$(stackStr)]\nVars: [$(varsStr)]\n============\n" "\n============\nDepth: $(depth)\nState: $(stateStr)\nStack: [$(stackStr)]\nVars: [$(varsStr)]\n============\n"
with : Str, (Context -> Task {} a) -> Task {} a with! : Str, (Context => a) => a
with = \path, callback -> with! = \path, callback! ->
File.withOpen path \handle -> File.withOpen! path \handle ->
# I cant define scope here and put it in the list in callback. It breaks alias anaysis. # I cant define scope here and put it in the list in callback. It breaks alias anaysis.
# Instead I have to inline this. # Instead I have to inline this.
# root_scope = { data: Some handle, index: 0, buf: [], whileInfo: None } # root_scope = { data: Some handle, index: 0, buf: [], whileInfo: None }
callback { scopes: [{ data: Some handle, index: 0, buf: [], whileInfo: None }], state: Executing, stack: [], vars: List.repeat (Number 0) Variable.totalCount } callback! { scopes: [{ data: Some handle, index: 0, buf: [], whileInfo: None }], state: Executing, stack: [], vars: List.repeat (Number 0) Variable.totalCount }
# I am pretty sure there is a syntax to destructure and keep a reference to the whole, but Im not sure what it is. # I am pretty sure there is a syntax to destructure and keep a reference to the whole, but Im not sure what it is.
getChar : Context -> Task [T U8 Context] [EndOfData, NoScope] getChar! : Context => Result (U8, Context) [EndOfData, NoScope]
getChar = \ctx -> getChar! = \ctx ->
when List.last ctx.scopes is when List.last ctx.scopes is
Ok scope -> Ok scope ->
(T val newScope) = getCharScope! scope (val, newScope) = getCharScope!? scope
Task.ok (T val { ctx & scopes: List.set ctx.scopes (List.len ctx.scopes - 1) newScope }) Ok (val, { ctx & scopes: List.set ctx.scopes (List.len ctx.scopes - 1) newScope })
Err ListWasEmpty -> Err ListWasEmpty ->
Task.err NoScope Err NoScope
getCharScope : Scope -> Task [T U8 Scope] [EndOfData, NoScope] getCharScope! : Scope => Result (U8, Scope) [EndOfData, NoScope]
getCharScope = \scope -> getCharScope! = \scope ->
when List.get scope.buf scope.index is when List.get scope.buf scope.index is
Ok val -> Ok val ->
Task.ok (T val { scope & index: scope.index + 1 }) Ok (val, { scope & index: scope.index + 1 })
Err OutOfBounds -> Err OutOfBounds ->
when scope.data is when scope.data is
@ -90,13 +90,13 @@ getCharScope = \scope ->
when List.first bytes is when List.first bytes is
Ok val -> Ok val ->
# This starts at 1 because the first character is already being returned. # This starts at 1 because the first character is already being returned.
Task.ok (T val { scope & buf: bytes, index: 1 }) Ok (val, { scope & buf: bytes, index: 1 })
Err ListWasEmpty -> Err ListWasEmpty ->
Task.err EndOfData Err EndOfData
None -> None ->
Task.err EndOfData Err EndOfData
inWhileScope : Context -> Bool inWhileScope : Context -> Bool
inWhileScope = \ctx -> inWhileScope = \ctx ->

View file

@ -1,4 +1,4 @@
app [main] { pf: platform "platform/main.roc" } app [main!] { pf: platform "platform/main.roc" }
import pf.Stdout import pf.Stdout
import pf.Stdin import pf.Stdin
@ -20,54 +20,58 @@ import Variable exposing [Variable]
# I assume all of the Task.awaits are the cause of this, but I am not 100% sure. # 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] InterpreterErrors : [BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, MaxInputNumber, NoLambdaOnStack, NoNumberOnStack, NoVariableOnStack, NoScope, OutOfBounds, UnexpectedEndOfData]
main : Str -> Task {} [] main! : Str => {}
main = \filename -> main! = \filename ->
interpretFile filename when interpretFile! filename is
|> Task.onErr \StringErr e -> Stdout.line "Ran into problem:\n$(e)\n" Ok {} ->
{}
interpretFile : Str -> Task {} [StringErr Str] Err (StringErr e) ->
interpretFile = \filename -> Stdout.line! "Ran into problem:\n$(e)\n"
Context.with filename \ctx ->
result = interpretCtx ctx |> Task.result! interpretFile! : Str => Result {} [StringErr Str]
interpretFile! = \filename ->
Context.with! filename \ctx ->
result = interpretCtx! ctx
when result is when result is
Ok _ -> Ok _ ->
Task.ok {} Ok {}
Err BadUtf8 -> Err BadUtf8 ->
Task.err (StringErr "Failed to convert string from Utf8 bytes") Err (StringErr "Failed to convert string from Utf8 bytes")
Err DivByZero -> Err DivByZero ->
Task.err (StringErr "Division by zero") Err (StringErr "Division by zero")
Err EmptyStack -> Err EmptyStack ->
Task.err (StringErr "Tried to pop a value off of the stack when it was empty") Err (StringErr "Tried to pop a value off of the stack when it was empty")
Err InvalidBooleanValue -> Err InvalidBooleanValue ->
Task.err (StringErr "Ran into an invalid boolean that was neither false (0) or true (-1)") Err (StringErr "Ran into an invalid boolean that was neither false (0) or true (-1)")
Err (InvalidChar char) -> Err (InvalidChar char) ->
Task.err (StringErr "Ran into an invalid character with ascii code: $(char)") Err (StringErr "Ran into an invalid character with ascii code: $(char)")
Err MaxInputNumber -> Err MaxInputNumber ->
Task.err (StringErr "Like the original false compiler, the max input number is 320,000") Err (StringErr "Like the original false compiler, the max input number is 320,000")
Err NoLambdaOnStack -> Err NoLambdaOnStack ->
Task.err (StringErr "Tried to run a lambda when no lambda was on the stack") Err (StringErr "Tried to run a lambda when no lambda was on the stack")
Err NoNumberOnStack -> Err NoNumberOnStack ->
Task.err (StringErr "Tried to run a number when no number was on the stack") Err (StringErr "Tried to run a number when no number was on the stack")
Err NoVariableOnStack -> Err NoVariableOnStack ->
Task.err (StringErr "Tried to load a variable when no variable was on the stack") Err (StringErr "Tried to load a variable when no variable was on the stack")
Err NoScope -> Err NoScope ->
Task.err (StringErr "Tried to run code when not in any scope") Err (StringErr "Tried to run code when not in any scope")
Err OutOfBounds -> Err OutOfBounds ->
Task.err (StringErr "Tried to load from an offset that was outside of the stack") Err (StringErr "Tried to load from an offset that was outside of the stack")
Err UnexpectedEndOfData -> Err UnexpectedEndOfData ->
Task.err (StringErr "Hit end of data while still parsing something") Err (StringErr "Hit end of data while still parsing something")
isDigit : U8 -> Bool isDigit : U8 -> Bool
isDigit = \char -> isDigit = \char ->
@ -75,6 +79,7 @@ isDigit = \char ->
>= 0x30 # `0` >= 0x30 # `0`
&& char && char
<= 0x39 # `0` <= 0x39 # `0`
isWhitespace : U8 -> Bool isWhitespace : U8 -> Bool
isWhitespace = \char -> isWhitespace = \char ->
char char
@ -85,12 +90,21 @@ isWhitespace = \char ->
== 0x20 # space == 0x20 # space
|| char || char
== 0x9 # tab == 0x9 # tab
interpretCtx : Context -> Task Context InterpreterErrors
interpretCtx = \ctx ->
Task.loop ctx interpretCtxLoop
interpretCtxLoop : Context -> Task [Step Context, Done Context] InterpreterErrors interpretCtx! : Context => Result Context InterpreterErrors
interpretCtxLoop = \ctx -> interpretCtx! = \ctx ->
when interpretCtxLoop! ctx is
Ok (Step next) ->
interpretCtx! next
Ok (Done next) ->
Ok next
Err e ->
Err e
interpretCtxLoop! : Context => Result [Step Context, Done Context] InterpreterErrors
interpretCtxLoop! = \ctx ->
when ctx.state is when ctx.state is
Executing if Context.inWhileScope ctx -> Executing if Context.inWhileScope ctx ->
# Deal with the current while loop potentially looping. # Deal with the current while loop potentially looping.
@ -102,41 +116,41 @@ interpretCtxLoop = \ctx ->
Some { state: InCond, body, cond } -> Some { state: InCond, body, cond } ->
# Just ran condition. Check the top of stack to see if body should run. # Just ran condition. Check the top of stack to see if body should run.
when popNumber ctx is when popNumber ctx is
Ok (T popCtx n) -> Ok (popCtx, n) ->
if n == 0 then if n == 0 then
newScope = { scope & whileInfo: None } newScope = { scope & whileInfo: None }
Task.ok (Step { popCtx & scopes: List.set ctx.scopes last newScope }) Ok (Step { popCtx & scopes: List.set ctx.scopes last newScope })
else else
newScope = { scope & whileInfo: Some { state: InBody, body, cond } } newScope = { scope & whileInfo: Some { state: InBody, body, cond } }
Task.ok (Step { popCtx & scopes: List.append (List.set ctx.scopes last newScope) { data: None, buf: body, index: 0, whileInfo: None } }) Ok (Step { popCtx & scopes: List.append (List.set ctx.scopes last newScope) { data: None, buf: body, index: 0, whileInfo: None } })
Err e -> Err e ->
Task.err e Err e
Some { state: InBody, body, cond } -> Some { state: InBody, body, cond } ->
# Just rand the body. Run the condition again. # Just rand the body. Run the condition again.
newScope = { scope & whileInfo: Some { state: InCond, body, cond } } newScope = { scope & whileInfo: Some { state: InCond, body, cond } }
Task.ok (Step { ctx & scopes: List.append (List.set ctx.scopes last newScope) { data: None, buf: cond, index: 0, whileInfo: None } }) Ok (Step { ctx & scopes: List.append (List.set ctx.scopes last newScope) { data: None, buf: cond, index: 0, whileInfo: None } })
None -> None ->
Task.err NoScope Err NoScope
Err OutOfBounds -> Err OutOfBounds ->
Task.err NoScope Err NoScope
Executing -> Executing ->
# Stdout.line! (Context.toStr ctx) # Stdout.line! (Context.toStr ctx)
result = Context.getChar ctx |> Task.result! result = Context.getChar! ctx
when result is when result is
Ok (T val newCtx) -> Ok (val, newCtx) ->
execCtx = stepExecCtx! newCtx val execCtx = stepExecCtx!? newCtx val
Task.ok (Step execCtx) Ok (Step execCtx)
Err NoScope -> Err NoScope ->
Task.err NoScope Err NoScope
Err EndOfData -> Err EndOfData ->
# Computation complete for this scope. # Computation complete for this scope.
@ -145,30 +159,30 @@ interpretCtxLoop = \ctx ->
# If no scopes left, all execution complete. # If no scopes left, all execution complete.
if List.isEmpty dropCtx.scopes then if List.isEmpty dropCtx.scopes then
Task.ok (Done dropCtx) Ok (Done dropCtx)
else else
Task.ok (Step dropCtx) Ok (Step dropCtx)
InComment -> InComment ->
result = Context.getChar ctx |> Task.result! result = Context.getChar! ctx
when result is when result is
Ok (T val newCtx) -> Ok (val, newCtx) ->
if val == 0x7D then if val == 0x7D then
# `}` end of comment # `}` end of comment
Task.ok (Step { newCtx & state: Executing }) Ok (Step { newCtx & state: Executing })
else else
Task.ok (Step { newCtx & state: InComment }) Ok (Step { newCtx & state: InComment })
Err NoScope -> Err NoScope ->
Task.err NoScope Err NoScope
Err EndOfData -> Err EndOfData ->
Task.err UnexpectedEndOfData Err UnexpectedEndOfData
InNumber accum -> InNumber accum ->
result = Context.getChar ctx |> Task.result! result = Context.getChar! ctx
when result is when result is
Ok (T val newCtx) -> Ok (val, newCtx) ->
if isDigit val then if isDigit val then
# still in the number # still in the number
# i32 multiplication is kinda broken because it implicitly seems to want to upcast to i64. # i32 multiplication is kinda broken because it implicitly seems to want to upcast to i64.
@ -176,72 +190,72 @@ interpretCtxLoop = \ctx ->
# so this is make i64 mul by 10 then convert back to i32. # so this is make i64 mul by 10 then convert back to i32.
nextAccum = (10 * Num.intCast accum) + Num.intCast (val - 0x30) nextAccum = (10 * Num.intCast accum) + Num.intCast (val - 0x30)
Task.ok (Step { newCtx & state: InNumber (Num.intCast nextAccum) }) Ok (Step { newCtx & state: InNumber (Num.intCast nextAccum) })
else else
# outside of number now, this needs to be executed. # outside of number now, this needs to be executed.
pushCtx = Context.pushStack newCtx (Number accum) pushCtx = Context.pushStack newCtx (Number accum)
execCtx = stepExecCtx! { pushCtx & state: Executing } val execCtx = stepExecCtx!? { pushCtx & state: Executing } val
Task.ok (Step execCtx) Ok (Step execCtx)
Err NoScope -> Err NoScope ->
Task.err NoScope Err NoScope
Err EndOfData -> Err EndOfData ->
Task.err UnexpectedEndOfData Err UnexpectedEndOfData
InString bytes -> InString bytes ->
result = Context.getChar ctx |> Task.result! result = Context.getChar! ctx
when result is when result is
Ok (T val newCtx) -> Ok (val, newCtx) ->
if val == 0x22 then if val == 0x22 then
# `"` end of string # `"` end of string
when Str.fromUtf8 bytes is when Str.fromUtf8 bytes is
Ok str -> Ok str ->
Stdout.raw! str Stdout.raw! str
Task.ok (Step { newCtx & state: Executing }) Ok (Step { newCtx & state: Executing })
Err _ -> Err _ ->
Task.err BadUtf8 Err BadUtf8
else else
Task.ok (Step { newCtx & state: InString (List.append bytes val) }) Ok (Step { newCtx & state: InString (List.append bytes val) })
Err NoScope -> Err NoScope ->
Task.err NoScope Err NoScope
Err EndOfData -> Err EndOfData ->
Task.err UnexpectedEndOfData Err UnexpectedEndOfData
InLambda depth bytes -> InLambda depth bytes ->
result = Context.getChar ctx |> Task.result! result = Context.getChar! ctx
when result is when result is
Ok (T val newCtx) -> Ok (val, newCtx) ->
if val == 0x5B then if val == 0x5B then
# start of a nested lambda `[` # start of a nested lambda `[`
Task.ok (Step { newCtx & state: InLambda (depth + 1) (List.append bytes val) }) Ok (Step { newCtx & state: InLambda (depth + 1) (List.append bytes val) })
else if val == 0x5D then else if val == 0x5D then
# `]` end of current lambda # `]` end of current lambda
if depth == 0 then if depth == 0 then
# end of all lambdas # end of all lambdas
Task.ok (Step (Context.pushStack { newCtx & state: Executing } (Lambda bytes))) Ok (Step (Context.pushStack { newCtx & state: Executing } (Lambda bytes)))
else else
# end of nested lambda # end of nested lambda
Task.ok (Step { newCtx & state: InLambda (depth - 1) (List.append bytes val) }) Ok (Step { newCtx & state: InLambda (depth - 1) (List.append bytes val) })
else else
Task.ok (Step { newCtx & state: InLambda depth (List.append bytes val) }) Ok (Step { newCtx & state: InLambda depth (List.append bytes val) })
Err NoScope -> Err NoScope ->
Task.err NoScope Err NoScope
Err EndOfData -> Err EndOfData ->
Task.err UnexpectedEndOfData Err UnexpectedEndOfData
InSpecialChar -> InSpecialChar ->
result = Context.getChar { ctx & state: Executing } |> Task.result! result = Context.getChar! { ctx & state: Executing }
when result is when result is
Ok (T 0xB8 newCtx) -> Ok (0xB8, newCtx) ->
result2 = result2 =
(T popCtx index) = popNumber? newCtx (popCtx, index) = 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. # 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 size = List.len popCtx.stack - 1
offset = Num.intCast size - index offset = Num.intCast size - index
@ -253,66 +267,58 @@ interpretCtxLoop = \ctx ->
Err OutOfBounds Err OutOfBounds
when result2 is when result2 is
Ok a -> Task.ok (Step a) Ok a -> Ok (Step a)
Err e -> Task.err e Err e -> Err e
Ok (T 0x9F newCtx) -> Ok (0x9F, newCtx) ->
# This is supposed to flush io buffers. We don't buffer, so it does nothing # This is supposed to flush io buffers. We don't buffer, so it does nothing
Task.ok (Step newCtx) Ok (Step newCtx)
Ok (T x _) -> Ok (x, _) ->
data = Num.toStr (Num.intCast x) data = Num.toStr (Num.intCast x)
Task.err (InvalidChar data) Err (InvalidChar data)
Err NoScope -> Err NoScope ->
Task.err NoScope Err NoScope
Err EndOfData -> Err EndOfData ->
Task.err UnexpectedEndOfData Err UnexpectedEndOfData
LoadChar -> LoadChar ->
result = Context.getChar { ctx & state: Executing } |> Task.result! result = Context.getChar! { ctx & state: Executing }
when result is when result is
Ok (T x newCtx) -> Ok (x, newCtx) ->
Task.ok (Step (Context.pushStack newCtx (Number (Num.intCast x)))) Ok (Step (Context.pushStack newCtx (Number (Num.intCast x))))
Err NoScope -> Err NoScope ->
Task.err NoScope Err NoScope
Err EndOfData -> Err EndOfData ->
Task.err UnexpectedEndOfData Err UnexpectedEndOfData
# If it weren't for reading stdin or writing to stdout, this could return a result. # If it weren't for reading stdin or writing to stdout, this could return a result.
stepExecCtx : Context, U8 -> Task Context InterpreterErrors stepExecCtx! : Context, U8 => Result Context InterpreterErrors
stepExecCtx = \ctx, char -> stepExecCtx! = \ctx, char ->
when char is when char is
0x21 -> 0x21 ->
# `!` execute lambda # `!` execute lambda
Task.fromResult (popCtx, bytes) = popLambda? ctx
(
(T popCtx bytes) = popLambda? ctx
Ok { popCtx & scopes: List.append popCtx.scopes { data: None, buf: bytes, index: 0, whileInfo: None } } Ok { popCtx & scopes: List.append popCtx.scopes { data: None, buf: bytes, index: 0, whileInfo: None } }
)
0x3F -> 0x3F ->
# `?` if # `?` if
Task.fromResult (popCtx1, bytes) = popLambda? ctx
( (popCtx2, n1) = popNumber? popCtx1
(T popCtx1 bytes) = popLambda? ctx
(T popCtx2 n1) = popNumber? popCtx1
if n1 == 0 then if n1 == 0 then
Ok popCtx2 Ok popCtx2
else else
Ok { popCtx2 & scopes: List.append popCtx2.scopes { data: None, buf: bytes, index: 0, whileInfo: None } } Ok { popCtx2 & scopes: List.append popCtx2.scopes { data: None, buf: bytes, index: 0, whileInfo: None } }
)
0x23 -> 0x23 ->
# `#` while # `#` while
Task.fromResult (popCtx1, body) = popLambda? ctx
( (popCtx2, cond) = popLambda? popCtx1
(T popCtx1 body) = popLambda? ctx
(T popCtx2 cond) = popLambda? popCtx1
last = (List.len popCtx2.scopes - 1) last = (List.len popCtx2.scopes - 1)
when List.get popCtx2.scopes last is when List.get popCtx2.scopes last is
@ -325,65 +331,62 @@ stepExecCtx = \ctx, char ->
Err OutOfBounds -> Err OutOfBounds ->
Err NoScope Err NoScope
)
0x24 -> 0x24 ->
# `$` dup # `$` dup
# Switching this to List.last and changing the error to ListWasEmpty leads to a compiler bug. # Switching this to List.last and changing the error to ListWasEmpty leads to a compiler bug.
# Complains about the types eq not matching. # Complains about the types eq not matching.
when List.get ctx.stack (List.len ctx.stack - 1) is when List.get ctx.stack (List.len ctx.stack - 1) is
Ok dupItem -> Task.ok (Context.pushStack ctx dupItem) Ok dupItem -> Ok (Context.pushStack ctx dupItem)
Err OutOfBounds -> Task.err EmptyStack Err OutOfBounds -> Err EmptyStack
0x25 -> 0x25 ->
# `%` drop # `%` drop
when Context.popStack ctx is when Context.popStack ctx is
# Dropping with an empty stack, all results here are fine # Dropping with an empty stack, all results here are fine
Ok (T popCtx _) -> Task.ok popCtx Ok (popCtx, _) -> Ok popCtx
Err _ -> Task.ok ctx Err _ -> Ok ctx
0x5C -> 0x5C ->
# `\` swap # `\` swap
result2 = result2 =
(T popCtx1 n1) = Context.popStack? ctx (popCtx1, n1) = Context.popStack? ctx
(T popCtx2 n2) = Context.popStack? popCtx1 (popCtx2, n2) = Context.popStack? popCtx1
Ok (Context.pushStack (Context.pushStack popCtx2 n1) n2) Ok (Context.pushStack (Context.pushStack popCtx2 n1) n2)
when result2 is when result2 is
Ok a -> Ok a ->
Task.ok a Ok a
# Being explicit with error type is required to stop the need to propogate the error parameters to Context.popStack # Being explicit with error type is required to stop the need to propogate the error parameters to Context.popStack
Err EmptyStack -> Err EmptyStack ->
Task.err EmptyStack Err EmptyStack
0x40 -> 0x40 ->
# `@` rot # `@` rot
result2 = result2 =
(T popCtx1 n1) = Context.popStack? ctx (popCtx1, n1) = Context.popStack? ctx
(T popCtx2 n2) = Context.popStack? popCtx1 (popCtx2, n2) = Context.popStack? popCtx1
(T popCtx3 n3) = Context.popStack? popCtx2 (popCtx3, n3) = Context.popStack? popCtx2
Ok (Context.pushStack (Context.pushStack (Context.pushStack popCtx3 n2) n1) n3) Ok (Context.pushStack (Context.pushStack (Context.pushStack popCtx3 n2) n1) n3)
when result2 is when result2 is
Ok a -> Ok a ->
Task.ok a Ok a
# Being explicit with error type is required to stop the need to propogate the error parameters to Context.popStack # Being explicit with error type is required to stop the need to propogate the error parameters to Context.popStack
Err EmptyStack -> Err EmptyStack ->
Task.err EmptyStack Err EmptyStack
0xC3 -> 0xC3 ->
# `ø` pick or `ß` flush # `ø` pick or `ß` flush
# these are actually 2 bytes, 0xC3 0xB8 or 0xC3 0x9F # these are actually 2 bytes, 0xC3 0xB8 or 0xC3 0x9F
# requires special parsing # requires special parsing
Task.ok { ctx & state: InSpecialChar } Ok { ctx & state: InSpecialChar }
0x4F -> 0x4F ->
# `O` also treat this as pick for easier script writing # `O` also treat this as pick for easier script writing
Task.fromResult (popCtx, index) = popNumber? ctx
(
(T popCtx index) = 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. # 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 size = List.len popCtx.stack - 1
offset = Num.intCast size - index offset = Num.intCast size - index
@ -393,189 +396,173 @@ stepExecCtx = \ctx, char ->
Ok (Context.pushStack popCtx stackVal) Ok (Context.pushStack popCtx stackVal)
else else
Err OutOfBounds Err OutOfBounds
)
0x42 -> 0x42 ->
# `B` also treat this as flush for easier script writing # `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 # This is supposed to flush io buffers. We don't buffer, so it does nothing
Task.ok ctx Ok ctx
0x27 -> 0x27 ->
# `'` load next char # `'` load next char
Task.ok { ctx & state: LoadChar } Ok { ctx & state: LoadChar }
0x2B -> 0x2B ->
# `+` add # `+` add
Task.fromResult (binaryOp ctx Num.addWrap) binaryOp ctx Num.addWrap
0x2D -> 0x2D ->
# `-` sub # `-` sub
Task.fromResult (binaryOp ctx Num.subWrap) binaryOp ctx Num.subWrap
0x2A -> 0x2A ->
# `*` mul # `*` mul
Task.fromResult (binaryOp ctx Num.mulWrap) binaryOp ctx Num.mulWrap
0x2F -> 0x2F ->
# `/` div # `/` div
# Due to possible division by zero error, this must be handled specially. # Due to possible division by zero error, this must be handled specially.
Task.fromResult (popCtx1, numR) = popNumber? ctx
( (popCtx2, numL) = popNumber? popCtx1
(T popCtx1 numR) = popNumber? ctx
(T popCtx2 numL) = popNumber? popCtx1
res = Num.divTruncChecked? numL numR res = Num.divTruncChecked? numL numR
Ok (Context.pushStack popCtx2 (Number res)) Ok (Context.pushStack popCtx2 (Number res))
)
0x26 -> 0x26 ->
# `&` bitwise and # `&` bitwise and
Task.fromResult (binaryOp ctx Num.bitwiseAnd) binaryOp ctx Num.bitwiseAnd
0x7C -> 0x7C ->
# `|` bitwise or # `|` bitwise or
Task.fromResult (binaryOp ctx Num.bitwiseOr) binaryOp ctx Num.bitwiseOr
0x3D -> 0x3D ->
# `=` equals # `=` equals
Task.fromResult
(
binaryOp ctx \a, b -> binaryOp ctx \a, b ->
if a == b then if a == b then
-1 -1
else else
0 0
)
0x3E -> 0x3E ->
# `>` greater than # `>` greater than
Task.fromResult
(
binaryOp ctx \a, b -> binaryOp ctx \a, b ->
if a > b then if a > b then
-1 -1
else else
0 0
)
0x5F -> 0x5F ->
# `_` negate # `_` negate
Task.fromResult (unaryOp ctx Num.neg) unaryOp ctx Num.neg
0x7E -> 0x7E ->
# `~` bitwise not # `~` bitwise not
Task.fromResult (unaryOp ctx (\x -> Num.bitwiseXor x -1)) # xor with -1 should be bitwise not unaryOp ctx (\x -> Num.bitwiseXor x -1) # xor with -1 should be bitwise not
0x2C -> 0x2C ->
# `,` write char # `,` write char
when popNumber ctx is when popNumber ctx is
Ok (T popCtx num) -> Ok (popCtx, num) ->
when Str.fromUtf8 [Num.intCast num] is when Str.fromUtf8 [Num.intCast num] is
Ok str -> Ok str ->
Stdout.raw! str Stdout.raw! str
Task.ok popCtx Ok popCtx
Err _ -> Err _ ->
Task.err BadUtf8 Err BadUtf8
Err e -> Err e ->
Task.err e Err e
0x2E -> 0x2E ->
# `.` write int # `.` write int
when popNumber ctx is when popNumber ctx is
Ok (T popCtx num) -> Ok (popCtx, num) ->
Stdout.raw! (Num.toStr (Num.intCast num)) Stdout.raw! (Num.toStr (Num.intCast num))
Task.ok popCtx Ok popCtx
Err e -> Err e ->
Task.err e Err e
0x5E -> 0x5E ->
# `^` read char as int # `^` read char as int
in = Stdin.char! {} in = Stdin.char! {}
if in == 255 then if in == 255 then
# max char sent on EOF. Change to -1 # max char sent on EOF. Change to -1
Task.ok (Context.pushStack ctx (Number -1)) Ok (Context.pushStack ctx (Number -1))
else else
Task.ok (Context.pushStack ctx (Number (Num.intCast in))) Ok (Context.pushStack ctx (Number (Num.intCast in)))
0x3A -> 0x3A ->
# `:` store to variable # `:` store to variable
Task.fromResult (popCtx1, var) = popVariable? ctx
(
(T popCtx1 var) = popVariable? ctx
# The Result.mapErr on the next line maps from EmptyStack in Context.roc to the full InterpreterErrors union here. # The Result.mapErr on the next line maps from EmptyStack in Context.roc to the full InterpreterErrors union here.
(T popCtx2 n1) = Result.mapErr? (Context.popStack popCtx1) (\EmptyStack -> EmptyStack) (popCtx2, n1) = Result.mapErr? (Context.popStack popCtx1) (\EmptyStack -> EmptyStack)
Ok { popCtx2 & vars: List.set popCtx2.vars (Variable.toIndex var) n1 } Ok { popCtx2 & vars: List.set popCtx2.vars (Variable.toIndex var) n1 }
)
0x3B -> 0x3B ->
# `;` load from variable # `;` load from variable
Task.fromResult (popCtx, var) = popVariable? ctx
(
(T popCtx var) = popVariable? ctx
elem = List.get? popCtx.vars (Variable.toIndex var) elem = List.get? popCtx.vars (Variable.toIndex var)
Ok (Context.pushStack popCtx elem) Ok (Context.pushStack popCtx elem)
)
0x22 -> 0x22 ->
# `"` string start # `"` string start
Task.ok { ctx & state: InString [] } Ok { ctx & state: InString [] }
0x5B -> 0x5B ->
# `"` string start # `"` string start
Task.ok { ctx & state: InLambda 0 [] } Ok { ctx & state: InLambda 0 [] }
0x7B -> 0x7B ->
# `{` comment start # `{` comment start
Task.ok { ctx & state: InComment } Ok { ctx & state: InComment }
x if isDigit x -> x if isDigit x ->
# number start # number start
Task.ok { ctx & state: InNumber (Num.intCast (x - 0x30)) } Ok { ctx & state: InNumber (Num.intCast (x - 0x30)) }
x if isWhitespace x -> x if isWhitespace x ->
Task.ok ctx Ok ctx
x -> x ->
when Variable.fromUtf8 x is when Variable.fromUtf8 x is
# letters are variable names # letters are variable names
Ok var -> Ok var ->
Task.ok (Context.pushStack ctx (Var var)) Ok (Context.pushStack ctx (Var var))
Err _ -> Err _ ->
data = Num.toStr (Num.intCast x) data = Num.toStr (Num.intCast x)
Task.err (InvalidChar data) Err (InvalidChar data)
unaryOp : Context, (I32 -> I32) -> Result Context InterpreterErrors unaryOp : Context, (I32 -> I32) -> Result Context InterpreterErrors
unaryOp = \ctx, op -> unaryOp = \ctx, op ->
(T popCtx num) = popNumber? ctx (popCtx, num) = popNumber? ctx
Ok (Context.pushStack popCtx (Number (op num))) Ok (Context.pushStack popCtx (Number (op num)))
binaryOp : Context, (I32, I32 -> I32) -> Result Context InterpreterErrors binaryOp : Context, (I32, I32 -> I32) -> Result Context InterpreterErrors
binaryOp = \ctx, op -> binaryOp = \ctx, op ->
(T popCtx1 numR) = popNumber? ctx (popCtx1, numR) = popNumber? ctx
(T popCtx2 numL) = popNumber? popCtx1 (popCtx2, numL) = popNumber? popCtx1
Ok (Context.pushStack popCtx2 (Number (op numL numR))) Ok (Context.pushStack popCtx2 (Number (op numL numR)))
popNumber : Context -> Result [T Context I32] InterpreterErrors popNumber : Context -> Result (Context, I32) InterpreterErrors
popNumber = \ctx -> popNumber = \ctx ->
when Context.popStack ctx is when Context.popStack ctx is
Ok (T popCtx (Number num)) -> Ok (T popCtx num) Ok (popCtx, Number num) -> Ok (popCtx, num)
Ok _ -> Err (NoNumberOnStack) Ok _ -> Err (NoNumberOnStack)
Err EmptyStack -> Err EmptyStack Err EmptyStack -> Err EmptyStack
popLambda : Context -> Result [T Context (List U8)] InterpreterErrors popLambda : Context -> Result (Context, List U8) InterpreterErrors
popLambda = \ctx -> popLambda = \ctx ->
when Context.popStack ctx is when Context.popStack ctx is
Ok (T popCtx (Lambda bytes)) -> Ok (T popCtx bytes) Ok (popCtx, Lambda bytes) -> Ok (popCtx, bytes)
Ok _ -> Err NoLambdaOnStack Ok _ -> Err NoLambdaOnStack
Err EmptyStack -> Err EmptyStack Err EmptyStack -> Err EmptyStack
popVariable : Context -> Result [T Context Variable] InterpreterErrors popVariable : Context -> Result (Context, Variable) InterpreterErrors
popVariable = \ctx -> popVariable = \ctx ->
when Context.popStack ctx is when Context.popStack ctx is
Ok (T popCtx (Var var)) -> Ok (T popCtx var) Ok (popCtx, Var var) -> Ok (popCtx, var)
Ok _ -> Err NoVariableOnStack Ok _ -> Err NoVariableOnStack
Err EmptyStack -> Err EmptyStack Err EmptyStack -> Err EmptyStack

View file

@ -1,34 +1,30 @@
module [line, withOpen, chunk, Handle] module [line!, withOpen!, chunk!, Handle]
import pf.PlatformTasks import pf.Host
Handle := U64 Handle := U64
line : Handle -> Task Str * line! : Handle => Str
line = \@Handle handle -> line! = \@Handle handle ->
PlatformTasks.getFileLine handle Host.getFileLine! handle
|> Task.mapErr \_ -> crash "unreachable File.line"
chunk : Handle -> Task (List U8) * chunk! : Handle => List U8
chunk = \@Handle handle -> chunk! = \@Handle handle ->
PlatformTasks.getFileBytes handle Host.getFileBytes! handle
|> Task.mapErr \_ -> crash "unreachable File.chunk"
open : Str -> Task Handle * open! : Str => Handle
open = \path -> open! = \path ->
PlatformTasks.openFile path Host.openFile! path
|> Task.mapErr \_ -> crash "unreachable File.open" |> @Handle
|> Task.map @Handle
close : Handle -> Task.Task {} * close! : Handle => {}
close = \@Handle handle -> close! = \@Handle handle ->
PlatformTasks.closeFile handle Host.closeFile! handle
|> Task.mapErr \_ -> crash "unreachable File.close"
withOpen : Str, (Handle -> Task {} a) -> Task {} a withOpen! : Str, (Handle => a) => a
withOpen = \path, callback -> withOpen! = \path, callback! ->
handle = open! path handle = open! path
result = callback handle |> Task.result! result = callback! handle
close! handle close! handle
Task.fromResult result result

View file

@ -0,0 +1,19 @@
hosted Host
exposes [openFile!, closeFile!, getFileLine!, getFileBytes!, putLine!, putRaw!, getLine!, getChar!]
imports []
openFile! : Str => U64
closeFile! : U64 => {}
getFileLine! : U64 => Str
getFileBytes! : U64 => List U8
putLine! : Str => {}
putRaw! : Str => {}
getLine! : {} => Str
getChar! : {} => U8

View file

@ -1,21 +0,0 @@
hosted PlatformTasks
exposes [openFile, closeFile, withFileOpen, getFileLine, getFileBytes, putLine, putRaw, getLine, getChar]
imports []
openFile : Str -> Task U64 {}
closeFile : U64 -> Task {} {}
withFileOpen : Str, (U64 -> Task ok err) -> Task {} {}
getFileLine : U64 -> Task Str {}
getFileBytes : U64 -> Task (List U8) {}
putLine : Str -> Task {} {}
putRaw : Str -> Task {} {}
getLine : Task Str {}
getChar : Task U8 {}

View file

@ -1,16 +1,11 @@
module [ module [line!, char!]
line,
char,
]
import pf.PlatformTasks import pf.Host
line : {} -> Task Str * line! : {} => Str
line = \{} -> line! = \{} ->
PlatformTasks.getLine Host.getLine! {}
|> Task.mapErr \_ -> crash "unreachable Stdin.line"
char : {} -> Task U8 * char! : {} => U8
char = \{} -> char! = \{} ->
PlatformTasks.getChar Host.getChar! {}
|> Task.mapErr \_ -> crash "unreachable Stdin.char"

View file

@ -1,13 +1,11 @@
module [line, raw] module [line!, raw!]
import pf.PlatformTasks import pf.Host
line : Str -> Task {} * line! : Str => {}
line = \text -> line! = \text ->
PlatformTasks.putLine text Host.putLine! text
|> Task.mapErr \_ -> crash "unreachable Stdout.line"
raw : Str -> Task {} * raw! : Str => {}
raw = \text -> raw! = \text ->
PlatformTasks.putRaw text Host.putRaw! text
|> Task.mapErr \_ -> crash "unreachable Stdout.raw"

View file

@ -1,9 +1,9 @@
platform "false-interpreter" platform "false-interpreter"
requires {} { main : Str -> Task {} [] } requires {} { main! : Str => {} }
exposes [] exposes []
packages {} packages {}
imports [] imports []
provides [mainForHost] provides [mainForHost!]
mainForHost : Str -> Task {} [] mainForHost! : Str => {}
mainForHost = \file -> main file mainForHost! = \file -> main! file

View file

@ -20,20 +20,8 @@ fn file_handles() -> &'static Mutex<HashMap<u64, BufReader<File>>> {
} }
extern "C" { extern "C" {
#[link_name = "roc__mainForHost_1_exposed_generic"] #[link_name = "roc__mainForHost_1_exposed"]
fn roc_main(output: *mut u8, args: &RocStr); fn roc_main(args: &RocStr);
#[link_name = "roc__mainForHost_1_exposed_size"]
fn roc_main_size() -> i64;
#[link_name = "roc__mainForHost_0_caller"]
fn call_Fx(flags: *const u8, closure_data: *const u8, output: *mut u8);
#[link_name = "roc__mainForHost_0_size"]
fn size_Fx() -> i64;
#[link_name = "roc__mainForHost_0_result_size"]
fn size_Fx_result() -> i64;
} }
#[no_mangle] #[no_mangle]
@ -116,86 +104,51 @@ pub extern "C" fn rust_main() -> i32 {
.expect("Please pass a .false file as a command-line argument to the false interpreter!"); .expect("Please pass a .false file as a command-line argument to the false interpreter!");
let arg = RocStr::from(arg.as_str()); let arg = RocStr::from(arg.as_str());
let size = unsafe { roc_main_size() } as usize; roc_main(&arg);
unsafe {
let buffer = roc_alloc(size, 1) as *mut u8;
roc_main(buffer, &arg);
// arg has been passed to roc now, and it assumes ownership.
// so we must not touch its refcount now
std::mem::forget(arg);
let result = call_the_closure(buffer);
roc_dealloc(buffer as _, 1);
result
};
// Exit code // Exit code
0 0
} }
unsafe fn call_the_closure(closure_data_ptr: *const u8) -> i64 {
let size = size_Fx_result() as usize;
let buffer = roc_alloc(size, 1) as *mut u8;
call_Fx(
// This flags pointer will never get dereferenced
MaybeUninit::uninit().as_ptr(),
closure_data_ptr as *const u8,
buffer as *mut u8,
);
roc_dealloc(buffer as _, 1);
0
}
#[no_mangle] #[no_mangle]
pub extern "C" fn roc_fx_getLine() -> RocResult<RocStr, ()> { pub extern "C" fn roc_fx_getLine() -> RocStr {
let stdin = std::io::stdin(); let stdin = std::io::stdin();
let line1 = stdin.lock().lines().next().unwrap().unwrap(); let line1 = stdin.lock().lines().next().unwrap().unwrap();
RocResult::ok(RocStr::from(line1.as_str())) RocStr::from(line1.as_str())
} }
#[no_mangle] #[no_mangle]
pub extern "C" fn roc_fx_getChar() -> RocResult<u8, ()> { pub extern "C" fn roc_fx_getChar() -> u8 {
let mut buffer = [0]; let mut buffer = [0];
if let Err(ioerr) = std::io::stdin().lock().read_exact(&mut buffer[..]) { if let Err(ioerr) = std::io::stdin().lock().read_exact(&mut buffer[..]) {
if ioerr.kind() == std::io::ErrorKind::UnexpectedEof { if ioerr.kind() == std::io::ErrorKind::UnexpectedEof {
RocResult::ok(u8::MAX) u8::MAX
} else { } else {
panic!("Got an unexpected error while reading char from stdin"); panic!("Got an unexpected error while reading char from stdin");
} }
} else { } else {
RocResult::ok(buffer[0]) buffer[0]
} }
} }
#[no_mangle] #[no_mangle]
pub extern "C" fn roc_fx_putLine(line: &RocStr) -> RocResult<(), ()> { pub extern "C" fn roc_fx_putLine(line: &RocStr) {
let string = line.as_str(); let string = line.as_str();
println!("{}", string); println!("{}", string);
let _ = std::io::stdout().lock().flush(); let _ = std::io::stdout().lock().flush();
RocResult::ok(())
} }
#[no_mangle] #[no_mangle]
pub extern "C" fn roc_fx_putRaw(line: &RocStr) -> RocResult<(), ()> { pub extern "C" fn roc_fx_putRaw(line: &RocStr) {
let string = line.as_str(); let string = line.as_str();
print!("{}", string); print!("{}", string);
let _ = std::io::stdout().lock().flush(); let _ = std::io::stdout().lock().flush();
RocResult::ok(())
} }
#[no_mangle] #[no_mangle]
pub extern "C" fn roc_fx_getFileLine(br_id: u64) -> RocResult<RocStr, ()> { pub extern "C" fn roc_fx_getFileLine(br_id: u64) -> RocStr {
let mut br_map = file_handles().lock().unwrap(); let mut br_map = file_handles().lock().unwrap();
let br = br_map.get_mut(&br_id).unwrap(); let br = br_map.get_mut(&br_id).unwrap();
let mut line1 = String::default(); let mut line1 = String::default();
@ -203,11 +156,11 @@ pub extern "C" fn roc_fx_getFileLine(br_id: u64) -> RocResult<RocStr, ()> {
br.read_line(&mut line1) br.read_line(&mut line1)
.expect("Failed to read line from file"); .expect("Failed to read line from file");
RocResult::ok(RocStr::from(line1.as_str())) RocStr::from(line1.as_str())
} }
#[no_mangle] #[no_mangle]
pub extern "C" fn roc_fx_getFileBytes(br_id: u64) -> RocResult<RocList<u8>, ()> { pub extern "C" fn roc_fx_getFileBytes(br_id: u64) -> RocList<u8> {
let mut br_map = file_handles().lock().unwrap(); let mut br_map = file_handles().lock().unwrap();
let br = br_map.get_mut(&br_id).unwrap(); let br = br_map.get_mut(&br_id).unwrap();
let mut buffer = [0; 0x10 /* This is intentionally small to ensure correct implementation */]; let mut buffer = [0; 0x10 /* This is intentionally small to ensure correct implementation */];
@ -216,18 +169,16 @@ pub extern "C" fn roc_fx_getFileBytes(br_id: u64) -> RocResult<RocList<u8>, ()>
.read(&mut buffer[..]) .read(&mut buffer[..])
.expect("Failed to read bytes from file"); .expect("Failed to read bytes from file");
RocResult::ok(RocList::from_slice(&buffer[..count])) RocList::from_slice(&buffer[..count])
} }
#[no_mangle] #[no_mangle]
pub extern "C" fn roc_fx_closeFile(br_id: u64) -> RocResult<(), ()> { pub extern "C" fn roc_fx_closeFile(br_id: u64) {
file_handles().lock().unwrap().remove(&br_id); file_handles().lock().unwrap().remove(&br_id);
RocResult::ok(())
} }
#[no_mangle] #[no_mangle]
pub extern "C" fn roc_fx_openFile(name: &RocStr) -> RocResult<u64, ()> { pub extern "C" fn roc_fx_openFile(name: &RocStr) -> u64 {
let string = name.as_str(); let string = name.as_str();
match File::open(string) { match File::open(string) {
Ok(f) => { Ok(f) => {
@ -236,7 +187,7 @@ pub extern "C" fn roc_fx_openFile(name: &RocStr) -> RocResult<u64, ()> {
file_handles().lock().unwrap().insert(br_id, br); file_handles().lock().unwrap().insert(br_id, br);
RocResult::ok(br_id) br_id
} }
Err(_) => { Err(_) => {
panic!( panic!(
@ -246,17 +197,3 @@ pub extern "C" fn roc_fx_openFile(name: &RocStr) -> RocResult<u64, ()> {
} }
} }
} }
#[no_mangle]
pub extern "C" fn roc_fx_withFileOpen(_name: &RocStr, _buffer: *const u8) -> RocResult<(), ()> {
// TODO: figure out accepting a closure in an fx and passing data to it.
// let f = File::open(name.as_str()).expect("Unable to open file");
// let mut br = BufReader::new(f);
// unsafe {
// let closure_data_ptr = buffer.offset(8);
// call_the_closure(closure_data_ptr);
// }
RocResult::ok(())
}