diff --git a/examples/false-interpreter/.gitignore b/examples/false-interpreter/.gitignore new file mode 100644 index 0000000000..c508d5366f --- /dev/null +++ b/examples/false-interpreter/.gitignore @@ -0,0 +1 @@ +false diff --git a/examples/false-interpreter/Context.roc b/examples/false-interpreter/Context.roc new file mode 100644 index 0000000000..2ee7f94da5 --- /dev/null +++ b/examples/false-interpreter/Context.roc @@ -0,0 +1,69 @@ +interface Context + exposes [ Context, Data, with, getChar, Option, consumeChar, pushStack, popStack, toStr ] + imports [ base.File, base.Task.{ Task }, Variable.{ Variable } ] + +Option a : [ Some a, None ] + +# The underlying context of the current location within the file + +# I want to change Number to I32, but now that everything is built out, I run into errors when doing so. +Data : [ Lambda (List U8), Number I64, Var Variable ] +Context : { data: Option File.Handle, index: Nat, buf: List U8, stack: List Data, vars: List Data } + +pushStack: Context, Data -> Context +pushStack = \ctx, data -> + {ctx & stack: List.append ctx.stack data} + +# The compiler fails to type check if I uncomment this. +#popStack: Context -> Result [T Context Data] [EmptyStack]* +popStack = \ctx -> + when List.last ctx.stack is + Ok val -> + # This is terrible, but is the simplest way to drop the last element that I can think of. + # Long term it looks like there is a List.dropLast builtin. + poppedCtx = { ctx & stack: List.reverse (List.drop (List.reverse ctx.stack) 1)} + Ok (T poppedCtx val) + Err ListWasEmpty -> + Err EmptyStack + +toStrData: Data -> Str +toStrData = \data -> + when data is + Lambda _ -> "[]" + Number n -> Str.fromInt n + Var v -> Variable.toStr v + +toStr: Context -> Str +toStr = \{stack, vars} -> + stackStr = Str.joinWith (List.map stack toStrData) " " + varsStr = Str.joinWith (List.map vars toStrData) " " + "\n============\nStack: [\(stackStr)]\nVars: [\(varsStr)]\n============\n" + +# The compiler fails to type check if I uncomment this. +# with : Str, (Context -> Task {} *) -> Task {} * +with = \path, callback -> + handle <- Task.await (File.open path) + {} <- Task.await (callback { data: Some handle, index: 0, buf: [], stack: [], vars: (List.repeat Variable.totalCount (Number 0)) }) + File.close handle + +# 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 ]* +getChar = \ctx -> + when List.get ctx.buf ctx.index is + Ok val -> Task.succeed (T val ctx) + Err OutOfBounds -> + when ctx.data is + Some h -> + chunk <- Task.await (File.chunk h) + bytes = Str.toUtf8 chunk + when List.first bytes is + Ok val -> + Task.succeed (T val {ctx & buf: bytes, index: 0 }) + Err ListWasEmpty -> + Task.fail EndOfData + None -> + Task.fail EndOfData + +consumeChar: Context -> Context +consumeChar = \ctx -> + { ctx & index: ctx.index + 1 } \ No newline at end of file diff --git a/examples/false-interpreter/False.roc b/examples/false-interpreter/False.roc new file mode 100644 index 0000000000..8a660838d1 --- /dev/null +++ b/examples/false-interpreter/False.roc @@ -0,0 +1,443 @@ +#!/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. + +main : List Str -> Task {} * +main = \filenames -> + filenames + |> List.walk (\filename, task -> Task.await task (\_ -> (interpretFile filename))) (Task.succeed {}) + |> Task.await (\_ -> Stdout.line "Completed all tasks successfully") + |> Task.onFail (\StringErr e -> Stdout.line "Ran into problem:\n\(e)\n") + + +interpretFile : Str -> Task {} [ StringErr Str ]* +interpretFile = \filename -> + {} <- Task.await (Stdout.line "\nInterpreting file: \(filename)\n") + ctx <- Context.with filename + result <- Task.attempt (interpretContext ctx) + when result is + Ok _ -> + Stdout.line "\n\nDone\n" + 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 NoLambdaOnStack -> + Task.fail (StringErr "Tried to run a lambda when no lambda was on the stack") + Err (NoNumberOnStack alt) -> + when alt is + Lambda _ -> + Task.fail (StringErr "Tried to load a number when no number was on the stack instead got a lambda") + Var _ -> + Task.fail (StringErr "Tried to load a number when no number was on the stack instead got a variable") + Number _ -> + Task.fail (StringErr "Tried to load a number when no number was on the stack instead got a ?number?") + Err NoVariableOnStack -> + Task.fail (StringErr "Tried to load a variable when no variable was on the stack") + 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 + +interpretContext : Context -> Task Context [ BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, NoLambdaOnStack, NoNumberOnStack Context.Data, NoVariableOnStack, OutOfBounds, UnexpectedEndOfData ]* +interpretContext = \ctx -> + # If I move this definition below interpretContext it breaks. + runLambda = \baseCtx, bytes -> + lambdaCtx = {baseCtx & data: None, index: 0, buf: bytes} + afterLambdaCtx <- Task.await (interpretContext lambdaCtx) + # Merge lambda changes back into ctx. + Task.succeed {baseCtx & stack: afterLambdaCtx.stack, vars: afterLambdaCtx.vars} + + runWhile = \baseCtx, cond, body -> + afterCondCtx <- Task.await (runLambda baseCtx cond) + when popNumber afterCondCtx is + Ok (T popCtx 0) -> + Task.succeed popCtx + Ok (T popCtx _) -> + afterBodyCtx <- Task.await (runLambda popCtx body) + runWhile afterBodyCtx cond body + Err e -> Task.fail e + + result <- Task.attempt (Context.getChar ctx) + #{} <- Task.await (Stdout.raw (Context.toStr ctx)) + when result is + Ok (T val newCtx) -> + when val is + 0x21 -> # `!` execute lambda + # I couldn't seem to move this into it's own function otherwise the compiler would get angry. + when popLambda (Context.consumeChar newCtx) is + Ok (T popCtx bytes) -> + afterLambdaCtx <- Task.await (runLambda popCtx bytes) + interpretContext afterLambdaCtx + Err e -> + Task.fail e + 0x3F -> # `?` if + result2 = + (T popCtx1 bytes) <- Result.after (popLambda (Context.consumeChar newCtx)) + (T popCtx2 n1) <- Result.after (popNumber popCtx1) + Ok (T3 popCtx2 n1 bytes) + when result2 is + Ok (T3 popCtx2 0 _) -> interpretContext popCtx2 + Ok (T3 popCtx2 _ bytes) -> + afterLambdaCtx <- Task.await (runLambda popCtx2 bytes) + interpretContext afterLambdaCtx + Err e -> Task.fail e + 0x23 -> # `#` while + result2 = + (T popCtx1 body) <- Result.after (popLambda (Context.consumeChar newCtx)) + (T popCtx2 cond) <- Result.after (popLambda popCtx1) + Ok (T3 popCtx2 cond body) + when result2 is + Ok (T3 popCtx2 cond body) -> + afterWhileCtx <- Task.await (runWhile popCtx2 cond body) + interpretContext afterWhileCtx + Err e -> Task.fail e + 0x24 -> # `$` dup + when List.last newCtx.stack is + Ok dupItem -> + interpretContext (Context.pushStack (Context.consumeChar newCtx) dupItem) + _ -> + Task.fail EmptyStack + 0x25 -> # `%` drop + consumeCtx = (Context.consumeChar newCtx) + when Context.popStack consumeCtx is + # Dropping with an empyt stack, all results here are fine + Ok (T popCtx _) -> + interpretContext popCtx + Err _ -> + interpretContext consumeCtx + 0x5C -> # `\` swap + result2 = + (T popCtx1 n1) <- Result.after (Context.popStack (Context.consumeChar newCtx)) + (T popCtx2 n2) <- Result.after (Context.popStack popCtx1) + Ok (Context.pushStack (Context.pushStack popCtx2 n1) n2) + when result2 is + Ok a -> interpretContext 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 (Context.consumeChar newCtx)) + (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 -> interpretContext 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 + # this is actually 2 bytes, 0xC3 0xB8 + result2 <- Task.attempt (Context.getChar (Context.consumeChar newCtx)) + when result2 is + Ok (T 0xB8 newCtx2) -> + result3 = + (T popCtx index) <- Result.after (popNumber (Context.consumeChar newCtx2)) + # 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 result3 is + Ok a -> interpretContext a + Err e -> Task.fail e + Ok (T x _) -> + data = Str.fromInt (Num.intCast x) + Task.fail (InvalidChar data) + Err EndOfData -> + Task.fail UnexpectedEndOfData + 0x4F -> # `O` also treat this as pick for easier script writing + result2 = + (T popCtx index) <- Result.after (popNumber (Context.consumeChar 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 -> interpretContext a + Err e -> Task.fail e + 0x27 -> # `'` load next char + result2 <- Task.attempt (Context.getChar (Context.consumeChar newCtx)) + when result2 is + Ok (T x newCtx2) -> + interpretContext (Context.pushStack (Context.consumeChar newCtx2) (Number (Num.intCast x))) + Err EndOfData -> + Task.fail UnexpectedEndOfData + 0x2B -> # `+` add + afterOpCtx <- Task.await (binaryOp (Context.consumeChar newCtx) Num.addWrap) + interpretContext afterOpCtx + 0x2D -> # `-` sub + afterOpCtx <- Task.await (binaryOp (Context.consumeChar newCtx) Num.subWrap) + interpretContext afterOpCtx + 0x2A -> # `*` mul + afterOpCtx <- Task.await (binaryOp (Context.consumeChar newCtx) Num.mulWrap) + interpretContext afterOpCtx + 0x2F -> # `/` div + # Due to possible division by zero error, this must be handled specially. + divResult = + (T popCtx1 numR) <- Result.after (popNumber (Context.consumeChar newCtx)) + (T popCtx2 numL) <- Result.after (popNumber popCtx1) + res <- Result.after (Num.divFloor numL numR) + Ok (Context.pushStack popCtx2 (Number res)) + when divResult is + Ok resCtx -> + interpretContext resCtx + Err e -> + Task.fail e + 0x26 -> # `&` bitwise and + afterOpCtx <- Task.await (binaryOp (Context.consumeChar newCtx) Num.bitwiseAnd) + interpretContext afterOpCtx + 0x7C -> # `|` bitwise or + afterOpCtx <- Task.await (binaryOp (Context.consumeChar newCtx) Num.bitwiseOr) + interpretContext afterOpCtx + 0x3D -> # `=` equals + afterOpCtx <- Task.await (binaryOp (Context.consumeChar newCtx) (\a, b -> + if a == b then + -1 + else + 0 + )) + interpretContext afterOpCtx + 0x3E -> # `>` greater than + afterOpCtx <- Task.await (binaryOp (Context.consumeChar newCtx) (\a, b -> + if a > b then + -1 + else + 0 + )) + interpretContext afterOpCtx + 0x5F -> # `_` negate + afterOpCtx <- Task.await (unaryOp (Context.consumeChar newCtx) Num.neg) + interpretContext afterOpCtx + 0x7E -> # `~` bitwise not + afterOpCtx <- Task.await (unaryOp (Context.consumeChar newCtx) (\x -> Num.bitwiseXor x -1)) # xor with -1 should be bitwise not + interpretContext afterOpCtx + 0x2C -> # `,` write char + when popNumber (Context.consumeChar newCtx) is + Ok (T popCtx num) -> + when Str.fromUtf8 [Num.intCast num] is + Ok str -> + {} <- Task.await (Stdout.raw str) + interpretContext popCtx + Err _ -> + Task.fail BadUtf8 + Err e -> + Task.fail e + 0x2E -> # `.` write int + when popNumber (Context.consumeChar newCtx) is + Ok (T popCtx num) -> + {} <- Task.await (Stdout.raw (Str.fromInt num)) + interpretContext popCtx + Err e -> + Task.fail e + 0x5E -> # `^` read char as int + char <- Task.await Stdin.char + interpretContext (Context.pushStack (Context.consumeChar newCtx) (Number (Num.intCast char))) + 0x3A -> # `:` store to variable + result2 = + (T popCtx1 var) <- Result.after (popVariable (Context.consumeChar newCtx)) + (T popCtx2 n1) <- Result.after (Context.popStack popCtx1) + Ok {popCtx2 & vars: List.set popCtx2.vars (Variable.toIndex var) n1} + when result2 is + Ok a -> interpretContext a + Err e -> Task.fail e + 0x3B -> # `;` load from variable + result2 = + (T popCtx var) <- Result.after (popVariable (Context.consumeChar newCtx)) + elem <- Result.after (List.get popCtx.vars (Variable.toIndex var)) + Ok (Context.pushStack popCtx elem) + when result2 is + Ok a -> interpretContext a + Err e -> Task.fail e + 0x22 -> # `"` string start + afterStringCtx <- Task.await (printString (Context.consumeChar newCtx)) + interpretContext afterStringCtx + 0x5B -> # `[` lambda start + afterLambdaCtx <- Task.await (pushLambda (Context.consumeChar newCtx)) + interpretContext afterLambdaCtx + 0x7B -> # `{` comment start + afterCommentCtx <- Task.await (consumeComment (Context.consumeChar newCtx)) + interpretContext afterCommentCtx + 0xE1 -> # `ß` flush + # This is supposed to flush io buffers. We don't buffer, so it does nothing + interpretContext (Context.consumeChar newCtx) + x if isDigit x -> # number start + afterNumberCtx <- Task.await (pushNumber newCtx) + interpretContext afterNumberCtx + x if isWhitespace x -> interpretContext (Context.consumeChar newCtx) + x -> + when (Variable.fromUtf8 x) is # letters are variable names + Ok var -> + interpretContext (Context.pushStack (Context.consumeChar newCtx) (Var var)) + Err _ -> + data = Str.fromInt (Num.intCast x) + Task.fail (InvalidChar data) + Err EndOfData -> + # Computation complete. + Task.succeed ctx + +unaryOp: Context, (I64 -> I64) -> Task Context [ BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, NoLambdaOnStack, NoNumberOnStack Context.Data, NoVariableOnStack, OutOfBounds, UnexpectedEndOfData ]* +unaryOp = \ctx, op -> + result = + (T popCtx num) <- Result.after (popNumber ctx) + Ok (Context.pushStack popCtx (Number (op num))) + when result is + Ok resCtx -> + Task.succeed resCtx + Err e -> + Task.fail e + +binaryOp: Context, (I64, I64 -> I64) -> Task Context [ BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, NoLambdaOnStack, NoNumberOnStack Context.Data, NoVariableOnStack, OutOfBounds, UnexpectedEndOfData ]* +binaryOp = \ctx, op -> + result = + (T popCtx1 numR) <- Result.after (popNumber ctx) + (T popCtx2 numL) <- Result.after (popNumber popCtx1) + Ok (Context.pushStack popCtx2 (Number (op numL numR))) + when result is + Ok resCtx -> + Task.succeed resCtx + Err e -> + Task.fail e + + +popNumber: Context -> Result [T Context I64] [ BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, NoLambdaOnStack, NoNumberOnStack Context.Data, NoVariableOnStack, OutOfBounds, UnexpectedEndOfData ]* +popNumber = \ctx -> + when Context.popStack ctx is + Ok (T popCtx (Number num)) -> + Ok (T popCtx num) + Ok (T _ alt) -> + Err (NoNumberOnStack alt) + Err EmptyStack -> + Err EmptyStack + +popLambda: Context -> Result [T Context (List U8)] [ BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, NoLambdaOnStack, NoNumberOnStack Context.Data, NoVariableOnStack, OutOfBounds, UnexpectedEndOfData ]* +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] [ BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, NoLambdaOnStack, NoNumberOnStack Context.Data, NoVariableOnStack, OutOfBounds, UnexpectedEndOfData ]* +popVariable = \ctx -> + when Context.popStack ctx is + Ok (T popCtx (Var var)) -> + Ok (T popCtx var) + Ok _ -> + Err NoVariableOnStack + Err EmptyStack -> + Err EmptyStack + +# This has to be a bit more complex than other options because they can be nested. +# Also, it puts the lambda on the stack +pushLambda: Context -> Task Context [ BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, NoLambdaOnStack, NoNumberOnStack Context.Data, NoVariableOnStack, OutOfBounds, UnexpectedEndOfData ]* +pushLambda = \ctx -> + (T newCtx bytes) <- Task.await (pushLambdaHelper ctx [] 0) + Task.succeed (Context.pushStack newCtx (Lambda bytes)) + +pushLambdaHelper: Context, List U8, U64 -> Task [ T Context (List U8) ] [ BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, NoLambdaOnStack, NoNumberOnStack Context.Data, NoVariableOnStack, OutOfBounds, UnexpectedEndOfData ]* +pushLambdaHelper = \ctx, base, depth -> + result <- Task.attempt (Context.getChar ctx) + when result is + Ok (T val newCtx) -> + if val == 0x5B then # start of a nested lambda `[` + pushLambdaHelper (Context.consumeChar newCtx) (List.append base val) (depth + 1) + else if val != 0x5D then # not lambda end `]` + pushLambdaHelper (Context.consumeChar newCtx) (List.append base val) depth + else if depth == 0 then + Task.succeed (T (Context.consumeChar newCtx) base) + else # Still need to finish nested lambda + pushLambdaHelper (Context.consumeChar newCtx) (List.append base val) (depth - 1) + Err EndOfData -> + Task.fail UnexpectedEndOfData + +pushNumber: Context -> Task Context [ BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, NoLambdaOnStack, NoNumberOnStack Context.Data, NoVariableOnStack, OutOfBounds, UnexpectedEndOfData ]* +pushNumber = \ctx -> + pushNumberHelper ctx 0 + +pushNumberHelper: Context, I64 -> Task Context [ BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, NoLambdaOnStack, NoNumberOnStack Context.Data, NoVariableOnStack, OutOfBounds, UnexpectedEndOfData ]* +pushNumberHelper = \ctx, accum -> + result <- Task.attempt (Context.getChar ctx) + when result is + Ok (T val newCtx) -> + if isDigit val then + pushNumberHelper (Context.consumeChar newCtx) (accum * 10 + (Num.intCast (val - 0x30))) + else + # Push the number onto the stack. + Task.succeed (Context.pushStack newCtx (Number accum)) + Err EndOfData -> + # Unlike many other cases, this is valid. + # Still push the number to the stack. + Task.succeed (Context.pushStack ctx (Number accum)) + + +# It seems that I need to specify all error types in every function for some reason. +# I feel like this should just need to say UnexpectedEndOfData. +printString : Context -> Task Context [ BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, NoLambdaOnStack, NoNumberOnStack Context.Data, NoVariableOnStack, OutOfBounds, UnexpectedEndOfData ]* +printString = \ctx -> + (T afterStringCtx bytes) <- Task.await (printStringHelper ctx []) + when Str.fromUtf8 bytes is + Ok str -> + {} <- Task.await (Stdout.raw str) + Task.succeed afterStringCtx + Err _ -> + Task.fail BadUtf8 + +printStringHelper : Context, List U8 -> Task [ T Context (List U8) ] [ BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, NoLambdaOnStack, NoNumberOnStack Context.Data, NoVariableOnStack, OutOfBounds, UnexpectedEndOfData ]* +printStringHelper = \ctx, base -> + result <- Task.attempt (Context.getChar ctx) + when result is + Ok (T val newCtx) -> + if val != 0x22 then # not string end `"` + printStringHelper (Context.consumeChar newCtx) (List.append base val) + else + Task.succeed (T (Context.consumeChar newCtx) base ) + Err EndOfData -> + Task.fail UnexpectedEndOfData + +consumeComment : Context -> Task Context [ BadUtf8, DivByZero, EmptyStack, InvalidBooleanValue, InvalidChar Str, NoLambdaOnStack, NoNumberOnStack Context.Data, NoVariableOnStack, OutOfBounds, UnexpectedEndOfData ]* +consumeComment = \ctx -> + result <- Task.attempt (Context.getChar ctx) + when result is + Ok (T val newCtx) -> + if val != 0x7D then # not comment end `}` + consumeComment (Context.consumeChar newCtx) + else + Task.succeed (Context.consumeChar newCtx) + Err EndOfData -> + Task.fail UnexpectedEndOfData diff --git a/examples/false-interpreter/Variable.roc b/examples/false-interpreter/Variable.roc new file mode 100644 index 0000000000..998a9dbca1 --- /dev/null +++ b/examples/false-interpreter/Variable.roc @@ -0,0 +1,34 @@ +interface Variable + exposes [ Variable, fromUtf8, toIndex, totalCount, toStr ] + imports [ ] + +# Variables in False can only be single letters. Thus, the valid variables are "a" to "z". +# This opaque type deals with ensure we always have valid variables. + +Variable : [ @Variable U8 ] + +totalCount: Nat +totalCount = + 0x7A # "z" + - 0x61 # "a" + + 1 + +toStr : Variable -> Str +toStr = \@Variable char -> + when Str.fromUtf8 [char] is + Ok str -> str + _ -> "_" + +fromUtf8 : U8 -> Result Variable [ InvalidVariableUtf8 ] +fromUtf8 = \char -> + if char >= 0x61 # "a" + && char <= 0x7A # "z" + then + Ok (@Variable char) + else + Err InvalidVariableUtf8 + +toIndex : Variable -> Nat +toIndex = \@Variable char -> + Num.intCast (char - 0x61) # "a" + # List.first (Str.toUtf8 "a") \ No newline at end of file diff --git a/examples/false-interpreter/examples/bottles.false b/examples/false-interpreter/examples/bottles.false new file mode 100644 index 0000000000..475f2cd4fb --- /dev/null +++ b/examples/false-interpreter/examples/bottles.false @@ -0,0 +1,5 @@ +{ False version of 99 Bottles by Marcus Comstedt (marcus@lysator.liu.se) } +[$0=["no more bottles"]?$1=["One bottle"]?$1>[$." bottles"]?%" of beer"]b: +100[$0>][$b;!" on the wall, "$b;!". +"1-"Take one down, pass it around, "$b;!" on the wall. +"]#% \ No newline at end of file diff --git a/examples/false-interpreter/examples/crc32.false b/examples/false-interpreter/examples/crc32.false new file mode 100644 index 0000000000..88949ca4df --- /dev/null +++ b/examples/false-interpreter/examples/crc32.false @@ -0,0 +1,9 @@ +{ This currently doesn't run cause the interpreter will stack overflow, even in optimized build} + +{ unix cksum, CRC32. -- Jonathan Neuschäfer } +[[$0>][\2*\1-]#%]l:[0\128[$0>][$2O&0>[$@\64/x;!@@$g;*@x;!@@]?2/]#%%]h: +[[$0>][\2/\1-]#%]r:[1O$8 28l;!1-&$@=~\24r;!\[128|]?x;!h;!\8l;!x;!]s:79764919g: +[q1_0[\1+\^$1_>]s;#%@%\$@[1O0>][1O255&s;!\8r;!\]#~n;!32,%.10,]m:[$2O&@@|~|~]x: +[$0\>\1O[$u;!]?\~[$.]?%]n:[h;y:[3+O]h:255[$0>][$y;!\1-]#m;!256[$0>][\%1-]#%]o: +[1000$$**0@[$$0\>\4O\>~|][2O-\1+\]#\.\[10/$0>][\$2O/$.2O*-\]#%%]u: {width: 78} +{ usage: run m for "main" or o for "optimized" (builds a lookup table) } o;! \ No newline at end of file diff --git a/examples/false-interpreter/examples/hello.false b/examples/false-interpreter/examples/hello.false new file mode 100644 index 0000000000..6676685732 --- /dev/null +++ b/examples/false-interpreter/examples/hello.false @@ -0,0 +1,11 @@ +{ This is a comment} + + + { White space doesn't matter} + + + +{ Strings in False just automatically print...So, "Hello, World!", I guess } +"Hello, World! +" +{ Note the new line created by the white space that matters in strings } diff --git a/examples/false-interpreter/examples/in.txt b/examples/false-interpreter/examples/in.txt new file mode 100644 index 0000000000..7898192261 --- /dev/null +++ b/examples/false-interpreter/examples/in.txt @@ -0,0 +1 @@ +a diff --git a/examples/false-interpreter/examples/odd_words.false b/examples/false-interpreter/examples/odd_words.false new file mode 100644 index 0000000000..0dc7b3847b --- /dev/null +++ b/examples/false-interpreter/examples/odd_words.false @@ -0,0 +1,10 @@ +{ + Dijkstra's odd words Problem + You'll need to enter a sentence in the Input box, ending with a period. Odd words are reversed. +} + +[[$' =][%^]#]b: +[$$'.=\' =|~]w: +[$'.=~[' ,]?]s: +[w;![^o;!\,]?]o: +^b;![$'.=~][w;[,^]#b;!s;!o;!b;!s;!]#, diff --git a/examples/false-interpreter/examples/primes.false b/examples/false-interpreter/examples/primes.false new file mode 100644 index 0000000000..dcfe3f4817 --- /dev/null +++ b/examples/false-interpreter/examples/primes.false @@ -0,0 +1,2 @@ +{This prints all of the primes from 1 to 99} +99 9[1-$][\$@$@$@$@\/*=[1-$$[%\1-$@]?0=[\$.' ,\]?]?]# diff --git a/examples/false-interpreter/examples/sqrt.false b/examples/false-interpreter/examples/sqrt.false new file mode 100644 index 0000000000..6f7b726757 --- /dev/null +++ b/examples/false-interpreter/examples/sqrt.false @@ -0,0 +1,3 @@ +{This will roughly calculate the sqrt of the number pushed here} +2000000 +[\$@$@\/+2/]r: [127r;!r;!r;!r;!r;!r;!r;!\%]s: s;!. diff --git a/examples/false-interpreter/platform/Cargo.lock b/examples/false-interpreter/platform/Cargo.lock new file mode 100644 index 0000000000..cfd1e1e09d --- /dev/null +++ b/examples/false-interpreter/platform/Cargo.lock @@ -0,0 +1,21 @@ +# This file is automatically @generated by Cargo. +# It is not intended for manual editing. +version = 3 + +[[package]] +name = "host" +version = "0.1.0" +dependencies = [ + "libc", + "roc_std", +] + +[[package]] +name = "libc" +version = "0.2.100" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a1fa8cddc8fbbee11227ef194b5317ed014b8acbf15139bd716a18ad3fe99ec5" + +[[package]] +name = "roc_std" +version = "0.1.0" diff --git a/examples/false-interpreter/platform/Cargo.toml b/examples/false-interpreter/platform/Cargo.toml new file mode 100644 index 0000000000..ad2bc7c449 --- /dev/null +++ b/examples/false-interpreter/platform/Cargo.toml @@ -0,0 +1,15 @@ +[package] +name = "host" +version = "0.1.0" +authors = ["The Roc Contributors"] +license = "UPL-1.0" +edition = "2018" + +[lib] +crate-type = ["staticlib"] + +[dependencies] +roc_std = { path = "../../../roc_std" } +libc = "0.2" + +[workspace] diff --git a/examples/false-interpreter/platform/File.roc b/examples/false-interpreter/platform/File.roc new file mode 100644 index 0000000000..129a4a93df --- /dev/null +++ b/examples/false-interpreter/platform/File.roc @@ -0,0 +1,27 @@ +interface File + exposes [ line, Handle, withOpen, open, close, chunk ] + imports [ fx.Effect, Task.{ Task } ] + +Handle: [ @Handle U64 ] + +line : Handle -> Task.Task Str * +line = \@Handle handle -> Effect.after (Effect.getFileLine handle) Task.succeed + +chunk : Handle -> Task.Task Str * +chunk = \@Handle handle -> Effect.after (Effect.getFileBytes handle) Task.succeed + +open : Str -> Task.Task Handle * +open = \path -> + Effect.openFile path + |> Effect.map (\id -> @Handle id) + |> Effect.after Task.succeed + +close : Handle -> Task.Task {} * +close = \@Handle handle -> Effect.after (Effect.closeFile handle) Task.succeed + +# The compiler fails to type check if I uncomment this. +# withOpen : Str, (Handle -> Task {} *) -> Task {} * +withOpen = \path, callback -> + handle <- Task.await (open path) + {} <- Task.await (callback handle) + close handle \ No newline at end of file diff --git a/examples/false-interpreter/platform/Package-Config.roc b/examples/false-interpreter/platform/Package-Config.roc new file mode 100644 index 0000000000..5ad50800f4 --- /dev/null +++ b/examples/false-interpreter/platform/Package-Config.roc @@ -0,0 +1,22 @@ +platform examples/cli + requires {}{ main : List Str -> Task {} [] } # TODO FIXME + exposes [] + packages {} + imports [ Task.{ Task } ] + provides [ mainForHost ] + effects fx.Effect + { + openFile : Str -> Effect U64, + closeFile : U64 -> Effect {}, + withFileOpen : Str, (U64 -> Effect (Result ok err)) -> Effect {}, + getFileLine : U64 -> Effect Str, + getFileBytes : U64 -> Effect Str, + putLine : Str -> Effect {}, + putRaw : Str -> Effect {}, + # Is there a limit to the number of effect, uncomment the next line and it crashes + #getLine : Effect Str, + getChar : Effect I8 + } + +mainForHost : List Str -> Task {} [] as Fx +mainForHost = \list -> main list diff --git a/examples/false-interpreter/platform/Stdin.roc b/examples/false-interpreter/platform/Stdin.roc new file mode 100644 index 0000000000..2f18817f08 --- /dev/null +++ b/examples/false-interpreter/platform/Stdin.roc @@ -0,0 +1,9 @@ +interface Stdin + exposes [ char ] + imports [ fx.Effect, Task ] + +#line : Task.Task Str * +#line = Effect.after Effect.getLine Task.succeed # TODO FIXME Effect.getLine should suffice + +char : Task.Task I8 * +char = Effect.after Effect.getChar Task.succeed # TODO FIXME Effect.getLine should suffice \ No newline at end of file diff --git a/examples/false-interpreter/platform/Stdout.roc b/examples/false-interpreter/platform/Stdout.roc new file mode 100644 index 0000000000..6acf849588 --- /dev/null +++ b/examples/false-interpreter/platform/Stdout.roc @@ -0,0 +1,9 @@ +interface Stdout + exposes [ line, raw ] + imports [ fx.Effect, Task.{ Task } ] + +line : Str -> Task {} * +line = \str -> Effect.map (Effect.putLine str) (\_ -> Ok {}) + +raw : Str -> Task {} * +raw = \str -> Effect.map (Effect.putRaw str) (\_ -> Ok {}) \ No newline at end of file diff --git a/examples/false-interpreter/platform/Task.roc b/examples/false-interpreter/platform/Task.roc new file mode 100644 index 0000000000..d3f996bc8a --- /dev/null +++ b/examples/false-interpreter/platform/Task.roc @@ -0,0 +1,44 @@ +interface Task + exposes [ Task, succeed, fail, await, map, onFail, attempt ] + imports [ fx.Effect ] + + +Task ok err : Effect.Effect (Result ok err) + + +succeed : val -> Task val * +succeed = \val -> + Effect.always (Ok val) + + +fail : err -> Task * err +fail = \val -> + Effect.always (Err val) + +attempt : Task a b, (Result a b -> Task c d) -> Task c d +attempt = \effect, transform -> + Effect.after effect \result -> + when result is + Ok ok -> transform (Ok ok) + Err err -> transform (Err err) + +await : Task a err, (a -> Task b err) -> Task b err +await = \effect, transform -> + Effect.after effect \result -> + when result is + Ok a -> transform a + Err err -> Task.fail err + +onFail : Task ok a, (a -> Task ok b) -> Task ok b +onFail = \effect, transform -> + Effect.after effect \result -> + when result is + Ok a -> Task.succeed a + Err err -> transform err + +map : Task a err, (a -> b) -> Task b err +map = \effect, transform -> + Effect.after effect \result -> + when result is + Ok a -> Task.succeed (transform a) + Err err -> Task.fail err diff --git a/examples/false-interpreter/platform/host.c b/examples/false-interpreter/platform/host.c new file mode 100644 index 0000000000..0378c69589 --- /dev/null +++ b/examples/false-interpreter/platform/host.c @@ -0,0 +1,7 @@ +#include + +extern int rust_main(); + +int main() { + return rust_main(); +} diff --git a/examples/false-interpreter/platform/src/lib.rs b/examples/false-interpreter/platform/src/lib.rs new file mode 100644 index 0000000000..fc4d1f2635 --- /dev/null +++ b/examples/false-interpreter/platform/src/lib.rs @@ -0,0 +1,214 @@ +#![allow(non_snake_case)] + +use core::alloc::Layout; +use core::ffi::c_void; +use core::mem::MaybeUninit; +use libc; +use roc_std::{RocList, RocStr}; +use std::env; +use std::ffi::CStr; +use std::fs::File; +use std::io::{BufRead, BufReader, Read, Write}; +use std::os::raw::c_char; + +extern "C" { + #[link_name = "roc__mainForHost_1_exposed"] + fn roc_main(args: RocList, output: *mut u8) -> (); + + #[link_name = "roc__mainForHost_size"] + fn roc_main_size() -> i64; + + #[link_name = "roc__mainForHost_1_Fx_caller"] + fn call_Fx(flags: *const u8, closure_data: *const u8, output: *mut u8) -> (); + + #[allow(dead_code)] + #[link_name = "roc__mainForHost_1_Fx_size"] + fn size_Fx() -> i64; + + #[link_name = "roc__mainForHost_1_Fx_result_size"] + fn size_Fx_result() -> i64; +} + +#[no_mangle] +pub unsafe fn roc_alloc(size: usize, _alignment: u32) -> *mut c_void { + libc::malloc(size) +} + +#[no_mangle] +pub unsafe fn roc_realloc( + c_ptr: *mut c_void, + new_size: usize, + _old_size: usize, + _alignment: u32, +) -> *mut c_void { + libc::realloc(c_ptr, new_size) +} + +#[no_mangle] +pub unsafe fn roc_dealloc(c_ptr: *mut c_void, _alignment: u32) { + libc::free(c_ptr) +} + +#[no_mangle] +pub unsafe fn roc_panic(c_ptr: *mut c_void, tag_id: u32) { + match tag_id { + 0 => { + let slice = CStr::from_ptr(c_ptr as *const c_char); + let string = slice.to_str().unwrap(); + eprintln!("Roc hit a panic: {}", string); + std::process::exit(1); + } + _ => todo!(), + } +} + +#[no_mangle] +pub fn rust_main() -> i32 { + let args: Vec = env::args() + .skip(1) + .map(|arg| RocStr::from_slice(arg.as_bytes())) + .collect(); + let args = RocList::::from_slice(&args); + + let size = unsafe { roc_main_size() } as usize; + let layout = Layout::array::(size).unwrap(); + + unsafe { + // TODO allocate on the stack if it's under a certain size + let buffer = std::alloc::alloc(layout); + + roc_main(args, buffer); + + let result = call_the_closure(buffer); + + std::alloc::dealloc(buffer, layout); + + result + }; + + // Exit code + 0 +} + +unsafe fn call_the_closure(closure_data_ptr: *const u8) -> i64 { + let size = size_Fx_result() as usize; + let layout = Layout::array::(size).unwrap(); + let buffer = std::alloc::alloc(layout) 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, + ); + + std::alloc::dealloc(buffer, layout); + + 0 +} + +#[no_mangle] +pub fn roc_fx_getLine() -> RocStr { + use std::io::{self, BufRead}; + + let stdin = io::stdin(); + let line1 = stdin.lock().lines().next().unwrap().unwrap(); + + RocStr::from_slice(line1.as_bytes()) +} + +#[no_mangle] +pub fn roc_fx_getChar() -> u8 { + use std::io::{self, BufRead}; + let mut buffer = [0]; + + if let Err(ioerr) = io::stdin().lock().read_exact(&mut buffer[..]) { + if ioerr.kind() == io::ErrorKind::UnexpectedEof { + u8::MAX + } else { + panic!("Got an unexpected error while reading char from stdin"); + } + } else { + buffer[0] + } +} + +#[no_mangle] +pub fn roc_fx_putLine(line: RocStr) -> () { + let bytes = line.as_slice(); + let string = unsafe { std::str::from_utf8_unchecked(bytes) }; + println!("{}", string); + std::io::stdout().lock().flush(); + + // don't mess with the refcount! + core::mem::forget(line); + + () +} + +#[no_mangle] +pub fn roc_fx_putRaw(line: RocStr) -> () { + let bytes = line.as_slice(); + let string = unsafe { std::str::from_utf8_unchecked(bytes) }; + print!("{}", string); + std::io::stdout().lock().flush(); + + // don't mess with the refcount! + core::mem::forget(line); + + () +} + +#[no_mangle] +pub fn roc_fx_getFileLine(br_ptr: *mut BufReader) -> RocStr { + let br = unsafe { &mut *br_ptr }; + let mut line1 = String::default(); + + br.read_line(&mut line1) + .expect("Failed to read line from file"); + + RocStr::from_slice(line1.as_bytes()) +} + +#[no_mangle] +pub fn roc_fx_getFileBytes(br_ptr: *mut BufReader) -> RocStr { + let br = unsafe { &mut *br_ptr }; + let mut buffer = [0; 0x10 /* This is intentially small to ensure correct implementation */]; + + let count = br + .read(&mut buffer[..]) + .expect("Failed to read bytes from file"); + + RocStr::from_slice(&buffer[..count]) +} + +#[no_mangle] +pub fn roc_fx_closeFile(br_ptr: *mut BufReader) -> () { + unsafe { + Box::from_raw(br_ptr); + } +} + +#[no_mangle] +pub fn roc_fx_openFile(name: RocStr) -> *mut BufReader { + let f = File::open(name.as_str()).expect("Unable to open file"); + let br = BufReader::new(f); + + Box::into_raw(Box::new(br)) +} + +#[no_mangle] +pub fn roc_fx_withFileOpen(name: RocStr, buffer: *const u8) -> () { + // 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); + // } + + // // don't mess with the refcount! + // core::mem::forget(name); + + () +}