mirror of
https://github.com/roc-lang/roc.git
synced 2025-08-31 00:57:24 +00:00
update benchmark platform to PI
This commit is contained in:
Brendan Hansknecht
parent
c85c864b5f
commit
07f930ca68
21 changed files with 652 additions and 690 deletions
|
|
@ -1,107 +1,107 @@
|
|||
module [findPath, Model, initialModel, cheapestOpen, reconstructPath]
|
||||
module [find_path, Model, initial_model, cheapest_open, reconstruct_path]
|
||||
|
||||
import Quicksort
|
||||
|
||||
findPath = \costFn, moveFn, start, end ->
|
||||
astar costFn moveFn end (initialModel start)
|
||||
find_path = \cost_fn, move_fn, start, end ->
|
||||
astar(cost_fn, move_fn, end, initial_model(start))
|
||||
|
||||
Model position : {
|
||||
evaluated : Set position,
|
||||
openSet : Set position,
|
||||
open_set : Set position,
|
||||
costs : Dict position F64,
|
||||
cameFrom : Dict position position,
|
||||
came_from : Dict position position,
|
||||
} where position implements Hash & Eq
|
||||
|
||||
initialModel : position -> Model position where position implements Hash & Eq
|
||||
initialModel = \start -> {
|
||||
evaluated: Set.empty {},
|
||||
openSet: Set.single start,
|
||||
costs: Dict.single start 0,
|
||||
cameFrom: Dict.empty {},
|
||||
initial_model : position -> Model position where position implements Hash & Eq
|
||||
initial_model = \start -> {
|
||||
evaluated: Set.empty({}),
|
||||
open_set: Set.single(start),
|
||||
costs: Dict.single(start, 0),
|
||||
came_from: Dict.empty({}),
|
||||
}
|
||||
|
||||
cheapestOpen : (position -> F64), Model position -> Result position {} where position implements Hash & Eq
|
||||
cheapestOpen = \costFn, model ->
|
||||
model.openSet
|
||||
cheapest_open : (position -> F64), Model position -> Result position {} where position implements Hash & Eq
|
||||
cheapest_open = \cost_fn, model ->
|
||||
model.open_set
|
||||
|> Set.toList
|
||||
|> List.keepOks
|
||||
(\position ->
|
||||
when Dict.get model.costs position is
|
||||
Err _ -> Err {}
|
||||
Ok cost -> Ok { cost: cost + costFn position, position }
|
||||
)
|
||||
|> Quicksort.sortBy .cost
|
||||
|> List.keepOks(
|
||||
\position ->
|
||||
when Dict.get(model.costs, position) is
|
||||
Err(_) -> Err({})
|
||||
Ok(cost) -> Ok({ cost: cost + cost_fn(position), position }),
|
||||
)
|
||||
|> Quicksort.sort_by(.cost)
|
||||
|> List.first
|
||||
|> Result.map .position
|
||||
|> Result.mapErr (\_ -> {})
|
||||
|> Result.map(.position)
|
||||
|> Result.mapErr(\_ -> {})
|
||||
|
||||
reconstructPath : Dict position position, position -> List position where position implements Hash & Eq
|
||||
reconstructPath = \cameFrom, goal ->
|
||||
when Dict.get cameFrom goal is
|
||||
Err _ -> []
|
||||
Ok next -> List.append (reconstructPath cameFrom next) goal
|
||||
reconstruct_path : Dict position position, position -> List position where position implements Hash & Eq
|
||||
reconstruct_path = \came_from, goal ->
|
||||
when Dict.get(came_from, goal) is
|
||||
Err(_) -> []
|
||||
Ok(next) -> List.append(reconstruct_path(came_from, next), goal)
|
||||
|
||||
updateCost : position, position, Model position -> Model position where position implements Hash & Eq
|
||||
updateCost = \current, neighbor, model ->
|
||||
newCameFrom =
|
||||
Dict.insert model.cameFrom neighbor current
|
||||
update_cost : position, position, Model position -> Model position where position implements Hash & Eq
|
||||
update_cost = \current, neighbor, model ->
|
||||
new_came_from =
|
||||
Dict.insert(model.came_from, neighbor, current)
|
||||
|
||||
newCosts =
|
||||
Dict.insert model.costs neighbor distanceTo
|
||||
new_costs =
|
||||
Dict.insert(model.costs, neighbor, distance_to)
|
||||
|
||||
distanceTo =
|
||||
reconstructPath newCameFrom neighbor
|
||||
distance_to =
|
||||
reconstruct_path(new_came_from, neighbor)
|
||||
|> List.len
|
||||
|> Num.toFrac
|
||||
|
||||
newModel =
|
||||
new_model =
|
||||
{ model &
|
||||
costs: newCosts,
|
||||
cameFrom: newCameFrom,
|
||||
costs: new_costs,
|
||||
came_from: new_came_from,
|
||||
}
|
||||
|
||||
when Dict.get model.costs neighbor is
|
||||
Err _ ->
|
||||
newModel
|
||||
when Dict.get(model.costs, neighbor) is
|
||||
Err(_) ->
|
||||
new_model
|
||||
|
||||
Ok previousDistance ->
|
||||
if distanceTo < previousDistance then
|
||||
newModel
|
||||
Ok(previous_distance) ->
|
||||
if distance_to < previous_distance then
|
||||
new_model
|
||||
else
|
||||
model
|
||||
|
||||
astar : (position, position -> F64), (position -> Set position), position, Model position -> Result (List position) {} where position implements Hash & Eq
|
||||
astar = \costFn, moveFn, goal, model ->
|
||||
when cheapestOpen (\source -> costFn source goal) model is
|
||||
Err {} -> Err {}
|
||||
Ok current ->
|
||||
astar = \cost_fn, move_fn, goal, model ->
|
||||
when cheapest_open(\source -> cost_fn(source, goal), model) is
|
||||
Err({}) -> Err({})
|
||||
Ok(current) ->
|
||||
if current == goal then
|
||||
Ok (reconstructPath model.cameFrom goal)
|
||||
Ok(reconstruct_path(model.came_from, goal))
|
||||
else
|
||||
modelPopped =
|
||||
model_popped =
|
||||
{ model &
|
||||
openSet: Set.remove model.openSet current,
|
||||
evaluated: Set.insert model.evaluated current,
|
||||
open_set: Set.remove(model.open_set, current),
|
||||
evaluated: Set.insert(model.evaluated, current),
|
||||
}
|
||||
|
||||
neighbors =
|
||||
moveFn current
|
||||
move_fn(current)
|
||||
|
||||
newNeighbors =
|
||||
Set.difference neighbors modelPopped.evaluated
|
||||
new_neighbors =
|
||||
Set.difference(neighbors, model_popped.evaluated)
|
||||
|
||||
modelWithNeighbors : Model position
|
||||
modelWithNeighbors =
|
||||
modelPopped
|
||||
|> &openSet (Set.union modelPopped.openSet newNeighbors)
|
||||
model_with_neighbors : Model position
|
||||
model_with_neighbors =
|
||||
model_popped
|
||||
|> &open_set(Set.union(model_popped.open_set, new_neighbors))
|
||||
|
||||
walker : Model position, position -> Model position
|
||||
walker = \amodel, n -> updateCost current n amodel
|
||||
walker = \amodel, n -> update_cost(current, n, amodel)
|
||||
|
||||
modelWithCosts =
|
||||
Set.walk newNeighbors modelWithNeighbors walker
|
||||
model_with_costs =
|
||||
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 ->
|
||||
# modelPopped =
|
||||
|
|
|
|||
|
|
@ -1,38 +1,38 @@
|
|||
module [fromBytes, fromStr, toBytes, toStr]
|
||||
module [from_bytes, from_str, to_bytes, to_str]
|
||||
|
||||
import Base64.Decode
|
||||
import Base64.Encode
|
||||
|
||||
# base 64 encoding from a sequence of bytes
|
||||
fromBytes : List U8 -> Result Str [InvalidInput]
|
||||
fromBytes = \bytes ->
|
||||
when Base64.Decode.fromBytes bytes is
|
||||
Ok v ->
|
||||
Ok v
|
||||
from_bytes : List U8 -> Result Str [InvalidInput]
|
||||
from_bytes = \bytes ->
|
||||
when Base64.Decode.from_bytes(bytes) is
|
||||
Ok(v) ->
|
||||
Ok(v)
|
||||
|
||||
Err _ ->
|
||||
Err InvalidInput
|
||||
Err(_) ->
|
||||
Err(InvalidInput)
|
||||
|
||||
# base 64 encoding from a string
|
||||
fromStr : Str -> Result Str [InvalidInput]
|
||||
fromStr = \str ->
|
||||
fromBytes (Str.toUtf8 str)
|
||||
from_str : Str -> Result Str [InvalidInput]
|
||||
from_str = \str ->
|
||||
from_bytes(Str.toUtf8(str))
|
||||
|
||||
# base64-encode bytes to the original
|
||||
toBytes : Str -> Result (List U8) [InvalidInput]
|
||||
toBytes = \str ->
|
||||
Ok (Base64.Encode.toBytes str)
|
||||
to_bytes : Str -> Result (List U8) [InvalidInput]
|
||||
to_bytes = \str ->
|
||||
Ok(Base64.Encode.to_bytes(str))
|
||||
|
||||
toStr : Str -> Result Str [InvalidInput]
|
||||
toStr = \str ->
|
||||
when toBytes str is
|
||||
Ok bytes ->
|
||||
when Str.fromUtf8 bytes is
|
||||
Ok v ->
|
||||
Ok v
|
||||
to_str : Str -> Result Str [InvalidInput]
|
||||
to_str = \str ->
|
||||
when to_bytes(str) is
|
||||
Ok(bytes) ->
|
||||
when Str.fromUtf8(bytes) is
|
||||
Ok(v) ->
|
||||
Ok(v)
|
||||
|
||||
Err _ ->
|
||||
Err InvalidInput
|
||||
Err(_) ->
|
||||
Err(InvalidInput)
|
||||
|
||||
Err _ ->
|
||||
Err InvalidInput
|
||||
Err(_) ->
|
||||
Err(InvalidInput)
|
||||
|
|
|
|||
|
|
@ -1,86 +1,86 @@
|
|||
module [fromBytes]
|
||||
module [from_bytes]
|
||||
|
||||
import Bytes.Decode exposing [ByteDecoder, DecodeProblem]
|
||||
|
||||
fromBytes : List U8 -> Result Str DecodeProblem
|
||||
fromBytes = \bytes ->
|
||||
Bytes.Decode.decode bytes (decodeBase64 (List.len bytes))
|
||||
from_bytes : List U8 -> Result Str DecodeProblem
|
||||
from_bytes = \bytes ->
|
||||
Bytes.Decode.decode(bytes, decode_base64(List.len(bytes)))
|
||||
|
||||
decodeBase64 : U64 -> ByteDecoder Str
|
||||
decodeBase64 = \width -> Bytes.Decode.loop loopHelp { remaining: width, string: "" }
|
||||
decode_base64 : U64 -> ByteDecoder Str
|
||||
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)
|
||||
loopHelp = \{ remaining, string } ->
|
||||
loop_help : { remaining : U64, string : Str } -> ByteDecoder (Bytes.Decode.Step { remaining : U64, string : Str } Str)
|
||||
loop_help = \{ remaining, string } ->
|
||||
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 = Num.intCast x
|
||||
a = Num.intCast(x)
|
||||
b : U32
|
||||
b = Num.intCast y
|
||||
b = Num.intCast(y)
|
||||
c : U32
|
||||
c = Num.intCast z
|
||||
combined = Num.bitwiseOr (Num.bitwiseOr (Num.shiftLeftBy a 16) (Num.shiftLeftBy b 8)) c
|
||||
c = Num.intCast(z)
|
||||
combined = Num.bitwiseOr(Num.bitwiseOr(Num.shiftLeftBy(a, 16), Num.shiftLeftBy(b, 8)), c)
|
||||
|
||||
Loop {
|
||||
Loop({
|
||||
remaining: remaining - 3,
|
||||
string: Str.concat string (bitsToChars combined 0),
|
||||
}
|
||||
string: Str.concat(string, bits_to_chars(combined, 0)),
|
||||
}))
|
||||
else if remaining == 0 then
|
||||
Bytes.Decode.succeed (Done string)
|
||||
Bytes.Decode.succeed(Done(string))
|
||||
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 = Num.intCast x
|
||||
a = Num.intCast(x)
|
||||
b : U32
|
||||
b = Num.intCast y
|
||||
combined = Num.bitwiseOr (Num.shiftLeftBy a 16) (Num.shiftLeftBy b 8)
|
||||
b = Num.intCast(y)
|
||||
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
|
||||
# remaining = 1
|
||||
Bytes.Decode.map Bytes.Decode.u8 \x ->
|
||||
Bytes.Decode.map(Bytes.Decode.u8, \x ->
|
||||
|
||||
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
|
||||
bitsToChars = \bits, missing ->
|
||||
when Str.fromUtf8 (bitsToCharsHelp bits missing) is
|
||||
Ok str -> str
|
||||
Err _ -> ""
|
||||
bits_to_chars : U32, Int * -> Str
|
||||
bits_to_chars = \bits, missing ->
|
||||
when Str.fromUtf8(bits_to_chars_help(bits, missing)) is
|
||||
Ok(str) -> str
|
||||
Err(_) -> ""
|
||||
|
||||
# Mask that can be used to get the lowest 6 bits of a binary number
|
||||
lowest6BitsMask : Int *
|
||||
lowest6BitsMask = 63
|
||||
lowest6_bits_mask : Int *
|
||||
lowest6_bits_mask = 63
|
||||
|
||||
bitsToCharsHelp : U32, Int * -> List U8
|
||||
bitsToCharsHelp = \bits, missing ->
|
||||
bits_to_chars_help : U32, Int * -> List U8
|
||||
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
|
||||
# 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.
|
||||
# any 6-bit number is a valid base64 digit, so this is actually safe
|
||||
p =
|
||||
Num.shiftRightZfBy bits 18
|
||||
Num.shiftRightZfBy(bits, 18)
|
||||
|> Num.intCast
|
||||
|> unsafeToChar
|
||||
|> unsafe_to_char
|
||||
|
||||
q =
|
||||
Num.bitwiseAnd (Num.shiftRightZfBy bits 12) lowest6BitsMask
|
||||
Num.bitwiseAnd(Num.shiftRightZfBy(bits, 12), lowest6_bits_mask)
|
||||
|> Num.intCast
|
||||
|> unsafeToChar
|
||||
|> unsafe_to_char
|
||||
|
||||
r =
|
||||
Num.bitwiseAnd (Num.shiftRightZfBy bits 6) lowest6BitsMask
|
||||
Num.bitwiseAnd(Num.shiftRightZfBy(bits, 6), lowest6_bits_mask)
|
||||
|> Num.intCast
|
||||
|> unsafeToChar
|
||||
|> unsafe_to_char
|
||||
|
||||
s =
|
||||
Num.bitwiseAnd bits lowest6BitsMask
|
||||
Num.bitwiseAnd(bits, lowest6_bits_mask)
|
||||
|> Num.intCast
|
||||
|> unsafeToChar
|
||||
|> unsafe_to_char
|
||||
|
||||
equals : U8
|
||||
equals = 61
|
||||
|
|
@ -94,8 +94,8 @@ bitsToCharsHelp = \bits, missing ->
|
|||
[]
|
||||
|
||||
# Base64 index to character/digit
|
||||
unsafeToChar : U8 -> U8
|
||||
unsafeToChar = \n ->
|
||||
unsafe_to_char : U8 -> U8
|
||||
unsafe_to_char = \n ->
|
||||
if n <= 25 then
|
||||
# uppercase characters
|
||||
65 + n
|
||||
|
|
|
|||
|
|
@ -1,22 +1,22 @@
|
|||
module [toBytes]
|
||||
module [to_bytes]
|
||||
|
||||
import Bytes.Encode exposing [ByteEncoder]
|
||||
|
||||
InvalidChar : U8
|
||||
|
||||
# State : [None, One U8, Two U8, Three U8]
|
||||
toBytes : Str -> List U8
|
||||
toBytes = \str ->
|
||||
to_bytes : Str -> List U8
|
||||
to_bytes = \str ->
|
||||
str
|
||||
|> Str.toUtf8
|
||||
|> encodeChunks
|
||||
|> encode_chunks
|
||||
|> Bytes.Encode.sequence
|
||||
|> Bytes.Encode.encode
|
||||
|
||||
encodeChunks : List U8 -> List ByteEncoder
|
||||
encodeChunks = \bytes ->
|
||||
List.walk bytes { output: [], accum: None } folder
|
||||
|> encodeResidual
|
||||
encode_chunks : List U8 -> List ByteEncoder
|
||||
encode_chunks = \bytes ->
|
||||
List.walk(bytes, { output: [], accum: None }, folder)
|
||||
|> encode_residual
|
||||
|
||||
coerce : U64, a -> a
|
||||
coerce = \_, x -> x
|
||||
|
|
@ -24,113 +24,114 @@ coerce = \_, x -> x
|
|||
# folder : { output : List ByteEncoder, accum : State }, U8 -> { output : List ByteEncoder, accum : State }
|
||||
folder = \{ output, accum }, char ->
|
||||
when accum is
|
||||
Unreachable n -> coerce n { output, accum: Unreachable n }
|
||||
None -> { output, accum: One char }
|
||||
One a -> { output, accum: Two a char }
|
||||
Two a b -> { output, accum: Three a b char }
|
||||
Three a b c ->
|
||||
when encodeCharacters a b c char is
|
||||
Ok encoder ->
|
||||
Unreachable(n) -> coerce(n, { output, accum: Unreachable(n) })
|
||||
None -> { output, accum: One(char) }
|
||||
One(a) -> { output, accum: Two(a, char) }
|
||||
Two(a, b) -> { output, accum: Three(a, b, char) }
|
||||
Three(a, b, c) ->
|
||||
when encode_characters(a, b, c, char) is
|
||||
Ok(encoder) ->
|
||||
{
|
||||
output: List.append output encoder,
|
||||
output: List.append(output, encoder),
|
||||
accum: None,
|
||||
}
|
||||
|
||||
Err _ ->
|
||||
Err(_) ->
|
||||
{ output, accum: None }
|
||||
|
||||
# SGVs bG8g V29y bGQ=
|
||||
# encodeResidual : { output : List ByteEncoder, accum : State } -> List ByteEncoder
|
||||
encodeResidual = \{ output, accum } ->
|
||||
encode_residual = \{ output, accum } ->
|
||||
when accum is
|
||||
Unreachable _ -> output
|
||||
Unreachable(_) -> output
|
||||
None -> output
|
||||
One _ -> output
|
||||
Two a b ->
|
||||
when encodeCharacters a b equals equals is
|
||||
Ok encoder -> List.append output encoder
|
||||
Err _ -> output
|
||||
One(_) -> output
|
||||
Two(a, b) ->
|
||||
when encode_characters(a, b, equals, equals) is
|
||||
Ok(encoder) -> List.append(output, encoder)
|
||||
Err(_) -> output
|
||||
|
||||
Three a b c ->
|
||||
when encodeCharacters a b c equals is
|
||||
Ok encoder -> List.append output encoder
|
||||
Err _ -> output
|
||||
Three(a, b, c) ->
|
||||
when encode_characters(a, b, c, equals) is
|
||||
Ok(encoder) -> List.append(output, encoder)
|
||||
Err(_) -> output
|
||||
|
||||
equals : U8
|
||||
equals = 61
|
||||
|
||||
# Convert 4 characters to 24 bits (as an ByteEncoder)
|
||||
encodeCharacters : U8, U8, U8, U8 -> Result ByteEncoder InvalidChar
|
||||
encodeCharacters = \a, b, c, d ->
|
||||
if !(isValidChar a) then
|
||||
Err a
|
||||
else if !(isValidChar b) then
|
||||
Err b
|
||||
encode_characters : U8, U8, U8, U8 -> Result ByteEncoder InvalidChar
|
||||
encode_characters = \a, b, c, d ->
|
||||
if !(is_valid_char(a)) then
|
||||
Err(a)
|
||||
else if !(is_valid_char(b)) then
|
||||
Err(b)
|
||||
else
|
||||
# `=` is the padding character, and must be special-cased
|
||||
# only the `c` and `d` char are allowed to be padding
|
||||
n1 = unsafeConvertChar a
|
||||
n2 = unsafeConvertChar b
|
||||
n1 = unsafe_convert_char(a)
|
||||
n2 = unsafe_convert_char(b)
|
||||
|
||||
x : U32
|
||||
x = Num.intCast n1
|
||||
x = Num.intCast(n1)
|
||||
|
||||
y : U32
|
||||
y = Num.intCast n2
|
||||
y = Num.intCast(n2)
|
||||
|
||||
if d == 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
|
||||
b1 : U8
|
||||
b1 = Num.intCast (Num.shiftRightBy n 16)
|
||||
b1 = Num.intCast(Num.shiftRightBy(n, 16))
|
||||
|
||||
Ok (Bytes.Encode.u8 b1)
|
||||
else if !(isValidChar c) then
|
||||
Err c
|
||||
Ok(Bytes.Encode.u8(b1))
|
||||
else if !(is_valid_char(c)) then
|
||||
Err(c)
|
||||
else
|
||||
n3 = unsafeConvertChar c
|
||||
n3 = unsafe_convert_char(c)
|
||||
|
||||
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 = Num.intCast (Num.shiftRightBy n 8)
|
||||
combined = Num.intCast(Num.shiftRightBy(n, 8))
|
||||
|
||||
Ok (Bytes.Encode.u16 BE combined)
|
||||
else if !(isValidChar d) then
|
||||
Err d
|
||||
Ok(Bytes.Encode.u16(BE, combined))
|
||||
else if !(is_valid_char(d)) then
|
||||
Err(d)
|
||||
else
|
||||
n3 = unsafeConvertChar c
|
||||
n4 = unsafeConvertChar d
|
||||
n3 = unsafe_convert_char(c)
|
||||
n4 = unsafe_convert_char(d)
|
||||
|
||||
z : U32
|
||||
z = Num.intCast n3
|
||||
z = Num.intCast(n3)
|
||||
|
||||
w : U32
|
||||
w = Num.intCast n4
|
||||
w = Num.intCast(n4)
|
||||
|
||||
n =
|
||||
Num.bitwiseOr
|
||||
(Num.bitwiseOr (Num.shiftLeftBy x 18) (Num.shiftLeftBy y 12))
|
||||
(Num.bitwiseOr (Num.shiftLeftBy z 6) w)
|
||||
Num.bitwiseOr(
|
||||
Num.bitwiseOr(Num.shiftLeftBy(x, 18), Num.shiftLeftBy(y, 12)),
|
||||
Num.bitwiseOr(Num.shiftLeftBy(z, 6), w),
|
||||
)
|
||||
|
||||
b3 : U8
|
||||
b3 = Num.intCast n
|
||||
b3 = Num.intCast(n)
|
||||
|
||||
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?
|
||||
# The base16 digits are: A-Z, a-z, 0-1, '+' and '/'
|
||||
isValidChar : U8 -> Bool
|
||||
isValidChar = \c ->
|
||||
if isAlphaNum c then
|
||||
is_valid_char : U8 -> Bool
|
||||
is_valid_char = \c ->
|
||||
if is_alpha_num(c) then
|
||||
Bool.true
|
||||
else
|
||||
when c is
|
||||
|
|
@ -145,14 +146,14 @@ isValidChar = \c ->
|
|||
_ ->
|
||||
Bool.false
|
||||
|
||||
isAlphaNum : U8 -> Bool
|
||||
isAlphaNum = \key ->
|
||||
is_alpha_num : U8 -> Bool
|
||||
is_alpha_num = \key ->
|
||||
(key >= 48 && key <= 57) || (key >= 64 && key <= 90) || (key >= 97 && key <= 122)
|
||||
|
||||
# Convert a base64 character/digit to its index
|
||||
# See also [Wikipedia](https://en.wikipedia.org/wiki/Base64#Base64_table)
|
||||
unsafeConvertChar : U8 -> U8
|
||||
unsafeConvertChar = \key ->
|
||||
unsafe_convert_char : U8 -> U8
|
||||
unsafe_convert_char = \key ->
|
||||
if key >= 65 && key <= 90 then
|
||||
# A-Z
|
||||
key - 65
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
module [text, asText]
|
||||
module [text, as_text]
|
||||
|
||||
text = "Hello, world!"
|
||||
|
||||
asText = Num.toStr
|
||||
as_text = Num.toStr
|
||||
|
|
|
|||
|
|
@ -1,75 +1,75 @@
|
|||
module [sortBy, sortWith, show]
|
||||
module [sort_by, sort_with, show]
|
||||
|
||||
show : List I64 -> Str
|
||||
show = \list ->
|
||||
if List.isEmpty list then
|
||||
if List.isEmpty(list) then
|
||||
"[]"
|
||||
else
|
||||
content =
|
||||
list
|
||||
|> List.map Num.toStr
|
||||
|> Str.joinWith ", "
|
||||
|> List.map(Num.toStr)
|
||||
|> Str.joinWith(", ")
|
||||
|
||||
"[$(content)]"
|
||||
|
||||
sortBy : List a, (a -> Num *) -> List a
|
||||
sortBy = \list, toComparable ->
|
||||
sortWith list (\x, y -> Num.compare (toComparable x) (toComparable y))
|
||||
sort_by : List a, (a -> Num *) -> List a
|
||||
sort_by = \list, to_comparable ->
|
||||
sort_with(list, \x, y -> Num.compare(to_comparable(x), to_comparable(y)))
|
||||
|
||||
Order a : a, a -> [LT, GT, EQ]
|
||||
|
||||
sortWith : List a, (a, a -> [LT, GT, EQ]) -> List a
|
||||
sortWith = \list, order ->
|
||||
n = List.len list
|
||||
sort_with : List a, (a, a -> [LT, GT, EQ]) -> List a
|
||||
sort_with = \list, order ->
|
||||
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
|
||||
quicksortHelp = \list, order, low, high ->
|
||||
quicksort_help : List a, Order a, U64, U64 -> List a
|
||||
quicksort_help = \list, order, low, high ->
|
||||
if low < high then
|
||||
when partition low high list order is
|
||||
Pair partitionIndex partitioned ->
|
||||
when partition(low, high, list, order) is
|
||||
Pair(partition_index, partitioned) ->
|
||||
partitioned
|
||||
|> quicksortHelp order low (Num.subSaturated partitionIndex 1)
|
||||
|> quicksortHelp order (partitionIndex + 1) high
|
||||
|> quicksort_help(order, low, Num.subSaturated(partition_index, 1))
|
||||
|> quicksort_help(order, (partition_index + 1), high)
|
||||
else
|
||||
list
|
||||
|
||||
partition : U64, U64, List a, Order a -> [Pair U64 (List a)]
|
||||
partition = \low, high, initialList, order ->
|
||||
when List.get initialList high is
|
||||
Ok pivot ->
|
||||
when partitionHelp low low initialList order high pivot is
|
||||
Pair newI newList ->
|
||||
Pair newI (swap newI high newList)
|
||||
partition = \low, high, initial_list, order ->
|
||||
when List.get(initial_list, high) is
|
||||
Ok(pivot) ->
|
||||
when partition_help(low, low, initial_list, order, high, pivot) is
|
||||
Pair(new_i, new_list) ->
|
||||
Pair(new_i, swap(new_i, high, new_list))
|
||||
|
||||
Err _ ->
|
||||
Pair low initialList
|
||||
Err(_) ->
|
||||
Pair(low, initial_list)
|
||||
|
||||
partitionHelp : U64, U64, List c, Order c, U64, c -> [Pair U64 (List c)]
|
||||
partitionHelp = \i, j, list, order, high, pivot ->
|
||||
partition_help : U64, U64, List c, Order c, U64, c -> [Pair U64 (List c)]
|
||||
partition_help = \i, j, list, order, high, pivot ->
|
||||
if j < high then
|
||||
when List.get list j is
|
||||
Ok value ->
|
||||
when order value pivot is
|
||||
when List.get(list, j) is
|
||||
Ok(value) ->
|
||||
when order(value, pivot) is
|
||||
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 ->
|
||||
partitionHelp i (j + 1) list order high pivot
|
||||
partition_help(i, (j + 1), list, order, high, pivot)
|
||||
|
||||
Err _ ->
|
||||
Pair i list
|
||||
Err(_) ->
|
||||
Pair(i, list)
|
||||
else
|
||||
Pair i list
|
||||
Pair(i, list)
|
||||
|
||||
swap : U64, U64, List a -> List a
|
||||
swap = \i, j, list ->
|
||||
when Pair (List.get list i) (List.get list j) is
|
||||
Pair (Ok atI) (Ok atJ) ->
|
||||
when Pair(List.get(list, i), List.get(list, j)) is
|
||||
Pair(Ok(at_i), Ok(at_j)) ->
|
||||
list
|
||||
|> List.set i atJ
|
||||
|> List.set j atI
|
||||
|> List.set(i, at_j)
|
||||
|> List.set(j, at_i)
|
||||
|
||||
_ ->
|
||||
[]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
main : Task {} []
|
||||
main =
|
||||
{ value, isError } = PlatformTasks.getInt!
|
||||
inputResult =
|
||||
if isError then
|
||||
Err GetIntError
|
||||
main! : {} => {}
|
||||
main! = \{} ->
|
||||
{ value, is_error } = Host.get_int!({})
|
||||
input_result =
|
||||
if is_error then
|
||||
Err(GetIntError)
|
||||
else
|
||||
Ok value
|
||||
Ok(value)
|
||||
|
||||
when inputResult is
|
||||
Ok n ->
|
||||
e = mkExpr n 1 # original koka n = 20 (set `ulimit -s unlimited` to avoid stack overflow for n = 20)
|
||||
unoptimized = eval e
|
||||
optimized = eval (constFolding (reassoc e))
|
||||
when input_result is
|
||||
Ok(n) ->
|
||||
e = mk_expr(n, 1) # original koka n = 20 (set `ulimit -s unlimited` to avoid stack overflow for n = 20)
|
||||
unoptimized = eval(e)
|
||||
optimized = eval(const_folding(reassoc(e)))
|
||||
|
||||
unoptimized
|
||||
|> Num.toStr
|
||||
|> Str.concat " & "
|
||||
|> Str.concat (Num.toStr optimized)
|
||||
|> PlatformTasks.putLine
|
||||
|> Str.concat(" & ")
|
||||
|> Str.concat(Num.toStr(optimized))
|
||||
|> Host.put_line!
|
||||
|
||||
Err GetIntError ->
|
||||
PlatformTasks.putLine "Error: Failed to get Integer from stdin."
|
||||
Err(GetIntError) ->
|
||||
Host.put_line!("Error: Failed to get Integer from stdin.")
|
||||
|
||||
Expr : [
|
||||
Add Expr Expr,
|
||||
|
|
@ -34,97 +34,97 @@ Expr : [
|
|||
Var I64,
|
||||
]
|
||||
|
||||
mkExpr : I64, I64 -> Expr
|
||||
mkExpr = \n, v ->
|
||||
mk_expr : I64, I64 -> Expr
|
||||
mk_expr = \n, v ->
|
||||
when n is
|
||||
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 = \a, b -> if a > b then a else b
|
||||
|
||||
appendAdd : Expr, Expr -> Expr
|
||||
appendAdd = \e1, e2 ->
|
||||
append_add : Expr, Expr -> Expr
|
||||
append_add = \e1, e2 ->
|
||||
when e1 is
|
||||
Add a1 a2 ->
|
||||
Add a1 (appendAdd a2 e2)
|
||||
Add(a1, a2) ->
|
||||
Add(a1, append_add(a2, e2))
|
||||
|
||||
_ ->
|
||||
Add e1 e2
|
||||
Add(e1, e2)
|
||||
|
||||
appendMul : Expr, Expr -> Expr
|
||||
appendMul = \e1, e2 ->
|
||||
append_mul : Expr, Expr -> Expr
|
||||
append_mul = \e1, e2 ->
|
||||
when e1 is
|
||||
Mul a1 a2 ->
|
||||
Mul a1 (appendMul a2 e2)
|
||||
Mul(a1, a2) ->
|
||||
Mul(a1, append_mul(a2, e2))
|
||||
|
||||
_ ->
|
||||
Mul e1 e2
|
||||
Mul(e1, e2)
|
||||
|
||||
eval : Expr -> I64
|
||||
eval = \e ->
|
||||
when e is
|
||||
Var _ ->
|
||||
Var(_) ->
|
||||
0
|
||||
|
||||
Val v ->
|
||||
Val(v) ->
|
||||
v
|
||||
|
||||
Add l r ->
|
||||
eval l + eval r
|
||||
Add(l, r) ->
|
||||
eval(l) + eval(r)
|
||||
|
||||
Mul l r ->
|
||||
eval l * eval r
|
||||
Mul(l, r) ->
|
||||
eval(l) * eval(r)
|
||||
|
||||
reassoc : Expr -> Expr
|
||||
reassoc = \e ->
|
||||
when e is
|
||||
Add e1 e2 ->
|
||||
x1 = reassoc e1
|
||||
x2 = reassoc e2
|
||||
Add(e1, e2) ->
|
||||
x1 = reassoc(e1)
|
||||
x2 = reassoc(e2)
|
||||
|
||||
appendAdd x1 x2
|
||||
append_add(x1, x2)
|
||||
|
||||
Mul e1 e2 ->
|
||||
x1 = reassoc e1
|
||||
x2 = reassoc e2
|
||||
Mul(e1, e2) ->
|
||||
x1 = reassoc(e1)
|
||||
x2 = reassoc(e2)
|
||||
|
||||
appendMul x1 x2
|
||||
append_mul(x1, x2)
|
||||
|
||||
_ ->
|
||||
e
|
||||
|
||||
constFolding : Expr -> Expr
|
||||
constFolding = \e ->
|
||||
const_folding : Expr -> Expr
|
||||
const_folding = \e ->
|
||||
when e is
|
||||
Add e1 e2 ->
|
||||
x1 = constFolding e1
|
||||
x2 = constFolding e2
|
||||
Add(e1, e2) ->
|
||||
x1 = const_folding(e1)
|
||||
x2 = const_folding(e2)
|
||||
|
||||
when x1 is
|
||||
Val a ->
|
||||
Val(a) ->
|
||||
when x2 is
|
||||
Val b -> Val (a + b)
|
||||
Add (Val b) x | Add x (Val b) -> Add (Val (a + b)) x
|
||||
_ -> Add x1 x2
|
||||
Val(b) -> Val((a + b))
|
||||
Add(Val(b), x) | Add(x, Val(b)) -> Add(Val((a + b)), x)
|
||||
_ -> Add(x1, x2)
|
||||
|
||||
_ -> Add x1 x2
|
||||
_ -> Add(x1, x2)
|
||||
|
||||
Mul e1 e2 ->
|
||||
x1 = constFolding e1
|
||||
x2 = constFolding e2
|
||||
Mul(e1, e2) ->
|
||||
x1 = const_folding(e1)
|
||||
x2 = const_folding(e2)
|
||||
|
||||
when x1 is
|
||||
Val a ->
|
||||
Val(a) ->
|
||||
when x2 is
|
||||
Val b -> Val (a * b)
|
||||
Mul (Val b) x | Mul x (Val b) -> Mul (Val (a * b)) x
|
||||
_ -> Mul x1 x2
|
||||
Val(b) -> Val((a * b))
|
||||
Mul(Val(b), x) | Mul(x, Val(b)) -> Mul(Val((a * b)), x)
|
||||
_ -> Mul(x1, x2)
|
||||
|
||||
_ -> Mul x1 x2
|
||||
_ -> Mul(x1, x2)
|
||||
|
||||
_ ->
|
||||
e
|
||||
|
|
|
|||
|
|
@ -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 = \_ ->
|
||||
Task.ok (foo toUnitBorrowed "a long string such that it's malloced")
|
||||
|> Task.map \_ -> {}
|
||||
Ok(foo(to_unit_borrowed, "a long string such that it's malloced"))
|
||||
|> 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 = \_ ->
|
||||
x : Str
|
||||
x = "a long string such that it's malloced"
|
||||
|
||||
Task.ok {}
|
||||
|> Task.map (\_ -> x)
|
||||
|> Task.map toUnit
|
||||
Ok({})
|
||||
|> Result.map(\_ -> x)
|
||||
|> Result.map(to_unit)
|
||||
|
||||
toUnit = \_ -> {}
|
||||
to_unit = \_ -> {}
|
||||
|
||||
# # ---
|
||||
closure3 : {} -> Task {} []
|
||||
closure3 : {} -> Result {} []
|
||||
closure3 = \_ ->
|
||||
x : Str
|
||||
x = "a long string such that it's malloced"
|
||||
|
||||
Task.ok {}
|
||||
|> Task.await (\_ -> Task.ok x |> Task.map (\_ -> {}))
|
||||
Ok({})
|
||||
|> Result.try(\_ -> Ok(x) |> Result.map(\_ -> {}))
|
||||
|
||||
# # ---
|
||||
closure4 : {} -> Task {} []
|
||||
closure4 : {} -> Result {} []
|
||||
closure4 = \_ ->
|
||||
x : Str
|
||||
x = "a long string such that it's malloced"
|
||||
|
||||
Task.ok {}
|
||||
|> Task.await (\_ -> Task.ok x)
|
||||
|> Task.map (\_ -> {})
|
||||
Ok({})
|
||||
|> Result.try(\_ -> Ok(x))
|
||||
|> Result.map(\_ -> {})
|
||||
|
|
|
|||
|
|
@ -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
|
||||
IO a : Task a []
|
||||
|
||||
main : Task {} []
|
||||
main =
|
||||
{ value, isError } = PlatformTasks.getInt!
|
||||
inputResult =
|
||||
if isError then
|
||||
Err GetIntError
|
||||
main! : {} => {}
|
||||
main! = \{} ->
|
||||
{ value, is_error } = Host.get_int!({})
|
||||
input_result =
|
||||
if is_error then
|
||||
Err(GetIntError)
|
||||
else
|
||||
Ok value
|
||||
Ok(value)
|
||||
|
||||
when inputResult is
|
||||
Ok n ->
|
||||
when input_result is
|
||||
Ok(n) ->
|
||||
x : Expr
|
||||
x = Var "x"
|
||||
x = Var("x")
|
||||
|
||||
f : Expr
|
||||
f = pow x x
|
||||
f = pow(x, x)
|
||||
|
||||
nest deriv n f # original koka n = 10
|
||||
|> Task.map \_ -> {}
|
||||
_ = nest!(deriv!, n, f) # original koka n = 10
|
||||
{}
|
||||
|
||||
Err GetIntError ->
|
||||
PlatformTasks.putLine "Error: Failed to get Integer from stdin."
|
||||
Err(GetIntError) ->
|
||||
Host.put_line!("Error: Failed to get Integer from stdin.")
|
||||
|
||||
nestHelp : I64, (I64, Expr -> IO Expr), I64, Expr -> IO Expr
|
||||
nestHelp = \s, f, m, x ->
|
||||
nest_help! : I64, (I64, Expr => Expr), I64, Expr => Expr
|
||||
nest_help! = \s, f!, m, x ->
|
||||
when m is
|
||||
0 -> Task.ok x
|
||||
0 -> x
|
||||
_ ->
|
||||
w = f! (s - m) x
|
||||
nestHelp s f (m - 1) w
|
||||
w = f!((s - m), x)
|
||||
nest_help!(s, f!, (m - 1), w)
|
||||
|
||||
nest : (I64, Expr -> IO Expr), I64, Expr -> IO Expr
|
||||
nest = \f, n, e -> nestHelp n f n e
|
||||
nest! : (I64, Expr => Expr), I64, Expr => Expr
|
||||
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]
|
||||
|
||||
divmod : I64, I64 -> Result { div : I64, mod : I64 } [DivByZero]
|
||||
divmod = \l, r ->
|
||||
when Pair (Num.divTruncChecked l r) (Num.remChecked l r) is
|
||||
Pair (Ok div) (Ok mod) -> Ok { div, mod }
|
||||
_ -> Err DivByZero
|
||||
when Pair(Num.divTruncChecked(l, r), Num.remChecked(l, r)) is
|
||||
Pair(Ok(div), Ok(mod)) -> Ok({ div, mod })
|
||||
_ -> Err(DivByZero)
|
||||
|
||||
pown : I64, I64 -> I64
|
||||
pown = \a, n ->
|
||||
|
|
@ -53,119 +51,119 @@ pown = \a, n ->
|
|||
0 -> 1
|
||||
1 -> a
|
||||
_ ->
|
||||
when divmod n 2 is
|
||||
Ok { div, mod } ->
|
||||
b = pown a div
|
||||
when divmod(n, 2) is
|
||||
Ok({ div, mod }) ->
|
||||
b = pown(a, div)
|
||||
|
||||
b * b * (if mod == 0 then 1 else a)
|
||||
|
||||
Err DivByZero ->
|
||||
Err(DivByZero) ->
|
||||
-1
|
||||
|
||||
add : Expr, Expr -> Expr
|
||||
add = \a, b ->
|
||||
when Pair a b is
|
||||
Pair (Val n) (Val m) ->
|
||||
Val (n + m)
|
||||
when Pair(a, b) is
|
||||
Pair(Val(n), Val(m)) ->
|
||||
Val((n + m))
|
||||
|
||||
Pair (Val 0) f ->
|
||||
Pair(Val(0), f) ->
|
||||
f
|
||||
|
||||
Pair f (Val 0) ->
|
||||
Pair(f, Val(0)) ->
|
||||
f
|
||||
|
||||
Pair f (Val n) ->
|
||||
add (Val n) f
|
||||
Pair(f, Val(n)) ->
|
||||
add(Val(n), f)
|
||||
|
||||
Pair (Val n) (Add (Val m) f) ->
|
||||
add (Val (n + m)) f
|
||||
Pair(Val(n), Add(Val(m), f)) ->
|
||||
add(Val((n + m)), f)
|
||||
|
||||
Pair f (Add (Val n) g) ->
|
||||
add (Val n) (add f g)
|
||||
Pair(f, Add(Val(n), g)) ->
|
||||
add(Val(n), add(f, g))
|
||||
|
||||
Pair (Add f g) h ->
|
||||
add f (add g h)
|
||||
Pair(Add(f, g), h) ->
|
||||
add(f, add(g, h))
|
||||
|
||||
Pair f g ->
|
||||
Add f g
|
||||
Pair(f, g) ->
|
||||
Add(f, g)
|
||||
|
||||
mul : Expr, Expr -> Expr
|
||||
mul = \a, b ->
|
||||
when Pair a b is
|
||||
Pair (Val n) (Val m) ->
|
||||
Val (n * m)
|
||||
when Pair(a, b) is
|
||||
Pair(Val(n), Val(m)) ->
|
||||
Val((n * m))
|
||||
|
||||
Pair (Val 0) _ ->
|
||||
Val 0
|
||||
Pair(Val(0), _) ->
|
||||
Val(0)
|
||||
|
||||
Pair _ (Val 0) ->
|
||||
Val 0
|
||||
Pair(_, Val(0)) ->
|
||||
Val(0)
|
||||
|
||||
Pair (Val 1) f ->
|
||||
Pair(Val(1), f) ->
|
||||
f
|
||||
|
||||
Pair f (Val 1) ->
|
||||
Pair(f, Val(1)) ->
|
||||
f
|
||||
|
||||
Pair f (Val n) ->
|
||||
mul (Val n) f
|
||||
Pair(f, Val(n)) ->
|
||||
mul(Val(n), f)
|
||||
|
||||
Pair (Val n) (Mul (Val m) f) ->
|
||||
mul (Val (n * m)) f
|
||||
Pair(Val(n), Mul(Val(m), f)) ->
|
||||
mul(Val((n * m)), f)
|
||||
|
||||
Pair f (Mul (Val n) g) ->
|
||||
mul (Val n) (mul f g)
|
||||
Pair(f, Mul(Val(n), g)) ->
|
||||
mul(Val(n), mul(f, g))
|
||||
|
||||
Pair (Mul f g) h ->
|
||||
mul f (mul g h)
|
||||
Pair(Mul(f, g), h) ->
|
||||
mul(f, mul(g, h))
|
||||
|
||||
Pair f g ->
|
||||
Mul f g
|
||||
Pair(f, g) ->
|
||||
Mul(f, g)
|
||||
|
||||
pow : Expr, Expr -> Expr
|
||||
pow = \a, b ->
|
||||
when Pair a b is
|
||||
Pair (Val m) (Val n) -> Val (pown m n)
|
||||
Pair _ (Val 0) -> Val 1
|
||||
Pair f (Val 1) -> f
|
||||
Pair (Val 0) _ -> Val 0
|
||||
Pair f g -> Pow f g
|
||||
when Pair(a, b) is
|
||||
Pair(Val(m), Val(n)) -> Val(pown(m, n))
|
||||
Pair(_, Val(0)) -> Val(1)
|
||||
Pair(f, Val(1)) -> f
|
||||
Pair(Val(0), _) -> Val(0)
|
||||
Pair(f, g) -> Pow(f, g)
|
||||
|
||||
ln : Expr -> Expr
|
||||
ln = \f ->
|
||||
when f is
|
||||
Val 1 -> Val 0
|
||||
_ -> Ln f
|
||||
Val(1) -> Val(0)
|
||||
_ -> Ln(f)
|
||||
|
||||
d : Str, Expr -> Expr
|
||||
d = \x, expr ->
|
||||
when expr is
|
||||
Val _ -> Val 0
|
||||
Var y -> if x == y then Val 1 else Val 0
|
||||
Add f g -> add (d x f) (d x g)
|
||||
Mul f g -> add (mul f (d x g)) (mul g (d x f))
|
||||
Pow f g ->
|
||||
mul (pow f g) (add (mul (mul g (d x f)) (pow f (Val (-1)))) (mul (ln f) (d x g)))
|
||||
Val(_) -> Val(0)
|
||||
Var(y) -> if x == y then Val(1) else Val(0)
|
||||
Add(f, g) -> add(d(x, f), d(x, g))
|
||||
Mul(f, g) -> add(mul(f, d(x, g)), mul(g, d(x, f)))
|
||||
Pow(f, g) ->
|
||||
mul(pow(f, g), add(mul(mul(g, d(x, f)), pow(f, Val(-1))), mul(ln(f), d(x, g))))
|
||||
|
||||
Ln f ->
|
||||
mul (d x f) (pow f (Val (-1)))
|
||||
Ln(f) ->
|
||||
mul(d(x, f), pow(f, Val(-1)))
|
||||
|
||||
count : Expr -> I64
|
||||
count = \expr ->
|
||||
when expr is
|
||||
Val _ -> 1
|
||||
Var _ -> 1
|
||||
Add f g -> count f + count g
|
||||
Mul f g -> count f + count g
|
||||
Pow f g -> count f + count g
|
||||
Ln f -> count f
|
||||
Val(_) -> 1
|
||||
Var(_) -> 1
|
||||
Add(f, g) -> count(f) + count(g)
|
||||
Mul(f, g) -> count(f) + count(g)
|
||||
Pow(f, g) -> count(f) + count(g)
|
||||
Ln(f) -> count(f)
|
||||
|
||||
deriv : I64, Expr -> IO Expr
|
||||
deriv = \i, f ->
|
||||
fprime = d "x" f
|
||||
deriv! : I64, Expr => Expr
|
||||
deriv! = \i, f ->
|
||||
fprime = d("x", f)
|
||||
line =
|
||||
Num.toStr (i + 1)
|
||||
|> Str.concat " count: "
|
||||
|> Str.concat (Num.toStr (count fprime))
|
||||
PlatformTasks.putLine! line
|
||||
Task.ok fprime
|
||||
Num.toStr((i + 1))
|
||||
|> Str.concat(" count: ")
|
||||
|> Str.concat(Num.toStr(count(fprime)))
|
||||
Host.put_line!(line)
|
||||
fprime
|
||||
|
|
|
|||
|
|
@ -1,13 +1,13 @@
|
|||
app [main] { pf: platform "platform/main.roc" }
|
||||
app [main!] { pf: platform "platform/main.roc" }
|
||||
|
||||
import Issue2279Help
|
||||
import pf.PlatformTasks
|
||||
import pf.Host
|
||||
|
||||
main =
|
||||
main! = \{} ->
|
||||
text =
|
||||
if Bool.true then
|
||||
Issue2279Help.text
|
||||
else
|
||||
Issue2279Help.asText 42
|
||||
Issue2279Help.as_text(42)
|
||||
|
||||
PlatformTasks.putLine text
|
||||
Host.put_line!(text)
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
{ value, isError } = PlatformTasks.getInt!
|
||||
inputResult =
|
||||
if isError then
|
||||
Err GetIntError
|
||||
main! : {} => {}
|
||||
main! = \{} ->
|
||||
{ value, is_error } = Host.get_int!({})
|
||||
input_result =
|
||||
if is_error then
|
||||
Err(GetIntError)
|
||||
else
|
||||
Ok value
|
||||
Ok(value)
|
||||
|
||||
when inputResult is
|
||||
Ok n ->
|
||||
queens n # original koka 13
|
||||
when input_result is
|
||||
Ok(n) ->
|
||||
queens(n) # original koka 13
|
||||
|> Num.toStr
|
||||
|> PlatformTasks.putLine
|
||||
|> Host.put_line!
|
||||
|
||||
Err GetIntError ->
|
||||
PlatformTasks.putLine "Error: Failed to get Integer from stdin."
|
||||
Err(GetIntError) ->
|
||||
Host.put_line!("Error: Failed to get Integer from stdin.")
|
||||
|
||||
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
|
||||
# should we use U64 as input type here instead?
|
||||
Cons Nil Nil
|
||||
Cons(Nil, Nil)
|
||||
else
|
||||
extend n Nil (findSolutions n (k - 1))
|
||||
extend(n, Nil, find_solutions(n, (k - 1)))
|
||||
|
||||
extend = \n, acc, solutions ->
|
||||
when solutions is
|
||||
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)
|
||||
appendSafe = \k, soln, solns ->
|
||||
append_safe : I64, ConsList I64, ConsList (ConsList I64) -> ConsList (ConsList I64)
|
||||
append_safe = \k, soln, solns ->
|
||||
if k <= 0 then
|
||||
solns
|
||||
else if safe k 1 soln then
|
||||
appendSafe (k - 1) soln (Cons (Cons k soln) solns)
|
||||
else if safe(k, 1, soln) then
|
||||
append_safe((k - 1), soln, Cons(Cons(k, soln), solns))
|
||||
else
|
||||
appendSafe (k - 1) soln solns
|
||||
append_safe((k - 1), soln, solns)
|
||||
|
||||
safe : I64, I64, ConsList I64 -> Bool
|
||||
safe = \queen, diagonal, xs ->
|
||||
when xs is
|
||||
Nil -> Bool.true
|
||||
Cons q t ->
|
||||
Cons(q, t) ->
|
||||
if queen != q && queen != q + diagonal && queen != q - diagonal then
|
||||
safe queen (diagonal + 1) t
|
||||
safe(queen, (diagonal + 1), t)
|
||||
else
|
||||
Bool.false
|
||||
|
||||
length : ConsList a -> I64
|
||||
length = \xs ->
|
||||
lengthHelp xs 0
|
||||
length_help(xs, 0)
|
||||
|
||||
lengthHelp : ConsList a, I64 -> I64
|
||||
lengthHelp = \foobar, acc ->
|
||||
length_help : ConsList a, I64 -> I64
|
||||
length_help = \foobar, acc ->
|
||||
when foobar is
|
||||
Cons _ lrest -> lengthHelp lrest (1 + acc)
|
||||
Cons(_, lrest) -> length_help(lrest, (1 + acc))
|
||||
Nil -> acc
|
||||
|
|
|
|||
9
crates/cli/tests/benchmarks/platform/Host.roc
Normal file
9
crates/cli/tests/benchmarks/platform/Host.roc
Normal 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 }
|
||||
|
|
@ -1,9 +0,0 @@
|
|||
hosted PlatformTasks
|
||||
exposes [putLine, putInt, getInt]
|
||||
imports []
|
||||
|
||||
putLine : Str -> Task {} *
|
||||
|
||||
putInt : I64 -> Task {} *
|
||||
|
||||
getInt : Task { value : I64, isError : Bool } *
|
||||
|
|
@ -1,3 +1,4 @@
|
|||
app [main] { pf: platform "main.roc" }
|
||||
app [main!] { pf: platform "main.roc" }
|
||||
|
||||
main = Task.ok {}
|
||||
main! : {} => {}
|
||||
main! = \{} -> {}
|
||||
|
|
|
|||
|
|
@ -10,11 +10,7 @@ const maxInt = std.math.maxInt;
|
|||
const mem = std.mem;
|
||||
const Allocator = mem.Allocator;
|
||||
|
||||
extern fn roc__mainForHost_1_exposed_generic([*]u8) 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;
|
||||
extern fn roc__main_for_host_1_exposed() void;
|
||||
|
||||
const Align = 2 * @alignOf(usize);
|
||||
extern fn malloc(size: usize) callconv(.C) ?*align(Align) anyopaque;
|
||||
|
|
@ -112,48 +108,12 @@ comptime {
|
|||
const Unit = extern struct {};
|
||||
|
||||
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
|
||||
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);
|
||||
roc__main_for_host_1_exposed();
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
fn call_the_closure(closure_data_pointer: [*]u8) void {
|
||||
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 {
|
||||
pub export fn roc_fx_put_int(int: i64) i64 {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
|
||||
stdout.print("{d}", .{int}) catch unreachable;
|
||||
|
|
@ -163,7 +123,7 @@ pub export fn roc_fx_putInt(int: i64) i64 {
|
|||
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();
|
||||
|
||||
for (rocPath.asSlice()) |char| {
|
||||
|
|
@ -180,14 +140,14 @@ const GetInt = extern struct {
|
|||
|
||||
comptime {
|
||||
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 {
|
||||
@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 {
|
||||
if (roc_fx_getInt_help()) |value| {
|
||||
fn roc_fx_get_int_64bit() callconv(.C) GetInt {
|
||||
if (roc_fx_get_int_help()) |value| {
|
||||
const get_int = GetInt{ .is_error = false, .value = value };
|
||||
return get_int;
|
||||
} else |err| switch (err) {
|
||||
|
|
@ -202,8 +162,8 @@ fn roc_fx_getInt_64bit() callconv(.C) GetInt {
|
|||
return 0;
|
||||
}
|
||||
|
||||
fn roc_fx_getInt_32bit(output: *GetInt) callconv(.C) void {
|
||||
if (roc_fx_getInt_help()) |value| {
|
||||
fn roc_fx_get_int_32bit(output: *GetInt) callconv(.C) void {
|
||||
if (roc_fx_get_int_help()) |value| {
|
||||
const get_int = GetInt{ .is_error = false, .value = value };
|
||||
output.* = get_int;
|
||||
} else |err| switch (err) {
|
||||
|
|
@ -218,7 +178,7 @@ fn roc_fx_getInt_32bit(output: *GetInt) callconv(.C) void {
|
|||
return;
|
||||
}
|
||||
|
||||
fn roc_fx_getInt_help() !i64 {
|
||||
fn roc_fx_get_int_help() !i64 {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
stdout.print("Please enter an integer\n", .{}) catch unreachable;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
platform "benchmarks"
|
||||
requires {} { main : Task {} [] }
|
||||
requires {} { main! : {} => {} }
|
||||
exposes []
|
||||
packages {}
|
||||
imports []
|
||||
provides [mainForHost]
|
||||
provides [main_for_host!]
|
||||
|
||||
mainForHost : Task {} []
|
||||
mainForHost = main
|
||||
main_for_host! : {} => {}
|
||||
main_for_host! = \{} -> main! {}
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
|
|
@ -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]
|
||||
|
||||
|
|
@ -10,75 +10,75 @@ Map : Tree I64 Bool
|
|||
|
||||
ConsList a : [Nil, Cons a (ConsList a)]
|
||||
|
||||
makeMap : I64, I64 -> ConsList Map
|
||||
makeMap = \freq, n ->
|
||||
makeMapHelp freq n Leaf Nil
|
||||
make_map : I64, I64 -> ConsList Map
|
||||
make_map = \freq, n ->
|
||||
make_map_help(freq, n, Leaf, Nil)
|
||||
|
||||
makeMapHelp : I64, I64, Map, ConsList Map -> ConsList Map
|
||||
makeMapHelp = \freq, n, m, acc ->
|
||||
make_map_help : I64, I64, Map, ConsList Map -> ConsList Map
|
||||
make_map_help = \freq, n, m, acc ->
|
||||
when n is
|
||||
0 -> Cons m acc
|
||||
0 -> Cons(m, acc)
|
||||
_ ->
|
||||
powerOf10 =
|
||||
power_of10 =
|
||||
n % 10 == 0
|
||||
|
||||
m1 = insert m n powerOf10
|
||||
m1 = insert(m, n, power_of10)
|
||||
|
||||
isFrequency =
|
||||
is_frequency =
|
||||
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 = \f, tree, b ->
|
||||
when tree is
|
||||
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 =
|
||||
{ value, isError } = PlatformTasks.getInt!
|
||||
inputResult =
|
||||
if isError then
|
||||
Err GetIntError
|
||||
main! : {} => {}
|
||||
main! = \{} ->
|
||||
{ value, is_error } = Host.get_int!({})
|
||||
input_result =
|
||||
if is_error then
|
||||
Err(GetIntError)
|
||||
else
|
||||
Ok value
|
||||
Ok(value)
|
||||
|
||||
when inputResult is
|
||||
Ok n ->
|
||||
when input_result is
|
||||
Ok(n) ->
|
||||
# original koka n = 4_200_000
|
||||
ms : ConsList Map
|
||||
ms = makeMap 5 n
|
||||
ms = make_map(5, n)
|
||||
|
||||
when ms is
|
||||
Cons head _ ->
|
||||
val = fold (\_, v, r -> if v then r + 1 else r) head 0
|
||||
Cons(head, _) ->
|
||||
val = fold(\_, v, r -> if v then r + 1 else r, head, 0)
|
||||
|
||||
val
|
||||
|> Num.toStr
|
||||
|> PlatformTasks.putLine
|
||||
|> Host.put_line!
|
||||
|
||||
Nil ->
|
||||
PlatformTasks.putLine "fail"
|
||||
Host.put_line!("fail")
|
||||
|
||||
Err GetIntError ->
|
||||
PlatformTasks.putLine "Error: Failed to get Integer from stdin."
|
||||
Err(GetIntError) ->
|
||||
Host.put_line!("Error: Failed to get Integer from stdin.")
|
||||
|
||||
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
|
||||
setBlack = \tree ->
|
||||
set_black : Tree a b -> Tree a b
|
||||
set_black = \tree ->
|
||||
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
|
||||
|
||||
isRed : Tree a b -> Bool
|
||||
isRed = \tree ->
|
||||
is_red : Tree a b -> Bool
|
||||
is_red = \tree ->
|
||||
when tree is
|
||||
Node Red _ _ _ _ -> Bool.true
|
||||
Node(Red, _, _, _, _) -> Bool.true
|
||||
_ -> Bool.false
|
||||
|
||||
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, kx, vx ->
|
||||
when tree is
|
||||
Leaf -> Node Red Leaf kx vx Leaf
|
||||
Node Red a ky vy b ->
|
||||
if lt kx ky then
|
||||
Node Red (ins a kx vx) ky vy b
|
||||
else if lt ky kx then
|
||||
Node Red a ky vy (ins b kx vx)
|
||||
Leaf -> Node(Red, Leaf, kx, vx, Leaf)
|
||||
Node(Red, a, ky, vy, b) ->
|
||||
if lt(kx, ky) then
|
||||
Node(Red, ins(a, kx, vx), ky, vy, b)
|
||||
else if lt(ky, kx) then
|
||||
Node(Red, a, ky, vy, ins(b, kx, vx))
|
||||
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 ->
|
||||
if lt kx ky then
|
||||
if isRed a then
|
||||
balance1 (Node Black Leaf ky vy b) (ins a kx vx)
|
||||
Node(Black, a, ky, vy, b) ->
|
||||
if lt(kx, ky) then
|
||||
if is_red(a) then
|
||||
balance1(Node(Black, Leaf, ky, vy, b), ins(a, kx, vx))
|
||||
else
|
||||
Node Black (ins a kx vx) ky vy b
|
||||
else if lt ky kx then
|
||||
if isRed b then
|
||||
balance2 (Node Black a ky vy Leaf) (ins b kx vx)
|
||||
Node(Black, ins(a, kx, vx), ky, vy, b)
|
||||
else if lt(ky, kx) then
|
||||
if is_red(b) then
|
||||
balance2(Node(Black, a, ky, vy, Leaf), ins(b, kx, vx))
|
||||
else
|
||||
Node Black a ky vy (ins b kx vx)
|
||||
Node(Black, a, ky, vy, ins(b, kx, vx))
|
||||
else
|
||||
Node Black a kx vx b
|
||||
Node(Black, a, kx, vx, b)
|
||||
|
||||
balance1 : Tree a b, Tree a b -> Tree a b
|
||||
balance1 = \tree1, tree2 ->
|
||||
when tree1 is
|
||||
Leaf -> Leaf
|
||||
Node _ _ kv vv t ->
|
||||
Node(_, _, kv, vv, t) ->
|
||||
when tree2 is
|
||||
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(_, 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 _ 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(_, 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 _ l ky vy r ->
|
||||
Node Black (Node Red l ky vy r) kv vv t
|
||||
Node(_, l, ky, vy, r) ->
|
||||
Node(Black, Node(Red, l, ky, vy, r), kv, vv, t)
|
||||
|
||||
Leaf -> Leaf
|
||||
|
||||
|
|
@ -130,16 +130,16 @@ balance2 : Tree a b, Tree a b -> Tree a b
|
|||
balance2 = \tree1, tree2 ->
|
||||
when tree1 is
|
||||
Leaf -> Leaf
|
||||
Node _ t kv vv _ ->
|
||||
Node(_, t, kv, vv, _) ->
|
||||
when tree2 is
|
||||
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(_, 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 _ 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(_, 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 _ l ky vy r ->
|
||||
Node Black t kv vv (Node Red l ky vy r)
|
||||
Node(_, l, ky, vy, r) ->
|
||||
Node(Black, t, kv, vv, Node(Red, l, ky, vy, r))
|
||||
|
||||
Leaf ->
|
||||
Leaf
|
||||
|
|
|
|||
|
|
@ -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 = insert 0 {} Empty
|
||||
tree = insert(0, {}, Empty)
|
||||
|
||||
tree
|
||||
|> show
|
||||
|> PlatformTasks.putLine
|
||||
|> Host.put_line!
|
||||
|
||||
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
|
||||
showRBTree = \tree, showKey, showValue ->
|
||||
show_rb_tree : RedBlackTree k v, (k -> Str), (v -> Str) -> Str
|
||||
show_rb_tree = \tree, show_key, show_value ->
|
||||
when tree is
|
||||
Empty -> "Empty"
|
||||
Node color key value left right ->
|
||||
sColor = showColor color
|
||||
sKey = showKey key
|
||||
sValue = showValue value
|
||||
sL = nodeInParens left showKey showValue
|
||||
sR = nodeInParens right showKey showValue
|
||||
Node(color, key, value, left, right) ->
|
||||
s_color = show_color(color)
|
||||
s_key = show_key(key)
|
||||
s_value = show_value(value)
|
||||
s_l = node_in_parens(left, show_key, show_value)
|
||||
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
|
||||
nodeInParens = \tree, showKey, showValue ->
|
||||
node_in_parens : RedBlackTree k v, (k -> Str), (v -> Str) -> Str
|
||||
node_in_parens = \tree, show_key, show_value ->
|
||||
when tree is
|
||||
Empty ->
|
||||
showRBTree tree showKey showValue
|
||||
show_rb_tree(tree, show_key, show_value)
|
||||
|
||||
Node _ _ _ _ _ ->
|
||||
inner = showRBTree tree showKey showValue
|
||||
Node(_, _, _, _, _) ->
|
||||
inner = show_rb_tree(tree, show_key, show_value)
|
||||
|
||||
"($(inner))"
|
||||
|
||||
showColor : NodeColor -> Str
|
||||
showColor = \color ->
|
||||
show_color : NodeColor -> Str
|
||||
show_color = \color ->
|
||||
when color is
|
||||
Red -> "Red"
|
||||
Black -> "Black"
|
||||
|
|
@ -52,49 +52,51 @@ Key k : Num k
|
|||
|
||||
insert : Key k, v, RedBlackTree (Key k) v -> RedBlackTree (Key k) v
|
||||
insert = \key, value, dict ->
|
||||
when insertHelp key value dict is
|
||||
Node Red k v l r -> Node Black k v l r
|
||||
when insert_help(key, value, dict) is
|
||||
Node(Red, k, v, l, r) -> Node(Black, k, v, l, r)
|
||||
x -> x
|
||||
|
||||
insertHelp : Key k, v, RedBlackTree (Key k) v -> RedBlackTree (Key k) v
|
||||
insertHelp = \key, value, dict ->
|
||||
insert_help : Key k, v, RedBlackTree (Key k) v -> RedBlackTree (Key k) v
|
||||
insert_help = \key, value, dict ->
|
||||
when dict is
|
||||
Empty ->
|
||||
# New nodes are always red. If it violates the rules, it will be fixed
|
||||
# when balancing.
|
||||
Node Red key value Empty Empty
|
||||
Node(Red, key, value, Empty, Empty)
|
||||
|
||||
Node nColor nKey nValue nLeft nRight ->
|
||||
when Num.compare key nKey is
|
||||
LT -> balance nColor nKey nValue (insertHelp key value nLeft) nRight
|
||||
EQ -> Node nColor nKey value nLeft nRight
|
||||
GT -> balance nColor nKey nValue nLeft (insertHelp key value nRight)
|
||||
Node(n_color, n_key, n_value, n_left, n_right) ->
|
||||
when Num.compare(key, n_key) is
|
||||
LT -> balance(n_color, n_key, n_value, insert_help(key, value, n_left), n_right)
|
||||
EQ -> Node(n_color, n_key, value, n_left, n_right)
|
||||
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 = \color, key, value, left, right ->
|
||||
when right is
|
||||
Node Red rK rV rLeft rRight ->
|
||||
Node(Red, r_k, r_v, r_left, r_right) ->
|
||||
when left is
|
||||
Node Red lK lV lLeft lRight ->
|
||||
Node
|
||||
Red
|
||||
key
|
||||
value
|
||||
(Node Black lK lV lLeft lRight)
|
||||
(Node Black rK rV rLeft rRight)
|
||||
Node(Red, l_k, l_v, l_left, l_right) ->
|
||||
Node(
|
||||
Red,
|
||||
key,
|
||||
value,
|
||||
Node(Black, l_k, l_v, l_left, l_right),
|
||||
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
|
||||
Node Red lK lV (Node Red llK llV llLeft llRight) lRight ->
|
||||
Node
|
||||
Red
|
||||
lK
|
||||
lV
|
||||
(Node Black llK llV llLeft llRight)
|
||||
(Node Black key value lRight right)
|
||||
Node(Red, l_k, l_v, Node(Red, ll_k, ll_v, ll_left, ll_right), l_right) ->
|
||||
Node(
|
||||
Red,
|
||||
l_k,
|
||||
l_v,
|
||||
Node(Black, ll_k, ll_v, ll_left, ll_right),
|
||||
Node(Black, key, value, l_right, right),
|
||||
)
|
||||
|
||||
_ ->
|
||||
Node color key value left right
|
||||
Node(color, key, value, left, right)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
main =
|
||||
PlatformTasks.putLine! (showBool test1)
|
||||
main! = \{} ->
|
||||
Host.put_line!(show_bool(test1))
|
||||
|
||||
showBool : Bool -> Str
|
||||
showBool = \b ->
|
||||
show_bool : Bool -> Str
|
||||
show_bool = \b ->
|
||||
if
|
||||
b
|
||||
then
|
||||
|
|
@ -24,14 +24,14 @@ example1 =
|
|||
step : I64 -> Set I64
|
||||
step = \n ->
|
||||
when n is
|
||||
1 -> Set.fromList [2, 3]
|
||||
2 -> Set.fromList [4]
|
||||
3 -> Set.fromList [4]
|
||||
_ -> Set.fromList []
|
||||
1 -> Set.fromList([2, 3])
|
||||
2 -> Set.fromList([4])
|
||||
3 -> Set.fromList([4])
|
||||
_ -> Set.fromList([])
|
||||
|
||||
cost : I64, I64 -> F64
|
||||
cost = \_, _ -> 1
|
||||
|
||||
when AStar.findPath cost step 1 4 is
|
||||
Ok path -> path
|
||||
Err _ -> []
|
||||
when AStar.find_path(cost, step, 1, 4) is
|
||||
Ok(path) -> path
|
||||
Err(_) -> []
|
||||
|
|
|
|||
|
|
@ -1,17 +1,15 @@
|
|||
app [main] { pf: platform "platform/main.roc" }
|
||||
app [main!] { pf: platform "platform/main.roc" }
|
||||
|
||||
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 {}
|
||||
main =
|
||||
when Base64.fromBytes (Str.toUtf8 "Hello World") is
|
||||
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"
|
||||
when Base64.to_str(encoded) is
|
||||
Ok(decoded) -> Host.put_line!(Str.concat("decoded: ", decoded))
|
||||
Err(_) -> Host.put_line!("sadness")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue