language-servers/roc
1
0
Fork 0
mirror of https://github.com/roc-lang/roc.git synced 2025-08-31 17:17:26 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 6

update benchmark platform to PI

Browse source
This commit is contained in:
Brendan Hansknecht 2025-01-04 08:58:36 -08:00
parent c85c864b5f
commit 07f930ca68
No known key found for this signature in database
GPG key ID: 0EA784685083E75B
21 changed files with 652 additions and 690 deletions
Download patch file Download diff file Expand all files Collapse all files

128
crates/cli/tests/benchmarks/AStar.roc
View file

@ -1,107 +1,107 @@
module [findPath, Model, initialModel, cheapestOpen, reconstructPath] module [find_path, Model, initial_model, cheapest_open, reconstruct_path]
import Quicksort import Quicksort
findPath = \costFn, moveFn, start, end -> find_path = \cost_fn, move_fn, start, end ->
astar costFn moveFn end (initialModel start) astar(cost_fn, move_fn, end, initial_model(start))
Model position : { Model position : {
evaluated : Set position, evaluated : Set position,
openSet : Set position, open_set : Set position,
costs : Dict position F64, costs : Dict position F64,
cameFrom : Dict position position, came_from : Dict position position,
} where position implements Hash & Eq } where position implements Hash & Eq
initialModel : position -> Model position where position implements Hash & Eq initial_model : position -> Model position where position implements Hash & Eq
initialModel = \start -> { initial_model = \start -> {
evaluated: Set.empty {}, evaluated: Set.empty({}),
openSet: Set.single start, open_set: Set.single(start),
costs: Dict.single start 0, costs: Dict.single(start, 0),
cameFrom: Dict.empty {}, came_from: Dict.empty({}),
} }
cheapestOpen : (position -> F64), Model position -> Result position {} where position implements Hash & Eq cheapest_open : (position -> F64), Model position -> Result position {} where position implements Hash & Eq
cheapestOpen = \costFn, model -> cheapest_open = \cost_fn, model ->
model.openSet model.open_set
|> Set.toList |> Set.toList
|> List.keepOks |> List.keepOks(
(\position -> \position ->
when Dict.get model.costs position is when Dict.get(model.costs, position) is
Err _ -> Err {} Err(_) -> Err({})
Ok cost -> Ok { cost: cost + costFn position, position } Ok(cost) -> Ok({ cost: cost + cost_fn(position), position }),
) )
|> Quicksort.sortBy .cost |> Quicksort.sort_by(.cost)
|> List.first |> List.first
|> Result.map .position |> Result.map(.position)
|> Result.mapErr (\_ -> {}) |> Result.mapErr(\_ -> {})
reconstructPath : Dict position position, position -> List position where position implements Hash & Eq reconstruct_path : Dict position position, position -> List position where position implements Hash & Eq
reconstructPath = \cameFrom, goal -> reconstruct_path = \came_from, goal ->
when Dict.get cameFrom goal is when Dict.get(came_from, goal) is
Err _ -> [] Err(_) -> []
Ok next -> List.append (reconstructPath cameFrom next) goal Ok(next) -> List.append(reconstruct_path(came_from, next), goal)
updateCost : position, position, Model position -> Model position where position implements Hash & Eq update_cost : position, position, Model position -> Model position where position implements Hash & Eq
updateCost = \current, neighbor, model -> update_cost = \current, neighbor, model ->
newCameFrom = new_came_from =
Dict.insert model.cameFrom neighbor current Dict.insert(model.came_from, neighbor, current)
newCosts = new_costs =
Dict.insert model.costs neighbor distanceTo Dict.insert(model.costs, neighbor, distance_to)
distanceTo = distance_to =
reconstructPath newCameFrom neighbor reconstruct_path(new_came_from, neighbor)
|> List.len |> List.len
|> Num.toFrac |> Num.toFrac
newModel = new_model =
{ model & { model &
costs: newCosts, costs: new_costs,
cameFrom: newCameFrom, came_from: new_came_from,
} }
when Dict.get model.costs neighbor is when Dict.get(model.costs, neighbor) is
Err _ -> Err(_) ->
newModel new_model
Ok previousDistance -> Ok(previous_distance) ->
if distanceTo < previousDistance then if distance_to < previous_distance then
newModel new_model
else else
model model
astar : (position, position -> F64), (position -> Set position), position, Model position -> Result (List position) {} where position implements Hash & Eq astar : (position, position -> F64), (position -> Set position), position, Model position -> Result (List position) {} where position implements Hash & Eq
astar = \costFn, moveFn, goal, model -> astar = \cost_fn, move_fn, goal, model ->
when cheapestOpen (\source -> costFn source goal) model is when cheapest_open(\source -> cost_fn(source, goal), model) is
Err {} -> Err {} Err({}) -> Err({})
Ok current -> Ok(current) ->
if current == goal then if current == goal then
Ok (reconstructPath model.cameFrom goal) Ok(reconstruct_path(model.came_from, goal))
else else
modelPopped = model_popped =
{ model & { model &
openSet: Set.remove model.openSet current, open_set: Set.remove(model.open_set, current),
evaluated: Set.insert model.evaluated current, evaluated: Set.insert(model.evaluated, current),
} }
neighbors = neighbors =
moveFn current move_fn(current)
newNeighbors = new_neighbors =
Set.difference neighbors modelPopped.evaluated Set.difference(neighbors, model_popped.evaluated)
modelWithNeighbors : Model position model_with_neighbors : Model position
modelWithNeighbors = model_with_neighbors =
modelPopped model_popped
|> &openSet (Set.union modelPopped.openSet newNeighbors) |> &open_set(Set.union(model_popped.open_set, new_neighbors))
walker : Model position, position -> Model position walker : Model position, position -> Model position
walker = \amodel, n -> updateCost current n amodel walker = \amodel, n -> update_cost(current, n, amodel)
modelWithCosts = model_with_costs =
Set.walk newNeighbors modelWithNeighbors walker Set.walk(new_neighbors, model_with_neighbors, walker)
astar costFn moveFn goal modelWithCosts astar(cost_fn, move_fn, goal, model_with_costs)
# takeStep = \moveFn, _goal, model, current -> # takeStep = \moveFn, _goal, model, current ->
# modelPopped = # modelPopped =

50
crates/cli/tests/benchmarks/Base64.roc
View file

@ -1,38 +1,38 @@
module [fromBytes, fromStr, toBytes, toStr] module [from_bytes, from_str, to_bytes, to_str]
import Base64.Decode import Base64.Decode
import Base64.Encode import Base64.Encode
# base 64 encoding from a sequence of bytes # base 64 encoding from a sequence of bytes
fromBytes : List U8 -> Result Str [InvalidInput] from_bytes : List U8 -> Result Str [InvalidInput]
fromBytes = \bytes -> from_bytes = \bytes ->
when Base64.Decode.fromBytes bytes is when Base64.Decode.from_bytes(bytes) is
Ok v -> Ok(v) ->
Ok v Ok(v)
Err _ -> Err(_) ->
Err InvalidInput Err(InvalidInput)
# base 64 encoding from a string # base 64 encoding from a string
fromStr : Str -> Result Str [InvalidInput] from_str : Str -> Result Str [InvalidInput]
fromStr = \str -> from_str = \str ->
fromBytes (Str.toUtf8 str) from_bytes(Str.toUtf8(str))
# base64-encode bytes to the original # base64-encode bytes to the original
toBytes : Str -> Result (List U8) [InvalidInput] to_bytes : Str -> Result (List U8) [InvalidInput]
toBytes = \str -> to_bytes = \str ->
Ok (Base64.Encode.toBytes str) Ok(Base64.Encode.to_bytes(str))
toStr : Str -> Result Str [InvalidInput] to_str : Str -> Result Str [InvalidInput]
toStr = \str -> to_str = \str ->
when toBytes str is when to_bytes(str) is
Ok bytes -> Ok(bytes) ->
when Str.fromUtf8 bytes is when Str.fromUtf8(bytes) is
Ok v -> Ok(v) ->
Ok v Ok(v)
Err _ -> Err(_) ->
Err InvalidInput Err(InvalidInput)
Err _ -> Err(_) ->
Err InvalidInput Err(InvalidInput)

88
crates/cli/tests/benchmarks/Base64/Decode.roc
View file

@ -1,86 +1,86 @@
module [fromBytes] module [from_bytes]
import Bytes.Decode exposing [ByteDecoder, DecodeProblem] import Bytes.Decode exposing [ByteDecoder, DecodeProblem]
fromBytes : List U8 -> Result Str DecodeProblem from_bytes : List U8 -> Result Str DecodeProblem
fromBytes = \bytes -> from_bytes = \bytes ->
Bytes.Decode.decode bytes (decodeBase64 (List.len bytes)) Bytes.Decode.decode(bytes, decode_base64(List.len(bytes)))
decodeBase64 : U64 -> ByteDecoder Str decode_base64 : U64 -> ByteDecoder Str
decodeBase64 = \width -> Bytes.Decode.loop loopHelp { remaining: width, string: "" } decode_base64 = \width -> Bytes.Decode.loop(loop_help, { remaining: width, string: "" })
loopHelp : { remaining : U64, string : Str } -> ByteDecoder (Bytes.Decode.Step { remaining : U64, string : Str } Str) loop_help : { remaining : U64, string : Str } -> ByteDecoder (Bytes.Decode.Step { remaining : U64, string : Str } Str)
loopHelp = \{ remaining, string } -> loop_help = \{ remaining, string } ->
if remaining >= 3 then if remaining >= 3 then
Bytes.Decode.map3 Bytes.Decode.u8 Bytes.Decode.u8 Bytes.Decode.u8 \x, y, z -> Bytes.Decode.map3(Bytes.Decode.u8, Bytes.Decode.u8, Bytes.Decode.u8, \x, y, z ->
a : U32 a : U32
a = Num.intCast x a = Num.intCast(x)
b : U32 b : U32
b = Num.intCast y b = Num.intCast(y)
c : U32 c : U32
c = Num.intCast z c = Num.intCast(z)
combined = Num.bitwiseOr (Num.bitwiseOr (Num.shiftLeftBy a 16) (Num.shiftLeftBy b 8)) c combined = Num.bitwiseOr(Num.bitwiseOr(Num.shiftLeftBy(a, 16), Num.shiftLeftBy(b, 8)), c)
Loop { Loop({
remaining: remaining - 3, remaining: remaining - 3,
string: Str.concat string (bitsToChars combined 0), string: Str.concat(string, bits_to_chars(combined, 0)),
} }))
else if remaining == 0 then else if remaining == 0 then
Bytes.Decode.succeed (Done string) Bytes.Decode.succeed(Done(string))
else if remaining == 2 then else if remaining == 2 then
Bytes.Decode.map2 Bytes.Decode.u8 Bytes.Decode.u8 \x, y -> Bytes.Decode.map2(Bytes.Decode.u8, Bytes.Decode.u8, \x, y ->
a : U32 a : U32
a = Num.intCast x a = Num.intCast(x)
b : U32 b : U32
b = Num.intCast y b = Num.intCast(y)
combined = Num.bitwiseOr (Num.shiftLeftBy a 16) (Num.shiftLeftBy b 8) combined = Num.bitwiseOr(Num.shiftLeftBy(a, 16), Num.shiftLeftBy(b, 8))
Done (Str.concat string (bitsToChars combined 1)) Done(Str.concat(string, bits_to_chars(combined, 1))))
else else
# remaining = 1 # remaining = 1
Bytes.Decode.map Bytes.Decode.u8 \x -> Bytes.Decode.map(Bytes.Decode.u8, \x ->
a : U32 a : U32
a = Num.intCast x a = Num.intCast(x)
Done (Str.concat string (bitsToChars (Num.shiftLeftBy a 16) 2)) Done(Str.concat(string, bits_to_chars(Num.shiftLeftBy(a, 16), 2))))
bitsToChars : U32, Int * -> Str bits_to_chars : U32, Int * -> Str
bitsToChars = \bits, missing -> bits_to_chars = \bits, missing ->
when Str.fromUtf8 (bitsToCharsHelp bits missing) is when Str.fromUtf8(bits_to_chars_help(bits, missing)) is
Ok str -> str Ok(str) -> str
Err _ -> "" Err(_) -> ""
# Mask that can be used to get the lowest 6 bits of a binary number # Mask that can be used to get the lowest 6 bits of a binary number
lowest6BitsMask : Int * lowest6_bits_mask : Int *
lowest6BitsMask = 63 lowest6_bits_mask = 63
bitsToCharsHelp : U32, Int * -> List U8 bits_to_chars_help : U32, Int * -> List U8
bitsToCharsHelp = \bits, missing -> bits_to_chars_help = \bits, missing ->
# The input is 24 bits, which we have to partition into 4 6-bit segments. We achieve this by # The input is 24 bits, which we have to partition into 4 6-bit segments. We achieve this by
# shifting to the right by (a multiple of) 6 to remove unwanted bits on the right, then `Num.bitwiseAnd` # shifting to the right by (a multiple of) 6 to remove unwanted bits on the right, then `Num.bitwiseAnd`
# with `0b111111` (which is 2^6 - 1 or 63) (so, 6 1s) to remove unwanted bits on the left. # with `0b111111` (which is 2^6 - 1 or 63) (so, 6 1s) to remove unwanted bits on the left.
# any 6-bit number is a valid base64 digit, so this is actually safe # any 6-bit number is a valid base64 digit, so this is actually safe
p = p =
Num.shiftRightZfBy bits 18 Num.shiftRightZfBy(bits, 18)
|> Num.intCast |> Num.intCast
|> unsafeToChar |> unsafe_to_char
q = q =
Num.bitwiseAnd (Num.shiftRightZfBy bits 12) lowest6BitsMask Num.bitwiseAnd(Num.shiftRightZfBy(bits, 12), lowest6_bits_mask)
|> Num.intCast |> Num.intCast
|> unsafeToChar |> unsafe_to_char
r = r =
Num.bitwiseAnd (Num.shiftRightZfBy bits 6) lowest6BitsMask Num.bitwiseAnd(Num.shiftRightZfBy(bits, 6), lowest6_bits_mask)
|> Num.intCast |> Num.intCast
|> unsafeToChar |> unsafe_to_char
s = s =
Num.bitwiseAnd bits lowest6BitsMask Num.bitwiseAnd(bits, lowest6_bits_mask)
|> Num.intCast |> Num.intCast
|> unsafeToChar |> unsafe_to_char
equals : U8 equals : U8
equals = 61 equals = 61
@ -94,8 +94,8 @@ bitsToCharsHelp = \bits, missing ->
[] []
# Base64 index to character/digit # Base64 index to character/digit
unsafeToChar : U8 -> U8 unsafe_to_char : U8 -> U8
unsafeToChar = \n -> unsafe_to_char = \n ->
if n <= 25 then if n <= 25 then
# uppercase characters # uppercase characters
65 + n 65 + n

135
crates/cli/tests/benchmarks/Base64/Encode.roc
View file

@ -1,22 +1,22 @@
module [toBytes] module [to_bytes]
import Bytes.Encode exposing [ByteEncoder] import Bytes.Encode exposing [ByteEncoder]
InvalidChar : U8 InvalidChar : U8
# State : [None, One U8, Two U8, Three U8] # State : [None, One U8, Two U8, Three U8]
toBytes : Str -> List U8 to_bytes : Str -> List U8
toBytes = \str -> to_bytes = \str ->
str str
|> Str.toUtf8 |> Str.toUtf8
|> encodeChunks |> encode_chunks
|> Bytes.Encode.sequence |> Bytes.Encode.sequence
|> Bytes.Encode.encode |> Bytes.Encode.encode
encodeChunks : List U8 -> List ByteEncoder encode_chunks : List U8 -> List ByteEncoder
encodeChunks = \bytes -> encode_chunks = \bytes ->
List.walk bytes { output: [], accum: None } folder List.walk(bytes, { output: [], accum: None }, folder)
|> encodeResidual |> encode_residual
coerce : U64, a -> a coerce : U64, a -> a
coerce = \_, x -> x coerce = \_, x -> x
@ -24,113 +24,114 @@ coerce = \_, x -> x
# folder : { output : List ByteEncoder, accum : State }, U8 -> { output : List ByteEncoder, accum : State } # folder : { output : List ByteEncoder, accum : State }, U8 -> { output : List ByteEncoder, accum : State }
folder = \{ output, accum }, char -> folder = \{ output, accum }, char ->
when accum is when accum is
Unreachable n -> coerce n { output, accum: Unreachable n } Unreachable(n) -> coerce(n, { output, accum: Unreachable(n) })
None -> { output, accum: One char } None -> { output, accum: One(char) }
One a -> { output, accum: Two a char } One(a) -> { output, accum: Two(a, char) }
Two a b -> { output, accum: Three a b char } Two(a, b) -> { output, accum: Three(a, b, char) }
Three a b c -> Three(a, b, c) ->
when encodeCharacters a b c char is when encode_characters(a, b, c, char) is
Ok encoder -> Ok(encoder) ->
{ {
output: List.append output encoder, output: List.append(output, encoder),
accum: None, accum: None,
} }
Err _ -> Err(_) ->
{ output, accum: None } { output, accum: None }
# SGVs bG8g V29y bGQ= # SGVs bG8g V29y bGQ=
# encodeResidual : { output : List ByteEncoder, accum : State } -> List ByteEncoder # encodeResidual : { output : List ByteEncoder, accum : State } -> List ByteEncoder
encodeResidual = \{ output, accum } -> encode_residual = \{ output, accum } ->
when accum is when accum is
Unreachable _ -> output Unreachable(_) -> output
None -> output None -> output
One _ -> output One(_) -> output
Two a b -> Two(a, b) ->
when encodeCharacters a b equals equals is when encode_characters(a, b, equals, equals) is
Ok encoder -> List.append output encoder Ok(encoder) -> List.append(output, encoder)
Err _ -> output Err(_) -> output
Three a b c -> Three(a, b, c) ->
when encodeCharacters a b c equals is when encode_characters(a, b, c, equals) is
Ok encoder -> List.append output encoder Ok(encoder) -> List.append(output, encoder)
Err _ -> output Err(_) -> output
equals : U8 equals : U8
equals = 61 equals = 61
# Convert 4 characters to 24 bits (as an ByteEncoder) # Convert 4 characters to 24 bits (as an ByteEncoder)
encodeCharacters : U8, U8, U8, U8 -> Result ByteEncoder InvalidChar encode_characters : U8, U8, U8, U8 -> Result ByteEncoder InvalidChar
encodeCharacters = \a, b, c, d -> encode_characters = \a, b, c, d ->
if !(isValidChar a) then if !(is_valid_char(a)) then
Err a Err(a)
else if !(isValidChar b) then else if !(is_valid_char(b)) then
Err b Err(b)
else else
# `=` is the padding character, and must be special-cased # `=` is the padding character, and must be special-cased
# only the `c` and `d` char are allowed to be padding # only the `c` and `d` char are allowed to be padding
n1 = unsafeConvertChar a n1 = unsafe_convert_char(a)
n2 = unsafeConvertChar b n2 = unsafe_convert_char(b)
x : U32 x : U32
x = Num.intCast n1 x = Num.intCast(n1)
y : U32 y : U32
y = Num.intCast n2 y = Num.intCast(n2)
if d == equals then if d == equals then
if c == equals then if c == equals then
n = Num.bitwiseOr (Num.shiftLeftBy x 18) (Num.shiftLeftBy y 12) n = Num.bitwiseOr(Num.shiftLeftBy(x, 18), Num.shiftLeftBy(y, 12))
# masking higher bits is not needed, Encode.unsignedInt8 ignores higher bits # masking higher bits is not needed, Encode.unsignedInt8 ignores higher bits
b1 : U8 b1 : U8
b1 = Num.intCast (Num.shiftRightBy n 16) b1 = Num.intCast(Num.shiftRightBy(n, 16))
Ok (Bytes.Encode.u8 b1) Ok(Bytes.Encode.u8(b1))
else if !(isValidChar c) then else if !(is_valid_char(c)) then
Err c Err(c)
else else
n3 = unsafeConvertChar c n3 = unsafe_convert_char(c)
z : U32 z : U32
z = Num.intCast n3 z = Num.intCast(n3)
n = Num.bitwiseOr (Num.bitwiseOr (Num.shiftLeftBy x 18) (Num.shiftLeftBy y 12)) (Num.shiftLeftBy z 6) n = Num.bitwiseOr(Num.bitwiseOr(Num.shiftLeftBy(x, 18), Num.shiftLeftBy(y, 12)), Num.shiftLeftBy(z, 6))
combined : U16 combined : U16
combined = Num.intCast (Num.shiftRightBy n 8) combined = Num.intCast(Num.shiftRightBy(n, 8))
Ok (Bytes.Encode.u16 BE combined) Ok(Bytes.Encode.u16(BE, combined))
else if !(isValidChar d) then else if !(is_valid_char(d)) then
Err d Err(d)
else else
n3 = unsafeConvertChar c n3 = unsafe_convert_char(c)
n4 = unsafeConvertChar d n4 = unsafe_convert_char(d)
z : U32 z : U32
z = Num.intCast n3 z = Num.intCast(n3)
w : U32 w : U32
w = Num.intCast n4 w = Num.intCast(n4)
n = n =
Num.bitwiseOr Num.bitwiseOr(
(Num.bitwiseOr (Num.shiftLeftBy x 18) (Num.shiftLeftBy y 12)) Num.bitwiseOr(Num.shiftLeftBy(x, 18), Num.shiftLeftBy(y, 12)),
(Num.bitwiseOr (Num.shiftLeftBy z 6) w) Num.bitwiseOr(Num.shiftLeftBy(z, 6), w),
)
b3 : U8 b3 : U8
b3 = Num.intCast n b3 = Num.intCast(n)
combined : U16 combined : U16
combined = Num.intCast (Num.shiftRightBy n 8) combined = Num.intCast(Num.shiftRightBy(n, 8))
Ok (Bytes.Encode.sequence [Bytes.Encode.u16 BE combined, Bytes.Encode.u8 b3]) Ok(Bytes.Encode.sequence([Bytes.Encode.u16(BE, combined), Bytes.Encode.u8(b3)]))
# is the character a base64 digit? # is the character a base64 digit?
# The base16 digits are: A-Z, a-z, 0-1, '+' and '/' # The base16 digits are: A-Z, a-z, 0-1, '+' and '/'
isValidChar : U8 -> Bool is_valid_char : U8 -> Bool
isValidChar = \c -> is_valid_char = \c ->
if isAlphaNum c then if is_alpha_num(c) then
Bool.true Bool.true
else else
when c is when c is
@ -145,14 +146,14 @@ isValidChar = \c ->
_ -> _ ->
Bool.false Bool.false
isAlphaNum : U8 -> Bool is_alpha_num : U8 -> Bool
isAlphaNum = \key -> is_alpha_num = \key ->
(key >= 48 && key <= 57) || (key >= 64 && key <= 90) || (key >= 97 && key <= 122) (key >= 48 && key <= 57) || (key >= 64 && key <= 90) || (key >= 97 && key <= 122)
# Convert a base64 character/digit to its index # Convert a base64 character/digit to its index
# See also [Wikipedia](https://en.wikipedia.org/wiki/Base64#Base64_table) # See also [Wikipedia](https://en.wikipedia.org/wiki/Base64#Base64_table)
unsafeConvertChar : U8 -> U8 unsafe_convert_char : U8 -> U8
unsafeConvertChar = \key -> unsafe_convert_char = \key ->
if key >= 65 && key <= 90 then if key >= 65 && key <= 90 then
# A-Z # A-Z
key - 65 key - 65

4
crates/cli/tests/benchmarks/Issue2279Help.roc
View file

@ -1,5 +1,5 @@
module [text, asText] module [text, as_text]
text = "Hello, world!" text = "Hello, world!"
asText = Num.toStr as_text = Num.toStr

78
crates/cli/tests/benchmarks/Quicksort.roc
View file

@ -1,75 +1,75 @@
module [sortBy, sortWith, show] module [sort_by, sort_with, show]
show : List I64 -> Str show : List I64 -> Str
show = \list -> show = \list ->
if List.isEmpty list then if List.isEmpty(list) then
"[]" "[]"
else else
content = content =
list list
|> List.map Num.toStr |> List.map(Num.toStr)
|> Str.joinWith ", " |> Str.joinWith(", ")
"[$(content)]" "[$(content)]"
sortBy : List a, (a -> Num *) -> List a sort_by : List a, (a -> Num *) -> List a
sortBy = \list, toComparable -> sort_by = \list, to_comparable ->
sortWith list (\x, y -> Num.compare (toComparable x) (toComparable y)) sort_with(list, \x, y -> Num.compare(to_comparable(x), to_comparable(y)))
Order a : a, a -> [LT, GT, EQ] Order a : a, a -> [LT, GT, EQ]
sortWith : List a, (a, a -> [LT, GT, EQ]) -> List a sort_with : List a, (a, a -> [LT, GT, EQ]) -> List a
sortWith = \list, order -> sort_with = \list, order ->
n = List.len list n = List.len(list)
quicksortHelp list order 0 (n - 1) quicksort_help(list, order, 0, (n - 1))
quicksortHelp : List a, Order a, U64, U64 -> List a quicksort_help : List a, Order a, U64, U64 -> List a
quicksortHelp = \list, order, low, high -> quicksort_help = \list, order, low, high ->
if low < high then if low < high then
when partition low high list order is when partition(low, high, list, order) is
Pair partitionIndex partitioned -> Pair(partition_index, partitioned) ->
partitioned partitioned
|> quicksortHelp order low (Num.subSaturated partitionIndex 1) |> quicksort_help(order, low, Num.subSaturated(partition_index, 1))
|> quicksortHelp order (partitionIndex + 1) high |> quicksort_help(order, (partition_index + 1), high)
else else
list list
partition : U64, U64, List a, Order a -> [Pair U64 (List a)] partition : U64, U64, List a, Order a -> [Pair U64 (List a)]
partition = \low, high, initialList, order -> partition = \low, high, initial_list, order ->
when List.get initialList high is when List.get(initial_list, high) is
Ok pivot -> Ok(pivot) ->
when partitionHelp low low initialList order high pivot is when partition_help(low, low, initial_list, order, high, pivot) is
Pair newI newList -> Pair(new_i, new_list) ->
Pair newI (swap newI high newList) Pair(new_i, swap(new_i, high, new_list))
Err _ -> Err(_) ->
Pair low initialList Pair(low, initial_list)
partitionHelp : U64, U64, List c, Order c, U64, c -> [Pair U64 (List c)] partition_help : U64, U64, List c, Order c, U64, c -> [Pair U64 (List c)]
partitionHelp = \i, j, list, order, high, pivot -> partition_help = \i, j, list, order, high, pivot ->
if j < high then if j < high then
when List.get list j is when List.get(list, j) is
Ok value -> Ok(value) ->
when order value pivot is when order(value, pivot) is
LT | EQ -> LT | EQ ->
partitionHelp (i + 1) (j + 1) (swap i j list) order high pivot partition_help((i + 1), (j + 1), swap(i, j, list), order, high, pivot)
GT -> GT ->
partitionHelp i (j + 1) list order high pivot partition_help(i, (j + 1), list, order, high, pivot)
Err _ -> Err(_) ->
Pair i list Pair(i, list)
else else
Pair i list Pair(i, list)
swap : U64, U64, List a -> List a swap : U64, U64, List a -> List a
swap = \i, j, list -> swap = \i, j, list ->
when Pair (List.get list i) (List.get list j) is when Pair(List.get(list, i), List.get(list, j)) is
Pair (Ok atI) (Ok atJ) -> Pair(Ok(at_i), Ok(at_j)) ->
list list
|> List.set i atJ |> List.set(i, at_j)
|> List.set j atI |> List.set(j, at_i)
_ -> _ ->
[] []

130
crates/cli/tests/benchmarks/cFold.roc
View file

@ -1,31 +1,31 @@
app [main] { pf: platform "platform/main.roc" } app [main!] { pf: platform "platform/main.roc" }
import pf.PlatformTasks import pf.Host
# adapted from https://github.com/koka-lang/koka/blob/master/test/bench/haskell/cfold.hs # adapted from https://github.com/koka-lang/koka/blob/master/test/bench/haskell/cfold.hs
main : Task {} [] main! : {} => {}
main = main! = \{} ->
{ value, isError } = PlatformTasks.getInt! { value, is_error } = Host.get_int!({})
inputResult = input_result =
if isError then if is_error then
Err GetIntError Err(GetIntError)
else else
Ok value Ok(value)
when inputResult is when input_result is
Ok n -> Ok(n) ->
e = mkExpr n 1 # original koka n = 20 (set `ulimit -s unlimited` to avoid stack overflow for n = 20) e = mk_expr(n, 1) # original koka n = 20 (set `ulimit -s unlimited` to avoid stack overflow for n = 20)
unoptimized = eval e unoptimized = eval(e)
optimized = eval (constFolding (reassoc e)) optimized = eval(const_folding(reassoc(e)))
unoptimized unoptimized
|> Num.toStr |> Num.toStr
|> Str.concat " & " |> Str.concat(" & ")
|> Str.concat (Num.toStr optimized) |> Str.concat(Num.toStr(optimized))
|> PlatformTasks.putLine |> Host.put_line!
Err GetIntError -> Err(GetIntError) ->
PlatformTasks.putLine "Error: Failed to get Integer from stdin." Host.put_line!("Error: Failed to get Integer from stdin.")
Expr : [ Expr : [
Add Expr Expr, Add Expr Expr,
@ -34,97 +34,97 @@ Expr : [
Var I64, Var I64,
] ]
mkExpr : I64, I64 -> Expr mk_expr : I64, I64 -> Expr
mkExpr = \n, v -> mk_expr = \n, v ->
when n is when n is
0 -> 0 ->
if v == 0 then Var 1 else Val v if v == 0 then Var(1) else Val(v)
_ -> _ ->
Add (mkExpr (n - 1) (v + 1)) (mkExpr (n - 1) (max (v - 1) 0)) Add(mk_expr((n - 1), (v + 1)), mk_expr((n - 1), max((v - 1), 0)))
max : I64, I64 -> I64 max : I64, I64 -> I64
max = \a, b -> if a > b then a else b max = \a, b -> if a > b then a else b
appendAdd : Expr, Expr -> Expr append_add : Expr, Expr -> Expr
appendAdd = \e1, e2 -> append_add = \e1, e2 ->
when e1 is when e1 is
Add a1 a2 -> Add(a1, a2) ->
Add a1 (appendAdd a2 e2) Add(a1, append_add(a2, e2))
_ -> _ ->
Add e1 e2 Add(e1, e2)
appendMul : Expr, Expr -> Expr append_mul : Expr, Expr -> Expr
appendMul = \e1, e2 -> append_mul = \e1, e2 ->
when e1 is when e1 is
Mul a1 a2 -> Mul(a1, a2) ->
Mul a1 (appendMul a2 e2) Mul(a1, append_mul(a2, e2))
_ -> _ ->
Mul e1 e2 Mul(e1, e2)
eval : Expr -> I64 eval : Expr -> I64
eval = \e -> eval = \e ->
when e is when e is
Var _ -> Var(_) ->
0 0
Val v -> Val(v) ->
v v
Add l r -> Add(l, r) ->
eval l + eval r eval(l) + eval(r)
Mul l r -> Mul(l, r) ->
eval l * eval r eval(l) * eval(r)
reassoc : Expr -> Expr reassoc : Expr -> Expr
reassoc = \e -> reassoc = \e ->
when e is when e is
Add e1 e2 -> Add(e1, e2) ->
x1 = reassoc e1 x1 = reassoc(e1)
x2 = reassoc e2 x2 = reassoc(e2)
appendAdd x1 x2 append_add(x1, x2)
Mul e1 e2 -> Mul(e1, e2) ->
x1 = reassoc e1 x1 = reassoc(e1)
x2 = reassoc e2 x2 = reassoc(e2)
appendMul x1 x2 append_mul(x1, x2)
_ -> _ ->
e e
constFolding : Expr -> Expr const_folding : Expr -> Expr
constFolding = \e -> const_folding = \e ->
when e is when e is
Add e1 e2 -> Add(e1, e2) ->
x1 = constFolding e1 x1 = const_folding(e1)
x2 = constFolding e2 x2 = const_folding(e2)
when x1 is when x1 is
Val a -> Val(a) ->
when x2 is when x2 is
Val b -> Val (a + b) Val(b) -> Val((a + b))
Add (Val b) x | Add x (Val b) -> Add (Val (a + b)) x Add(Val(b), x) | Add(x, Val(b)) -> Add(Val((a + b)), x)
_ -> Add x1 x2 _ -> Add(x1, x2)
_ -> Add x1 x2 _ -> Add(x1, x2)
Mul e1 e2 -> Mul(e1, e2) ->
x1 = constFolding e1 x1 = const_folding(e1)
x2 = constFolding e2 x2 = const_folding(e2)
when x1 is when x1 is
Val a -> Val(a) ->
when x2 is when x2 is
Val b -> Val (a * b) Val(b) -> Val((a * b))
Mul (Val b) x | Mul x (Val b) -> Mul (Val (a * b)) x Mul(Val(b), x) | Mul(x, Val(b)) -> Mul(Val((a * b)), x)
_ -> Mul x1 x2 _ -> Mul(x1, x2)
_ -> Mul x1 x2 _ -> Mul(x1, x2)
_ -> _ ->
e e

50
crates/cli/tests/benchmarks/closure.roc
View file

@ -1,48 +1,50 @@
app [main] { pf: platform "platform/main.roc" } app [main!] { pf: platform "platform/main.roc" }
main! : {} => {}
main! = \{} ->
closure1({})
|> Result.try(closure2)
|> Result.try(closure3)
|> Result.try(closure4)
|> Result.withDefault({})
main : Task {} []
main =
closure1 {}
|> Task.await (\_ -> closure2 {})
|> Task.await (\_ -> closure3 {})
|> Task.await (\_ -> closure4 {})
# --- # ---
closure1 : {} -> Task {} [] closure1 : {} -> Result {} []
closure1 = \_ -> closure1 = \_ ->
Task.ok (foo toUnitBorrowed "a long string such that it's malloced") Ok(foo(to_unit_borrowed, "a long string such that it's malloced"))
|> Task.map \_ -> {} |> Result.map(\_ -> {})
toUnitBorrowed = \x -> Str.countUtf8Bytes x to_unit_borrowed = \x -> Str.countUtf8Bytes(x)
foo = \f, x -> f x foo = \f, x -> f(x)
# --- # ---
closure2 : {} -> Task {} [] closure2 : {} -> Result {} []
closure2 = \_ -> closure2 = \_ ->
x : Str x : Str
x = "a long string such that it's malloced" x = "a long string such that it's malloced"
Task.ok {} Ok({})
|> Task.map (\_ -> x) |> Result.map(\_ -> x)
|> Task.map toUnit |> Result.map(to_unit)
toUnit = \_ -> {} to_unit = \_ -> {}
# # --- # # ---
closure3 : {} -> Task {} [] closure3 : {} -> Result {} []
closure3 = \_ -> closure3 = \_ ->
x : Str x : Str
x = "a long string such that it's malloced" x = "a long string such that it's malloced"
Task.ok {} Ok({})
|> Task.await (\_ -> Task.ok x |> Task.map (\_ -> {})) |> Result.try(\_ -> Ok(x) |> Result.map(\_ -> {}))
# # --- # # ---
closure4 : {} -> Task {} [] closure4 : {} -> Result {} []
closure4 = \_ -> closure4 = \_ ->
x : Str x : Str
x = "a long string such that it's malloced" x = "a long string such that it's malloced"
Task.ok {} Ok({})
|> Task.await (\_ -> Task.ok x) |> Result.try(\_ -> Ok(x))
|> Task.map (\_ -> {}) |> Result.map(\_ -> {})

192
crates/cli/tests/benchmarks/deriv.roc
View file

@ -1,51 +1,49 @@
app [main] { pf: platform "platform/main.roc" } app [main!] { pf: platform "platform/main.roc" }
import pf.PlatformTasks import pf.Host
# based on: https://github.com/koka-lang/koka/blob/master/test/bench/haskell/deriv.hs # based on: https://github.com/koka-lang/koka/blob/master/test/bench/haskell/deriv.hs
IO a : Task a [] main! : {} => {}
main! = \{} ->
main : Task {} [] { value, is_error } = Host.get_int!({})
main = input_result =
{ value, isError } = PlatformTasks.getInt! if is_error then
inputResult = Err(GetIntError)
if isError then
Err GetIntError
else else
Ok value Ok(value)
when inputResult is when input_result is
Ok n -> Ok(n) ->
x : Expr x : Expr
x = Var "x" x = Var("x")
f : Expr f : Expr
f = pow x x f = pow(x, x)
nest deriv n f # original koka n = 10 _ = nest!(deriv!, n, f) # original koka n = 10
|> Task.map \_ -> {} {}
Err GetIntError -> Err(GetIntError) ->
PlatformTasks.putLine "Error: Failed to get Integer from stdin." Host.put_line!("Error: Failed to get Integer from stdin.")
nestHelp : I64, (I64, Expr -> IO Expr), I64, Expr -> IO Expr nest_help! : I64, (I64, Expr => Expr), I64, Expr => Expr
nestHelp = \s, f, m, x -> nest_help! = \s, f!, m, x ->
when m is when m is
0 -> Task.ok x 0 -> x
_ -> _ ->
w = f! (s - m) x w = f!((s - m), x)
nestHelp s f (m - 1) w nest_help!(s, f!, (m - 1), w)
nest : (I64, Expr -> IO Expr), I64, Expr -> IO Expr nest! : (I64, Expr => Expr), I64, Expr => Expr
nest = \f, n, e -> nestHelp n f n e nest! = \f!, n, e -> nest_help!(n, f!, n, e)
Expr : [Val I64, Var Str, Add Expr Expr, Mul Expr Expr, Pow Expr Expr, Ln Expr] Expr : [Val I64, Var Str, Add Expr Expr, Mul Expr Expr, Pow Expr Expr, Ln Expr]
divmod : I64, I64 -> Result { div : I64, mod : I64 } [DivByZero] divmod : I64, I64 -> Result { div : I64, mod : I64 } [DivByZero]
divmod = \l, r -> divmod = \l, r ->
when Pair (Num.divTruncChecked l r) (Num.remChecked l r) is when Pair(Num.divTruncChecked(l, r), Num.remChecked(l, r)) is
Pair (Ok div) (Ok mod) -> Ok { div, mod } Pair(Ok(div), Ok(mod)) -> Ok({ div, mod })
_ -> Err DivByZero _ -> Err(DivByZero)
pown : I64, I64 -> I64 pown : I64, I64 -> I64
pown = \a, n -> pown = \a, n ->
@ -53,119 +51,119 @@ pown = \a, n ->
0 -> 1 0 -> 1
1 -> a 1 -> a
_ -> _ ->
when divmod n 2 is when divmod(n, 2) is
Ok { div, mod } -> Ok({ div, mod }) ->
b = pown a div b = pown(a, div)
b * b * (if mod == 0 then 1 else a) b * b * (if mod == 0 then 1 else a)
Err DivByZero -> Err(DivByZero) ->
-1 -1
add : Expr, Expr -> Expr add : Expr, Expr -> Expr
add = \a, b -> add = \a, b ->
when Pair a b is when Pair(a, b) is
Pair (Val n) (Val m) -> Pair(Val(n), Val(m)) ->
Val (n + m) Val((n + m))
Pair (Val 0) f -> Pair(Val(0), f) ->
f f
Pair f (Val 0) -> Pair(f, Val(0)) ->
f f
Pair f (Val n) -> Pair(f, Val(n)) ->
add (Val n) f add(Val(n), f)
Pair (Val n) (Add (Val m) f) -> Pair(Val(n), Add(Val(m), f)) ->
add (Val (n + m)) f add(Val((n + m)), f)
Pair f (Add (Val n) g) -> Pair(f, Add(Val(n), g)) ->
add (Val n) (add f g) add(Val(n), add(f, g))
Pair (Add f g) h -> Pair(Add(f, g), h) ->
add f (add g h) add(f, add(g, h))
Pair f g -> Pair(f, g) ->
Add f g Add(f, g)
mul : Expr, Expr -> Expr mul : Expr, Expr -> Expr
mul = \a, b -> mul = \a, b ->
when Pair a b is when Pair(a, b) is
Pair (Val n) (Val m) -> Pair(Val(n), Val(m)) ->
Val (n * m) Val((n * m))
Pair (Val 0) _ -> Pair(Val(0), _) ->
Val 0 Val(0)
Pair _ (Val 0) -> Pair(_, Val(0)) ->
Val 0 Val(0)
Pair (Val 1) f -> Pair(Val(1), f) ->
f f
Pair f (Val 1) -> Pair(f, Val(1)) ->
f f
Pair f (Val n) -> Pair(f, Val(n)) ->
mul (Val n) f mul(Val(n), f)
Pair (Val n) (Mul (Val m) f) -> Pair(Val(n), Mul(Val(m), f)) ->
mul (Val (n * m)) f mul(Val((n * m)), f)
Pair f (Mul (Val n) g) -> Pair(f, Mul(Val(n), g)) ->
mul (Val n) (mul f g) mul(Val(n), mul(f, g))
Pair (Mul f g) h -> Pair(Mul(f, g), h) ->
mul f (mul g h) mul(f, mul(g, h))
Pair f g -> Pair(f, g) ->
Mul f g Mul(f, g)
pow : Expr, Expr -> Expr pow : Expr, Expr -> Expr
pow = \a, b -> pow = \a, b ->
when Pair a b is when Pair(a, b) is
Pair (Val m) (Val n) -> Val (pown m n) Pair(Val(m), Val(n)) -> Val(pown(m, n))
Pair _ (Val 0) -> Val 1 Pair(_, Val(0)) -> Val(1)
Pair f (Val 1) -> f Pair(f, Val(1)) -> f
Pair (Val 0) _ -> Val 0 Pair(Val(0), _) -> Val(0)
Pair f g -> Pow f g Pair(f, g) -> Pow(f, g)
ln : Expr -> Expr ln : Expr -> Expr
ln = \f -> ln = \f ->
when f is when f is
Val 1 -> Val 0 Val(1) -> Val(0)
_ -> Ln f _ -> Ln(f)
d : Str, Expr -> Expr d : Str, Expr -> Expr
d = \x, expr -> d = \x, expr ->
when expr is when expr is
Val _ -> Val 0 Val(_) -> Val(0)
Var y -> if x == y then Val 1 else Val 0 Var(y) -> if x == y then Val(1) else Val(0)
Add f g -> add (d x f) (d x g) Add(f, g) -> add(d(x, f), d(x, g))
Mul f g -> add (mul f (d x g)) (mul g (d x f)) Mul(f, g) -> add(mul(f, d(x, g)), mul(g, d(x, f)))
Pow f g -> Pow(f, g) ->
mul (pow f g) (add (mul (mul g (d x f)) (pow f (Val (-1)))) (mul (ln f) (d x g))) mul(pow(f, g), add(mul(mul(g, d(x, f)), pow(f, Val(-1))), mul(ln(f), d(x, g))))
Ln f -> Ln(f) ->
mul (d x f) (pow f (Val (-1))) mul(d(x, f), pow(f, Val(-1)))
count : Expr -> I64 count : Expr -> I64
count = \expr -> count = \expr ->
when expr is when expr is
Val _ -> 1 Val(_) -> 1
Var _ -> 1 Var(_) -> 1
Add f g -> count f + count g Add(f, g) -> count(f) + count(g)
Mul f g -> count f + count g Mul(f, g) -> count(f) + count(g)
Pow f g -> count f + count g Pow(f, g) -> count(f) + count(g)
Ln f -> count f Ln(f) -> count(f)
deriv : I64, Expr -> IO Expr deriv! : I64, Expr => Expr
deriv = \i, f -> deriv! = \i, f ->
fprime = d "x" f fprime = d("x", f)
line = line =
Num.toStr (i + 1) Num.toStr((i + 1))
|> Str.concat " count: " |> Str.concat(" count: ")
|> Str.concat (Num.toStr (count fprime)) |> Str.concat(Num.toStr(count(fprime)))
PlatformTasks.putLine! line Host.put_line!(line)
Task.ok fprime fprime

10
crates/cli/tests/benchmarks/issue2279.roc
View file

@ -1,13 +1,13 @@
app [main] { pf: platform "platform/main.roc" } app [main!] { pf: platform "platform/main.roc" }
import Issue2279Help import Issue2279Help
import pf.PlatformTasks import pf.Host
main = main! = \{} ->
text = text =
if Bool.true then if Bool.true then
Issue2279Help.text Issue2279Help.text
else else
Issue2279Help.asText 42 Issue2279Help.as_text(42)
PlatformTasks.putLine text Host.put_line!(text)

62
crates/cli/tests/benchmarks/nQueens.roc
View file

@ -1,66 +1,66 @@
app [main] { pf: platform "platform/main.roc" } app [main!] { pf: platform "platform/main.roc" }
import pf.PlatformTasks import pf.Host
main : Task {} [] main! : {} => {}
main = main! = \{} ->
{ value, isError } = PlatformTasks.getInt! { value, is_error } = Host.get_int!({})
inputResult = input_result =
if isError then if is_error then
Err GetIntError Err(GetIntError)
else else
Ok value Ok(value)
when inputResult is when input_result is
Ok n -> Ok(n) ->
queens n # original koka 13 queens(n) # original koka 13
|> Num.toStr |> Num.toStr
|> PlatformTasks.putLine |> Host.put_line!
Err GetIntError -> Err(GetIntError) ->
PlatformTasks.putLine "Error: Failed to get Integer from stdin." Host.put_line!("Error: Failed to get Integer from stdin.")
ConsList a : [Nil, Cons a (ConsList a)] ConsList a : [Nil, Cons a (ConsList a)]
queens = \n -> length (findSolutions n n) queens = \n -> length(find_solutions(n, n))
findSolutions = \n, k -> find_solutions = \n, k ->
if k <= 0 then if k <= 0 then
# should we use U64 as input type here instead? # should we use U64 as input type here instead?
Cons Nil Nil Cons(Nil, Nil)
else else
extend n Nil (findSolutions n (k - 1)) extend(n, Nil, find_solutions(n, (k - 1)))
extend = \n, acc, solutions -> extend = \n, acc, solutions ->
when solutions is when solutions is
Nil -> acc Nil -> acc
Cons soln rest -> extend n (appendSafe n soln acc) rest Cons(soln, rest) -> extend(n, append_safe(n, soln, acc), rest)
appendSafe : I64, ConsList I64, ConsList (ConsList I64) -> ConsList (ConsList I64) append_safe : I64, ConsList I64, ConsList (ConsList I64) -> ConsList (ConsList I64)
appendSafe = \k, soln, solns -> append_safe = \k, soln, solns ->
if k <= 0 then if k <= 0 then
solns solns
else if safe k 1 soln then else if safe(k, 1, soln) then
appendSafe (k - 1) soln (Cons (Cons k soln) solns) append_safe((k - 1), soln, Cons(Cons(k, soln), solns))
else else
appendSafe (k - 1) soln solns append_safe((k - 1), soln, solns)
safe : I64, I64, ConsList I64 -> Bool safe : I64, I64, ConsList I64 -> Bool
safe = \queen, diagonal, xs -> safe = \queen, diagonal, xs ->
when xs is when xs is
Nil -> Bool.true Nil -> Bool.true
Cons q t -> Cons(q, t) ->
if queen != q && queen != q + diagonal && queen != q - diagonal then if queen != q && queen != q + diagonal && queen != q - diagonal then
safe queen (diagonal + 1) t safe(queen, (diagonal + 1), t)
else else
Bool.false Bool.false
length : ConsList a -> I64 length : ConsList a -> I64
length = \xs -> length = \xs ->
lengthHelp xs 0 length_help(xs, 0)
lengthHelp : ConsList a, I64 -> I64 length_help : ConsList a, I64 -> I64
lengthHelp = \foobar, acc -> length_help = \foobar, acc ->
when foobar is when foobar is
Cons _ lrest -> lengthHelp lrest (1 + acc) Cons(_, lrest) -> length_help(lrest, (1 + acc))
Nil -> acc Nil -> acc

9
crates/cli/tests/benchmarks/platform/Host.roc Normal file
View file

@ -0,0 +1,9 @@
hosted Host
exposes [put_line!, put_int!, get_int!]
imports []
put_line! : Str => {}
put_int! : I64 => {}
get_int! : {} => { value : I64, is_error : Bool }

9
crates/cli/tests/benchmarks/platform/PlatformTasks.roc
View file

@ -1,9 +0,0 @@
hosted PlatformTasks
exposes [putLine, putInt, getInt]
imports []
putLine : Str -> Task {} *
putInt : I64 -> Task {} *
getInt : Task { value : I64, isError : Bool } *

5
crates/cli/tests/benchmarks/platform/app.roc
View file

@ -1,3 +1,4 @@
app [main] { pf: platform "main.roc" } app [main!] { pf: platform "main.roc" }
main = Task.ok {} main! : {} => {}
main! = \{} -> {}

62
crates/cli/tests/benchmarks/platform/host.zig
View file

@ -10,11 +10,7 @@ const maxInt = std.math.maxInt;
const mem = std.mem; const mem = std.mem;
const Allocator = mem.Allocator; const Allocator = mem.Allocator;
extern fn roc__mainForHost_1_exposed_generic([*]u8) void; extern fn roc__main_for_host_1_exposed() void;
extern fn roc__mainForHost_1_exposed_size() i64;
extern fn roc__mainForHost_0_caller(*const u8, [*]u8, [*]u8) void;
extern fn roc__mainForHost_0_size() i64;
extern fn roc__mainForHost_0_result_size() i64;
const Align = 2 * @alignOf(usize); const Align = 2 * @alignOf(usize);
extern fn malloc(size: usize) callconv(.C) ?*align(Align) anyopaque; extern fn malloc(size: usize) callconv(.C) ?*align(Align) anyopaque;
@ -112,48 +108,12 @@ comptime {
const Unit = extern struct {}; const Unit = extern struct {};
pub export fn main() u8 { pub export fn main() u8 {
// The size might be zero; if so, make it at least 8 so that we don't have a nullptr roc__main_for_host_1_exposed();
const size = @max(@as(usize, @intCast(roc__mainForHost_1_exposed_size())), 8);
const raw_output = roc_alloc(@as(usize, @intCast(size)), @alignOf(u64)) orelse {
std.log.err("Memory allocation failed", .{});
return 1;
};
const output = @as([*]u8, @ptrCast(raw_output));
defer {
roc_dealloc(raw_output, @alignOf(u64));
}
roc__mainForHost_1_exposed_generic(output);
const closure_data_pointer = @as([*]u8, @ptrCast(output));
call_the_closure(closure_data_pointer);
return 0; return 0;
} }
fn call_the_closure(closure_data_pointer: [*]u8) void { pub export fn roc_fx_put_int(int: i64) i64 {
const allocator = std.heap.page_allocator;
// The size might be zero; if so, make it at least 8 so that we don't have a nullptr
const size = @max(roc__mainForHost_0_result_size(), 8);
const raw_output = allocator.alignedAlloc(u8, @alignOf(u64), @as(usize, @intCast(size))) catch unreachable;
const output = @as([*]u8, @ptrCast(raw_output));
defer {
allocator.free(raw_output);
}
const flags: u8 = 0;
roc__mainForHost_0_caller(&flags, closure_data_pointer, output);
// The closure returns result, nothing interesting to do with it
return;
}
pub export fn roc_fx_putInt(int: i64) i64 {
const stdout = std.io.getStdOut().writer(); const stdout = std.io.getStdOut().writer();
stdout.print("{d}", .{int}) catch unreachable; stdout.print("{d}", .{int}) catch unreachable;
@ -163,7 +123,7 @@ pub export fn roc_fx_putInt(int: i64) i64 {
return 0; return 0;
} }
export fn roc_fx_putLine(rocPath: *str.RocStr) callconv(.C) void { export fn roc_fx_put_line(rocPath: *str.RocStr) callconv(.C) void {
const stdout = std.io.getStdOut().writer(); const stdout = std.io.getStdOut().writer();
for (rocPath.asSlice()) |char| { for (rocPath.asSlice()) |char| {
@ -180,14 +140,14 @@ const GetInt = extern struct {
comptime { comptime {
if (@sizeOf(usize) == 8) { if (@sizeOf(usize) == 8) {
@export(roc_fx_getInt_64bit, .{ .name = "roc_fx_getInt" }); @export(roc_fx_get_int_64bit, .{ .name = "roc_fx_get_int" });
} else { } else {
@export(roc_fx_getInt_32bit, .{ .name = "roc_fx_getInt" }); @export(roc_fx_get_int_32bit, .{ .name = "roc_fx_get_int" });
} }
} }
fn roc_fx_getInt_64bit() callconv(.C) GetInt { fn roc_fx_get_int_64bit() callconv(.C) GetInt {
if (roc_fx_getInt_help()) |value| { if (roc_fx_get_int_help()) |value| {
const get_int = GetInt{ .is_error = false, .value = value }; const get_int = GetInt{ .is_error = false, .value = value };
return get_int; return get_int;
} else |err| switch (err) { } else |err| switch (err) {
@ -202,8 +162,8 @@ fn roc_fx_getInt_64bit() callconv(.C) GetInt {
return 0; return 0;
} }
fn roc_fx_getInt_32bit(output: *GetInt) callconv(.C) void { fn roc_fx_get_int_32bit(output: *GetInt) callconv(.C) void {
if (roc_fx_getInt_help()) |value| { if (roc_fx_get_int_help()) |value| {
const get_int = GetInt{ .is_error = false, .value = value }; const get_int = GetInt{ .is_error = false, .value = value };
output.* = get_int; output.* = get_int;
} else |err| switch (err) { } else |err| switch (err) {
@ -218,7 +178,7 @@ fn roc_fx_getInt_32bit(output: *GetInt) callconv(.C) void {
return; return;
} }
fn roc_fx_getInt_help() !i64 { fn roc_fx_get_int_help() !i64 {
const stdout = std.io.getStdOut().writer(); const stdout = std.io.getStdOut().writer();
stdout.print("Please enter an integer\n", .{}) catch unreachable; stdout.print("Please enter an integer\n", .{}) catch unreachable;

8
crates/cli/tests/benchmarks/platform/main.roc
View file

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

34
crates/cli/tests/benchmarks/quicksortApp.roc
View file

File diff suppressed because one or more lines are too long

136
crates/cli/tests/benchmarks/rBTreeCk.roc
View file

@ -1,6 +1,6 @@
app [main] { pf: platform "platform/main.roc" } app [main!] { pf: platform "platform/main.roc" }
import pf.PlatformTasks import pf.Host
Color : [Red, Black] Color : [Red, Black]
@ -10,75 +10,75 @@ Map : Tree I64 Bool
ConsList a : [Nil, Cons a (ConsList a)] ConsList a : [Nil, Cons a (ConsList a)]
makeMap : I64, I64 -> ConsList Map make_map : I64, I64 -> ConsList Map
makeMap = \freq, n -> make_map = \freq, n ->
makeMapHelp freq n Leaf Nil make_map_help(freq, n, Leaf, Nil)
makeMapHelp : I64, I64, Map, ConsList Map -> ConsList Map make_map_help : I64, I64, Map, ConsList Map -> ConsList Map
makeMapHelp = \freq, n, m, acc -> make_map_help = \freq, n, m, acc ->
when n is when n is
0 -> Cons m acc 0 -> Cons(m, acc)
_ -> _ ->
powerOf10 = power_of10 =
n % 10 == 0 n % 10 == 0
m1 = insert m n powerOf10 m1 = insert(m, n, power_of10)
isFrequency = is_frequency =
n % freq == 0 n % freq == 0
x = (if isFrequency then Cons m1 acc else acc) x = (if is_frequency then Cons(m1, acc) else acc)
makeMapHelp freq (n - 1) m1 x make_map_help(freq, (n - 1), m1, x)
fold : (a, b, omega -> omega), Tree a b, omega -> omega fold : (a, b, omega -> omega), Tree a b, omega -> omega
fold = \f, tree, b -> fold = \f, tree, b ->
when tree is when tree is
Leaf -> b Leaf -> b
Node _ l k v r -> fold f r (f k v (fold f l b)) Node(_, l, k, v, r) -> fold(f, r, f(k, v, fold(f, l, b)))
main : Task {} [] main! : {} => {}
main = main! = \{} ->
{ value, isError } = PlatformTasks.getInt! { value, is_error } = Host.get_int!({})
inputResult = input_result =
if isError then if is_error then
Err GetIntError Err(GetIntError)
else else
Ok value Ok(value)
when inputResult is when input_result is
Ok n -> Ok(n) ->
# original koka n = 4_200_000 # original koka n = 4_200_000
ms : ConsList Map ms : ConsList Map
ms = makeMap 5 n ms = make_map(5, n)
when ms is when ms is
Cons head _ -> Cons(head, _) ->
val = fold (\_, v, r -> if v then r + 1 else r) head 0 val = fold(\_, v, r -> if v then r + 1 else r, head, 0)
val val
|> Num.toStr |> Num.toStr
|> PlatformTasks.putLine |> Host.put_line!
Nil -> Nil ->
PlatformTasks.putLine "fail" Host.put_line!("fail")
Err GetIntError -> Err(GetIntError) ->
PlatformTasks.putLine "Error: Failed to get Integer from stdin." Host.put_line!("Error: Failed to get Integer from stdin.")
insert : Tree (Num k) v, Num k, v -> Tree (Num k) v insert : Tree (Num k) v, Num k, v -> Tree (Num k) v
insert = \t, k, v -> if isRed t then setBlack (ins t k v) else ins t k v insert = \t, k, v -> if is_red(t) then set_black(ins(t, k, v)) else ins(t, k, v)
setBlack : Tree a b -> Tree a b set_black : Tree a b -> Tree a b
setBlack = \tree -> set_black = \tree ->
when tree is when tree is
Node _ l k v r -> Node Black l k v r Node(_, l, k, v, r) -> Node(Black, l, k, v, r)
_ -> tree _ -> tree
isRed : Tree a b -> Bool is_red : Tree a b -> Bool
isRed = \tree -> is_red = \tree ->
when tree is when tree is
Node Red _ _ _ _ -> Bool.true Node(Red, _, _, _, _) -> Bool.true
_ -> Bool.false _ -> Bool.false
lt = \x, y -> x < y lt = \x, y -> x < y
@ -86,43 +86,43 @@ lt = \x, y -> x < y
ins : Tree (Num k) v, Num k, v -> Tree (Num k) v ins : Tree (Num k) v, Num k, v -> Tree (Num k) v
ins = \tree, kx, vx -> ins = \tree, kx, vx ->
when tree is when tree is
Leaf -> Node Red Leaf kx vx Leaf Leaf -> Node(Red, Leaf, kx, vx, Leaf)
Node Red a ky vy b -> Node(Red, a, ky, vy, b) ->
if lt kx ky then if lt(kx, ky) then
Node Red (ins a kx vx) ky vy b Node(Red, ins(a, kx, vx), ky, vy, b)
else if lt ky kx then else if lt(ky, kx) then
Node Red a ky vy (ins b kx vx) Node(Red, a, ky, vy, ins(b, kx, vx))
else else
Node Red a ky vy (ins b kx vx) Node(Red, a, ky, vy, ins(b, kx, vx))
Node Black a ky vy b -> Node(Black, a, ky, vy, b) ->
if lt kx ky then if lt(kx, ky) then
if isRed a then if is_red(a) then
balance1 (Node Black Leaf ky vy b) (ins a kx vx) balance1(Node(Black, Leaf, ky, vy, b), ins(a, kx, vx))
else else
Node Black (ins a kx vx) ky vy b Node(Black, ins(a, kx, vx), ky, vy, b)
else if lt ky kx then else if lt(ky, kx) then
if isRed b then if is_red(b) then
balance2 (Node Black a ky vy Leaf) (ins b kx vx) balance2(Node(Black, a, ky, vy, Leaf), ins(b, kx, vx))
else else
Node Black a ky vy (ins b kx vx) Node(Black, a, ky, vy, ins(b, kx, vx))
else else
Node Black a kx vx b Node(Black, a, kx, vx, b)
balance1 : Tree a b, Tree a b -> Tree a b balance1 : Tree a b, Tree a b -> Tree a b
balance1 = \tree1, tree2 -> balance1 = \tree1, tree2 ->
when tree1 is when tree1 is
Leaf -> Leaf Leaf -> Leaf
Node _ _ kv vv t -> Node(_, _, kv, vv, t) ->
when tree2 is when tree2 is
Node _ (Node Red l kx vx r1) ky vy r2 -> Node(_, Node(Red, l, kx, vx, r1), ky, vy, r2) ->
Node Red (Node Black l kx vx r1) ky vy (Node Black r2 kv vv t) Node(Red, Node(Black, l, kx, vx, r1), ky, vy, Node(Black, r2, kv, vv, t))
Node _ l1 ky vy (Node Red l2 kx vx r) -> Node(_, l1, ky, vy, Node(Red, l2, kx, vx, r)) ->
Node Red (Node Black l1 ky vy l2) kx vx (Node Black r kv vv t) Node(Red, Node(Black, l1, ky, vy, l2), kx, vx, Node(Black, r, kv, vv, t))
Node _ l ky vy r -> Node(_, l, ky, vy, r) ->
Node Black (Node Red l ky vy r) kv vv t Node(Black, Node(Red, l, ky, vy, r), kv, vv, t)
Leaf -> Leaf Leaf -> Leaf
@ -130,16 +130,16 @@ balance2 : Tree a b, Tree a b -> Tree a b
balance2 = \tree1, tree2 -> balance2 = \tree1, tree2 ->
when tree1 is when tree1 is
Leaf -> Leaf Leaf -> Leaf
Node _ t kv vv _ -> Node(_, t, kv, vv, _) ->
when tree2 is when tree2 is
Node _ (Node Red l kx1 vx1 r1) ky vy r2 -> Node(_, Node(Red, l, kx1, vx1, r1), ky, vy, r2) ->
Node Red (Node Black t kv vv l) kx1 vx1 (Node Black r1 ky vy r2) Node(Red, Node(Black, t, kv, vv, l), kx1, vx1, Node(Black, r1, ky, vy, r2))
Node _ l1 ky vy (Node Red l2 kx2 vx2 r2) -> Node(_, l1, ky, vy, Node(Red, l2, kx2, vx2, r2)) ->
Node Red (Node Black t kv vv l1) ky vy (Node Black l2 kx2 vx2 r2) Node(Red, Node(Black, t, kv, vv, l1), ky, vy, Node(Black, l2, kx2, vx2, r2))
Node _ l ky vy r -> Node(_, l, ky, vy, r) ->
Node Black t kv vv (Node Red l ky vy r) Node(Black, t, kv, vv, Node(Red, l, ky, vy, r))
Leaf -> Leaf ->
Leaf Leaf

102
crates/cli/tests/benchmarks/rBTreeInsert.roc
View file

@ -1,45 +1,45 @@
app [main] { pf: platform "platform/main.roc" } app [main!] { pf: platform "platform/main.roc" }
import pf.PlatformTasks import pf.Host
main : Task {} [] main! : {} => {}
main = main! = \{} ->
tree : RedBlackTree I64 {} tree : RedBlackTree I64 {}
tree = insert 0 {} Empty tree = insert(0, {}, Empty)
tree tree
|> show |> show
|> PlatformTasks.putLine |> Host.put_line!
show : RedBlackTree I64 {} -> Str show : RedBlackTree I64 {} -> Str
show = \tree -> showRBTree tree Num.toStr (\{} -> "{}") show = \tree -> show_rb_tree(tree, Num.toStr, \{} -> "{}")
showRBTree : RedBlackTree k v, (k -> Str), (v -> Str) -> Str show_rb_tree : RedBlackTree k v, (k -> Str), (v -> Str) -> Str
showRBTree = \tree, showKey, showValue -> show_rb_tree = \tree, show_key, show_value ->
when tree is when tree is
Empty -> "Empty" Empty -> "Empty"
Node color key value left right -> Node(color, key, value, left, right) ->
sColor = showColor color s_color = show_color(color)
sKey = showKey key s_key = show_key(key)
sValue = showValue value s_value = show_value(value)
sL = nodeInParens left showKey showValue s_l = node_in_parens(left, show_key, show_value)
sR = nodeInParens right showKey showValue s_r = node_in_parens(right, show_key, show_value)
"Node $(sColor) $(sKey) $(sValue) $(sL) $(sR)" "Node $(s_color) $(s_key) $(s_value) $(s_l) $(s_r)"
nodeInParens : RedBlackTree k v, (k -> Str), (v -> Str) -> Str node_in_parens : RedBlackTree k v, (k -> Str), (v -> Str) -> Str
nodeInParens = \tree, showKey, showValue -> node_in_parens = \tree, show_key, show_value ->
when tree is when tree is
Empty -> Empty ->
showRBTree tree showKey showValue show_rb_tree(tree, show_key, show_value)
Node _ _ _ _ _ -> Node(_, _, _, _, _) ->
inner = showRBTree tree showKey showValue inner = show_rb_tree(tree, show_key, show_value)
"($(inner))" "($(inner))"
showColor : NodeColor -> Str show_color : NodeColor -> Str
showColor = \color -> show_color = \color ->
when color is when color is
Red -> "Red" Red -> "Red"
Black -> "Black" Black -> "Black"
@ -52,49 +52,51 @@ Key k : Num k
insert : Key k, v, RedBlackTree (Key k) v -> RedBlackTree (Key k) v insert : Key k, v, RedBlackTree (Key k) v -> RedBlackTree (Key k) v
insert = \key, value, dict -> insert = \key, value, dict ->
when insertHelp key value dict is when insert_help(key, value, dict) is
Node Red k v l r -> Node Black k v l r Node(Red, k, v, l, r) -> Node(Black, k, v, l, r)
x -> x x -> x
insertHelp : Key k, v, RedBlackTree (Key k) v -> RedBlackTree (Key k) v insert_help : Key k, v, RedBlackTree (Key k) v -> RedBlackTree (Key k) v
insertHelp = \key, value, dict -> insert_help = \key, value, dict ->
when dict is when dict is
Empty -> Empty ->
# New nodes are always red. If it violates the rules, it will be fixed # New nodes are always red. If it violates the rules, it will be fixed
# when balancing. # when balancing.
Node Red key value Empty Empty Node(Red, key, value, Empty, Empty)
Node nColor nKey nValue nLeft nRight -> Node(n_color, n_key, n_value, n_left, n_right) ->
when Num.compare key nKey is when Num.compare(key, n_key) is
LT -> balance nColor nKey nValue (insertHelp key value nLeft) nRight LT -> balance(n_color, n_key, n_value, insert_help(key, value, n_left), n_right)
EQ -> Node nColor nKey value nLeft nRight EQ -> Node(n_color, n_key, value, n_left, n_right)
GT -> balance nColor nKey nValue nLeft (insertHelp key value nRight) GT -> balance(n_color, n_key, n_value, n_left, insert_help(key, value, n_right))
balance : NodeColor, k, v, RedBlackTree k v, RedBlackTree k v -> RedBlackTree k v balance : NodeColor, k, v, RedBlackTree k v, RedBlackTree k v -> RedBlackTree k v
balance = \color, key, value, left, right -> balance = \color, key, value, left, right ->
when right is when right is
Node Red rK rV rLeft rRight -> Node(Red, r_k, r_v, r_left, r_right) ->
when left is when left is
Node Red lK lV lLeft lRight -> Node(Red, l_k, l_v, l_left, l_right) ->
Node Node(
Red Red,
key key,
value value,
(Node Black lK lV lLeft lRight) Node(Black, l_k, l_v, l_left, l_right),
(Node Black rK rV rLeft rRight) Node(Black, r_k, r_v, r_left, r_right),
)
_ -> _ ->
Node color rK rV (Node Red key value left rLeft) rRight Node(color, r_k, r_v, Node(Red, key, value, left, r_left), r_right)
_ -> _ ->
when left is when left is
Node Red lK lV (Node Red llK llV llLeft llRight) lRight -> Node(Red, l_k, l_v, Node(Red, ll_k, ll_v, ll_left, ll_right), l_right) ->
Node Node(
Red Red,
lK l_k,
lV l_v,
(Node Black llK llV llLeft llRight) Node(Black, ll_k, ll_v, ll_left, ll_right),
(Node Black key value lRight right) Node(Black, key, value, l_right, right),
)
_ -> _ ->
Node color key value left right Node(color, key, value, left, right)

26
crates/cli/tests/benchmarks/testAStar.roc
View file

@ -1,13 +1,13 @@
app [main] { pf: platform "platform/main.roc" } app [main!] { pf: platform "platform/main.roc" }
import pf.PlatformTasks import pf.Host
import AStar import AStar
main = main! = \{} ->
PlatformTasks.putLine! (showBool test1) Host.put_line!(show_bool(test1))
showBool : Bool -> Str show_bool : Bool -> Str
showBool = \b -> show_bool = \b ->
if if
b b
then then
@ -24,14 +24,14 @@ example1 =
step : I64 -> Set I64 step : I64 -> Set I64
step = \n -> step = \n ->
when n is when n is
1 -> Set.fromList [2, 3] 1 -> Set.fromList([2, 3])
2 -> Set.fromList [4] 2 -> Set.fromList([4])
3 -> Set.fromList [4] 3 -> Set.fromList([4])
_ -> Set.fromList [] _ -> Set.fromList([])
cost : I64, I64 -> F64 cost : I64, I64 -> F64
cost = \_, _ -> 1 cost = \_, _ -> 1
when AStar.findPath cost step 1 4 is when AStar.find_path(cost, step, 1, 4) is
Ok path -> path Ok(path) -> path
Err _ -> [] Err(_) -> []

24
crates/cli/tests/benchmarks/testBase64.roc
View file

@ -1,17 +1,15 @@
app [main] { pf: platform "platform/main.roc" } app [main!] { pf: platform "platform/main.roc" }
import Base64 import Base64
import pf.PlatformTasks import pf.Host
IO a : Task a [] main! : {} => {}
main! = \{} ->
when Base64.from_bytes(Str.toUtf8("Hello World")) is
Err(_) -> Host.put_line!("sadness")
Ok(encoded) ->
Host.put_line!(Str.concat("encoded: ", encoded))
main : IO {} when Base64.to_str(encoded) is
main = Ok(decoded) -> Host.put_line!(Str.concat("decoded: ", decoded))
when Base64.fromBytes (Str.toUtf8 "Hello World") is Err(_) -> Host.put_line!("sadness")
Err _ -> PlatformTasks.putLine "sadness"
Ok encoded ->
PlatformTasks.putLine! (Str.concat "encoded: " encoded)
when Base64.toStr encoded is
Ok decoded -> PlatformTasks.putLine (Str.concat "decoded: " decoded)
Err _ -> PlatformTasks.putLine "sadness"