mirror of
https://github.com/roc-lang/roc.git
synced 2025-10-02 00:01:16 +00:00
Merge remote-tracking branch 'origin/main' into roc-dev-inline-expects
This commit is contained in:
Folkert
commit
e62ab00c65
275 changed files with 4038 additions and 2432 deletions
|
|
@ -100,8 +100,6 @@ indoc = "1.0.7"
|
|||
serial_test = "0.9.0"
|
||||
criterion = { git = "https://github.com/Anton-4/criterion.rs"}
|
||||
cli_utils = { path = "../cli_utils" }
|
||||
strum = "0.24.0"
|
||||
strum_macros = "0.24"
|
||||
once_cell = "1.14.0"
|
||||
parking_lot = "0.12"
|
||||
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -1,5 +1,5 @@
|
|||
app "type-error"
|
||||
packages { pf: "../../../../examples/interactive/cli-platform/main.roc" }
|
||||
packages { pf: "../../../../examples/cli/cli-platform/main.roc" }
|
||||
imports [pf.Stdout.{ line }, pf.Task.{ await }, pf.Program]
|
||||
provides [main] to pf
|
||||
|
||||
|
|
|
|||
6
crates/cli_testing_examples/.gitignore
vendored
Normal file
6
crates/cli_testing_examples/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
*.dSYM
|
||||
libhost.a
|
||||
libapp.so
|
||||
dynhost
|
||||
preprocessedhost
|
||||
metadata
|
||||
2
crates/cli_testing_examples/algorithms/.gitignore
vendored
Normal file
2
crates/cli_testing_examples/algorithms/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
fibonacci
|
||||
quicksort
|
||||
15
crates/cli_testing_examples/algorithms/README.md
Normal file
15
crates/cli_testing_examples/algorithms/README.md
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
# Algorithm examples
|
||||
|
||||
To run:
|
||||
|
||||
```bash
|
||||
cargo run fibonacci.roc
|
||||
cargo run quicksort.roc
|
||||
```
|
||||
|
||||
To run in release mode instead, do:
|
||||
|
||||
```bash
|
||||
cargo run --release fibonacci.roc
|
||||
cargo run --release quicksort.roc
|
||||
```
|
||||
|
|
@ -0,0 +1,109 @@
|
|||
const std = @import("std");
|
||||
const testing = std.testing;
|
||||
const expectEqual = testing.expectEqual;
|
||||
const expect = testing.expect;
|
||||
const maxInt = std.math.maxInt;
|
||||
|
||||
comptime {
|
||||
// This is a workaround for https://github.com/ziglang/zig/issues/8218
|
||||
// which is only necessary on macOS.
|
||||
//
|
||||
// Once that issue is fixed, we can undo the changes in
|
||||
// 177cf12e0555147faa4d436e52fc15175c2c4ff0 and go back to passing
|
||||
// -fcompiler-rt in link.rs instead of doing this. Note that this
|
||||
// workaround is present in many host.zig files, so make sure to undo
|
||||
// it everywhere!
|
||||
const builtin = @import("builtin");
|
||||
if (builtin.os.tag == .macos) {
|
||||
_ = @import("compiler_rt");
|
||||
}
|
||||
}
|
||||
|
||||
const mem = std.mem;
|
||||
const Allocator = mem.Allocator;
|
||||
|
||||
// NOTE the LLVM backend expects this signature
|
||||
// extern fn roc__mainForHost_1_exposed(i64, *i64) void;
|
||||
extern fn roc__mainForHost_1_exposed(i64) i64;
|
||||
|
||||
const Align = 2 * @alignOf(usize);
|
||||
extern fn malloc(size: usize) callconv(.C) ?*align(Align) anyopaque;
|
||||
extern fn realloc(c_ptr: [*]align(Align) u8, size: usize) callconv(.C) ?*anyopaque;
|
||||
extern fn free(c_ptr: [*]align(Align) u8) callconv(.C) void;
|
||||
extern fn memcpy(dst: [*]u8, src: [*]u8, size: usize) callconv(.C) void;
|
||||
extern fn memset(dst: [*]u8, value: i32, size: usize) callconv(.C) void;
|
||||
|
||||
const DEBUG: bool = false;
|
||||
|
||||
export fn roc_alloc(size: usize, alignment: u32) callconv(.C) ?*anyopaque {
|
||||
if (DEBUG) {
|
||||
var ptr = malloc(size);
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
stdout.print("alloc: {d} (alignment {d}, size {d})\n", .{ ptr, alignment, size }) catch unreachable;
|
||||
return ptr;
|
||||
} else {
|
||||
return malloc(size);
|
||||
}
|
||||
}
|
||||
|
||||
export fn roc_realloc(c_ptr: *anyopaque, new_size: usize, old_size: usize, alignment: u32) callconv(.C) ?*anyopaque {
|
||||
if (DEBUG) {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
stdout.print("realloc: {d} (alignment {d}, old_size {d})\n", .{ c_ptr, alignment, old_size }) catch unreachable;
|
||||
}
|
||||
|
||||
return realloc(@alignCast(Align, @ptrCast([*]u8, c_ptr)), new_size);
|
||||
}
|
||||
|
||||
export fn roc_dealloc(c_ptr: *anyopaque, alignment: u32) callconv(.C) void {
|
||||
if (DEBUG) {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
stdout.print("dealloc: {d} (alignment {d})\n", .{ c_ptr, alignment }) catch unreachable;
|
||||
}
|
||||
|
||||
free(@alignCast(Align, @ptrCast([*]u8, c_ptr)));
|
||||
}
|
||||
|
||||
export fn roc_panic(c_ptr: *anyopaque, tag_id: u32) callconv(.C) void {
|
||||
_ = tag_id;
|
||||
|
||||
const stderr = std.io.getStdErr().writer();
|
||||
const msg = @ptrCast([*:0]const u8, c_ptr);
|
||||
stderr.print("Application crashed with message\n\n {s}\n\nShutting down\n", .{msg}) catch unreachable;
|
||||
std.process.exit(0);
|
||||
}
|
||||
|
||||
export fn roc_memcpy(dst: [*]u8, src: [*]u8, size: usize) callconv(.C) void {
|
||||
return memcpy(dst, src, size);
|
||||
}
|
||||
|
||||
export fn roc_memset(dst: [*]u8, value: i32, size: usize) callconv(.C) void {
|
||||
return memset(dst, value, size);
|
||||
}
|
||||
|
||||
pub export fn main() u8 {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
const stderr = std.io.getStdErr().writer();
|
||||
|
||||
// start time
|
||||
var ts1: std.os.timespec = undefined;
|
||||
std.os.clock_gettime(std.os.CLOCK.REALTIME, &ts1) catch unreachable;
|
||||
|
||||
const result = roc__mainForHost_1_exposed(10);
|
||||
|
||||
// end time
|
||||
var ts2: std.os.timespec = undefined;
|
||||
std.os.clock_gettime(std.os.CLOCK.REALTIME, &ts2) catch unreachable;
|
||||
|
||||
stdout.print("{d}\n", .{result}) catch unreachable;
|
||||
|
||||
const delta = to_seconds(ts2) - to_seconds(ts1);
|
||||
|
||||
stderr.print("runtime: {d:.3}ms\n", .{delta * 1000}) catch unreachable;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
fn to_seconds(tms: std.os.timespec) f64 {
|
||||
return @intToFloat(f64, tms.tv_sec) + (@intToFloat(f64, tms.tv_nsec) / 1_000_000_000.0);
|
||||
}
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
platform "fibonacci"
|
||||
requires {} { main : I64 -> I64 }
|
||||
exposes []
|
||||
packages {}
|
||||
imports []
|
||||
provides [mainForHost]
|
||||
|
||||
mainForHost : I64 -> I64
|
||||
mainForHost = \a -> main a
|
||||
13
crates/cli_testing_examples/algorithms/fibonacci.roc
Normal file
13
crates/cli_testing_examples/algorithms/fibonacci.roc
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
app "fibonacci"
|
||||
packages { pf: "fibonacci-platform/main.roc" }
|
||||
imports []
|
||||
provides [main] to pf
|
||||
|
||||
main = \n -> fib n 0 1
|
||||
|
||||
# the clever implementation requires join points
|
||||
fib = \n, a, b ->
|
||||
if n == 0 then
|
||||
a
|
||||
else
|
||||
fib (n - 1) b (a + b)
|
||||
|
|
@ -0,0 +1,140 @@
|
|||
const std = @import("std");
|
||||
const builtin = @import("builtin");
|
||||
const str = @import("str");
|
||||
const RocStr = str.RocStr;
|
||||
const testing = std.testing;
|
||||
const expectEqual = testing.expectEqual;
|
||||
const expect = testing.expect;
|
||||
|
||||
comptime {
|
||||
// This is a workaround for https://github.com/ziglang/zig/issues/8218
|
||||
// which is only necessary on macOS.
|
||||
//
|
||||
// Once that issue is fixed, we can undo the changes in
|
||||
// 177cf12e0555147faa4d436e52fc15175c2c4ff0 and go back to passing
|
||||
// -fcompiler-rt in link.rs instead of doing this. Note that this
|
||||
// workaround is present in many host.zig files, so make sure to undo
|
||||
// it everywhere!
|
||||
if (builtin.os.tag == .macos) {
|
||||
_ = @import("compiler_rt");
|
||||
}
|
||||
}
|
||||
|
||||
const mem = std.mem;
|
||||
const Allocator = mem.Allocator;
|
||||
|
||||
extern fn roc__mainForHost_1_exposed(input: RocList) callconv(.C) RocList;
|
||||
|
||||
const Align = 2 * @alignOf(usize);
|
||||
extern fn malloc(size: usize) callconv(.C) ?*align(Align) anyopaque;
|
||||
extern fn realloc(c_ptr: [*]align(Align) u8, size: usize) callconv(.C) ?*anyopaque;
|
||||
extern fn free(c_ptr: [*]align(Align) u8) callconv(.C) void;
|
||||
extern fn memcpy(dst: [*]u8, src: [*]u8, size: usize) callconv(.C) void;
|
||||
extern fn memset(dst: [*]u8, value: i32, size: usize) callconv(.C) void;
|
||||
|
||||
const DEBUG: bool = false;
|
||||
|
||||
export fn roc_alloc(size: usize, alignment: u32) callconv(.C) ?*anyopaque {
|
||||
if (DEBUG) {
|
||||
var ptr = malloc(size);
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
stdout.print("alloc: {d} (alignment {d}, size {d})\n", .{ ptr, alignment, size }) catch unreachable;
|
||||
return ptr;
|
||||
} else {
|
||||
return malloc(size);
|
||||
}
|
||||
}
|
||||
|
||||
export fn roc_realloc(c_ptr: *anyopaque, new_size: usize, old_size: usize, alignment: u32) callconv(.C) ?*anyopaque {
|
||||
if (DEBUG) {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
stdout.print("realloc: {d} (alignment {d}, old_size {d})\n", .{ c_ptr, alignment, old_size }) catch unreachable;
|
||||
}
|
||||
|
||||
return realloc(@alignCast(Align, @ptrCast([*]u8, c_ptr)), new_size);
|
||||
}
|
||||
|
||||
export fn roc_dealloc(c_ptr: *anyopaque, alignment: u32) callconv(.C) void {
|
||||
if (DEBUG) {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
stdout.print("dealloc: {d} (alignment {d})\n", .{ c_ptr, alignment }) catch unreachable;
|
||||
}
|
||||
|
||||
free(@alignCast(Align, @ptrCast([*]u8, c_ptr)));
|
||||
}
|
||||
|
||||
export fn roc_panic(c_ptr: *anyopaque, tag_id: u32) callconv(.C) void {
|
||||
_ = tag_id;
|
||||
|
||||
const stderr = std.io.getStdErr().writer();
|
||||
const msg = @ptrCast([*:0]const u8, c_ptr);
|
||||
stderr.print("Application crashed with message\n\n {s}\n\nShutting down\n", .{msg}) catch unreachable;
|
||||
std.process.exit(0);
|
||||
}
|
||||
|
||||
export fn roc_memcpy(dst: [*]u8, src: [*]u8, size: usize) callconv(.C) void {
|
||||
return memcpy(dst, src, size);
|
||||
}
|
||||
|
||||
export fn roc_memset(dst: [*]u8, value: i32, size: usize) callconv(.C) void {
|
||||
return memset(dst, value, size);
|
||||
}
|
||||
|
||||
// warning! the array is currently stack-allocated so don't make this too big
|
||||
const NUM_NUMS = 100;
|
||||
|
||||
const RocList = extern struct { elements: [*]i64, length: usize, capacity: usize };
|
||||
|
||||
const Unit = extern struct {};
|
||||
|
||||
pub export fn main() u8 {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
|
||||
var raw_numbers: [NUM_NUMS + 1]i64 = undefined;
|
||||
|
||||
// set refcount to one
|
||||
raw_numbers[0] = -9223372036854775808;
|
||||
|
||||
var numbers = raw_numbers[1..];
|
||||
|
||||
for (numbers) |_, i| {
|
||||
numbers[i] = @mod(@intCast(i64, i), 12);
|
||||
}
|
||||
|
||||
var roc_list = RocList{ .elements = numbers, .length = NUM_NUMS, .capacity = NUM_NUMS };
|
||||
|
||||
// start time
|
||||
var ts1: std.os.timespec = undefined;
|
||||
std.os.clock_gettime(std.os.CLOCK.REALTIME, &ts1) catch unreachable;
|
||||
|
||||
// actually call roc to populate the callresult
|
||||
const callresult: RocList = roc__mainForHost_1_exposed(roc_list);
|
||||
|
||||
// stdout the result
|
||||
const length = std.math.min(20, callresult.length);
|
||||
var result = callresult.elements[0..length];
|
||||
|
||||
// end time
|
||||
var ts2: std.os.timespec = undefined;
|
||||
std.os.clock_gettime(std.os.CLOCK.REALTIME, &ts2) catch unreachable;
|
||||
|
||||
for (result) |x, i| {
|
||||
if (i == 0) {
|
||||
stdout.print("[{}, ", .{x}) catch unreachable;
|
||||
} else if (i == length - 1) {
|
||||
stdout.print("{}]\n", .{x}) catch unreachable;
|
||||
} else {
|
||||
stdout.print("{}, ", .{x}) catch unreachable;
|
||||
}
|
||||
}
|
||||
|
||||
// TODO apparently the typestamps are still (partially) undefined?
|
||||
// const delta = to_seconds(ts2) - to_seconds(ts1);
|
||||
// stderr.print("runtime: {d:.3}ms\n", .{delta * 1000}) catch unreachable;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
fn to_seconds(tms: std.os.timespec) f64 {
|
||||
return @intToFloat(f64, tms.tv_sec) + (@intToFloat(f64, tms.tv_nsec) / 1_000_000_000.0);
|
||||
}
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
platform "quicksort"
|
||||
requires {} { quicksort : List I64 -> List I64 }
|
||||
exposes []
|
||||
packages {}
|
||||
imports []
|
||||
provides [mainForHost]
|
||||
|
||||
mainForHost : List I64 -> List I64
|
||||
mainForHost = \list -> quicksort list
|
||||
59
crates/cli_testing_examples/algorithms/quicksort.roc
Normal file
59
crates/cli_testing_examples/algorithms/quicksort.roc
Normal file
|
|
@ -0,0 +1,59 @@
|
|||
app "quicksort"
|
||||
packages { pf: "quicksort-platform/main.roc" }
|
||||
imports []
|
||||
provides [quicksort] to pf
|
||||
|
||||
quicksort = \originalList ->
|
||||
n = List.len originalList
|
||||
|
||||
quicksortHelp originalList 0 (n - 1)
|
||||
|
||||
quicksortHelp : List (Num a), Nat, Nat -> List (Num a)
|
||||
quicksortHelp = \list, low, high ->
|
||||
if low < high then
|
||||
when partition low high list is
|
||||
Pair partitionIndex partitioned ->
|
||||
partitioned
|
||||
|> quicksortHelp low (partitionIndex - 1)
|
||||
|> quicksortHelp (partitionIndex + 1) high
|
||||
else
|
||||
list
|
||||
|
||||
partition : Nat, Nat, List (Num a) -> [Pair Nat (List (Num a))]
|
||||
partition = \low, high, initialList ->
|
||||
when List.get initialList high is
|
||||
Ok pivot ->
|
||||
when partitionHelp low low initialList high pivot is
|
||||
Pair newI newList ->
|
||||
Pair newI (swap newI high newList)
|
||||
|
||||
Err _ ->
|
||||
Pair low initialList
|
||||
|
||||
partitionHelp : Nat, Nat, List (Num c), Nat, Num c -> [Pair Nat (List (Num c))]
|
||||
partitionHelp = \i, j, list, high, pivot ->
|
||||
if j < high then
|
||||
when List.get list j is
|
||||
Ok value ->
|
||||
if value <= pivot then
|
||||
partitionHelp (i + 1) (j + 1) (swap i j list) high pivot
|
||||
else
|
||||
partitionHelp i (j + 1) list high pivot
|
||||
|
||||
Err _ ->
|
||||
Pair i list
|
||||
else
|
||||
Pair i list
|
||||
|
||||
swap : Nat, Nat, List a -> List a
|
||||
swap = \i, j, list ->
|
||||
when Pair (List.get list i) (List.get list j) is
|
||||
Pair (Ok atI) (Ok atJ) ->
|
||||
list
|
||||
|> List.set i atJ
|
||||
|> List.set j atI
|
||||
|
||||
_ ->
|
||||
# to prevent a decrement on list
|
||||
# turns out this is very important for optimizations
|
||||
list
|
||||
12
crates/cli_testing_examples/benchmarks/.gitignore
vendored
Normal file
12
crates/cli_testing_examples/benchmarks/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
cfold
|
||||
closure
|
||||
deriv
|
||||
issue2279
|
||||
nqueens
|
||||
quicksortapp
|
||||
rbtree-ck
|
||||
rbtree-del
|
||||
rbtree-insert
|
||||
test-astar
|
||||
test-base64
|
||||
*.wasm
|
||||
124
crates/cli_testing_examples/benchmarks/AStar.roc
Normal file
124
crates/cli_testing_examples/benchmarks/AStar.roc
Normal file
|
|
@ -0,0 +1,124 @@
|
|||
interface AStar
|
||||
exposes [findPath, Model, initialModel, cheapestOpen, reconstructPath]
|
||||
imports [Quicksort]
|
||||
|
||||
findPath = \costFn, moveFn, start, end ->
|
||||
astar costFn moveFn end (initialModel start)
|
||||
|
||||
Model position : {
|
||||
evaluated : Set position,
|
||||
openSet : Set position,
|
||||
costs : Dict position F64,
|
||||
cameFrom : Dict position position,
|
||||
}
|
||||
|
||||
initialModel : position -> Model position
|
||||
initialModel = \start -> {
|
||||
evaluated: Set.empty,
|
||||
openSet: Set.single start,
|
||||
costs: Dict.single start 0,
|
||||
cameFrom: Dict.empty,
|
||||
}
|
||||
|
||||
cheapestOpen : (position -> F64), Model position -> Result position {}
|
||||
cheapestOpen = \costFn, model ->
|
||||
model.openSet
|
||||
|> 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.first
|
||||
|> Result.map .position
|
||||
|> Result.mapErr (\_ -> {})
|
||||
|
||||
reconstructPath : Dict position position, position -> List position
|
||||
reconstructPath = \cameFrom, goal ->
|
||||
when Dict.get cameFrom goal is
|
||||
Err _ -> []
|
||||
Ok next -> List.append (reconstructPath cameFrom next) goal
|
||||
|
||||
updateCost : position, position, Model position -> Model position
|
||||
updateCost = \current, neighbor, model ->
|
||||
newCameFrom =
|
||||
Dict.insert model.cameFrom neighbor current
|
||||
|
||||
newCosts =
|
||||
Dict.insert model.costs neighbor distanceTo
|
||||
|
||||
distanceTo =
|
||||
reconstructPath newCameFrom neighbor
|
||||
|> List.len
|
||||
|> Num.toFrac
|
||||
|
||||
newModel =
|
||||
{ model &
|
||||
costs: newCosts,
|
||||
cameFrom: newCameFrom,
|
||||
}
|
||||
|
||||
when Dict.get model.costs neighbor is
|
||||
Err _ ->
|
||||
newModel
|
||||
|
||||
Ok previousDistance ->
|
||||
if distanceTo < previousDistance then
|
||||
newModel
|
||||
else
|
||||
model
|
||||
|
||||
astar : (position, position -> F64), (position -> Set position), position, Model position -> Result (List position) {}
|
||||
astar = \costFn, moveFn, goal, model ->
|
||||
when cheapestOpen (\source -> costFn source goal) model is
|
||||
Err {} -> Err {}
|
||||
Ok current ->
|
||||
if current == goal then
|
||||
Ok (reconstructPath model.cameFrom goal)
|
||||
else
|
||||
modelPopped =
|
||||
{ model &
|
||||
openSet: Set.remove model.openSet current,
|
||||
evaluated: Set.insert model.evaluated current,
|
||||
}
|
||||
|
||||
neighbors =
|
||||
moveFn current
|
||||
|
||||
newNeighbors =
|
||||
Set.difference neighbors modelPopped.evaluated
|
||||
|
||||
modelWithNeighbors : Model position
|
||||
modelWithNeighbors =
|
||||
{ modelPopped &
|
||||
openSet: Set.union modelPopped.openSet newNeighbors,
|
||||
}
|
||||
|
||||
walker : Model position, position -> Model position
|
||||
walker = \amodel, n -> updateCost current n amodel
|
||||
|
||||
modelWithCosts =
|
||||
Set.walk newNeighbors modelWithNeighbors walker
|
||||
|
||||
astar costFn moveFn goal modelWithCosts
|
||||
|
||||
# takeStep = \moveFn, _goal, model, current ->
|
||||
# modelPopped =
|
||||
# { model &
|
||||
# openSet: Set.remove model.openSet current,
|
||||
# evaluated: Set.insert model.evaluated current,
|
||||
# }
|
||||
#
|
||||
# neighbors = moveFn current
|
||||
#
|
||||
# newNeighbors = Set.difference neighbors modelPopped.evaluated
|
||||
#
|
||||
# modelWithNeighbors = { modelPopped & openSet: Set.union modelPopped.openSet newNeighbors }
|
||||
#
|
||||
# # a lot goes wrong here
|
||||
# modelWithCosts =
|
||||
# Set.walk newNeighbors modelWithNeighbors (\n, m -> updateCost current n m)
|
||||
#
|
||||
# modelWithCosts
|
||||
35
crates/cli_testing_examples/benchmarks/Base64.roc
Normal file
35
crates/cli_testing_examples/benchmarks/Base64.roc
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
interface Base64 exposes [fromBytes, fromStr, toBytes, toStr] imports [Base64.Decode, 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
|
||||
|
||||
Err _ ->
|
||||
Err InvalidInput
|
||||
|
||||
# base 64 encoding from a string
|
||||
fromStr : Str -> Result Str [InvalidInput]*
|
||||
fromStr = \str ->
|
||||
fromBytes (Str.toUtf8 str)
|
||||
|
||||
# base64-encode bytes to the original
|
||||
toBytes : Str -> Result (List U8) [InvalidInput]*
|
||||
toBytes = \str ->
|
||||
Ok (Base64.Encode.toBytes str)
|
||||
|
||||
toStr : Str -> Result Str [InvalidInput]*
|
||||
toStr = \str ->
|
||||
when toBytes str is
|
||||
Ok bytes ->
|
||||
when Str.fromUtf8 bytes is
|
||||
Ok v ->
|
||||
Ok v
|
||||
|
||||
Err _ ->
|
||||
Err InvalidInput
|
||||
|
||||
Err _ ->
|
||||
Err InvalidInput
|
||||
120
crates/cli_testing_examples/benchmarks/Base64/Decode.roc
Normal file
120
crates/cli_testing_examples/benchmarks/Base64/Decode.roc
Normal file
|
|
@ -0,0 +1,120 @@
|
|||
interface Base64.Decode exposes [fromBytes] imports [Bytes.Decode.{ ByteDecoder, DecodeProblem }]
|
||||
|
||||
fromBytes : List U8 -> Result Str DecodeProblem
|
||||
fromBytes = \bytes ->
|
||||
Bytes.Decode.decode bytes (decodeBase64 (List.len bytes))
|
||||
|
||||
decodeBase64 : Nat -> ByteDecoder Str
|
||||
decodeBase64 = \width -> Bytes.Decode.loop loopHelp { remaining: width, string: "" }
|
||||
|
||||
loopHelp : { remaining : Nat, string : Str } -> ByteDecoder (Bytes.Decode.Step { remaining : Nat, string : Str } Str)
|
||||
loopHelp = \{ remaining, string } ->
|
||||
if remaining >= 3 then
|
||||
x, y, z <- Bytes.Decode.map3 Bytes.Decode.u8 Bytes.Decode.u8 Bytes.Decode.u8
|
||||
|
||||
a : U32
|
||||
a = Num.intCast x
|
||||
b : U32
|
||||
b = Num.intCast y
|
||||
c : U32
|
||||
c = Num.intCast z
|
||||
combined = Num.bitwiseOr (Num.bitwiseOr (Num.shiftLeftBy a 16) (Num.shiftLeftBy b 8)) c
|
||||
|
||||
Loop {
|
||||
remaining: remaining - 3,
|
||||
string: Str.concat string (bitsToChars combined 0),
|
||||
}
|
||||
else if remaining == 0 then
|
||||
Bytes.Decode.succeed (Done string)
|
||||
else if remaining == 2 then
|
||||
x, y <- Bytes.Decode.map2 Bytes.Decode.u8 Bytes.Decode.u8
|
||||
|
||||
a : U32
|
||||
a = Num.intCast x
|
||||
b : U32
|
||||
b = Num.intCast y
|
||||
combined = Num.bitwiseOr (Num.shiftLeftBy a 16) (Num.shiftLeftBy b 8)
|
||||
|
||||
Done (Str.concat string (bitsToChars combined 1))
|
||||
else
|
||||
# remaining = 1
|
||||
x <- Bytes.Decode.map Bytes.Decode.u8
|
||||
|
||||
a : U32
|
||||
a = Num.intCast x
|
||||
|
||||
Done (Str.concat string (bitsToChars (Num.shiftLeftBy a 16) 2))
|
||||
|
||||
bitsToChars : U32, Int * -> Str
|
||||
bitsToChars = \bits, missing ->
|
||||
when Str.fromUtf8 (bitsToCharsHelp 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
|
||||
|
||||
bitsToCharsHelp : U32, Int * -> List U8
|
||||
bitsToCharsHelp = \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.intCast
|
||||
|> unsafeToChar
|
||||
|
||||
q =
|
||||
Num.bitwiseAnd (Num.shiftRightZfBy bits 12) lowest6BitsMask
|
||||
|> Num.intCast
|
||||
|> unsafeToChar
|
||||
|
||||
r =
|
||||
Num.bitwiseAnd (Num.shiftRightZfBy bits 6) lowest6BitsMask
|
||||
|> Num.intCast
|
||||
|> unsafeToChar
|
||||
|
||||
s =
|
||||
Num.bitwiseAnd bits lowest6BitsMask
|
||||
|> Num.intCast
|
||||
|> unsafeToChar
|
||||
|
||||
equals : U8
|
||||
equals = 61
|
||||
|
||||
when missing is
|
||||
0 -> [p, q, r, s]
|
||||
1 -> [p, q, r, equals]
|
||||
2 -> [p, q, equals, equals]
|
||||
_ ->
|
||||
# unreachable
|
||||
[]
|
||||
|
||||
# Base64 index to character/digit
|
||||
unsafeToChar : U8 -> U8
|
||||
unsafeToChar = \n ->
|
||||
if n <= 25 then
|
||||
# uppercase characters
|
||||
65 + n
|
||||
else if n <= 51 then
|
||||
# lowercase characters
|
||||
97 + (n - 26)
|
||||
else if n <= 61 then
|
||||
# digit characters
|
||||
48 + (n - 52)
|
||||
else
|
||||
# special cases
|
||||
when n is
|
||||
62 ->
|
||||
# '+'
|
||||
43
|
||||
|
||||
63 ->
|
||||
# '/'
|
||||
47
|
||||
|
||||
_ ->
|
||||
# anything else is invalid '\u{0000}'
|
||||
0
|
||||
176
crates/cli_testing_examples/benchmarks/Base64/Encode.roc
Normal file
176
crates/cli_testing_examples/benchmarks/Base64/Encode.roc
Normal file
|
|
@ -0,0 +1,176 @@
|
|||
interface Base64.Encode
|
||||
exposes [toBytes]
|
||||
imports [Bytes.Encode.{ ByteEncoder }]
|
||||
|
||||
InvalidChar : U8
|
||||
|
||||
# State : [None, One U8, Two U8, Three U8]
|
||||
toBytes : Str -> List U8
|
||||
toBytes = \str ->
|
||||
str
|
||||
|> Str.toUtf8
|
||||
|> encodeChunks
|
||||
|> Bytes.Encode.sequence
|
||||
|> Bytes.Encode.encode
|
||||
|
||||
encodeChunks : List U8 -> List ByteEncoder
|
||||
encodeChunks = \bytes ->
|
||||
List.walk bytes { output: [], accum: None } folder
|
||||
|> encodeResidual
|
||||
|
||||
coerce : Nat, a -> a
|
||||
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 ->
|
||||
{
|
||||
output: List.append output encoder,
|
||||
accum: None,
|
||||
}
|
||||
|
||||
Err _ ->
|
||||
{ output, accum: None }
|
||||
|
||||
# SGVs bG8g V29y bGQ=
|
||||
# encodeResidual : { output : List ByteEncoder, accum : State } -> List ByteEncoder
|
||||
encodeResidual = \{ output, accum } ->
|
||||
when accum is
|
||||
Unreachable _ -> output
|
||||
None -> output
|
||||
One _ -> output
|
||||
Two a b ->
|
||||
when encodeCharacters 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
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
x : U32
|
||||
x = Num.intCast n1
|
||||
|
||||
y : U32
|
||||
y = Num.intCast n2
|
||||
|
||||
if d == equals then
|
||||
if c == equals then
|
||||
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)
|
||||
|
||||
Ok (Bytes.Encode.u8 b1)
|
||||
else if !(isValidChar c) then
|
||||
Err c
|
||||
else
|
||||
n3 = unsafeConvertChar c
|
||||
|
||||
z : U32
|
||||
z = Num.intCast n3
|
||||
|
||||
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)
|
||||
|
||||
Ok (Bytes.Encode.u16 BE combined)
|
||||
else if !(isValidChar d) then
|
||||
Err d
|
||||
else
|
||||
n3 = unsafeConvertChar c
|
||||
n4 = unsafeConvertChar d
|
||||
|
||||
z : U32
|
||||
z = Num.intCast n3
|
||||
|
||||
w : U32
|
||||
w = Num.intCast n4
|
||||
|
||||
n =
|
||||
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
|
||||
|
||||
combined : U16
|
||||
combined = Num.intCast (Num.shiftRightBy n 8)
|
||||
|
||||
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
|
||||
Bool.true
|
||||
else
|
||||
when c is
|
||||
43 ->
|
||||
# '+'
|
||||
Bool.true
|
||||
|
||||
47 ->
|
||||
# '/'
|
||||
Bool.true
|
||||
|
||||
_ ->
|
||||
Bool.false
|
||||
|
||||
isAlphaNum : U8 -> Bool
|
||||
isAlphaNum = \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 ->
|
||||
if key >= 65 && key <= 90 then
|
||||
# A-Z
|
||||
key - 65
|
||||
else if key >= 97 && key <= 122 then
|
||||
# a-z
|
||||
(key - 97) + 26
|
||||
else if key >= 48 && key <= 57 then
|
||||
# 0-9
|
||||
(key - 48) + 26 + 26
|
||||
else
|
||||
when key is
|
||||
43 ->
|
||||
# '+'
|
||||
62
|
||||
|
||||
47 ->
|
||||
# '/'
|
||||
63
|
||||
|
||||
_ ->
|
||||
0
|
||||
111
crates/cli_testing_examples/benchmarks/Bytes/Decode.roc
Normal file
111
crates/cli_testing_examples/benchmarks/Bytes/Decode.roc
Normal file
|
|
@ -0,0 +1,111 @@
|
|||
interface Bytes.Decode exposes [ByteDecoder, decode, map, map2, u8, loop, Step, succeed, DecodeProblem, after, map3] imports []
|
||||
|
||||
State : { bytes : List U8, cursor : Nat }
|
||||
|
||||
DecodeProblem : [OutOfBytes]
|
||||
|
||||
ByteDecoder a := State -> [Good State a, Bad DecodeProblem]
|
||||
|
||||
decode : List U8, ByteDecoder a -> Result a DecodeProblem
|
||||
decode = \bytes, @ByteDecoder decoder ->
|
||||
when decoder { bytes, cursor: 0 } is
|
||||
Good _ value ->
|
||||
Ok value
|
||||
|
||||
Bad e ->
|
||||
Err e
|
||||
|
||||
succeed : a -> ByteDecoder a
|
||||
succeed = \value -> @ByteDecoder \state -> Good state value
|
||||
|
||||
map : ByteDecoder a, (a -> b) -> ByteDecoder b
|
||||
map = \@ByteDecoder decoder, transform ->
|
||||
@ByteDecoder
|
||||
\state ->
|
||||
when decoder state is
|
||||
Good state1 value ->
|
||||
Good state1 (transform value)
|
||||
|
||||
Bad e ->
|
||||
Bad e
|
||||
|
||||
map2 : ByteDecoder a, ByteDecoder b, (a, b -> c) -> ByteDecoder c
|
||||
map2 = \@ByteDecoder decoder1, @ByteDecoder decoder2, transform ->
|
||||
@ByteDecoder
|
||||
\state1 ->
|
||||
when decoder1 state1 is
|
||||
Good state2 a ->
|
||||
when decoder2 state2 is
|
||||
Good state3 b ->
|
||||
Good state3 (transform a b)
|
||||
|
||||
Bad e ->
|
||||
Bad e
|
||||
|
||||
Bad e ->
|
||||
Bad e
|
||||
|
||||
map3 : ByteDecoder a, ByteDecoder b, ByteDecoder c, (a, b, c -> d) -> ByteDecoder d
|
||||
map3 = \@ByteDecoder decoder1, @ByteDecoder decoder2, @ByteDecoder decoder3, transform ->
|
||||
@ByteDecoder
|
||||
\state1 ->
|
||||
when decoder1 state1 is
|
||||
Good state2 a ->
|
||||
when decoder2 state2 is
|
||||
Good state3 b ->
|
||||
when decoder3 state3 is
|
||||
Good state4 c ->
|
||||
Good state4 (transform a b c)
|
||||
|
||||
Bad e ->
|
||||
Bad e
|
||||
|
||||
Bad e ->
|
||||
Bad e
|
||||
|
||||
Bad e ->
|
||||
Bad e
|
||||
|
||||
after : ByteDecoder a, (a -> ByteDecoder b) -> ByteDecoder b
|
||||
after = \@ByteDecoder decoder, transform ->
|
||||
@ByteDecoder
|
||||
\state ->
|
||||
when decoder state is
|
||||
Good state1 value ->
|
||||
(@ByteDecoder decoder1) = transform value
|
||||
|
||||
decoder1 state1
|
||||
|
||||
Bad e ->
|
||||
Bad e
|
||||
|
||||
u8 : ByteDecoder U8
|
||||
u8 = @ByteDecoder
|
||||
\state ->
|
||||
when List.get state.bytes state.cursor is
|
||||
Ok b ->
|
||||
Good { state & cursor: state.cursor + 1 } b
|
||||
|
||||
Err _ ->
|
||||
Bad OutOfBytes
|
||||
|
||||
Step state b : [Loop state, Done b]
|
||||
|
||||
loop : (state -> ByteDecoder (Step state a)), state -> ByteDecoder a
|
||||
loop = \stepper, initial ->
|
||||
@ByteDecoder
|
||||
\state ->
|
||||
loopHelp stepper initial state
|
||||
|
||||
loopHelp = \stepper, accum, state ->
|
||||
(@ByteDecoder stepper1) = stepper accum
|
||||
|
||||
when stepper1 state is
|
||||
Good newState (Done value) ->
|
||||
Good newState value
|
||||
|
||||
Good newState (Loop newAccum) ->
|
||||
loopHelp stepper newAccum newState
|
||||
|
||||
Bad e ->
|
||||
Bad e
|
||||
134
crates/cli_testing_examples/benchmarks/Bytes/Encode.roc
Normal file
134
crates/cli_testing_examples/benchmarks/Bytes/Encode.roc
Normal file
|
|
@ -0,0 +1,134 @@
|
|||
interface Bytes.Encode exposes [ByteEncoder, sequence, u8, u16, bytes, empty, encode] imports []
|
||||
|
||||
Endianness : [BE, LE]
|
||||
|
||||
ByteEncoder : [Signed8 I8, Unsigned8 U8, Signed16 Endianness I16, Unsigned16 Endianness U16, Sequence Nat (List ByteEncoder), Bytes (List U8)]
|
||||
|
||||
u8 : U8 -> ByteEncoder
|
||||
u8 = \value -> Unsigned8 value
|
||||
|
||||
empty : ByteEncoder
|
||||
empty =
|
||||
foo : List ByteEncoder
|
||||
foo = []
|
||||
|
||||
Sequence 0 foo
|
||||
|
||||
u16 : Endianness, U16 -> ByteEncoder
|
||||
u16 = \endianness, value -> Unsigned16 endianness value
|
||||
|
||||
bytes : List U8 -> ByteEncoder
|
||||
bytes = \bs -> Bytes bs
|
||||
|
||||
sequence : List ByteEncoder -> ByteEncoder
|
||||
sequence = \encoders ->
|
||||
Sequence (getWidths encoders 0) encoders
|
||||
|
||||
getWidth : ByteEncoder -> Nat
|
||||
getWidth = \encoder ->
|
||||
when encoder is
|
||||
Signed8 _ -> 1
|
||||
Unsigned8 _ -> 1
|
||||
Signed16 _ _ -> 2
|
||||
Unsigned16 _ _ -> 2
|
||||
# Signed32 _ -> 4
|
||||
# Unsigned32 _ -> 4
|
||||
# Signed64 _ -> 8
|
||||
# Unsigned64 _ -> 8
|
||||
# Signed128 _ -> 16
|
||||
# Unsigned128 _ -> 16
|
||||
Sequence w _ -> w
|
||||
Bytes bs -> List.len bs
|
||||
|
||||
getWidths : List ByteEncoder, Nat -> Nat
|
||||
getWidths = \encoders, initial ->
|
||||
List.walk encoders initial \accum, encoder -> accum + getWidth encoder
|
||||
|
||||
encode : ByteEncoder -> List U8
|
||||
encode = \encoder ->
|
||||
output = List.repeat 0 (getWidth encoder)
|
||||
|
||||
encodeHelp encoder 0 output
|
||||
|> .output
|
||||
|
||||
encodeHelp : ByteEncoder, Nat, List U8 -> { output : List U8, offset : Nat }
|
||||
encodeHelp = \encoder, offset, output ->
|
||||
when encoder is
|
||||
Unsigned8 value ->
|
||||
{
|
||||
output: List.set output offset value,
|
||||
offset: offset + 1,
|
||||
}
|
||||
|
||||
Signed8 value ->
|
||||
cast : U8
|
||||
cast = Num.intCast value
|
||||
|
||||
{
|
||||
output: List.set output offset cast,
|
||||
offset: offset + 1,
|
||||
}
|
||||
|
||||
Unsigned16 endianness value ->
|
||||
a : U8
|
||||
a = Num.intCast (Num.shiftRightBy value 8)
|
||||
|
||||
b : U8
|
||||
b = Num.intCast value
|
||||
|
||||
newOutput =
|
||||
when endianness is
|
||||
BE ->
|
||||
output
|
||||
|> List.set (offset + 0) a
|
||||
|> List.set (offset + 1) b
|
||||
|
||||
LE ->
|
||||
output
|
||||
|> List.set (offset + 0) b
|
||||
|> List.set (offset + 1) a
|
||||
|
||||
{
|
||||
output: newOutput,
|
||||
offset: offset + 2,
|
||||
}
|
||||
|
||||
Signed16 endianness value ->
|
||||
a : U8
|
||||
a = Num.intCast (Num.shiftRightBy value 8)
|
||||
|
||||
b : U8
|
||||
b = Num.intCast value
|
||||
|
||||
newOutput =
|
||||
when endianness is
|
||||
BE ->
|
||||
output
|
||||
|> List.set (offset + 0) a
|
||||
|> List.set (offset + 1) b
|
||||
|
||||
LE ->
|
||||
output
|
||||
|> List.set (offset + 0) b
|
||||
|> List.set (offset + 1) a
|
||||
|
||||
{
|
||||
output: newOutput,
|
||||
offset: offset + 1,
|
||||
}
|
||||
|
||||
Bytes bs ->
|
||||
List.walk
|
||||
bs
|
||||
{ output, offset }
|
||||
\accum, byte -> {
|
||||
offset: accum.offset + 1,
|
||||
output: List.set accum.output offset byte,
|
||||
}
|
||||
|
||||
Sequence _ encoders ->
|
||||
List.walk
|
||||
encoders
|
||||
{ output, offset }
|
||||
\accum, single ->
|
||||
encodeHelp single accum.offset accum.output
|
||||
130
crates/cli_testing_examples/benchmarks/CFold.roc
Normal file
130
crates/cli_testing_examples/benchmarks/CFold.roc
Normal file
|
|
@ -0,0 +1,130 @@
|
|||
app "cfold"
|
||||
packages { pf: "platform/main.roc" }
|
||||
imports [pf.Task]
|
||||
provides [main] to pf
|
||||
|
||||
# adapted from https://github.com/koka-lang/koka/blob/master/test/bench/haskell/cfold.hs
|
||||
main : Task.Task {} []
|
||||
main =
|
||||
Task.after
|
||||
Task.getInt
|
||||
\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))
|
||||
|
||||
unoptimized
|
||||
|> Num.toStr
|
||||
|> Str.concat " & "
|
||||
|> Str.concat (Num.toStr optimized)
|
||||
|> Task.putLine
|
||||
|
||||
Expr : [
|
||||
Add Expr Expr,
|
||||
Mul Expr Expr,
|
||||
Val I64,
|
||||
Var I64,
|
||||
]
|
||||
|
||||
mkExpr : I64, I64 -> Expr
|
||||
mkExpr = \n, v ->
|
||||
when n is
|
||||
0 ->
|
||||
if v == 0 then Var 1 else Val v
|
||||
|
||||
_ ->
|
||||
Add (mkExpr (n - 1) (v + 1)) (mkExpr (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 ->
|
||||
when e1 is
|
||||
Add a1 a2 ->
|
||||
Add a1 (appendAdd a2 e2)
|
||||
|
||||
_ ->
|
||||
Add e1 e2
|
||||
|
||||
appendMul : Expr, Expr -> Expr
|
||||
appendMul = \e1, e2 ->
|
||||
when e1 is
|
||||
Mul a1 a2 ->
|
||||
Mul a1 (appendMul a2 e2)
|
||||
|
||||
_ ->
|
||||
Mul e1 e2
|
||||
|
||||
eval : Expr -> I64
|
||||
eval = \e ->
|
||||
when e is
|
||||
Var _ ->
|
||||
0
|
||||
|
||||
Val v ->
|
||||
v
|
||||
|
||||
Add 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
|
||||
|
||||
appendAdd x1 x2
|
||||
|
||||
Mul e1 e2 ->
|
||||
x1 = reassoc e1
|
||||
x2 = reassoc e2
|
||||
|
||||
appendMul x1 x2
|
||||
|
||||
_ ->
|
||||
e
|
||||
|
||||
constFolding : Expr -> Expr
|
||||
constFolding = \e ->
|
||||
when e is
|
||||
Add e1 e2 ->
|
||||
x1 = constFolding e1
|
||||
x2 = constFolding e2
|
||||
|
||||
when Pair x1 x2 is
|
||||
Pair (Val a) (Val b) ->
|
||||
Val (a + b)
|
||||
|
||||
Pair (Val a) (Add (Val b) x) ->
|
||||
Add (Val (a + b)) x
|
||||
|
||||
Pair (Val a) (Add x (Val b)) ->
|
||||
Add (Val (a + b)) x
|
||||
|
||||
Pair y1 y2 ->
|
||||
Add y1 y2
|
||||
|
||||
Mul e1 e2 ->
|
||||
x1 = constFolding e1
|
||||
x2 = constFolding e2
|
||||
|
||||
when Pair x1 x2 is
|
||||
Pair (Val a) (Val b) ->
|
||||
Val (a * b)
|
||||
|
||||
Pair (Val a) (Mul (Val b) x) ->
|
||||
Mul (Val (a * b)) x
|
||||
|
||||
Pair (Val a) (Mul x (Val b)) ->
|
||||
Mul (Val (a * b)) x
|
||||
|
||||
Pair y1 y2 ->
|
||||
Add y1 y2
|
||||
|
||||
_ ->
|
||||
e
|
||||
51
crates/cli_testing_examples/benchmarks/Closure.roc
Normal file
51
crates/cli_testing_examples/benchmarks/Closure.roc
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
app "closure"
|
||||
packages { pf: "platform/main.roc" }
|
||||
imports [pf.Task]
|
||||
provides [main] to pf
|
||||
|
||||
# see https://github.com/roc-lang/roc/issues/985
|
||||
main : Task.Task {} []
|
||||
main = closure1 {}
|
||||
# |> Task.after (\_ -> closure2 {})
|
||||
# |> Task.after (\_ -> closure3 {})
|
||||
# |> Task.after (\_ -> closure4 {})
|
||||
# ---
|
||||
closure1 : {} -> Task.Task {} []
|
||||
closure1 = \_ ->
|
||||
Task.succeed (foo toUnitBorrowed "a long string such that it's malloced")
|
||||
|> Task.map \_ -> {}
|
||||
|
||||
toUnitBorrowed = \x -> Str.countGraphemes x
|
||||
|
||||
foo = \f, x -> f x
|
||||
|
||||
# ---
|
||||
# closure2 : {} -> Task.Task {} []
|
||||
# closure2 = \_ ->
|
||||
# x : Str
|
||||
# x = "a long string such that it's malloced"
|
||||
#
|
||||
# Task.succeed {}
|
||||
# |> Task.map (\_ -> x)
|
||||
# |> Task.map toUnit
|
||||
#
|
||||
# toUnit = \_ -> {}
|
||||
#
|
||||
# # ---
|
||||
# closure3 : {} -> Task.Task {} []
|
||||
# closure3 = \_ ->
|
||||
# x : Str
|
||||
# x = "a long string such that it's malloced"
|
||||
#
|
||||
# Task.succeed {}
|
||||
# |> Task.after (\_ -> Task.succeed x |> Task.map (\_ -> {}))
|
||||
#
|
||||
# # ---
|
||||
# closure4 : {} -> Task.Task {} []
|
||||
# closure4 = \_ ->
|
||||
# x : Str
|
||||
# x = "a long string such that it's malloced"
|
||||
#
|
||||
# Task.succeed {}
|
||||
# |> Task.after (\_ -> Task.succeed x)
|
||||
# |> Task.map (\_ -> {})
|
||||
167
crates/cli_testing_examples/benchmarks/Deriv.roc
Normal file
167
crates/cli_testing_examples/benchmarks/Deriv.roc
Normal file
|
|
@ -0,0 +1,167 @@
|
|||
app "deriv"
|
||||
packages { pf: "platform/main.roc" }
|
||||
imports [pf.Task]
|
||||
provides [main] to pf
|
||||
|
||||
# based on: https://github.com/koka-lang/koka/blob/master/test/bench/haskell/deriv.hs
|
||||
IO a : Task.Task a []
|
||||
|
||||
main : Task.Task {} []
|
||||
main =
|
||||
Task.after
|
||||
Task.getInt
|
||||
\n ->
|
||||
x : Expr
|
||||
x = Var "x"
|
||||
|
||||
f : Expr
|
||||
f = pow x x
|
||||
|
||||
nest deriv n f # original koka n = 10
|
||||
|> Task.map \_ -> {}
|
||||
|
||||
nest : (I64, Expr -> IO Expr), I64, Expr -> IO Expr
|
||||
nest = \f, n, e -> Task.loop { s: n, f, m: n, x: e } nestHelp
|
||||
|
||||
State : { s : I64, f : I64, Expr -> IO Expr, m : I64, x : Expr }
|
||||
|
||||
nestHelp : State -> IO [Step State, Done Expr]
|
||||
nestHelp = \{ s, f, m, x } ->
|
||||
when m is
|
||||
0 -> Task.succeed (Done x)
|
||||
_ ->
|
||||
w <- Task.after (f (s - m) x)
|
||||
|
||||
Task.succeed (Step { s, f, m: (m - 1), x: w })
|
||||
|
||||
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
|
||||
|
||||
pown : I64, I64 -> I64
|
||||
pown = \a, n ->
|
||||
when n is
|
||||
0 -> 1
|
||||
1 -> a
|
||||
_ ->
|
||||
when divmod n 2 is
|
||||
Ok { div, mod } ->
|
||||
b = pown a div
|
||||
|
||||
b * b * (if mod == 0 then 1 else a)
|
||||
|
||||
Err DivByZero ->
|
||||
-1
|
||||
|
||||
add : Expr, Expr -> Expr
|
||||
add = \a, b ->
|
||||
when Pair a b is
|
||||
Pair (Val n) (Val m) ->
|
||||
Val (n + m)
|
||||
|
||||
Pair (Val 0) f ->
|
||||
f
|
||||
|
||||
Pair f (Val 0) ->
|
||||
f
|
||||
|
||||
Pair f (Val n) ->
|
||||
add (Val n) 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 (Add f g) h ->
|
||||
add f (add g h)
|
||||
|
||||
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)
|
||||
|
||||
Pair (Val 0) _ ->
|
||||
Val 0
|
||||
|
||||
Pair _ (Val 0) ->
|
||||
Val 0
|
||||
|
||||
Pair (Val 1) f ->
|
||||
f
|
||||
|
||||
Pair f (Val 1) ->
|
||||
f
|
||||
|
||||
Pair f (Val n) ->
|
||||
mul (Val n) 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 (Mul f g) h ->
|
||||
mul f (mul g h)
|
||||
|
||||
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
|
||||
|
||||
ln : Expr -> Expr
|
||||
ln = \f ->
|
||||
when f is
|
||||
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)))
|
||||
|
||||
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
|
||||
|
||||
deriv : I64, Expr -> IO Expr
|
||||
deriv = \i, f ->
|
||||
fprime = d "x" f
|
||||
line =
|
||||
Num.toStr (i + 1)
|
||||
|> Str.concat " count: "
|
||||
|> Str.concat (Num.toStr (count fprime))
|
||||
|
||||
Task.putLine line
|
||||
|> Task.after \_ -> Task.succeed fprime
|
||||
13
crates/cli_testing_examples/benchmarks/Issue2279.roc
Normal file
13
crates/cli_testing_examples/benchmarks/Issue2279.roc
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
app "issue2279"
|
||||
packages { pf: "platform/main.roc" }
|
||||
imports [Issue2279Help, pf.Task]
|
||||
provides [main] to pf
|
||||
|
||||
main =
|
||||
text =
|
||||
if Bool.true then
|
||||
Issue2279Help.text
|
||||
else
|
||||
Issue2279Help.asText 42
|
||||
|
||||
Task.putLine text
|
||||
7
crates/cli_testing_examples/benchmarks/Issue2279Help.roc
Normal file
7
crates/cli_testing_examples/benchmarks/Issue2279Help.roc
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
interface Issue2279Help
|
||||
exposes [text, asText]
|
||||
imports []
|
||||
|
||||
text = "Hello, world!"
|
||||
|
||||
asText = Num.toStr
|
||||
53
crates/cli_testing_examples/benchmarks/NQueens.roc
Normal file
53
crates/cli_testing_examples/benchmarks/NQueens.roc
Normal file
|
|
@ -0,0 +1,53 @@
|
|||
app "nqueens"
|
||||
packages { pf: "platform/main.roc" }
|
||||
imports [pf.Task]
|
||||
provides [main] to pf
|
||||
|
||||
main : Task.Task {} []
|
||||
main =
|
||||
Task.after
|
||||
Task.getInt
|
||||
\n ->
|
||||
queens n # original koka 13
|
||||
|> Num.toStr
|
||||
|> Task.putLine
|
||||
|
||||
ConsList a : [Nil, Cons a (ConsList a)]
|
||||
|
||||
queens = \n -> length (findSolutions n n)
|
||||
|
||||
length : ConsList a -> I64
|
||||
length = \xs -> lengthHelp xs 0
|
||||
|
||||
lengthHelp : ConsList a, I64 -> I64
|
||||
lengthHelp = \foobar, acc ->
|
||||
when foobar is
|
||||
Cons _ lrest -> lengthHelp lrest (1 + acc)
|
||||
Nil -> acc
|
||||
|
||||
safe : I64, I64, ConsList I64 -> Bool
|
||||
safe = \queen, diagonal, xs ->
|
||||
when xs is
|
||||
Nil -> Bool.true
|
||||
Cons q t ->
|
||||
queen != q && queen != q + diagonal && queen != q - diagonal && safe queen (diagonal + 1) t
|
||||
|
||||
appendSafe : I64, ConsList I64, ConsList (ConsList I64) -> ConsList (ConsList I64)
|
||||
appendSafe = \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
|
||||
appendSafe (k - 1) soln solns
|
||||
|
||||
extend = \n, acc, solutions ->
|
||||
when solutions is
|
||||
Nil -> acc
|
||||
Cons soln rest -> extend n (appendSafe n soln acc) rest
|
||||
|
||||
findSolutions = \n, k ->
|
||||
if k == 0 then
|
||||
Cons Nil Nil
|
||||
else
|
||||
extend n Nil (findSolutions n (k - 1))
|
||||
75
crates/cli_testing_examples/benchmarks/Quicksort.roc
Normal file
75
crates/cli_testing_examples/benchmarks/Quicksort.roc
Normal file
|
|
@ -0,0 +1,75 @@
|
|||
interface Quicksort exposes [sortBy, sortWith, show] imports []
|
||||
|
||||
show : List I64 -> Str
|
||||
show = \list ->
|
||||
if List.isEmpty list then
|
||||
"[]"
|
||||
else
|
||||
content =
|
||||
list
|
||||
|> 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))
|
||||
|
||||
Order a : a, a -> [LT, GT, EQ]
|
||||
|
||||
sortWith : List a, (a, a -> [LT, GT, EQ]) -> List a
|
||||
sortWith = \list, order ->
|
||||
n = List.len list
|
||||
|
||||
quicksortHelp list order 0 (n - 1)
|
||||
|
||||
quicksortHelp : List a, Order a, Nat, Nat -> List a
|
||||
quicksortHelp = \list, order, low, high ->
|
||||
if low < high then
|
||||
when partition low high list order is
|
||||
Pair partitionIndex partitioned ->
|
||||
partitioned
|
||||
|> quicksortHelp order low (Num.subSaturated partitionIndex 1)
|
||||
|> quicksortHelp order (partitionIndex + 1) high
|
||||
else
|
||||
list
|
||||
|
||||
partition : Nat, Nat, List a, Order a -> [Pair Nat (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)
|
||||
|
||||
Err _ ->
|
||||
Pair low initialList
|
||||
|
||||
partitionHelp : Nat, Nat, List c, Order c, Nat, c -> [Pair Nat (List c)]
|
||||
partitionHelp = \i, j, list, order, high, pivot ->
|
||||
if j < high then
|
||||
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
|
||||
|
||||
GT ->
|
||||
partitionHelp i (j + 1) list order high pivot
|
||||
|
||||
Err _ ->
|
||||
Pair i list
|
||||
else
|
||||
Pair i list
|
||||
|
||||
swap : Nat, Nat, List a -> List a
|
||||
swap = \i, j, list ->
|
||||
when Pair (List.get list i) (List.get list j) is
|
||||
Pair (Ok atI) (Ok atJ) ->
|
||||
list
|
||||
|> List.set i atJ
|
||||
|> List.set j atI
|
||||
|
||||
_ ->
|
||||
[]
|
||||
25
crates/cli_testing_examples/benchmarks/QuicksortApp.roc
Normal file
25
crates/cli_testing_examples/benchmarks/QuicksortApp.roc
Normal file
File diff suppressed because one or more lines are too long
131
crates/cli_testing_examples/benchmarks/RBTreeCk.roc
Normal file
131
crates/cli_testing_examples/benchmarks/RBTreeCk.roc
Normal file
|
|
@ -0,0 +1,131 @@
|
|||
app "rbtree-ck"
|
||||
packages { pf: "platform/main.roc" }
|
||||
imports [pf.Task]
|
||||
provides [main] to pf
|
||||
|
||||
Color : [Red, Black]
|
||||
|
||||
Tree a b : [Leaf, Node Color (Tree a b) a b (Tree a b)]
|
||||
|
||||
Map : Tree I64 Bool
|
||||
|
||||
ConsList a : [Nil, Cons a (ConsList a)]
|
||||
|
||||
makeMap : I64, I64 -> ConsList Map
|
||||
makeMap = \freq, n ->
|
||||
makeMapHelp freq n Leaf Nil
|
||||
|
||||
makeMapHelp : I64, I64, Map, ConsList Map -> ConsList Map
|
||||
makeMapHelp = \freq, n, m, acc ->
|
||||
when n is
|
||||
0 -> Cons m acc
|
||||
_ ->
|
||||
powerOf10 =
|
||||
n % 10 == 0
|
||||
|
||||
m1 = insert m n powerOf10
|
||||
|
||||
isFrequency =
|
||||
n % freq == 0
|
||||
|
||||
x = (if isFrequency then Cons m1 acc else acc)
|
||||
|
||||
makeMapHelp 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))
|
||||
|
||||
main : Task.Task {} []
|
||||
main =
|
||||
Task.after
|
||||
Task.getInt
|
||||
\n ->
|
||||
# original koka n = 4_200_000
|
||||
ms : ConsList Map
|
||||
ms = makeMap 5 n
|
||||
|
||||
when ms is
|
||||
Cons head _ ->
|
||||
val = fold (\_, v, r -> if v then r + 1 else r) head 0
|
||||
|
||||
val
|
||||
|> Num.toStr
|
||||
|> Task.putLine
|
||||
|
||||
Nil ->
|
||||
Task.putLine "fail"
|
||||
|
||||
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
|
||||
|
||||
setBlack : Tree a b -> Tree a b
|
||||
setBlack = \tree ->
|
||||
when tree is
|
||||
Node _ l k v r -> Node Black l k v r
|
||||
_ -> tree
|
||||
|
||||
isRed : Tree a b -> Bool
|
||||
isRed = \tree ->
|
||||
when tree is
|
||||
Node Red _ _ _ _ -> Bool.true
|
||||
_ -> Bool.false
|
||||
|
||||
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)
|
||||
else
|
||||
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) 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) else Node Black a ky vy (ins b kx vx))
|
||||
else
|
||||
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 ->
|
||||
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 _ 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
|
||||
|
||||
Leaf -> Leaf
|
||||
|
||||
balance2 : Tree a b, Tree a b -> Tree a b
|
||||
balance2 = \tree1, tree2 ->
|
||||
when tree1 is
|
||||
Leaf -> Leaf
|
||||
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 _ 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)
|
||||
|
||||
Leaf ->
|
||||
Leaf
|
||||
247
crates/cli_testing_examples/benchmarks/RBTreeDel.roc
Normal file
247
crates/cli_testing_examples/benchmarks/RBTreeDel.roc
Normal file
|
|
@ -0,0 +1,247 @@
|
|||
app "rbtree-del"
|
||||
packages { pf: "platform/main.roc" }
|
||||
imports [pf.Task]
|
||||
provides [main] to pf
|
||||
|
||||
Color : [Red, Black]
|
||||
|
||||
Tree a b : [Leaf, Node Color (Tree a b) a b (Tree a b)]
|
||||
|
||||
Map : Tree I64 Bool
|
||||
|
||||
ConsList a : [Nil, Cons a (ConsList a)]
|
||||
|
||||
main : Task.Task {} []
|
||||
main =
|
||||
Task.after
|
||||
Task.getInt
|
||||
\n ->
|
||||
m = makeMap n # koka original n = 4_200_000
|
||||
val = fold (\_, v, r -> if v then r + 1 else r) m 0
|
||||
|
||||
val
|
||||
|> Num.toStr
|
||||
|> Task.putLine
|
||||
|
||||
boom : Str -> a
|
||||
boom = \_ -> boom ""
|
||||
|
||||
makeMap : I64 -> Map
|
||||
makeMap = \n ->
|
||||
makeMapHelp n n Leaf
|
||||
|
||||
makeMapHelp : I64, I64, Map -> Map
|
||||
makeMapHelp = \total, n, m ->
|
||||
when n is
|
||||
0 -> m
|
||||
_ ->
|
||||
n1 = n - 1
|
||||
|
||||
powerOf10 =
|
||||
n |> Num.isMultipleOf 10
|
||||
|
||||
t1 = insert m n powerOf10
|
||||
|
||||
isFrequency =
|
||||
n |> Num.isMultipleOf 4
|
||||
|
||||
key = n1 + ((total - n1) // 5)
|
||||
t2 = if isFrequency then delete t1 key else t1
|
||||
|
||||
makeMapHelp total n1 t2
|
||||
|
||||
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))
|
||||
|
||||
depth : Tree * * -> I64
|
||||
depth = \tree ->
|
||||
when tree is
|
||||
Leaf -> 1
|
||||
Node _ l _ _ r -> 1 + depth l + depth r
|
||||
|
||||
insert : Map, I64, Bool -> Map
|
||||
insert = \t, k, v -> if isRed t then setBlack (ins t k v) else ins t k v
|
||||
|
||||
setBlack : Tree a b -> Tree a b
|
||||
setBlack = \tree ->
|
||||
when tree is
|
||||
Node _ l k v r -> Node Black l k v r
|
||||
_ -> tree
|
||||
|
||||
isRed : Tree a b -> Bool
|
||||
isRed = \tree ->
|
||||
when tree is
|
||||
Node Red _ _ _ _ -> Bool.true
|
||||
_ -> Bool.false
|
||||
|
||||
ins : Tree I64 Bool, I64, Bool -> Tree I64 Bool
|
||||
ins = \tree, kx, vx ->
|
||||
when tree is
|
||||
Leaf ->
|
||||
Node Red Leaf kx vx Leaf
|
||||
|
||||
Node Red a ky vy b ->
|
||||
when Num.compare kx ky is
|
||||
LT -> Node Red (ins a kx vx) ky vy b
|
||||
GT -> Node Red a ky vy (ins b kx vx)
|
||||
EQ -> Node Red a ky vy (ins b kx vx)
|
||||
|
||||
Node Black a ky vy b ->
|
||||
when Num.compare kx ky is
|
||||
LT ->
|
||||
when isRed a is
|
||||
Bool.true -> balanceLeft (ins a kx vx) ky vy b
|
||||
Bool.false -> Node Black (ins a kx vx) ky vy b
|
||||
|
||||
GT ->
|
||||
when isRed b is
|
||||
Bool.true -> balanceRight a ky vy (ins b kx vx)
|
||||
Bool.false -> Node Black a ky vy (ins b kx vx)
|
||||
|
||||
EQ ->
|
||||
Node Black a kx vx b
|
||||
|
||||
balanceLeft : Tree a b, a, b, Tree a b -> Tree a b
|
||||
balanceLeft = \l, k, v, r ->
|
||||
when l is
|
||||
Leaf ->
|
||||
Leaf
|
||||
|
||||
Node _ (Node Red lx kx vx rx) ky vy ry ->
|
||||
Node Red (Node Black lx kx vx rx) ky vy (Node Black ry k v r)
|
||||
|
||||
Node _ ly ky vy (Node Red lx kx vx rx) ->
|
||||
Node Red (Node Black ly ky vy lx) kx vx (Node Black rx k v r)
|
||||
|
||||
Node _ lx kx vx rx ->
|
||||
Node Black (Node Red lx kx vx rx) k v r
|
||||
|
||||
balanceRight : Tree a b, a, b, Tree a b -> Tree a b
|
||||
balanceRight = \l, k, v, r ->
|
||||
when r is
|
||||
Leaf ->
|
||||
Leaf
|
||||
|
||||
Node _ (Node Red lx kx vx rx) ky vy ry ->
|
||||
Node Red (Node Black l k v lx) kx vx (Node Black rx ky vy ry)
|
||||
|
||||
Node _ lx kx vx (Node Red ly ky vy ry) ->
|
||||
Node Red (Node Black l k v lx) kx vx (Node Black ly ky vy ry)
|
||||
|
||||
Node _ lx kx vx rx ->
|
||||
Node Black l k v (Node Red lx kx vx rx)
|
||||
|
||||
isBlack : Color -> Bool
|
||||
isBlack = \c ->
|
||||
when c is
|
||||
Black -> Bool.true
|
||||
Red -> Bool.false
|
||||
|
||||
Del a b : [Del (Tree a b) Bool]
|
||||
|
||||
setRed : Map -> Map
|
||||
setRed = \t ->
|
||||
when t is
|
||||
Node _ l k v r ->
|
||||
Node Red l k v r
|
||||
|
||||
_ ->
|
||||
t
|
||||
|
||||
makeBlack : Map -> Del I64 Bool
|
||||
makeBlack = \t ->
|
||||
when t is
|
||||
Node Red l k v r ->
|
||||
Del (Node Black l k v r) Bool.false
|
||||
|
||||
_ ->
|
||||
Del t Bool.true
|
||||
|
||||
rebalanceLeft = \c, l, k, v, r ->
|
||||
when l is
|
||||
Node Black _ _ _ _ ->
|
||||
Del (balanceLeft (setRed l) k v r) (isBlack c)
|
||||
|
||||
Node Red lx kx vx rx ->
|
||||
Del (Node Black lx kx vx (balanceLeft (setRed rx) k v r)) Bool.false
|
||||
|
||||
_ ->
|
||||
boom "unreachable"
|
||||
|
||||
rebalanceRight = \c, l, k, v, r ->
|
||||
when r is
|
||||
Node Black _ _ _ _ ->
|
||||
Del (balanceRight l k v (setRed r)) (isBlack c)
|
||||
|
||||
Node Red lx kx vx rx ->
|
||||
Del (Node Black (balanceRight l k v (setRed lx)) kx vx rx) Bool.false
|
||||
|
||||
_ ->
|
||||
boom "unreachable"
|
||||
|
||||
delMin = \t ->
|
||||
when t is
|
||||
Node Black Leaf k v r ->
|
||||
when r is
|
||||
Leaf ->
|
||||
Delmin (Del Leaf Bool.true) k v
|
||||
|
||||
_ ->
|
||||
Delmin (Del (setBlack r) Bool.false) k v
|
||||
|
||||
Node Red Leaf k v r ->
|
||||
Delmin (Del r Bool.false) k v
|
||||
|
||||
Node c l k v r ->
|
||||
when delMin l is
|
||||
Delmin (Del lx Bool.true) kx vx ->
|
||||
Delmin (rebalanceRight c lx k v r) kx vx
|
||||
|
||||
Delmin (Del lx Bool.false) kx vx ->
|
||||
Delmin (Del (Node c lx k v r) Bool.false) kx vx
|
||||
|
||||
Leaf ->
|
||||
Delmin (Del t Bool.false) 0 Bool.false
|
||||
|
||||
delete : Tree I64 Bool, I64 -> Tree I64 Bool
|
||||
delete = \t, k ->
|
||||
when del t k is
|
||||
Del tx _ ->
|
||||
setBlack tx
|
||||
|
||||
del : Tree I64 Bool, I64 -> Del I64 Bool
|
||||
del = \t, k ->
|
||||
when t is
|
||||
Leaf ->
|
||||
Del Leaf Bool.false
|
||||
|
||||
Node cx lx kx vx rx ->
|
||||
if (k < kx) then
|
||||
when del lx k is
|
||||
Del ly Bool.true ->
|
||||
rebalanceRight cx ly kx vx rx
|
||||
|
||||
Del ly Bool.false ->
|
||||
Del (Node cx ly kx vx rx) Bool.false
|
||||
else if (k > kx) then
|
||||
when del rx k is
|
||||
Del ry Bool.true ->
|
||||
rebalanceLeft cx lx kx vx ry
|
||||
|
||||
Del ry Bool.false ->
|
||||
Del (Node cx lx kx vx ry) Bool.false
|
||||
else
|
||||
when rx is
|
||||
Leaf ->
|
||||
if isBlack cx then makeBlack lx else Del lx Bool.false
|
||||
|
||||
Node _ _ _ _ _ ->
|
||||
when delMin rx is
|
||||
Delmin (Del ry Bool.true) ky vy ->
|
||||
rebalanceLeft cx lx ky vy ry
|
||||
|
||||
Delmin (Del ry Bool.false) ky vy ->
|
||||
Del (Node cx lx ky vy ry) Bool.false
|
||||
101
crates/cli_testing_examples/benchmarks/RBTreeInsert.roc
Normal file
101
crates/cli_testing_examples/benchmarks/RBTreeInsert.roc
Normal file
|
|
@ -0,0 +1,101 @@
|
|||
app "rbtree-insert"
|
||||
packages { pf: "platform/main.roc" }
|
||||
imports [pf.Task]
|
||||
provides [main] to pf
|
||||
|
||||
main : Task.Task {} []
|
||||
main =
|
||||
tree : RedBlackTree I64 {}
|
||||
tree = insert 0 {} Empty
|
||||
|
||||
tree
|
||||
|> show
|
||||
|> Task.putLine
|
||||
|
||||
show : RedBlackTree I64 {} -> Str
|
||||
show = \tree -> showRBTree tree Num.toStr (\{} -> "{}")
|
||||
|
||||
showRBTree : RedBlackTree k v, (k -> Str), (v -> Str) -> Str
|
||||
showRBTree = \tree, showKey, showValue ->
|
||||
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 \(sColor) \(sKey) \(sValue) \(sL) \(sR)"
|
||||
|
||||
nodeInParens : RedBlackTree k v, (k -> Str), (v -> Str) -> Str
|
||||
nodeInParens = \tree, showKey, showValue ->
|
||||
when tree is
|
||||
Empty ->
|
||||
showRBTree tree showKey showValue
|
||||
|
||||
Node _ _ _ _ _ ->
|
||||
inner = showRBTree tree showKey showValue
|
||||
|
||||
"(\(inner))"
|
||||
|
||||
showColor : NodeColor -> Str
|
||||
showColor = \color ->
|
||||
when color is
|
||||
Red -> "Red"
|
||||
Black -> "Black"
|
||||
|
||||
NodeColor : [Red, Black]
|
||||
|
||||
RedBlackTree k v : [Node NodeColor k v (RedBlackTree k v) (RedBlackTree k v), Empty]
|
||||
|
||||
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
|
||||
x -> x
|
||||
|
||||
insertHelp : Key k, v, RedBlackTree (Key k) v -> RedBlackTree (Key k) v
|
||||
insertHelp = \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 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)
|
||||
|
||||
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 ->
|
||||
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 color rK rV (Node Red key value left rLeft) rRight
|
||||
|
||||
_ ->
|
||||
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 color key value left right
|
||||
46
crates/cli_testing_examples/benchmarks/TestAStar.roc
Normal file
46
crates/cli_testing_examples/benchmarks/TestAStar.roc
Normal file
|
|
@ -0,0 +1,46 @@
|
|||
app "test-astar"
|
||||
packages { pf: "platform/main.roc" }
|
||||
imports [pf.Task, AStar]
|
||||
provides [main] to pf
|
||||
|
||||
main : Task.Task {} []
|
||||
main =
|
||||
Task.putLine (showBool test1)
|
||||
|
||||
# Task.after Task.getInt \n ->
|
||||
# when n is
|
||||
# 1 ->
|
||||
# Task.putLine (showBool test1)
|
||||
#
|
||||
# _ ->
|
||||
# ns = Num.toStr n
|
||||
# Task.putLine "No test \(ns)"
|
||||
showBool : Bool -> Str
|
||||
showBool = \b ->
|
||||
if
|
||||
b
|
||||
then
|
||||
"True"
|
||||
else
|
||||
"False"
|
||||
|
||||
test1 : Bool
|
||||
test1 =
|
||||
example1 == [2, 4]
|
||||
|
||||
example1 : List I64
|
||||
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 []
|
||||
|
||||
cost : I64, I64 -> F64
|
||||
cost = \_, _ -> 1
|
||||
|
||||
when AStar.findPath cost step 1 4 is
|
||||
Ok path -> path
|
||||
Err _ -> []
|
||||
18
crates/cli_testing_examples/benchmarks/TestBase64.roc
Normal file
18
crates/cli_testing_examples/benchmarks/TestBase64.roc
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
app "test-base64"
|
||||
packages { pf: "platform/main.roc" }
|
||||
imports [pf.Task, Base64]
|
||||
provides [main] to pf
|
||||
|
||||
IO a : Task.Task a []
|
||||
|
||||
main : IO {}
|
||||
main =
|
||||
when Base64.fromBytes (Str.toUtf8 "Hello World") is
|
||||
Err _ -> Task.putLine "sadness"
|
||||
Ok encoded ->
|
||||
Task.after
|
||||
(Task.putLine (Str.concat "encoded: " encoded))
|
||||
\_ ->
|
||||
when Base64.toStr encoded is
|
||||
Ok decoded -> Task.putLine (Str.concat "decoded: " decoded)
|
||||
Err _ -> Task.putLine "sadness"
|
||||
10
crates/cli_testing_examples/benchmarks/platform/Effect.roc
Normal file
10
crates/cli_testing_examples/benchmarks/platform/Effect.roc
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
hosted Effect
|
||||
exposes [Effect, after, map, always, forever, loop, putLine, putInt, getInt]
|
||||
imports []
|
||||
generates Effect with [after, map, always, forever, loop]
|
||||
|
||||
putLine : Str -> Effect {}
|
||||
|
||||
putInt : I64 -> Effect {}
|
||||
|
||||
getInt : Effect { value : I64, isError : Bool }
|
||||
78
crates/cli_testing_examples/benchmarks/platform/Task.roc
Normal file
78
crates/cli_testing_examples/benchmarks/platform/Task.roc
Normal file
|
|
@ -0,0 +1,78 @@
|
|||
interface Task
|
||||
exposes [Task, succeed, fail, after, map, putLine, putInt, getInt, forever, loop]
|
||||
imports [pf.Effect]
|
||||
|
||||
Task ok err : Effect.Effect (Result ok err)
|
||||
|
||||
forever : Task val err -> Task * err
|
||||
forever = \task ->
|
||||
looper = \{} ->
|
||||
task
|
||||
|> Effect.map
|
||||
\res ->
|
||||
when res is
|
||||
Ok _ -> Step {}
|
||||
Err e -> Done (Err e)
|
||||
|
||||
Effect.loop {} looper
|
||||
|
||||
loop : state, (state -> Task [Step state, Done done] err) -> Task done err
|
||||
loop = \state, step ->
|
||||
looper = \current ->
|
||||
step current
|
||||
|> Effect.map
|
||||
\res ->
|
||||
when res is
|
||||
Ok (Step newState) -> Step newState
|
||||
Ok (Done result) -> Done (Ok result)
|
||||
Err e -> Done (Err e)
|
||||
|
||||
Effect.loop state looper
|
||||
|
||||
succeed : val -> Task val *
|
||||
succeed = \val ->
|
||||
Effect.always (Ok val)
|
||||
|
||||
fail : err -> Task * err
|
||||
fail = \val ->
|
||||
Effect.always (Err val)
|
||||
|
||||
after : Task a err, (a -> Task b err) -> Task b err
|
||||
after = \effect, transform ->
|
||||
Effect.after
|
||||
effect
|
||||
\result ->
|
||||
when result is
|
||||
Ok a -> transform a
|
||||
Err err -> Task.fail err
|
||||
|
||||
map : Task a err, (a -> b) -> Task b err
|
||||
map = \effect, transform ->
|
||||
Effect.map
|
||||
effect
|
||||
\result ->
|
||||
when result is
|
||||
Ok a -> Ok (transform a)
|
||||
Err err -> Err err
|
||||
|
||||
putLine : Str -> Task {} *
|
||||
putLine = \line -> Effect.map (Effect.putLine line) (\_ -> Ok {})
|
||||
|
||||
putInt : I64 -> Task {} *
|
||||
putInt = \line -> Effect.map (Effect.putInt line) (\_ -> Ok {})
|
||||
|
||||
getInt : Task I64 []
|
||||
getInt =
|
||||
Effect.after
|
||||
Effect.getInt
|
||||
\{ isError, value } ->
|
||||
if
|
||||
isError
|
||||
then
|
||||
# when errorCode is
|
||||
# # A -> Task.fail InvalidCharacter
|
||||
# # B -> Task.fail IOError
|
||||
# _ ->
|
||||
Task.succeed -1
|
||||
else
|
||||
Task.succeed value
|
||||
217
crates/cli_testing_examples/benchmarks/platform/host.zig
Normal file
217
crates/cli_testing_examples/benchmarks/platform/host.zig
Normal file
|
|
@ -0,0 +1,217 @@
|
|||
const std = @import("std");
|
||||
const str = @import("str");
|
||||
const RocStr = str.RocStr;
|
||||
const testing = std.testing;
|
||||
const expectEqual = testing.expectEqual;
|
||||
const expect = testing.expect;
|
||||
const maxInt = std.math.maxInt;
|
||||
|
||||
comptime {
|
||||
// This is a workaround for https://github.com/ziglang/zig/issues/8218
|
||||
// which is only necessary on macOS.
|
||||
//
|
||||
// Once that issue is fixed, we can undo the changes in
|
||||
// 177cf12e0555147faa4d436e52fc15175c2c4ff0 and go back to passing
|
||||
// -fcompiler-rt in link.rs instead of doing this. Note that this
|
||||
// workaround is present in many host.zig files, so make sure to undo
|
||||
// it everywhere!
|
||||
const builtin = @import("builtin");
|
||||
if (builtin.os.tag == .macos) {
|
||||
_ = @import("compiler_rt");
|
||||
}
|
||||
}
|
||||
|
||||
const mem = std.mem;
|
||||
const Allocator = mem.Allocator;
|
||||
|
||||
extern fn roc__mainForHost_1_exposed_generic([*]u8) void;
|
||||
extern fn roc__mainForHost_size() i64;
|
||||
extern fn roc__mainForHost_1__Fx_caller(*const u8, [*]u8, [*]u8) void;
|
||||
extern fn roc__mainForHost_1__Fx_size() i64;
|
||||
extern fn roc__mainForHost_1__Fx_result_size() i64;
|
||||
|
||||
const Align = 2 * @alignOf(usize);
|
||||
extern fn malloc(size: usize) callconv(.C) ?*align(Align) anyopaque;
|
||||
extern fn realloc(c_ptr: [*]align(Align) u8, size: usize) callconv(.C) ?*anyopaque;
|
||||
extern fn free(c_ptr: [*]align(Align) u8) callconv(.C) void;
|
||||
extern fn memcpy(dst: [*]u8, src: [*]u8, size: usize) callconv(.C) void;
|
||||
extern fn memset(dst: [*]u8, value: i32, size: usize) callconv(.C) void;
|
||||
|
||||
const DEBUG: bool = false;
|
||||
|
||||
export fn roc_alloc(size: usize, alignment: u32) callconv(.C) ?*anyopaque {
|
||||
if (DEBUG) {
|
||||
var ptr = malloc(size);
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
stdout.print("alloc: {d} (alignment {d}, size {d})\n", .{ ptr, alignment, size }) catch unreachable;
|
||||
return ptr;
|
||||
} else {
|
||||
return malloc(size);
|
||||
}
|
||||
}
|
||||
|
||||
export fn roc_realloc(c_ptr: *anyopaque, new_size: usize, old_size: usize, alignment: u32) callconv(.C) ?*anyopaque {
|
||||
if (DEBUG) {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
stdout.print("realloc: {d} (alignment {d}, old_size {d})\n", .{ c_ptr, alignment, old_size }) catch unreachable;
|
||||
}
|
||||
|
||||
return realloc(@alignCast(Align, @ptrCast([*]u8, c_ptr)), new_size);
|
||||
}
|
||||
|
||||
export fn roc_dealloc(c_ptr: *anyopaque, alignment: u32) callconv(.C) void {
|
||||
if (DEBUG) {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
stdout.print("dealloc: {d} (alignment {d})\n", .{ c_ptr, alignment }) catch unreachable;
|
||||
}
|
||||
|
||||
free(@alignCast(Align, @ptrCast([*]u8, c_ptr)));
|
||||
}
|
||||
|
||||
export fn roc_panic(c_ptr: *anyopaque, tag_id: u32) callconv(.C) void {
|
||||
_ = tag_id;
|
||||
|
||||
const stderr = std.io.getStdErr().writer();
|
||||
const msg = @ptrCast([*:0]const u8, c_ptr);
|
||||
stderr.print("Application crashed with message\n\n {s}\n\nShutting down\n", .{msg}) catch unreachable;
|
||||
std.process.exit(0);
|
||||
}
|
||||
|
||||
export fn roc_memcpy(dst: [*]u8, src: [*]u8, size: usize) callconv(.C) void {
|
||||
return memcpy(dst, src, size);
|
||||
}
|
||||
|
||||
export fn roc_memset(dst: [*]u8, value: i32, size: usize) callconv(.C) void {
|
||||
return memset(dst, value, size);
|
||||
}
|
||||
|
||||
const Unit = extern struct {};
|
||||
|
||||
pub fn main() !u8 {
|
||||
const stderr = std.io.getStdErr().writer();
|
||||
|
||||
// The size might be zero; if so, make it at least 8 so that we don't have a nullptr
|
||||
const size = std.math.max(@intCast(usize, roc__mainForHost_size()), 8);
|
||||
const raw_output = roc_alloc(@intCast(usize, size), @alignOf(u64)).?;
|
||||
var output = @ptrCast([*]u8, raw_output);
|
||||
|
||||
defer {
|
||||
roc_dealloc(raw_output, @alignOf(u64));
|
||||
}
|
||||
|
||||
var timer = std.time.Timer.start() catch unreachable;
|
||||
|
||||
roc__mainForHost_1_exposed_generic(output);
|
||||
|
||||
const closure_data_pointer = @ptrCast([*]u8, output);
|
||||
|
||||
call_the_closure(closure_data_pointer);
|
||||
|
||||
const nanos = timer.read();
|
||||
const seconds = (@intToFloat(f64, nanos) / 1_000_000_000.0);
|
||||
|
||||
stderr.print("runtime: {d:.3}ms\n", .{seconds * 1000}) catch unreachable;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
fn to_seconds(tms: std.os.timespec) f64 {
|
||||
return @intToFloat(f64, tms.tv_sec) + (@intToFloat(f64, tms.tv_nsec) / 1_000_000_000.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 = std.math.max(roc__mainForHost_1__Fx_result_size(), 8);
|
||||
const raw_output = allocator.allocAdvanced(u8, @alignOf(u64), @intCast(usize, size), .at_least) catch unreachable;
|
||||
var output = @ptrCast([*]u8, raw_output);
|
||||
|
||||
defer {
|
||||
allocator.free(raw_output);
|
||||
}
|
||||
|
||||
const flags: u8 = 0;
|
||||
|
||||
roc__mainForHost_1__Fx_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();
|
||||
|
||||
stdout.print("{d}", .{int}) catch unreachable;
|
||||
|
||||
stdout.print("\n", .{}) catch unreachable;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
export fn roc_fx_putLine(rocPath: *str.RocStr) callconv(.C) void {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
|
||||
for (rocPath.asSlice()) |char| {
|
||||
stdout.print("{c}", .{char}) catch unreachable;
|
||||
}
|
||||
|
||||
stdout.print("\n", .{}) catch unreachable;
|
||||
}
|
||||
|
||||
const GetInt = extern struct {
|
||||
value: i64,
|
||||
is_error: bool,
|
||||
};
|
||||
|
||||
comptime {
|
||||
if (@sizeOf(usize) == 8) {
|
||||
@export(roc_fx_getInt_64bit, .{ .name = "roc_fx_getInt" });
|
||||
} else {
|
||||
@export(roc_fx_getInt_32bit, .{ .name = "roc_fx_getInt" });
|
||||
}
|
||||
}
|
||||
|
||||
fn roc_fx_getInt_64bit() callconv(.C) GetInt {
|
||||
if (roc_fx_getInt_help()) |value| {
|
||||
const get_int = GetInt{ .is_error = false, .value = value };
|
||||
return get_int;
|
||||
} else |err| switch (err) {
|
||||
error.InvalidCharacter => {
|
||||
return GetInt{ .is_error = true, .value = 0 };
|
||||
},
|
||||
else => {
|
||||
return GetInt{ .is_error = true, .value = 0 };
|
||||
},
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
fn roc_fx_getInt_32bit(output: *GetInt) callconv(.C) void {
|
||||
if (roc_fx_getInt_help()) |value| {
|
||||
const get_int = GetInt{ .is_error = false, .value = value, .error_code = false };
|
||||
output.* = get_int;
|
||||
} else |err| switch (err) {
|
||||
error.InvalidCharacter => {
|
||||
output.* = GetInt{ .is_error = true, .value = 0, .error_code = false };
|
||||
},
|
||||
else => {
|
||||
output.* = GetInt{ .is_error = true, .value = 0, .error_code = true };
|
||||
},
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
fn roc_fx_getInt_help() !i64 {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
stdout.print("Please enter an integer\n", .{}) catch unreachable;
|
||||
|
||||
const stdin = std.io.getStdIn().reader();
|
||||
var buf: [40]u8 = undefined;
|
||||
|
||||
const line: []u8 = (try stdin.readUntilDelimiterOrEof(&buf, '\n')) orelse "";
|
||||
|
||||
return std.fmt.parseInt(i64, line, 10);
|
||||
}
|
||||
9
crates/cli_testing_examples/benchmarks/platform/main.roc
Normal file
9
crates/cli_testing_examples/benchmarks/platform/main.roc
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
platform "benchmarks"
|
||||
requires {} { main : Task {} [] }
|
||||
exposes []
|
||||
packages {}
|
||||
imports [Task.{ Task }]
|
||||
provides [mainForHost]
|
||||
|
||||
mainForHost : Task {} [] as Fx
|
||||
mainForHost = main
|
||||
7
crates/cli_testing_examples/platform-switching/.gitignore
vendored
Normal file
7
crates/cli_testing_examples/platform-switching/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
rocLovesC
|
||||
rocLovesPlatforms
|
||||
rocLovesRust
|
||||
rocLovesSwift
|
||||
rocLovesWebAssembly
|
||||
rocLovesZig
|
||||
*.wasm
|
||||
20
crates/cli_testing_examples/platform-switching/README.md
Normal file
20
crates/cli_testing_examples/platform-switching/README.md
Normal file
|
|
@ -0,0 +1,20 @@
|
|||
# Platform switching
|
||||
|
||||
To run, `cd` into this directory and run this in your terminal:
|
||||
|
||||
```bash
|
||||
roc run
|
||||
```
|
||||
|
||||
This will run `main.roc` because, unless you explicitly give it a filename, `roc run`
|
||||
defaults to running a file named `main.roc`. Other `roc` commands (like `roc build`, `roc test`, and so on) also default to `main.roc` unless you explicitly give them a filename.
|
||||
|
||||
## About this example
|
||||
|
||||
This uses a very simple platform which does nothing more than printing the string you give it.
|
||||
|
||||
The line `main = "Which platform am I running on now?\n"` sets this string to be `"Which platform am I running on now?"` with a newline at the end, and the lines `packages { pf: "c-platform/main.roc" }` and `provides [main] to pf` specify that the `c-platform/` directory contains this app's platform.
|
||||
|
||||
This platform is called `c-platform` because its lower-level code is written in C. There's also a `rust-platform`, `zig-platform`, and so on; if you like, you can try switching `pf: "c-platform/main.roc"` to `pf: "zig-platform/main.roc"` or `pf: "rust-platform/main.roc"` to try one of those platforms instead. They all do similar things, so the application won't look any different.
|
||||
|
||||
If you want to start building your own platforms, these are some very simple example platforms to use as starting points.
|
||||
|
|
@ -0,0 +1,89 @@
|
|||
#include <errno.h>
|
||||
#include <stdbool.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <unistd.h>
|
||||
|
||||
void* roc_alloc(size_t size, unsigned int alignment) { return malloc(size); }
|
||||
|
||||
void* roc_realloc(void* ptr, size_t new_size, size_t old_size,
|
||||
unsigned int alignment) {
|
||||
return realloc(ptr, new_size);
|
||||
}
|
||||
|
||||
void roc_dealloc(void* ptr, unsigned int alignment) { free(ptr); }
|
||||
|
||||
void roc_panic(void* ptr, unsigned int alignment) {
|
||||
char* msg = (char*)ptr;
|
||||
fprintf(stderr,
|
||||
"Application crashed with message\n\n %s\n\nShutting down\n", msg);
|
||||
exit(0);
|
||||
}
|
||||
|
||||
void* roc_memcpy(void* dest, const void* src, size_t n) {
|
||||
return memcpy(dest, src, n);
|
||||
}
|
||||
|
||||
void* roc_memset(void* str, int c, size_t n) { return memset(str, c, n); }
|
||||
|
||||
struct RocStr {
|
||||
char* bytes;
|
||||
size_t len;
|
||||
size_t capacity;
|
||||
};
|
||||
|
||||
bool is_small_str(struct RocStr str) { return ((ssize_t)str.capacity) < 0; }
|
||||
|
||||
// Determine the length of the string, taking into
|
||||
// account the small string optimization
|
||||
size_t roc_str_len(struct RocStr str) {
|
||||
char* bytes = (char*)&str;
|
||||
char last_byte = bytes[sizeof(str) - 1];
|
||||
char last_byte_xored = last_byte ^ 0b10000000;
|
||||
size_t small_len = (size_t)(last_byte_xored);
|
||||
size_t big_len = str.len;
|
||||
|
||||
// Avoid branch misprediction costs by always
|
||||
// determining both small_len and big_len,
|
||||
// so this compiles to a cmov instruction.
|
||||
if (is_small_str(str)) {
|
||||
return small_len;
|
||||
} else {
|
||||
return big_len;
|
||||
}
|
||||
}
|
||||
|
||||
extern void roc__mainForHost_1_exposed_generic(struct RocStr *string);
|
||||
|
||||
int main() {
|
||||
|
||||
struct RocStr str;
|
||||
roc__mainForHost_1_exposed_generic(&str);
|
||||
|
||||
// Determine str_len and the str_bytes pointer,
|
||||
// taking into account the small string optimization.
|
||||
size_t str_len = roc_str_len(str);
|
||||
char* str_bytes;
|
||||
|
||||
if (is_small_str(str)) {
|
||||
str_bytes = (char*)&str;
|
||||
} else {
|
||||
str_bytes = str.bytes;
|
||||
}
|
||||
|
||||
// Write to stdout
|
||||
if (write(1, str_bytes, str_len) >= 0) {
|
||||
// Writing succeeded!
|
||||
|
||||
// NOTE: the string is a static string, read from in the binary
|
||||
// if you make it a heap-allocated string, it'll be leaked here
|
||||
return 0;
|
||||
} else {
|
||||
printf("Error writing to stdout: %s\n", strerror(errno));
|
||||
|
||||
// NOTE: the string is a static string, read from in the binary
|
||||
// if you make it a heap-allocated string, it'll be leaked here
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
platform "echo-in-c"
|
||||
requires {} { main : Str }
|
||||
exposes []
|
||||
packages {}
|
||||
imports []
|
||||
provides [mainForHost]
|
||||
|
||||
mainForHost : Str
|
||||
mainForHost = main
|
||||
11
crates/cli_testing_examples/platform-switching/main.roc
Normal file
11
crates/cli_testing_examples/platform-switching/main.roc
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
app "rocLovesPlatforms"
|
||||
packages { pf: "c-platform/main.roc" }
|
||||
# To switch platforms, comment-out the line above and un-comment one below.
|
||||
# packages { pf: "rust-platform/main.roc" }
|
||||
# packages { pf: "swift-platform/main.roc" }
|
||||
# packages { pf: "web-assembly-platform/main.roc" } # See ./web-assembly-platform/README.md
|
||||
# packages { pf: "zig-platform/main.roc" }
|
||||
imports []
|
||||
provides [main] to pf
|
||||
|
||||
main = "Which platform am I running on now?\n"
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
app "rocLovesC"
|
||||
packages { pf: "c-platform/main.roc" }
|
||||
imports []
|
||||
provides [main] to pf
|
||||
|
||||
main = "Roc <3 C!\n"
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
app "rocLovesRust"
|
||||
packages { pf: "rust-platform/main.roc" }
|
||||
imports []
|
||||
provides [main] to pf
|
||||
|
||||
main = "Roc <3 Rust!\n"
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
app "rocLovesSwift"
|
||||
packages { pf: "swift-platform/main.roc" }
|
||||
imports []
|
||||
provides [main] to pf
|
||||
|
||||
main = "Roc <3 Swift!\n"
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
app "rocLovesWebAssembly"
|
||||
packages { pf: "web-assembly-platform/main.roc" }
|
||||
imports []
|
||||
provides [main] to pf
|
||||
|
||||
main = "Roc <3 Web Assembly!\n"
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
app "rocLovesZig"
|
||||
packages { pf: "zig-platform/main.roc" }
|
||||
imports []
|
||||
provides [main] to pf
|
||||
|
||||
main = "Roc <3 Zig!\n"
|
||||
37
crates/cli_testing_examples/platform-switching/rust-platform/Cargo.lock
generated
Normal file
37
crates/cli_testing_examples/platform-switching/rust-platform/Cargo.lock
generated
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
# This file is automatically @generated by Cargo.
|
||||
# It is not intended for manual editing.
|
||||
version = 3
|
||||
|
||||
[[package]]
|
||||
name = "arrayvec"
|
||||
version = "0.7.2"
|
||||
source = "registry+https://github.com/rust-lang/crates.io-index"
|
||||
checksum = "8da52d66c7071e2e3fa2a1e5c6d088fec47b593032b254f5e980de8ea54454d6"
|
||||
|
||||
[[package]]
|
||||
name = "host"
|
||||
version = "0.0.1"
|
||||
dependencies = [
|
||||
"libc",
|
||||
"roc_std",
|
||||
]
|
||||
|
||||
[[package]]
|
||||
name = "libc"
|
||||
version = "0.2.92"
|
||||
source = "registry+https://github.com/rust-lang/crates.io-index"
|
||||
checksum = "56d855069fafbb9b344c0f962150cd2c1187975cb1c22c1522c240d8c4986714"
|
||||
|
||||
[[package]]
|
||||
name = "roc_std"
|
||||
version = "0.0.1"
|
||||
dependencies = [
|
||||
"arrayvec",
|
||||
"static_assertions",
|
||||
]
|
||||
|
||||
[[package]]
|
||||
name = "static_assertions"
|
||||
version = "1.1.0"
|
||||
source = "registry+https://github.com/rust-lang/crates.io-index"
|
||||
checksum = "a2eb9349b6444b326872e140eb1cf5e7c522154d69e7a0ffb0fb81c06b37543f"
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
[package]
|
||||
name = "host"
|
||||
version = "0.0.1"
|
||||
authors = ["The Roc Contributors"]
|
||||
license = "UPL-1.0"
|
||||
edition = "2021"
|
||||
links = "app"
|
||||
|
||||
[lib]
|
||||
name = "host"
|
||||
path = "src/lib.rs"
|
||||
crate-type = ["staticlib", "rlib"]
|
||||
|
||||
[[bin]]
|
||||
name = "host"
|
||||
path = "src/main.rs"
|
||||
|
||||
[dependencies]
|
||||
roc_std = { path = "../../../../crates/roc_std" }
|
||||
libc = "0.2"
|
||||
|
||||
[workspace]
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
fn main() {
|
||||
println!("cargo:rustc-link-lib=dylib=app");
|
||||
println!("cargo:rustc-link-search=.");
|
||||
}
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
extern int rust_main();
|
||||
|
||||
int main() { return rust_main(); }
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
platform "echo-in-rust"
|
||||
requires {} { main : Str }
|
||||
exposes []
|
||||
packages {}
|
||||
imports []
|
||||
provides [mainForHost]
|
||||
|
||||
mainForHost : Str
|
||||
mainForHost = main
|
||||
|
|
@ -0,0 +1,78 @@
|
|||
#![allow(non_snake_case)]
|
||||
|
||||
use core::ffi::c_void;
|
||||
use roc_std::RocStr;
|
||||
use std::ffi::CStr;
|
||||
use std::mem::ManuallyDrop;
|
||||
use std::os::raw::c_char;
|
||||
|
||||
extern "C" {
|
||||
#[link_name = "roc__mainForHost_1_exposed_generic"]
|
||||
fn roc_main(_: &mut RocStr);
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub unsafe extern "C" fn roc_alloc(size: usize, _alignment: u32) -> *mut c_void {
|
||||
return libc::malloc(size);
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub unsafe extern "C" fn roc_realloc(
|
||||
c_ptr: *mut c_void,
|
||||
new_size: usize,
|
||||
_old_size: usize,
|
||||
_alignment: u32,
|
||||
) -> *mut c_void {
|
||||
return libc::realloc(c_ptr, new_size);
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub unsafe extern "C" fn roc_dealloc(c_ptr: *mut c_void, _alignment: u32) {
|
||||
return libc::free(c_ptr);
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub unsafe extern "C" fn roc_panic(c_ptr: *mut c_void, tag_id: u32) {
|
||||
match tag_id {
|
||||
0 => {
|
||||
let slice = CStr::from_ptr(c_ptr as *const c_char);
|
||||
let string = slice.to_str().unwrap();
|
||||
eprintln!("Roc hit a panic: {}", string);
|
||||
std::process::exit(1);
|
||||
}
|
||||
_ => todo!(),
|
||||
}
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub unsafe extern "C" fn roc_memcpy(dst: *mut c_void, src: *mut c_void, n: usize) -> *mut c_void {
|
||||
libc::memcpy(dst, src, n)
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub unsafe extern "C" fn roc_memset(dst: *mut c_void, c: i32, n: usize) -> *mut c_void {
|
||||
libc::memset(dst, c, n)
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn rust_main() -> i32 {
|
||||
unsafe {
|
||||
// ManuallyDrop must be used here in order to prevent the RocStr from
|
||||
// getting dropped as soon as it's no longer referenced anywhere, which
|
||||
// happens earlier than the libc::write that receives a pointer to its data.
|
||||
let mut roc_str = ManuallyDrop::new(RocStr::default());
|
||||
roc_main(&mut roc_str);
|
||||
|
||||
let len = roc_str.len();
|
||||
let str_bytes = roc_str.as_bytes().as_ptr() as *const libc::c_void;
|
||||
|
||||
if libc::write(1, str_bytes, len) < 0 {
|
||||
panic!("Writing to stdout failed!");
|
||||
}
|
||||
|
||||
ManuallyDrop::drop(&mut roc_str)
|
||||
}
|
||||
|
||||
// Exit code
|
||||
0
|
||||
}
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
fn main() {
|
||||
std::process::exit(host::rust_main() as _);
|
||||
}
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
#include <stdlib.h>
|
||||
|
||||
struct RocStr {
|
||||
char* bytes;
|
||||
size_t len;
|
||||
size_t capacity;
|
||||
};
|
||||
|
||||
extern void roc__mainForHost_1_exposed_generic(const struct RocStr *data);
|
||||
|
|
@ -0,0 +1,62 @@
|
|||
import Foundation
|
||||
|
||||
@_cdecl("roc_alloc")
|
||||
func rocAlloc(size: Int, _alignment: UInt) -> UInt {
|
||||
guard let ptr = malloc(size) else {
|
||||
return 0
|
||||
}
|
||||
return UInt(bitPattern: ptr)
|
||||
}
|
||||
|
||||
@_cdecl("roc_dealloc")
|
||||
func rocDealloc(ptr: UInt, _alignment: UInt) {
|
||||
free(UnsafeMutableRawPointer(bitPattern: ptr))
|
||||
}
|
||||
|
||||
@_cdecl("roc_realloc")
|
||||
func rocRealloc(ptr: UInt, _oldSize: Int, newSize: Int, _alignment: UInt) -> UInt {
|
||||
guard let ptr = realloc(UnsafeMutableRawPointer(bitPattern: ptr), newSize) else {
|
||||
return 0
|
||||
}
|
||||
return UInt(bitPattern: ptr)
|
||||
}
|
||||
|
||||
func isSmallString(rocStr: RocStr) -> Bool {
|
||||
return rocStr.capacity < 0
|
||||
}
|
||||
|
||||
func getStrLen(rocStr: RocStr) -> Int {
|
||||
if isSmallString(rocStr: rocStr) {
|
||||
// Small String length is last in the byte of capacity.
|
||||
var cap = rocStr.capacity
|
||||
let count = MemoryLayout.size(ofValue: cap)
|
||||
let bytes = Data(bytes: &cap, count: count)
|
||||
let lastByte = bytes[count - 1]
|
||||
return Int(lastByte ^ 0b1000_0000)
|
||||
} else {
|
||||
return rocStr.len
|
||||
}
|
||||
}
|
||||
|
||||
func getSwiftString(rocStr: RocStr) -> String {
|
||||
let length = getStrLen(rocStr: rocStr)
|
||||
|
||||
if isSmallString(rocStr: rocStr) {
|
||||
let data: Data = withUnsafePointer(to: rocStr) { ptr in
|
||||
Data(bytes: ptr, count: length)
|
||||
}
|
||||
return String(data: data, encoding: .utf8)!
|
||||
} else {
|
||||
let data = Data(bytes: rocStr.bytes, count: length)
|
||||
return String(data: data, encoding: .utf8)!
|
||||
}
|
||||
}
|
||||
|
||||
@_cdecl("main")
|
||||
func main() -> UInt8 {
|
||||
var rocStr = RocStr()
|
||||
roc__mainForHost_1_exposed_generic(&rocStr)
|
||||
|
||||
print(getSwiftString(rocStr: rocStr), terminator: "")
|
||||
return 0
|
||||
}
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
platform "echo-in-swift"
|
||||
requires {} { main : Str }
|
||||
exposes []
|
||||
packages {}
|
||||
imports []
|
||||
provides [mainForHost]
|
||||
|
||||
mainForHost : Str
|
||||
mainForHost = main
|
||||
|
|
@ -0,0 +1,55 @@
|
|||
# Hello, World!
|
||||
|
||||
To run this website, first compile either of these identical apps:
|
||||
|
||||
```bash
|
||||
# Option A: Compile crates/cli_testing_examples/platform-switching/rocLovesWebAssembly.roc
|
||||
cargo run -- build --target=wasm32 crates/cli_testing_examples/platform-switching/rocLovesWebAssembly.roc
|
||||
|
||||
# Option B: Compile crates/cli_testing_examples/platform-switching/main.roc with `pf: "web-assembly-platform/main.roc"` and move the result
|
||||
cargo run -- build --target=wasm32 crates/cli_testing_examples/platform-switching/main.roc
|
||||
(cd crates/cli_testing_examples/platform-switching && mv rocLovesPlatforms.wasm web-assembly-platform/rocLovesWebAssembly.wasm)
|
||||
```
|
||||
|
||||
Then `cd` into the website directory
|
||||
and run any web server that can handle WebAssembly.
|
||||
For example, with `http-server`:
|
||||
|
||||
```bash
|
||||
cd crates/cli_testing_examples/platform-switching/web-assembly-platform
|
||||
npm install -g http-server
|
||||
http-server
|
||||
```
|
||||
|
||||
Now open your browser at <http://localhost:8080>
|
||||
|
||||
## Design Notes
|
||||
|
||||
This demonstrates the basic design of hosts: Roc code gets compiled into a pure
|
||||
function (in this case, a thunk that always returns `"Hello, World!\n"`) and
|
||||
then the host calls that function. Fundamentally, that's the whole idea! The host
|
||||
might not even have a `main` - it could be a library, a plugin, anything.
|
||||
Everything else is built on this basic "hosts calling linked pure functions" design.
|
||||
|
||||
For example, things get more interesting when the compiled Roc function returns
|
||||
a `Task` - that is, a tagged union data structure containing function pointers
|
||||
to callback closures. This lets the Roc pure function describe arbitrary
|
||||
chainable effects, which the host can interpret to perform I/O as requested by
|
||||
the Roc program. (The tagged union `Task` would have a variant for each supported
|
||||
I/O operation.)
|
||||
|
||||
In this trivial example, it's very easy to line up the API between the host and
|
||||
the Roc program. In a more involved host, this would be much trickier - especially
|
||||
if the API were changing frequently during development.
|
||||
|
||||
The idea there is to have a first-class concept of "glue code" which host authors
|
||||
can write (it would be plain Roc code, but with some extra keywords that aren't
|
||||
available in normal modules - kinda like `port module` in Elm), and which
|
||||
describe both the Roc-host/C boundary as well as the Roc-host/Roc-app boundary.
|
||||
Roc application authors only care about the Roc-host/Roc-app portion, and the
|
||||
host author only cares about the Roc-host/C boundary when implementing the host.
|
||||
|
||||
Using this glue code, the Roc compiler can generate C header files describing the
|
||||
boundary. This not only gets us host compatibility with C compilers, but also
|
||||
Rust FFI for free, because [`rust-bindgen`](https://github.com/rust-lang/rust-bindgen)
|
||||
generates correct Rust FFI bindings from C headers.
|
||||
|
|
@ -0,0 +1,58 @@
|
|||
async function roc_web_platform_run(wasm_filename, callback) {
|
||||
const decoder = new TextDecoder();
|
||||
let memory_bytes;
|
||||
let exit_code;
|
||||
|
||||
function js_display_roc_string(str_bytes, str_len) {
|
||||
const utf8_bytes = memory_bytes.subarray(str_bytes, str_bytes + str_len);
|
||||
const js_string = decoder.decode(utf8_bytes);
|
||||
callback(js_string);
|
||||
}
|
||||
|
||||
const importObj = {
|
||||
wasi_snapshot_preview1: {
|
||||
proc_exit: (code) => {
|
||||
if (code !== 0) {
|
||||
console.error(`Exited with code ${code}`);
|
||||
}
|
||||
exit_code = code;
|
||||
},
|
||||
fd_write: (x) => { console.error(`fd_write not supported: ${x}`); }
|
||||
},
|
||||
env: {
|
||||
js_display_roc_string,
|
||||
roc_panic: (_pointer, _tag_id) => {
|
||||
throw "Roc panicked!";
|
||||
},
|
||||
},
|
||||
};
|
||||
|
||||
let wasm;
|
||||
|
||||
const response = await fetch(wasm_filename);
|
||||
|
||||
if (WebAssembly.instantiateStreaming) {
|
||||
// streaming API has better performance if available
|
||||
wasm = await WebAssembly.instantiateStreaming(response, importObj);
|
||||
} else {
|
||||
const module_bytes = await response.arrayBuffer();
|
||||
wasm = await WebAssembly.instantiate(module_bytes, importObj);
|
||||
}
|
||||
|
||||
memory_bytes = new Uint8Array(wasm.instance.exports.memory.buffer);
|
||||
|
||||
try {
|
||||
wasm.instance.exports._start();
|
||||
} catch (e) {
|
||||
const is_ok = e.message === "unreachable" && exit_code === 0;
|
||||
if (!is_ok) {
|
||||
console.error(e);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (typeof module !== "undefined") {
|
||||
module.exports = {
|
||||
roc_web_platform_run,
|
||||
};
|
||||
}
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
/**
|
||||
* Node.js test file for helloWeb example
|
||||
* We are not running this in CI currently, and Node.js is not a Roc dependency.
|
||||
* But if you happen to have it, you can run this.
|
||||
*/
|
||||
|
||||
// Node doesn't have the fetch API
|
||||
const fs = require("fs/promises");
|
||||
global.fetch = (filename) =>
|
||||
fs.readFile(filename).then((buffer) => ({
|
||||
arrayBuffer() {
|
||||
return buffer;
|
||||
},
|
||||
}));
|
||||
|
||||
const { roc_web_platform_run } = require("./host");
|
||||
|
||||
roc_web_platform_run("./rocLovesWebAssembly.wasm", (string_from_roc) => {
|
||||
const expected = "Roc <3 Web Assembly!\n";
|
||||
if (string_from_roc !== expected) {
|
||||
console.error(`Expected "${expected}", but got "${string_from_roc}"`);
|
||||
process.exit(1);
|
||||
}
|
||||
console.log("OK");
|
||||
});
|
||||
|
|
@ -0,0 +1,74 @@
|
|||
const std = @import("std");
|
||||
const str = @import("str");
|
||||
const builtin = @import("builtin");
|
||||
const RocStr = str.RocStr;
|
||||
const testing = std.testing;
|
||||
const expectEqual = testing.expectEqual;
|
||||
const expect = testing.expect;
|
||||
|
||||
comptime {
|
||||
// This is a workaround for https://github.com/ziglang/zig/issues/8218
|
||||
// which is only necessary on macOS.
|
||||
//
|
||||
// Once that issue is fixed, we can undo the changes in
|
||||
// 177cf12e0555147faa4d436e52fc15175c2c4ff0 and go back to passing
|
||||
// -fcompiler-rt in link.rs instead of doing this. Note that this
|
||||
// workaround is present in many host.zig files, so make sure to undo
|
||||
// it everywhere!
|
||||
if (builtin.os.tag == .macos) {
|
||||
_ = @import("compiler_rt");
|
||||
}
|
||||
}
|
||||
|
||||
const Align = extern struct { a: usize, b: usize };
|
||||
extern fn malloc(size: usize) callconv(.C) ?*align(@alignOf(Align)) anyopaque;
|
||||
extern fn realloc(c_ptr: [*]align(@alignOf(Align)) u8, size: usize) callconv(.C) ?*anyopaque;
|
||||
extern fn free(c_ptr: [*]align(@alignOf(Align)) u8) callconv(.C) void;
|
||||
extern fn memcpy(dest: *anyopaque, src: *anyopaque, count: usize) *anyopaque;
|
||||
|
||||
export fn roc_alloc(size: usize, alignment: u32) callconv(.C) ?*anyopaque {
|
||||
_ = alignment;
|
||||
|
||||
return malloc(size);
|
||||
}
|
||||
|
||||
export fn roc_realloc(c_ptr: *anyopaque, new_size: usize, old_size: usize, alignment: u32) callconv(.C) ?*anyopaque {
|
||||
_ = old_size;
|
||||
_ = alignment;
|
||||
|
||||
return realloc(@alignCast(@alignOf(Align), @ptrCast([*]u8, c_ptr)), new_size);
|
||||
}
|
||||
|
||||
export fn roc_dealloc(c_ptr: *anyopaque, alignment: u32) callconv(.C) void {
|
||||
_ = alignment;
|
||||
|
||||
free(@alignCast(@alignOf(Align), @ptrCast([*]u8, c_ptr)));
|
||||
}
|
||||
|
||||
export fn roc_memcpy(dest: *anyopaque, src: *anyopaque, count: usize) callconv(.C) void {
|
||||
_ = memcpy(dest, src, count);
|
||||
}
|
||||
|
||||
// NOTE roc_panic is provided in the JS file, so it can throw an exception
|
||||
|
||||
const mem = std.mem;
|
||||
const Allocator = mem.Allocator;
|
||||
|
||||
extern fn roc__mainForHost_1_exposed(*RocStr) void;
|
||||
|
||||
const Unit = extern struct {};
|
||||
|
||||
extern fn js_display_roc_string(str_bytes: ?[*]u8, str_len: usize) void;
|
||||
|
||||
pub fn main() u8 {
|
||||
// actually call roc to populate the callresult
|
||||
var callresult = RocStr.empty();
|
||||
roc__mainForHost_1_exposed(&callresult);
|
||||
|
||||
// display the result using JavaScript
|
||||
js_display_roc_string(callresult.asU8ptr(), callresult.len());
|
||||
|
||||
callresult.deinit();
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
<html>
|
||||
<body>
|
||||
<div id="output"></div>
|
||||
<script src="./host.js"></script>
|
||||
<script>
|
||||
const elem = document.getElementById("output");
|
||||
roc_web_platform_run("./rocLovesWebAssembly.wasm", (string_from_roc) => {
|
||||
elem.textContent = string_from_roc;
|
||||
});
|
||||
</script>
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
platform "echo-in-web-assembly"
|
||||
requires {} { main : Str }
|
||||
exposes []
|
||||
packages {}
|
||||
imports []
|
||||
provides [mainForHost]
|
||||
|
||||
mainForHost : Str
|
||||
mainForHost = main
|
||||
|
|
@ -0,0 +1,106 @@
|
|||
const std = @import("std");
|
||||
const builtin = @import("builtin");
|
||||
const str = @import("str");
|
||||
const RocStr = str.RocStr;
|
||||
const testing = std.testing;
|
||||
const expectEqual = testing.expectEqual;
|
||||
const expect = testing.expect;
|
||||
|
||||
comptime {
|
||||
// This is a workaround for https://github.com/ziglang/zig/issues/8218
|
||||
// which is only necessary on macOS.
|
||||
//
|
||||
// Once that issue is fixed, we can undo the changes in
|
||||
// 177cf12e0555147faa4d436e52fc15175c2c4ff0 and go back to passing
|
||||
// -fcompiler-rt in link.rs instead of doing this. Note that this
|
||||
// workaround is present in many host.zig files, so make sure to undo
|
||||
// it everywhere!
|
||||
if (builtin.os.tag == .macos) {
|
||||
_ = @import("compiler_rt");
|
||||
}
|
||||
}
|
||||
|
||||
const Align = 2 * @alignOf(usize);
|
||||
extern fn malloc(size: usize) callconv(.C) ?*align(Align) anyopaque;
|
||||
extern fn realloc(c_ptr: [*]align(Align) u8, size: usize) callconv(.C) ?*anyopaque;
|
||||
extern fn free(c_ptr: [*]align(Align) u8) callconv(.C) void;
|
||||
extern fn memcpy(dst: [*]u8, src: [*]u8, size: usize) callconv(.C) void;
|
||||
extern fn memset(dst: [*]u8, value: i32, size: usize) callconv(.C) void;
|
||||
|
||||
const DEBUG: bool = false;
|
||||
|
||||
export fn roc_alloc(size: usize, alignment: u32) callconv(.C) ?*anyopaque {
|
||||
if (DEBUG) {
|
||||
var ptr = malloc(size);
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
stdout.print("alloc: {d} (alignment {d}, size {d})\n", .{ ptr, alignment, size }) catch unreachable;
|
||||
return ptr;
|
||||
} else {
|
||||
return malloc(size);
|
||||
}
|
||||
}
|
||||
|
||||
export fn roc_realloc(c_ptr: *anyopaque, new_size: usize, old_size: usize, alignment: u32) callconv(.C) ?*anyopaque {
|
||||
if (DEBUG) {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
stdout.print("realloc: {d} (alignment {d}, old_size {d})\n", .{ c_ptr, alignment, old_size }) catch unreachable;
|
||||
}
|
||||
|
||||
return realloc(@alignCast(Align, @ptrCast([*]u8, c_ptr)), new_size);
|
||||
}
|
||||
|
||||
export fn roc_dealloc(c_ptr: *anyopaque, alignment: u32) callconv(.C) void {
|
||||
if (DEBUG) {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
stdout.print("dealloc: {d} (alignment {d})\n", .{ c_ptr, alignment }) catch unreachable;
|
||||
}
|
||||
|
||||
free(@alignCast(Align, @ptrCast([*]u8, c_ptr)));
|
||||
}
|
||||
|
||||
export fn roc_panic(c_ptr: *anyopaque, tag_id: u32) callconv(.C) void {
|
||||
_ = tag_id;
|
||||
|
||||
const stderr = std.io.getStdErr().writer();
|
||||
const msg = @ptrCast([*:0]const u8, c_ptr);
|
||||
stderr.print("Application crashed with message\n\n {s}\n\nShutting down\n", .{msg}) catch unreachable;
|
||||
std.process.exit(0);
|
||||
}
|
||||
|
||||
export fn roc_memcpy(dst: [*]u8, src: [*]u8, size: usize) callconv(.C) void {
|
||||
return memcpy(dst, src, size);
|
||||
}
|
||||
|
||||
export fn roc_memset(dst: [*]u8, value: i32, size: usize) callconv(.C) void {
|
||||
return memset(dst, value, size);
|
||||
}
|
||||
|
||||
const mem = std.mem;
|
||||
const Allocator = mem.Allocator;
|
||||
|
||||
extern fn roc__mainForHost_1_exposed_generic(*RocStr) void;
|
||||
|
||||
const Unit = extern struct {};
|
||||
|
||||
pub fn main() u8 {
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
const stderr = std.io.getStdErr().writer();
|
||||
|
||||
var timer = std.time.Timer.start() catch unreachable;
|
||||
|
||||
// actually call roc to populate the callresult
|
||||
var callresult = RocStr.empty();
|
||||
roc__mainForHost_1_exposed_generic(&callresult);
|
||||
|
||||
const nanos = timer.read();
|
||||
const seconds = (@intToFloat(f64, nanos) / 1_000_000_000.0);
|
||||
|
||||
// stdout the result
|
||||
stdout.print("{s}", .{callresult.asSlice()}) catch unreachable;
|
||||
|
||||
callresult.deinit();
|
||||
|
||||
stderr.print("runtime: {d:.3}ms\n", .{seconds * 1000}) catch unreachable;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
platform "echo-in-zig"
|
||||
requires {} { main : Str }
|
||||
exposes []
|
||||
packages {}
|
||||
imports []
|
||||
provides [mainForHost]
|
||||
|
||||
mainForHost : Str
|
||||
mainForHost = main
|
||||
File diff suppressed because one or more lines are too long
|
|
@ -22,7 +22,7 @@ pub struct Out {
|
|||
pub status: ExitStatus,
|
||||
}
|
||||
|
||||
pub fn run_roc<I, S>(args: I, stdin_vals: &[&str]) -> Out
|
||||
pub fn run_roc<I, S>(args: I, stdin_vals: &[&str], extra_env: &[(&str, &str)]) -> Out
|
||||
where
|
||||
I: IntoIterator<Item = S>,
|
||||
S: AsRef<OsStr>,
|
||||
|
|
@ -62,7 +62,7 @@ where
|
|||
}
|
||||
}
|
||||
|
||||
run_with_stdin(&roc_binary_path, args, stdin_vals)
|
||||
run_with_stdin_and_env(&roc_binary_path, args, stdin_vals, extra_env)
|
||||
}
|
||||
|
||||
pub fn run_glue<I, S>(args: I) -> Out
|
||||
|
|
@ -118,6 +118,19 @@ pub fn strip_colors(str: &str) -> String {
|
|||
}
|
||||
|
||||
pub fn run_with_stdin<I, S>(path: &Path, args: I, stdin_vals: &[&str]) -> Out
|
||||
where
|
||||
I: IntoIterator<Item = S>,
|
||||
S: AsRef<OsStr>,
|
||||
{
|
||||
run_with_stdin_and_env(path, args, stdin_vals, &[])
|
||||
}
|
||||
|
||||
pub fn run_with_stdin_and_env<I, S>(
|
||||
path: &Path,
|
||||
args: I,
|
||||
stdin_vals: &[&str],
|
||||
extra_env: &[(&str, &str)],
|
||||
) -> Out
|
||||
where
|
||||
I: IntoIterator<Item = S>,
|
||||
S: AsRef<OsStr>,
|
||||
|
|
@ -128,6 +141,10 @@ where
|
|||
cmd.arg(arg);
|
||||
}
|
||||
|
||||
for (k, v) in extra_env {
|
||||
cmd.env(k, v);
|
||||
}
|
||||
|
||||
let mut child = cmd
|
||||
.stdin(Stdio::piped())
|
||||
.stdout(Stdio::piped())
|
||||
|
|
@ -364,20 +381,31 @@ pub fn root_dir() -> PathBuf {
|
|||
path
|
||||
}
|
||||
|
||||
// start the dir with crates/cli_testing_examples
|
||||
#[allow(dead_code)]
|
||||
pub fn examples_dir(dir_name: &str) -> PathBuf {
|
||||
pub fn cli_testing_dir(dir_name: &str) -> PathBuf {
|
||||
let mut path = root_dir();
|
||||
|
||||
// Descend into examples/{dir_name}
|
||||
path.push("examples");
|
||||
path.push("crates");
|
||||
path.push("cli_testing_examples");
|
||||
path.extend(dir_name.split("/")); // Make slashes cross-target
|
||||
|
||||
path
|
||||
}
|
||||
|
||||
#[allow(dead_code)]
|
||||
pub fn example_file(dir_name: &str, file_name: &str) -> PathBuf {
|
||||
let mut path = examples_dir(dir_name);
|
||||
pub fn dir_path_from_root(dir_name: &str) -> PathBuf {
|
||||
let mut path = root_dir();
|
||||
|
||||
path.extend(dir_name.split("/")); // Make slashes cross-target
|
||||
|
||||
path
|
||||
}
|
||||
|
||||
#[allow(dead_code)]
|
||||
pub fn file_path_from_root(dir_name: &str, file_name: &str) -> PathBuf {
|
||||
let mut path = dir_path_from_root(dir_name);
|
||||
|
||||
path.push(file_name);
|
||||
|
||||
|
|
|
|||
|
|
@ -374,7 +374,7 @@ pub fn build_zig_host_wasm32(
|
|||
"c",
|
||||
"-target",
|
||||
zig_target,
|
||||
// "-femit-llvm-ir=/home/folkertdev/roc/roc/examples/benchmarks/platform/host.ll",
|
||||
// "-femit-llvm-ir=/home/folkertdev/roc/roc/crates/cli_testing_examples/benchmarks/platform/host.ll",
|
||||
"-fPIC",
|
||||
"--strip",
|
||||
];
|
||||
|
|
@ -635,6 +635,7 @@ pub fn rebuild_host(
|
|||
} else if cargo_host_src.exists() {
|
||||
// Compile and link Cargo.toml, if it exists
|
||||
let cargo_dir = host_input_path.parent().unwrap();
|
||||
|
||||
let cargo_out_dir = cargo_dir.join("target").join(
|
||||
if matches!(opt_level, OptLevel::Optimize | OptLevel::Size) {
|
||||
"release"
|
||||
|
|
@ -1215,7 +1216,7 @@ fn link_wasm32(
|
|||
"-O",
|
||||
"ReleaseSmall",
|
||||
// useful for debugging
|
||||
// "-femit-llvm-ir=/home/folkertdev/roc/roc/examples/benchmarks/platform/host.ll",
|
||||
// "-femit-llvm-ir=/home/folkertdev/roc/roc/crates/cli_testing_examples/benchmarks/platform/host.ll",
|
||||
])
|
||||
.spawn()?;
|
||||
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ lazy_static = "1.4.0"
|
|||
|
||||
[build-dependencies]
|
||||
# dunce can be removed once ziglang/zig#5109 is fixed
|
||||
dunce = "1.0.2"
|
||||
dunce = "1.0.3"
|
||||
|
||||
[target.'cfg(target_os = "macos")'.build-dependencies]
|
||||
tempfile = "3.2.0"
|
||||
|
|
|
|||
|
|
@ -93,20 +93,6 @@ pub const RocList = extern struct {
|
|||
return (ptr - 1)[0] == utils.REFCOUNT_ONE;
|
||||
}
|
||||
|
||||
pub fn allocate(
|
||||
alignment: u32,
|
||||
length: usize,
|
||||
element_size: usize,
|
||||
) RocList {
|
||||
const data_bytes = length * element_size;
|
||||
|
||||
return RocList{
|
||||
.bytes = utils.allocateWithRefcount(data_bytes, alignment),
|
||||
.length = length,
|
||||
.capacity = length,
|
||||
};
|
||||
}
|
||||
|
||||
pub fn makeUniqueExtra(self: RocList, alignment: u32, element_width: usize, update_mode: UpdateMode) RocList {
|
||||
if (update_mode == .InPlace) {
|
||||
return self;
|
||||
|
|
@ -140,11 +126,117 @@ pub const RocList = extern struct {
|
|||
return new_list;
|
||||
}
|
||||
|
||||
// We follow roughly the [fbvector](https://github.com/facebook/folly/blob/main/folly/docs/FBVector.md) when it comes to growing a RocList.
|
||||
// Here is [their growth strategy](https://github.com/facebook/folly/blob/3e0525988fd444201b19b76b390a5927c15cb697/folly/FBVector.h#L1128) for push_back:
|
||||
//
|
||||
// (1) initial size
|
||||
// Instead of growing to size 1 from empty, fbvector allocates at least
|
||||
// 64 bytes. You may still use reserve to reserve a lesser amount of
|
||||
// memory.
|
||||
// (2) 1.5x
|
||||
// For medium-sized vectors, the growth strategy is 1.5x. See the docs
|
||||
// for details.
|
||||
// This does not apply to very small or very large fbvectors. This is a
|
||||
// heuristic.
|
||||
//
|
||||
// In our case, we exposed allocate and reallocate, which will use a smart growth stategy.
|
||||
// We also expose allocateExact and reallocateExact for case where a specific number of elements is requested.
|
||||
|
||||
// calculateCapacity should only be called in cases the list will be growing.
|
||||
// requested_length should always be greater than old_capacity.
|
||||
inline fn calculateCapacity(
|
||||
old_capacity: usize,
|
||||
requested_length: usize,
|
||||
element_width: usize,
|
||||
) usize {
|
||||
// TODO: there are two adjustments that would likely lead to better results for Roc.
|
||||
// 1. Deal with the fact we allocate an extra u64 for refcount.
|
||||
// This may lead to allocating page size + 8 bytes.
|
||||
// That could mean allocating an entire page for 8 bytes of data which isn't great.
|
||||
// 2. Deal with the fact that we can request more than 1 element at a time.
|
||||
// fbvector assumes just appending 1 element at a time when using this algorithm.
|
||||
// As such, they will generally grow in a way that should better match certain memory multiple.
|
||||
// This is also the normal case for roc, but we could also grow by a much larger amount.
|
||||
// We may want to round to multiples of 2 or something similar.
|
||||
var new_capacity: usize = 0;
|
||||
if (element_width == 0) {
|
||||
return requested_length;
|
||||
} else if (old_capacity == 0) {
|
||||
new_capacity = 64 / element_width;
|
||||
} else if (old_capacity < 4096 / element_width) {
|
||||
new_capacity = old_capacity * 2;
|
||||
} else if (old_capacity > 4096 * 32 / element_width) {
|
||||
new_capacity = old_capacity * 2;
|
||||
} else {
|
||||
new_capacity = (old_capacity * 3 + 1) / 2;
|
||||
}
|
||||
return @maximum(new_capacity, requested_length);
|
||||
}
|
||||
|
||||
pub fn allocate(
|
||||
alignment: u32,
|
||||
length: usize,
|
||||
element_width: usize,
|
||||
) RocList {
|
||||
if (length == 0) {
|
||||
return empty();
|
||||
}
|
||||
|
||||
const capacity = calculateCapacity(0, length, element_width);
|
||||
const data_bytes = capacity * element_width;
|
||||
return RocList{
|
||||
.bytes = utils.allocateWithRefcount(data_bytes, alignment),
|
||||
.length = length,
|
||||
.capacity = capacity,
|
||||
};
|
||||
}
|
||||
|
||||
pub fn allocateExact(
|
||||
alignment: u32,
|
||||
length: usize,
|
||||
element_width: usize,
|
||||
) RocList {
|
||||
if (length == 0) {
|
||||
return empty();
|
||||
}
|
||||
|
||||
const data_bytes = length * element_width;
|
||||
return RocList{
|
||||
.bytes = utils.allocateWithRefcount(data_bytes, alignment),
|
||||
.length = length,
|
||||
.capacity = length,
|
||||
};
|
||||
}
|
||||
|
||||
pub fn reallocate(
|
||||
self: RocList,
|
||||
alignment: u32,
|
||||
new_length: usize,
|
||||
element_width: usize,
|
||||
) RocList {
|
||||
if (self.bytes) |source_ptr| {
|
||||
if (self.isUnique()) {
|
||||
if (self.capacity >= new_length) {
|
||||
return RocList{ .bytes = self.bytes, .length = new_length, .capacity = self.capacity };
|
||||
} else {
|
||||
const new_capacity = calculateCapacity(self.capacity, new_length, element_width);
|
||||
const new_source = utils.unsafeReallocate(source_ptr, alignment, self.len(), new_capacity, element_width);
|
||||
return RocList{ .bytes = new_source, .length = new_length, .capacity = new_capacity };
|
||||
}
|
||||
}
|
||||
// TODO: Investigate the performance of this.
|
||||
// Maybe we should just always reallocate to the new_length instead of expanding capacity?
|
||||
const new_capacity = if (self.capacity >= new_length) self.capacity else calculateCapacity(self.capacity, new_length, element_width);
|
||||
return self.reallocateFresh(alignment, new_length, new_capacity, element_width);
|
||||
}
|
||||
return RocList.allocate(alignment, new_length, element_width);
|
||||
}
|
||||
|
||||
pub fn reallocateExact(
|
||||
self: RocList,
|
||||
alignment: u32,
|
||||
new_length: usize,
|
||||
element_width: usize,
|
||||
) RocList {
|
||||
if (self.bytes) |source_ptr| {
|
||||
if (self.isUnique()) {
|
||||
|
|
@ -155,9 +247,9 @@ pub const RocList = extern struct {
|
|||
return RocList{ .bytes = new_source, .length = new_length, .capacity = new_length };
|
||||
}
|
||||
}
|
||||
return self.reallocateFresh(alignment, new_length, new_length, element_width);
|
||||
}
|
||||
|
||||
return self.reallocateFresh(alignment, new_length, element_width);
|
||||
return RocList.allocateExact(alignment, new_length, element_width);
|
||||
}
|
||||
|
||||
/// reallocate by explicitly making a new allocation and copying elements over
|
||||
|
|
@ -165,16 +257,16 @@ pub const RocList = extern struct {
|
|||
self: RocList,
|
||||
alignment: u32,
|
||||
new_length: usize,
|
||||
new_capacity: usize,
|
||||
element_width: usize,
|
||||
) RocList {
|
||||
const old_length = self.length;
|
||||
const delta_length = new_length - old_length;
|
||||
|
||||
const data_bytes = new_length * element_width;
|
||||
const data_bytes = new_capacity * element_width;
|
||||
const first_slot = utils.allocateWithRefcount(data_bytes, alignment);
|
||||
|
||||
// transfer the memory
|
||||
|
||||
if (self.bytes) |source_ptr| {
|
||||
const dest_ptr = first_slot;
|
||||
|
||||
|
|
@ -185,7 +277,7 @@ pub const RocList = extern struct {
|
|||
const result = RocList{
|
||||
.bytes = first_slot,
|
||||
.length = new_length,
|
||||
.capacity = new_length,
|
||||
.capacity = new_capacity,
|
||||
};
|
||||
|
||||
utils.decref(self.bytes, old_length * element_width, alignment);
|
||||
|
|
@ -412,7 +504,7 @@ pub fn listWithCapacity(
|
|||
alignment: u32,
|
||||
element_width: usize,
|
||||
) callconv(.C) RocList {
|
||||
var output = RocList.allocate(alignment, capacity, element_width);
|
||||
var output = RocList.allocateExact(alignment, capacity, element_width);
|
||||
output.length = 0;
|
||||
return output;
|
||||
}
|
||||
|
|
@ -517,17 +609,25 @@ pub fn listSublist(
|
|||
len: usize,
|
||||
dec: Dec,
|
||||
) callconv(.C) RocList {
|
||||
if (len == 0) {
|
||||
const size = list.len();
|
||||
if (len == 0 or start >= size) {
|
||||
if (list.isUnique()) {
|
||||
// Decrement the reference counts of all elements.
|
||||
if (list.bytes) |source_ptr| {
|
||||
var i: usize = 0;
|
||||
while (i < size) : (i += 1) {
|
||||
const element = source_ptr + i * element_width;
|
||||
dec(element);
|
||||
}
|
||||
var output = list;
|
||||
output.length = 0;
|
||||
return output;
|
||||
}
|
||||
}
|
||||
return RocList.empty();
|
||||
}
|
||||
|
||||
if (list.bytes) |source_ptr| {
|
||||
const size = list.len();
|
||||
|
||||
if (start >= size) {
|
||||
return RocList.empty();
|
||||
}
|
||||
|
||||
const keep_len = std.math.min(len, size - start);
|
||||
const drop_start_len = start;
|
||||
const drop_end_len = size - (start + keep_len);
|
||||
|
|
@ -546,10 +646,17 @@ pub fn listSublist(
|
|||
dec(element);
|
||||
}
|
||||
|
||||
if (start == 0 and list.isUnique()) {
|
||||
if (list.isUnique()) {
|
||||
var output = list;
|
||||
output.length = keep_len;
|
||||
return output;
|
||||
if (start == 0) {
|
||||
return output;
|
||||
} else {
|
||||
// We want memmove due to aliasing. Zig does not expose it directly.
|
||||
// Instead use copy which can write to aliases as long as the dest is before the source.
|
||||
mem.copy(u8, source_ptr[0 .. keep_len * element_width], source_ptr[start * element_width .. (start + keep_len) * element_width]);
|
||||
return output;
|
||||
}
|
||||
} else {
|
||||
const output = RocList.allocate(alignment, keep_len, element_width);
|
||||
const target_ptr = output.bytes orelse unreachable;
|
||||
|
|
|
|||
|
|
@ -144,6 +144,7 @@ comptime {
|
|||
exportStrFn(str.strTrimLeft, "trim_left");
|
||||
exportStrFn(str.strTrimRight, "trim_right");
|
||||
exportStrFn(str.strCloneTo, "clone_to");
|
||||
exportStrFn(str.withCapacity, "with_capacity");
|
||||
|
||||
inline for (INTEGERS) |T| {
|
||||
str.exportFromInt(T, ROC_BUILTINS ++ "." ++ STR ++ ".from_int.");
|
||||
|
|
|
|||
|
|
@ -2596,6 +2596,10 @@ pub fn reserve(string: RocStr, capacity: usize) callconv(.C) RocStr {
|
|||
}
|
||||
}
|
||||
|
||||
pub fn withCapacity(capacity: usize) callconv(.C) RocStr {
|
||||
return RocStr.allocate(0, capacity);
|
||||
}
|
||||
|
||||
pub fn getScalarUnsafe(string: RocStr, index: usize) callconv(.C) extern struct { bytesParsed: usize, scalar: u32 } {
|
||||
const slice = string.asSlice();
|
||||
const bytesParsed = @intCast(usize, std.unicode.utf8ByteSequenceLength(slice[index]) catch unreachable);
|
||||
|
|
|
|||
|
|
@ -30,6 +30,23 @@ interface Decode
|
|||
]
|
||||
imports [
|
||||
List,
|
||||
Result.{ Result },
|
||||
Num.{
|
||||
U8,
|
||||
U16,
|
||||
U32,
|
||||
U64,
|
||||
U128,
|
||||
I8,
|
||||
I16,
|
||||
I32,
|
||||
I64,
|
||||
I128,
|
||||
F32,
|
||||
F64,
|
||||
Dec,
|
||||
},
|
||||
Bool.{ Bool },
|
||||
]
|
||||
|
||||
DecodeError : [TooShort]
|
||||
|
|
|
|||
|
|
@ -20,6 +20,7 @@ interface Dict
|
|||
Bool.{ Bool },
|
||||
Result.{ Result },
|
||||
List,
|
||||
Num.{ Nat },
|
||||
]
|
||||
|
||||
## A [dictionary](https://en.wikipedia.org/wiki/Associative_array) that lets you can associate keys with values.
|
||||
|
|
|
|||
|
|
@ -27,7 +27,24 @@ interface Encode
|
|||
append,
|
||||
toBytes,
|
||||
]
|
||||
imports []
|
||||
imports [
|
||||
Num.{
|
||||
U8,
|
||||
U16,
|
||||
U32,
|
||||
U64,
|
||||
U128,
|
||||
I8,
|
||||
I16,
|
||||
I32,
|
||||
I64,
|
||||
I128,
|
||||
F32,
|
||||
F64,
|
||||
Dec,
|
||||
},
|
||||
Bool.{ Bool },
|
||||
]
|
||||
|
||||
Encoder fmt := List U8, fmt -> List U8 | fmt has EncoderFormatting
|
||||
|
||||
|
|
|
|||
|
|
@ -20,6 +20,7 @@ interface Hash
|
|||
] imports [
|
||||
List,
|
||||
Str,
|
||||
Num.{ U8, U16, U32, U64, U128, I8, I16, I32, I64, I128 },
|
||||
]
|
||||
|
||||
## A value that can hashed.
|
||||
|
|
|
|||
|
|
@ -18,6 +18,23 @@ interface Json
|
|||
DecoderFormatting,
|
||||
DecodeResult,
|
||||
},
|
||||
Num.{
|
||||
U8,
|
||||
U16,
|
||||
U32,
|
||||
U64,
|
||||
U128,
|
||||
I8,
|
||||
I16,
|
||||
I32,
|
||||
I64,
|
||||
I128,
|
||||
F32,
|
||||
F64,
|
||||
Dec,
|
||||
},
|
||||
Bool.{ Bool },
|
||||
Result,
|
||||
]
|
||||
|
||||
Json := {} has [
|
||||
|
|
@ -187,9 +204,8 @@ takeWhile = \list, predicate ->
|
|||
|
||||
helper { taken: [], rest: list }
|
||||
|
||||
asciiByte = \b -> Num.toU8 b
|
||||
|
||||
digits = List.range (asciiByte '0') (asciiByte '9' + 1)
|
||||
digits : List U8
|
||||
digits = List.range '0' ('9' + 1)
|
||||
|
||||
takeDigits = \bytes ->
|
||||
takeWhile bytes \n -> List.contains digits n
|
||||
|
|
@ -198,10 +214,10 @@ takeFloat = \bytes ->
|
|||
{ taken: intPart, rest } = takeDigits bytes
|
||||
|
||||
when List.get rest 0 is
|
||||
Ok 46 -> # 46 = .
|
||||
Ok '.' ->
|
||||
{ taken: floatPart, rest: afterAll } = takeDigits (List.split rest 1).others
|
||||
builtFloat =
|
||||
List.concat (List.append intPart (asciiByte '.')) floatPart
|
||||
List.concat (List.append intPart '.') floatPart
|
||||
|
||||
{ taken: builtFloat, rest: afterAll }
|
||||
|
||||
|
|
@ -305,14 +321,14 @@ decodeBool = Decode.custom \bytes, @Json {} ->
|
|||
# Note: this could be more performant by traversing both branches char-by-char.
|
||||
# Doing that would also make `rest` more correct in the erroring case.
|
||||
if
|
||||
maybeFalse == [asciiByte 'f', asciiByte 'a', asciiByte 'l', asciiByte 's', asciiByte 'e']
|
||||
maybeFalse == ['f', 'a', 'l', 's', 'e']
|
||||
then
|
||||
{ result: Ok Bool.false, rest: afterFalse }
|
||||
else
|
||||
{ before: maybeTrue, others: afterTrue } = List.split bytes 4
|
||||
|
||||
if
|
||||
maybeTrue == [asciiByte 't', asciiByte 'r', asciiByte 'u', asciiByte 'e']
|
||||
maybeTrue == ['t', 'r', 'u', 'e']
|
||||
then
|
||||
{ result: Ok Bool.true, rest: afterTrue }
|
||||
else
|
||||
|
|
@ -323,10 +339,10 @@ jsonString = \bytes ->
|
|||
{ before, others: afterStartingQuote } = List.split bytes 1
|
||||
|
||||
if
|
||||
before == [asciiByte '"']
|
||||
before == ['"']
|
||||
then
|
||||
# TODO: handle escape sequences
|
||||
{ taken: strSequence, rest } = takeWhile afterStartingQuote \n -> n != asciiByte '"'
|
||||
{ taken: strSequence, rest } = takeWhile afterStartingQuote \n -> n != '"'
|
||||
|
||||
when Str.fromUtf8 strSequence is
|
||||
Ok s ->
|
||||
|
|
@ -351,7 +367,7 @@ decodeList = \decodeElem -> Decode.custom \bytes, @Json {} ->
|
|||
{ before: afterElem, others } = List.split rest 1
|
||||
|
||||
if
|
||||
afterElem == [asciiByte ',']
|
||||
afterElem == [',']
|
||||
then
|
||||
decodeElems others (List.append accum val)
|
||||
else
|
||||
|
|
@ -362,7 +378,7 @@ decodeList = \decodeElem -> Decode.custom \bytes, @Json {} ->
|
|||
{ before, others: afterStartingBrace } = List.split bytes 1
|
||||
|
||||
if
|
||||
before == [asciiByte '[']
|
||||
before == ['[']
|
||||
then
|
||||
# TODO: empty lists
|
||||
when decodeElems afterStartingBrace [] is
|
||||
|
|
@ -371,7 +387,7 @@ decodeList = \decodeElem -> Decode.custom \bytes, @Json {} ->
|
|||
{ before: maybeEndingBrace, others: afterEndingBrace } = List.split rest 1
|
||||
|
||||
if
|
||||
maybeEndingBrace == [asciiByte ']']
|
||||
maybeEndingBrace == [']']
|
||||
then
|
||||
{ result: Ok vals, rest: afterEndingBrace }
|
||||
else
|
||||
|
|
@ -393,10 +409,10 @@ parseExactChar = \bytes, char ->
|
|||
Err _ -> { result: Err TooShort, rest: bytes }
|
||||
|
||||
openBrace : List U8 -> DecodeResult {}
|
||||
openBrace = \bytes -> parseExactChar bytes (asciiByte '{')
|
||||
openBrace = \bytes -> parseExactChar bytes '{'
|
||||
|
||||
closingBrace : List U8 -> DecodeResult {}
|
||||
closingBrace = \bytes -> parseExactChar bytes (asciiByte '}')
|
||||
closingBrace = \bytes -> parseExactChar bytes '}'
|
||||
|
||||
recordKey : List U8 -> DecodeResult Str
|
||||
recordKey = \bytes -> jsonString bytes
|
||||
|
|
@ -405,10 +421,10 @@ anything : List U8 -> DecodeResult {}
|
|||
anything = \bytes -> { result: Err TooShort, rest: bytes }
|
||||
|
||||
colon : List U8 -> DecodeResult {}
|
||||
colon = \bytes -> parseExactChar bytes (asciiByte ':')
|
||||
colon = \bytes -> parseExactChar bytes ':'
|
||||
|
||||
comma : List U8 -> DecodeResult {}
|
||||
comma = \bytes -> parseExactChar bytes (asciiByte ',')
|
||||
comma = \bytes -> parseExactChar bytes ','
|
||||
|
||||
tryDecode : DecodeResult a, ({ val : a, rest : List U8 } -> DecodeResult b) -> DecodeResult b
|
||||
tryDecode = \{ result, rest }, mapper ->
|
||||
|
|
|
|||
|
|
@ -39,6 +39,7 @@ interface List
|
|||
max,
|
||||
map4,
|
||||
mapTry,
|
||||
walkTry,
|
||||
dropFirst,
|
||||
joinMap,
|
||||
any,
|
||||
|
|
@ -60,9 +61,12 @@ interface List
|
|||
sortAsc,
|
||||
sortDesc,
|
||||
reserve,
|
||||
walkBackwardsUntil,
|
||||
]
|
||||
imports [
|
||||
Bool.{ Bool },
|
||||
Result.{ Result },
|
||||
Num.{ Nat, Num, Int },
|
||||
]
|
||||
|
||||
## Types
|
||||
|
|
@ -85,9 +89,8 @@ interface List
|
|||
##
|
||||
## ## Performance Details
|
||||
##
|
||||
## Under the hood, a list is a record containing a `len : Nat` field as well
|
||||
## as a pointer to a reference count and a flat array of bytes. Unique lists
|
||||
## store a capacity #Nat instead of a reference count.
|
||||
## Under the hood, a list is a record containing a `len : Nat` field, a `capacity : Nat`
|
||||
## field, and a pointer to a reference count and a flat array of bytes.
|
||||
##
|
||||
## ## Shared Lists
|
||||
##
|
||||
|
|
@ -109,9 +112,8 @@ interface List
|
|||
## begins with a refcount of 1, because so far only `ratings` is referencing it.
|
||||
##
|
||||
## The second line alters this refcount. `{ foo: ratings` references
|
||||
## the `ratings` list, which will result in its refcount getting incremented
|
||||
## from 0 to 1. Similarly, `bar: ratings }` also references the `ratings` list,
|
||||
## which will result in its refcount getting incremented from 1 to 2.
|
||||
## the `ratings` list, and so does `bar: ratings }`. This will result in its
|
||||
## refcount getting incremented from 1 to 3.
|
||||
##
|
||||
## Let's turn this example into a function.
|
||||
##
|
||||
|
|
@ -129,11 +131,11 @@ interface List
|
|||
##
|
||||
## Since `ratings` represented a way to reference the list, and that way is no
|
||||
## longer accessible, the list's refcount gets decremented when `ratings` goes
|
||||
## out of scope. It will decrease from 2 back down to 1.
|
||||
## out of scope. It will decrease from 3 back down to 2.
|
||||
##
|
||||
## Putting these together, when we call `getRatings 5`, what we get back is
|
||||
## a record with two fields, `foo`, and `bar`, each of which refers to the same
|
||||
## list, and that list has a refcount of 1.
|
||||
## list, and that list has a refcount of 2.
|
||||
##
|
||||
## Let's change the last line to be `(getRatings 5).bar` instead of `getRatings 5`:
|
||||
##
|
||||
|
|
@ -433,6 +435,13 @@ walkUntil = \list, initial, step ->
|
|||
Continue new -> new
|
||||
Break new -> new
|
||||
|
||||
## Same as [List.walkUntil], but does it from the end of the list instead.
|
||||
walkBackwardsUntil : List elem, state, (state, elem -> [Continue state, Break state]) -> state
|
||||
walkBackwardsUntil = \list, initial, func ->
|
||||
when List.iterateBackwards list initial func is
|
||||
Continue new -> new
|
||||
Break new -> new
|
||||
|
||||
sum : List (Num a) -> Num a
|
||||
sum = \list ->
|
||||
List.walk list 0 Num.add
|
||||
|
|
@ -957,9 +966,8 @@ mapTry = \list, toResult ->
|
|||
Result.map (toResult elem) \ok ->
|
||||
List.append state ok
|
||||
|
||||
## This is the same as `iterate` but with Result instead of [Continue, Break].
|
||||
## This is the same as `iterate` but with [Result] instead of `[Continue, Break]`.
|
||||
## Using `Result` saves a conditional in `mapTry`.
|
||||
## It might be useful to expose this in userspace?
|
||||
walkTry : List elem, state, (state, elem -> Result state err) -> Result state err
|
||||
walkTry = \list, init, func ->
|
||||
walkTryHelp list init func 0 (List.len list)
|
||||
|
|
|
|||
|
|
@ -145,6 +145,7 @@ interface Num
|
|||
]
|
||||
imports [
|
||||
Bool.{ Bool },
|
||||
Result.{ Result },
|
||||
]
|
||||
|
||||
## Represents a number that could be either an [Int] or a [Frac].
|
||||
|
|
@ -574,7 +575,6 @@ isGte : Num a, Num a -> Bool
|
|||
|
||||
## Returns `Bool.true` if the number is `0`, and `Bool.false` otherwise.
|
||||
isZero : Num a -> Bool
|
||||
isZero = \x -> x == 0
|
||||
|
||||
## A number is even if dividing it by 2 gives a remainder of 0.
|
||||
##
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ interface Set
|
|||
intersection,
|
||||
difference,
|
||||
]
|
||||
imports [List, Bool.{ Bool }, Dict.{ Dict }]
|
||||
imports [List, Bool.{ Bool }, Dict.{ Dict }, Num.{ Nat }]
|
||||
|
||||
Set k := Dict.Dict k {}
|
||||
|
||||
|
|
|
|||
|
|
@ -43,8 +43,14 @@ interface Str
|
|||
appendScalar,
|
||||
walkScalars,
|
||||
walkScalarsUntil,
|
||||
withCapacity,
|
||||
]
|
||||
imports [
|
||||
Bool.{ Bool },
|
||||
Result.{ Result },
|
||||
List,
|
||||
Num.{ Nat, Num, U8, U16, U32, U64, U128, I8, I16, I32, I64, I128, F32, F64, Dec },
|
||||
]
|
||||
imports [Bool.{ Bool }, Result.{ Result }, List]
|
||||
|
||||
## # Types
|
||||
##
|
||||
|
|
@ -139,6 +145,9 @@ Utf8Problem : { byteIndex : Nat, problem : Utf8ByteProblem }
|
|||
isEmpty : Str -> Bool
|
||||
concat : Str, Str -> Str
|
||||
|
||||
## Returns a string of the specified capacity without any content
|
||||
withCapacity : Nat -> Str
|
||||
|
||||
## Combine a list of strings into a single string, with a separator
|
||||
## string in between each.
|
||||
##
|
||||
|
|
|
|||
|
|
@ -361,6 +361,7 @@ pub const STR_RESERVE: &str = "roc_builtins.str.reserve";
|
|||
pub const STR_APPEND_SCALAR: &str = "roc_builtins.str.append_scalar";
|
||||
pub const STR_GET_SCALAR_UNSAFE: &str = "roc_builtins.str.get_scalar_unsafe";
|
||||
pub const STR_CLONE_TO: &str = "roc_builtins.str.clone_to";
|
||||
pub const STR_WITH_CAPACITY: &str = "roc_builtins.str.with_capacity";
|
||||
|
||||
pub const LIST_MAP: &str = "roc_builtins.list.map";
|
||||
pub const LIST_MAP2: &str = "roc_builtins.list.map2";
|
||||
|
|
|
|||
|
|
@ -55,6 +55,8 @@ macro_rules! map_symbol_to_lowlevel_and_arity {
|
|||
Symbol::NUM_TO_F32_CHECKED => Some(to_num_checked(Symbol::NUM_TO_F32_CHECKED, var_store, LowLevel::NumToFloatChecked)),
|
||||
Symbol::NUM_TO_F64_CHECKED => Some(to_num_checked(Symbol::NUM_TO_F64_CHECKED, var_store, LowLevel::NumToFloatChecked)),
|
||||
|
||||
Symbol::NUM_IS_ZERO => Some(to_num_is_zero(Symbol::NUM_IS_ZERO, var_store)),
|
||||
|
||||
_ => None,
|
||||
}
|
||||
}
|
||||
|
|
@ -121,6 +123,7 @@ map_symbol_to_lowlevel_and_arity! {
|
|||
StrGetScalarUnsafe; STR_GET_SCALAR_UNSAFE; 2,
|
||||
StrToNum; STR_TO_NUM; 1,
|
||||
StrGetCapacity; STR_CAPACITY; 1,
|
||||
StrWithCapacity; STR_WITH_CAPACITY; 1,
|
||||
|
||||
ListLen; LIST_LEN; 1,
|
||||
ListWithCapacity; LIST_WITH_CAPACITY; 1,
|
||||
|
|
@ -535,3 +538,33 @@ fn to_num_checked(symbol: Symbol, var_store: &mut VarStore, lowlevel: LowLevel)
|
|||
ret_var,
|
||||
)
|
||||
}
|
||||
|
||||
fn to_num_is_zero(symbol: Symbol, var_store: &mut VarStore) -> Def {
|
||||
let bool_var = var_store.fresh();
|
||||
let num_var = var_store.fresh();
|
||||
|
||||
let body = Expr::RunLowLevel {
|
||||
op: LowLevel::Eq,
|
||||
args: vec![
|
||||
(num_var, Var(Symbol::ARG_1)),
|
||||
(
|
||||
num_var,
|
||||
Num(
|
||||
var_store.fresh(),
|
||||
"0".to_string().into_boxed_str(),
|
||||
crate::expr::IntValue::I128(0i128.to_ne_bytes()),
|
||||
roc_types::num::NumBound::None,
|
||||
),
|
||||
),
|
||||
],
|
||||
ret_var: bool_var,
|
||||
};
|
||||
|
||||
defn(
|
||||
symbol,
|
||||
vec![(num_var, Symbol::ARG_1)],
|
||||
var_store,
|
||||
body,
|
||||
bool_var,
|
||||
)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -60,8 +60,6 @@ trait CopyEnv {
|
|||
|
||||
fn clone_name(&mut self, name: SubsIndex<Lowercase>) -> SubsIndex<Lowercase>;
|
||||
|
||||
fn clone_tag_name(&mut self, tag_name: SubsIndex<TagName>) -> SubsIndex<TagName>;
|
||||
|
||||
fn clone_field_names(&mut self, field_names: SubsSlice<Lowercase>) -> SubsSlice<Lowercase>;
|
||||
|
||||
fn clone_tag_names(&mut self, tag_names: SubsSlice<TagName>) -> SubsSlice<TagName>;
|
||||
|
|
@ -95,11 +93,6 @@ impl CopyEnv for Subs {
|
|||
name
|
||||
}
|
||||
|
||||
#[inline(always)]
|
||||
fn clone_tag_name(&mut self, tag_name: SubsIndex<TagName>) -> SubsIndex<TagName> {
|
||||
tag_name
|
||||
}
|
||||
|
||||
#[inline(always)]
|
||||
fn clone_field_names(&mut self, field_names: SubsSlice<Lowercase>) -> SubsSlice<Lowercase> {
|
||||
field_names
|
||||
|
|
@ -150,11 +143,6 @@ impl<'a> CopyEnv for AcrossSubs<'a> {
|
|||
SubsIndex::push_new(&mut self.target.field_names, self.source[name].clone())
|
||||
}
|
||||
|
||||
#[inline(always)]
|
||||
fn clone_tag_name(&mut self, tag_name: SubsIndex<TagName>) -> SubsIndex<TagName> {
|
||||
SubsIndex::push_new(&mut self.target.tag_names, self.source[tag_name].clone())
|
||||
}
|
||||
|
||||
#[inline(always)]
|
||||
fn clone_field_names(&mut self, field_names: SubsSlice<Lowercase>) -> SubsSlice<Lowercase> {
|
||||
SubsSlice::extend_new(
|
||||
|
|
@ -259,7 +247,7 @@ fn deep_copy_expr_help<C: CopyEnv>(env: &mut C, copied: &mut Vec<Variable>, expr
|
|||
Int(v1, v2, str, val, bound) => Int(sub!(*v1), sub!(*v2), str.clone(), *val, *bound),
|
||||
Float(v1, v2, str, val, bound) => Float(sub!(*v1), sub!(*v2), str.clone(), *val, *bound),
|
||||
Str(str) => Str(str.clone()),
|
||||
SingleQuote(char) => SingleQuote(*char),
|
||||
SingleQuote(v1, v2, char, bound) => SingleQuote(sub!(*v1), sub!(*v2), *char, *bound),
|
||||
List {
|
||||
elem_var,
|
||||
loc_elems,
|
||||
|
|
@ -725,7 +713,7 @@ fn deep_copy_pattern_help<C: CopyEnv>(
|
|||
FloatLiteral(sub!(*v1), sub!(*v2), s.clone(), *n, *bound)
|
||||
}
|
||||
StrLiteral(s) => StrLiteral(s.clone()),
|
||||
SingleQuote(c) => SingleQuote(*c),
|
||||
SingleQuote(v1, v2, c, bound) => SingleQuote(sub!(*v1), sub!(*v2), *c, *bound),
|
||||
Underscore => Underscore,
|
||||
AbilityMemberSpecialization { ident, specializes } => AbilityMemberSpecialization {
|
||||
ident: *ident,
|
||||
|
|
@ -935,12 +923,13 @@ fn deep_copy_type_vars<C: CopyEnv>(
|
|||
Structure(RecursiveTagUnion(new_rec_var, new_union_tags, new_ext_var))
|
||||
})
|
||||
}
|
||||
FunctionOrTagUnion(tag_name, symbol, ext_var) => {
|
||||
FunctionOrTagUnion(tag_names, symbols, ext_var) => {
|
||||
let new_ext_var = descend_var!(ext_var);
|
||||
let new_tag_name = env.clone_tag_name(tag_name);
|
||||
let new_tag_names = env.clone_tag_names(tag_names);
|
||||
let new_symbols = env.clone_lambda_names(symbols);
|
||||
perform_clone!(Structure(FunctionOrTagUnion(
|
||||
new_tag_name,
|
||||
symbol,
|
||||
new_tag_names,
|
||||
new_symbols,
|
||||
new_ext_var
|
||||
)))
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1884,7 +1884,7 @@ fn pattern_to_vars_by_symbol(
|
|||
| IntLiteral(..)
|
||||
| FloatLiteral(..)
|
||||
| StrLiteral(_)
|
||||
| SingleQuote(_)
|
||||
| SingleQuote(..)
|
||||
| Underscore
|
||||
| MalformedPattern(_, _)
|
||||
| UnsupportedPattern(_)
|
||||
|
|
|
|||
|
|
@ -253,7 +253,7 @@ fn sketch_pattern(pattern: &crate::pattern::Pattern) -> SketchedPattern {
|
|||
}
|
||||
&FloatLiteral(_, _, _, f, _) => SP::Literal(Literal::Float(f64::to_bits(f))),
|
||||
StrLiteral(v) => SP::Literal(Literal::Str(v.clone())),
|
||||
&SingleQuote(c) => SP::Literal(Literal::Byte(c as u8)),
|
||||
&SingleQuote(_, _, c, _) => SP::Literal(Literal::Byte(c as u8)),
|
||||
RecordDestructure { destructs, .. } => {
|
||||
let tag_id = TagId(0);
|
||||
let mut patterns = std::vec::Vec::with_capacity(destructs.len());
|
||||
|
|
|
|||
|
|
@ -22,6 +22,7 @@ use roc_parse::ast::{self, Defs, EscapedChar, StrLiteral};
|
|||
use roc_parse::pattern::PatternType::*;
|
||||
use roc_problem::can::{PrecedenceProblem, Problem, RuntimeError};
|
||||
use roc_region::all::{Loc, Region};
|
||||
use roc_types::num::SingleQuoteBound;
|
||||
use roc_types::subs::{ExhaustiveMark, IllegalCycleMark, RedundantMark, VarStore, Variable};
|
||||
use roc_types::types::{Alias, Category, LambdaSet, OptAbleVar, Type};
|
||||
use std::fmt::{Debug, Display};
|
||||
|
|
@ -91,7 +92,8 @@ pub enum Expr {
|
|||
Int(Variable, Variable, Box<str>, IntValue, IntBound),
|
||||
Float(Variable, Variable, Box<str>, f64, FloatBound),
|
||||
Str(Box<str>),
|
||||
SingleQuote(char),
|
||||
// Number variable, precision variable, value, bound
|
||||
SingleQuote(Variable, Variable, char, SingleQuoteBound),
|
||||
List {
|
||||
elem_var: Variable,
|
||||
loc_elems: Vec<Loc<Expr>>,
|
||||
|
|
@ -637,7 +639,15 @@ pub fn canonicalize_expr<'a>(
|
|||
let mut it = string.chars().peekable();
|
||||
if let Some(char) = it.next() {
|
||||
if it.peek().is_none() {
|
||||
(Expr::SingleQuote(char), Output::default())
|
||||
(
|
||||
Expr::SingleQuote(
|
||||
var_store.fresh(),
|
||||
var_store.fresh(),
|
||||
char,
|
||||
SingleQuoteBound::from_char(char),
|
||||
),
|
||||
Output::default(),
|
||||
)
|
||||
} else {
|
||||
// multiple chars is found
|
||||
let error = roc_problem::can::RuntimeError::MultipleCharsInSingleQuote(region);
|
||||
|
|
@ -1642,7 +1652,7 @@ pub fn inline_calls(var_store: &mut VarStore, scope: &mut Scope, expr: Expr) ->
|
|||
| other @ Int(..)
|
||||
| other @ Float(..)
|
||||
| other @ Str { .. }
|
||||
| other @ SingleQuote(_)
|
||||
| other @ SingleQuote(..)
|
||||
| other @ RuntimeError(_)
|
||||
| other @ EmptyRecord
|
||||
| other @ Accessor { .. }
|
||||
|
|
@ -2703,7 +2713,7 @@ fn get_lookup_symbols(expr: &Expr, var_store: &mut VarStore) -> Vec<(Symbol, Var
|
|||
| Expr::Str(_)
|
||||
| Expr::ZeroArgumentTag { .. }
|
||||
| Expr::Accessor(_)
|
||||
| Expr::SingleQuote(_)
|
||||
| Expr::SingleQuote(..)
|
||||
| Expr::EmptyRecord
|
||||
| Expr::TypedHole(_)
|
||||
| Expr::RuntimeError(_)
|
||||
|
|
|
|||
|
|
@ -899,7 +899,7 @@ fn fix_values_captured_in_closure_pattern(
|
|||
| IntLiteral(..)
|
||||
| FloatLiteral(..)
|
||||
| StrLiteral(_)
|
||||
| SingleQuote(_)
|
||||
| SingleQuote(..)
|
||||
| Underscore
|
||||
| Shadowed(..)
|
||||
| MalformedPattern(_, _)
|
||||
|
|
@ -1038,7 +1038,7 @@ fn fix_values_captured_in_closure_expr(
|
|||
| Int(..)
|
||||
| Float(..)
|
||||
| Str(_)
|
||||
| SingleQuote(_)
|
||||
| SingleQuote(..)
|
||||
| Var(_)
|
||||
| AbilityMember(..)
|
||||
| EmptyRecord
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@ use roc_parse::ast::{self, StrLiteral, StrSegment};
|
|||
use roc_parse::pattern::PatternType;
|
||||
use roc_problem::can::{MalformedPatternProblem, Problem, RuntimeError, ShadowKind};
|
||||
use roc_region::all::{Loc, Region};
|
||||
use roc_types::num::SingleQuoteBound;
|
||||
use roc_types::subs::{VarStore, Variable};
|
||||
use roc_types::types::{LambdaSet, OptAbleVar, PatternCategory, Type};
|
||||
|
||||
|
|
@ -59,7 +60,7 @@ pub enum Pattern {
|
|||
IntLiteral(Variable, Variable, Box<str>, IntValue, IntBound),
|
||||
FloatLiteral(Variable, Variable, Box<str>, f64, FloatBound),
|
||||
StrLiteral(Box<str>),
|
||||
SingleQuote(char),
|
||||
SingleQuote(Variable, Variable, char, SingleQuoteBound),
|
||||
Underscore,
|
||||
|
||||
/// An identifier that marks a specialization of an ability member.
|
||||
|
|
@ -95,7 +96,7 @@ impl Pattern {
|
|||
IntLiteral(var, ..) => Some(*var),
|
||||
FloatLiteral(var, ..) => Some(*var),
|
||||
StrLiteral(_) => None,
|
||||
SingleQuote(_) => None,
|
||||
SingleQuote(..) => None,
|
||||
Underscore => None,
|
||||
|
||||
AbilityMemberSpecialization { .. } => None,
|
||||
|
|
@ -148,7 +149,7 @@ impl Pattern {
|
|||
IntLiteral(..) => C::Int,
|
||||
FloatLiteral(..) => C::Float,
|
||||
StrLiteral(_) => C::Str,
|
||||
SingleQuote(_) => C::Character,
|
||||
SingleQuote(..) => C::Character,
|
||||
Underscore => C::PatternDefault,
|
||||
|
||||
AbilityMemberSpecialization { .. } => C::PatternDefault,
|
||||
|
|
@ -456,7 +457,12 @@ pub fn canonicalize_pattern<'a>(
|
|||
let mut it = string.chars().peekable();
|
||||
if let Some(char) = it.next() {
|
||||
if it.peek().is_none() {
|
||||
Pattern::SingleQuote(char)
|
||||
Pattern::SingleQuote(
|
||||
var_store.fresh(),
|
||||
var_store.fresh(),
|
||||
char,
|
||||
SingleQuoteBound::from_char(char),
|
||||
)
|
||||
} else {
|
||||
// multiple chars is found
|
||||
let problem = MalformedPatternProblem::MultipleCharsInSingleQuote;
|
||||
|
|
@ -724,7 +730,7 @@ impl<'a> BindingsFromPattern<'a> {
|
|||
| IntLiteral(..)
|
||||
| FloatLiteral(..)
|
||||
| StrLiteral(_)
|
||||
| SingleQuote(_)
|
||||
| SingleQuote(..)
|
||||
| Underscore
|
||||
| Shadowed(_, _, _)
|
||||
| MalformedPattern(_, _)
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ use roc_can::expected::Expected::{self, *};
|
|||
use roc_can::num::{FloatBound, FloatWidth, IntBound, IntLitWidth, NumBound, SignDemand};
|
||||
use roc_module::symbol::Symbol;
|
||||
use roc_region::all::Region;
|
||||
use roc_types::num::NumericRange;
|
||||
use roc_types::num::{NumericRange, SingleQuoteBound};
|
||||
use roc_types::subs::Variable;
|
||||
use roc_types::types::Type::{self, *};
|
||||
use roc_types::types::{AliasKind, Category};
|
||||
|
|
@ -99,6 +99,42 @@ pub fn int_literal(
|
|||
constraints.exists([num_var], and_constraint)
|
||||
}
|
||||
|
||||
pub fn single_quote_literal(
|
||||
constraints: &mut Constraints,
|
||||
num_var: Variable,
|
||||
precision_var: Variable,
|
||||
expected: Expected<Type>,
|
||||
region: Region,
|
||||
bound: SingleQuoteBound,
|
||||
) -> Constraint {
|
||||
let reason = Reason::IntLiteral;
|
||||
|
||||
// Always add the bound first; this improves the resolved type quality in case it's an alias like "U8".
|
||||
let mut constrs = ArrayVec::<_, 3>::new();
|
||||
let num_type = add_numeric_bound_constr(
|
||||
constraints,
|
||||
&mut constrs,
|
||||
num_var,
|
||||
precision_var,
|
||||
bound,
|
||||
region,
|
||||
Category::Character,
|
||||
);
|
||||
|
||||
constrs.extend([
|
||||
constraints.equal_types(
|
||||
num_type.clone(),
|
||||
ForReason(reason, num_int(Type::Variable(precision_var)), region),
|
||||
Category::Character,
|
||||
region,
|
||||
),
|
||||
constraints.equal_types(num_type, expected, Category::Character, region),
|
||||
]);
|
||||
|
||||
let and_constraint = constraints.and_constraint(constrs);
|
||||
constraints.exists([num_var], and_constraint)
|
||||
}
|
||||
|
||||
#[inline(always)]
|
||||
pub fn float_literal(
|
||||
constraints: &mut Constraints,
|
||||
|
|
@ -332,6 +368,16 @@ impl TypedNumericBound for NumBound {
|
|||
}
|
||||
}
|
||||
|
||||
impl TypedNumericBound for SingleQuoteBound {
|
||||
fn numeric_bound(&self) -> NumericBound {
|
||||
match self {
|
||||
&SingleQuoteBound::AtLeast { width } => {
|
||||
NumericBound::Range(NumericRange::IntAtLeastEitherSign(width))
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/// A bound placed on a number because of its literal value.
|
||||
/// e.g. `-5` cannot be unsigned, and 300 does not fit in a U8
|
||||
#[derive(Debug, Clone, Copy, PartialEq, Eq)]
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
use std::ops::Range;
|
||||
|
||||
use crate::builtins::{
|
||||
empty_list_type, float_literal, int_literal, list_type, num_literal, num_u32, str_type,
|
||||
empty_list_type, float_literal, int_literal, list_type, num_literal, single_quote_literal,
|
||||
str_type,
|
||||
};
|
||||
use crate::pattern::{constrain_pattern, PatternState};
|
||||
use roc_can::annotation::IntroducedVariables;
|
||||
|
|
@ -292,7 +293,14 @@ pub fn constrain_expr(
|
|||
constraints.exists(vars, and_constraint)
|
||||
}
|
||||
Str(_) => constraints.equal_types(str_type(), expected, Category::Str, region),
|
||||
SingleQuote(_) => constraints.equal_types(num_u32(), expected, Category::Character, region),
|
||||
SingleQuote(num_var, precision_var, _, bound) => single_quote_literal(
|
||||
constraints,
|
||||
*num_var,
|
||||
*precision_var,
|
||||
expected,
|
||||
region,
|
||||
*bound,
|
||||
),
|
||||
List {
|
||||
elem_var,
|
||||
loc_elems,
|
||||
|
|
|
|||
|
|
@ -71,7 +71,7 @@ fn headers_from_annotation_help(
|
|||
| NumLiteral(..)
|
||||
| IntLiteral(..)
|
||||
| FloatLiteral(..)
|
||||
| SingleQuote(_)
|
||||
| SingleQuote(..)
|
||||
| StrLiteral(_) => true,
|
||||
|
||||
RecordDestructure { destructs, .. } => match annotation.value.shallow_dealias() {
|
||||
|
|
@ -320,9 +320,32 @@ pub fn constrain_pattern(
|
|||
));
|
||||
}
|
||||
|
||||
SingleQuote(_) => {
|
||||
&SingleQuote(num_var, precision_var, _, bound) => {
|
||||
// First constraint on the free num var; this improves the resolved type quality in
|
||||
// case the bound is an alias.
|
||||
let num_type = builtins::add_numeric_bound_constr(
|
||||
constraints,
|
||||
&mut state.constraints,
|
||||
num_var,
|
||||
num_var,
|
||||
bound,
|
||||
region,
|
||||
Category::Int,
|
||||
);
|
||||
|
||||
// Link the free num var with the int var and our expectation.
|
||||
let int_type = builtins::num_int(Type::Variable(precision_var));
|
||||
|
||||
state.constraints.push(constraints.equal_types(
|
||||
num_type.clone(), // TODO check me if something breaks!
|
||||
Expected::NoExpectation(int_type),
|
||||
Category::Int,
|
||||
region,
|
||||
));
|
||||
|
||||
// Also constrain the pattern against the num var, again to reuse aliases if they're present.
|
||||
state.constraints.push(constraints.equal_pattern_types(
|
||||
builtins::num_u32(),
|
||||
num_type,
|
||||
expected,
|
||||
PatternCategory::Character,
|
||||
region,
|
||||
|
|
|
|||
|
|
@ -1,14 +1,191 @@
|
|||
//! Derivers for the `Hash` ability.
|
||||
|
||||
use std::iter::once;
|
||||
|
||||
use roc_can::{
|
||||
expr::{AnnotatedMark, ClosureData, Expr, Recursive},
|
||||
pattern::Pattern,
|
||||
};
|
||||
use roc_derive_key::hash::FlatHashKey;
|
||||
use roc_module::symbol::Symbol;
|
||||
use roc_module::{called_via::CalledVia, ident::Lowercase, symbol::Symbol};
|
||||
use roc_region::all::Loc;
|
||||
use roc_types::{
|
||||
subs::{
|
||||
Content, FlatType, LambdaSet, OptVariable, RecordFields, SubsSlice, UnionLambdas, Variable,
|
||||
VariableSubsSlice,
|
||||
},
|
||||
types::RecordField,
|
||||
};
|
||||
|
||||
use crate::{util::Env, DerivedBody};
|
||||
use crate::{synth_var, util::Env, DerivedBody};
|
||||
|
||||
pub(crate) fn derive_hash(
|
||||
_env: &mut Env<'_>,
|
||||
key: FlatHashKey,
|
||||
_def_symbol: Symbol,
|
||||
) -> DerivedBody {
|
||||
match key {}
|
||||
pub(crate) fn derive_hash(env: &mut Env<'_>, key: FlatHashKey, def_symbol: Symbol) -> DerivedBody {
|
||||
let (body, body_type) = match key {
|
||||
FlatHashKey::Record(fields) => hash_record(env, def_symbol, fields),
|
||||
};
|
||||
|
||||
let specialization_lambda_sets =
|
||||
env.get_specialization_lambda_sets(body_type, Symbol::HASH_HASH);
|
||||
|
||||
DerivedBody {
|
||||
body,
|
||||
body_type,
|
||||
specialization_lambda_sets,
|
||||
}
|
||||
}
|
||||
|
||||
fn hash_record(env: &mut Env<'_>, fn_name: Symbol, fields: Vec<Lowercase>) -> (Expr, Variable) {
|
||||
// Suppose rcd = { f1, ..., fn }.
|
||||
// Build a generalized type t_rcd = { f1: t1, ..., fn: tn }, with fresh t1, ..., tn,
|
||||
// so that we can re-use the derived impl for many records of the same fields.
|
||||
let (record_var, record_fields) = {
|
||||
let flex_fields = fields
|
||||
.into_iter()
|
||||
.map(|name| {
|
||||
(
|
||||
name,
|
||||
RecordField::Required(env.subs.fresh_unnamed_flex_var()),
|
||||
)
|
||||
})
|
||||
.collect::<Vec<(Lowercase, _)>>();
|
||||
let fields = RecordFields::insert_into_subs(env.subs, flex_fields);
|
||||
let record_var = synth_var(
|
||||
env.subs,
|
||||
Content::Structure(FlatType::Record(fields, Variable::EMPTY_RECORD)),
|
||||
);
|
||||
|
||||
(record_var, fields)
|
||||
};
|
||||
|
||||
// Now, a hasher for this record is
|
||||
//
|
||||
// hash_rcd : hasher, { f1: t1, ..., fn: tn } -> hasher | hasher has Hasher
|
||||
// hash_rcd = \hasher, rcd ->
|
||||
// Hash.hash (
|
||||
// Hash.hash
|
||||
// ...
|
||||
// (Hash.hash hasher rcd.f1)
|
||||
// ...
|
||||
// rcd.f_n1)
|
||||
// rcd.fn
|
||||
//
|
||||
// So, just a build a fold travelling up the fields.
|
||||
let rcd_sym = env.new_symbol("rcd");
|
||||
|
||||
let hasher_sym = env.new_symbol("hasher");
|
||||
let hasher_var = synth_var(env.subs, Content::FlexAbleVar(None, Symbol::HASH_HASHER));
|
||||
|
||||
let (body, body_var) = record_fields.iter_all().fold(
|
||||
(Expr::Var(hasher_sym), hasher_var),
|
||||
|(body, body_var), (field_name, field_var, _)| {
|
||||
let field_name = env.subs[field_name].clone();
|
||||
let field_var = env.subs[field_var];
|
||||
|
||||
let field_access = Expr::Access {
|
||||
record_var,
|
||||
field_var,
|
||||
ext_var: env.subs.fresh_unnamed_flex_var(),
|
||||
loc_expr: Box::new(Loc::at_zero(Expr::Var(rcd_sym))),
|
||||
field: field_name,
|
||||
};
|
||||
|
||||
let (hash_fn_data, returned_hasher_var) = {
|
||||
// build `Hash.hash ...` function type
|
||||
//
|
||||
// hasher, val -[uls]-> hasher | hasher has Hasher, val has Hash
|
||||
let exposed_hash_fn_var = env.import_builtin_symbol_var(Symbol::HASH_HASH);
|
||||
|
||||
// (typeof body), (typeof field) -[clos]-> hasher_result
|
||||
let this_arguments_slice =
|
||||
VariableSubsSlice::insert_into_subs(env.subs, [body_var, field_var]);
|
||||
let this_hash_clos_var = env.subs.fresh_unnamed_flex_var();
|
||||
let this_hasher_result_var = env.subs.fresh_unnamed_flex_var();
|
||||
let this_hash_fn_var = synth_var(
|
||||
env.subs,
|
||||
Content::Structure(FlatType::Func(
|
||||
this_arguments_slice,
|
||||
this_hash_clos_var,
|
||||
this_hasher_result_var,
|
||||
)),
|
||||
);
|
||||
|
||||
// hasher, val -[uls]-> hasher | hasher has Hasher, val has Hash
|
||||
// ~ (typeof body), (typeof field) -[clos]-> hasher_result
|
||||
env.unify(exposed_hash_fn_var, this_hash_fn_var);
|
||||
|
||||
// Hash.hash : hasher, (typeof field) -[clos]-> hasher | hasher has Hasher, (typeof field) has Hash
|
||||
let hash_fn_head = Expr::AbilityMember(Symbol::HASH_HASH, None, this_hash_fn_var);
|
||||
let hash_fn_data = Box::new((
|
||||
this_hash_fn_var,
|
||||
Loc::at_zero(hash_fn_head),
|
||||
this_hash_clos_var,
|
||||
this_hasher_result_var,
|
||||
));
|
||||
|
||||
(hash_fn_data, this_hasher_result_var)
|
||||
};
|
||||
|
||||
let hash_arguments = vec![
|
||||
(body_var, Loc::at_zero(body)),
|
||||
(field_var, Loc::at_zero(field_access)),
|
||||
];
|
||||
let call_hash = Expr::Call(hash_fn_data, hash_arguments, CalledVia::Space);
|
||||
|
||||
(call_hash, returned_hasher_var)
|
||||
},
|
||||
);
|
||||
|
||||
// Finally, build the closure
|
||||
// \hasher, rcd -> body
|
||||
|
||||
let (fn_var, fn_clos_var) = {
|
||||
// Create fn_var for ambient capture; we fix it up below.
|
||||
let fn_var = synth_var(env.subs, Content::Error);
|
||||
|
||||
// -[fn_name]->
|
||||
let fn_captures = vec![];
|
||||
let fn_name_labels = UnionLambdas::insert_into_subs(env.subs, once((fn_name, fn_captures)));
|
||||
let fn_clos_var = synth_var(
|
||||
env.subs,
|
||||
Content::LambdaSet(LambdaSet {
|
||||
solved: fn_name_labels,
|
||||
recursion_var: OptVariable::NONE,
|
||||
unspecialized: SubsSlice::default(),
|
||||
ambient_function: fn_var,
|
||||
}),
|
||||
);
|
||||
|
||||
// hasher, rcd_var -[fn_name]-> (hasher = body_var)
|
||||
let args_slice = SubsSlice::insert_into_subs(env.subs, [hasher_var, record_var]);
|
||||
env.subs.set_content(
|
||||
fn_var,
|
||||
Content::Structure(FlatType::Func(args_slice, fn_clos_var, body_var)),
|
||||
);
|
||||
|
||||
(fn_var, fn_clos_var)
|
||||
};
|
||||
|
||||
let clos_expr = Expr::Closure(ClosureData {
|
||||
function_type: fn_var,
|
||||
closure_type: fn_clos_var,
|
||||
return_type: body_var,
|
||||
name: fn_name,
|
||||
captured_symbols: vec![],
|
||||
recursive: Recursive::NotRecursive,
|
||||
arguments: vec![
|
||||
(
|
||||
hasher_var,
|
||||
AnnotatedMark::known_exhaustive(),
|
||||
Loc::at_zero(Pattern::Identifier(hasher_sym)),
|
||||
),
|
||||
(
|
||||
record_var,
|
||||
AnnotatedMark::known_exhaustive(),
|
||||
Loc::at_zero(Pattern::Identifier(rcd_sym)),
|
||||
),
|
||||
],
|
||||
loc_body: Box::new(Loc::at_zero(body)),
|
||||
});
|
||||
|
||||
(clos_expr, fn_var)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ use roc_module::{
|
|||
ident::{Lowercase, TagName},
|
||||
symbol::Symbol,
|
||||
};
|
||||
use roc_types::subs::{Content, FlatType, Subs, Variable};
|
||||
use roc_types::subs::{Content, FlatType, GetSubsSlice, Subs, Variable};
|
||||
|
||||
use crate::{
|
||||
util::{check_derivable_ext_var, debug_name_record},
|
||||
|
|
@ -107,9 +107,14 @@ impl FlatEncodable {
|
|||
|
||||
Ok(Key(FlatEncodableKey::TagUnion(tag_names_and_payload_sizes)))
|
||||
}
|
||||
FlatType::FunctionOrTagUnion(name_index, _, _) => Ok(Key(
|
||||
FlatEncodableKey::TagUnion(vec![(subs[name_index].clone(), 0)]),
|
||||
)),
|
||||
FlatType::FunctionOrTagUnion(names_index, _, _) => {
|
||||
Ok(Key(FlatEncodableKey::TagUnion(
|
||||
subs.get_subs_slice(names_index)
|
||||
.iter()
|
||||
.map(|t| (t.clone(), 0))
|
||||
.collect(),
|
||||
)))
|
||||
}
|
||||
FlatType::EmptyRecord => Ok(Key(FlatEncodableKey::Record(vec![]))),
|
||||
FlatType::EmptyTagUnion => Ok(Key(FlatEncodableKey::TagUnion(vec![]))),
|
||||
//
|
||||
|
|
|
|||
|
|
@ -1,7 +1,10 @@
|
|||
use roc_module::symbol::Symbol;
|
||||
use roc_module::{ident::Lowercase, symbol::Symbol};
|
||||
use roc_types::subs::{Content, FlatType, Subs, Variable};
|
||||
|
||||
use crate::DeriveError;
|
||||
use crate::{
|
||||
util::{check_derivable_ext_var, debug_name_record},
|
||||
DeriveError,
|
||||
};
|
||||
|
||||
#[derive(Hash)]
|
||||
pub enum FlatHash {
|
||||
|
|
@ -12,11 +15,16 @@ pub enum FlatHash {
|
|||
}
|
||||
|
||||
#[derive(Hash, PartialEq, Eq, Debug, Clone)]
|
||||
pub enum FlatHashKey {}
|
||||
pub enum FlatHashKey {
|
||||
// Unfortunate that we must allocate here, c'est la vie
|
||||
Record(Vec<Lowercase>),
|
||||
}
|
||||
|
||||
impl FlatHashKey {
|
||||
pub(crate) fn debug_name(&self) -> String {
|
||||
unreachable!() // yet
|
||||
match self {
|
||||
FlatHashKey::Record(fields) => debug_name_record(fields),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -31,8 +39,26 @@ impl FlatHash {
|
|||
Symbol::STR_STR => Ok(SingleLambdaSetImmediate(Symbol::HASH_HASH_STR_BYTES)),
|
||||
_ => Err(Underivable),
|
||||
},
|
||||
FlatType::Record(_fields, _ext) => {
|
||||
Err(Underivable) // yet
|
||||
FlatType::Record(fields, ext) => {
|
||||
let (fields_iter, ext) = fields.unsorted_iterator_and_ext(subs, ext);
|
||||
|
||||
check_derivable_ext_var(subs, ext, |ext| {
|
||||
matches!(ext, Content::Structure(FlatType::EmptyRecord))
|
||||
})?;
|
||||
|
||||
let mut field_names = Vec::with_capacity(fields.len());
|
||||
for (field_name, record_field) in fields_iter {
|
||||
if record_field.is_optional() {
|
||||
// Can't derive a concrete decoder for optional fields, since those are
|
||||
// compile-time-polymorphic
|
||||
return Err(Underivable);
|
||||
}
|
||||
field_names.push(field_name.clone());
|
||||
}
|
||||
|
||||
field_names.sort();
|
||||
|
||||
Ok(Key(FlatHashKey::Record(field_names)))
|
||||
}
|
||||
FlatType::TagUnion(_tags, _ext) | FlatType::RecursiveTagUnion(_, _tags, _ext) => {
|
||||
Err(Underivable) // yet
|
||||
|
|
@ -40,7 +66,7 @@ impl FlatHash {
|
|||
FlatType::FunctionOrTagUnion(_name_index, _, _) => {
|
||||
Err(Underivable) // yet
|
||||
}
|
||||
FlatType::EmptyRecord => Err(Underivable), // yet
|
||||
FlatType::EmptyRecord => Ok(Key(FlatHashKey::Record(vec![]))),
|
||||
FlatType::EmptyTagUnion => {
|
||||
Err(Underivable) // yet
|
||||
}
|
||||
|
|
|
|||
|
|
@ -718,7 +718,7 @@ pub fn construct_optimization_passes<'a>(
|
|||
OptLevel::Optimize => {
|
||||
pmb.set_optimization_level(OptimizationLevel::Aggressive);
|
||||
// this threshold seems to do what we want
|
||||
pmb.set_inliner_with_threshold(275);
|
||||
pmb.set_inliner_with_threshold(750);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -6049,6 +6049,20 @@ fn run_low_level<'a, 'ctx, 'env>(
|
|||
bitcode::STR_TRIM_RIGHT,
|
||||
)
|
||||
}
|
||||
StrWithCapacity => {
|
||||
// Str.withCapacity : Nat -> Str
|
||||
debug_assert_eq!(args.len(), 1);
|
||||
|
||||
let str_len = load_symbol(scope, &args[0]);
|
||||
|
||||
call_str_bitcode_fn(
|
||||
env,
|
||||
&[],
|
||||
&[str_len],
|
||||
BitcodeReturns::Str,
|
||||
bitcode::STR_WITH_CAPACITY,
|
||||
)
|
||||
}
|
||||
ListLen => {
|
||||
// List.len : List * -> Nat
|
||||
debug_assert_eq!(args.len(), 1);
|
||||
|
|
@ -6171,7 +6185,7 @@ fn run_low_level<'a, 'ctx, 'env>(
|
|||
list_prepend(env, original_wrapper, elem, elem_layout)
|
||||
}
|
||||
StrGetUnsafe => {
|
||||
// List.getUnsafe : Str, Nat -> u8
|
||||
// Str.getUnsafe : Str, Nat -> u8
|
||||
debug_assert_eq!(args.len(), 2);
|
||||
|
||||
let wrapper_struct = load_symbol(scope, &args[0]);
|
||||
|
|
|
|||
|
|
@ -302,6 +302,7 @@ impl<'a> LowLevelCall<'a> {
|
|||
StrSubstringUnsafe => {
|
||||
self.load_args_and_call_zig(backend, bitcode::STR_SUBSTRING_UNSAFE)
|
||||
}
|
||||
StrWithCapacity => self.load_args_and_call_zig(backend, bitcode::STR_WITH_CAPACITY),
|
||||
|
||||
// List
|
||||
ListLen => match backend.storage.get(&self.arguments[0]) {
|
||||
|
|
|
|||
|
|
@ -2239,24 +2239,15 @@ fn update<'a>(
|
|||
// add the prelude
|
||||
let mut header = header;
|
||||
|
||||
if ![ModuleId::RESULT, ModuleId::BOOL].contains(&header.module_id) {
|
||||
extend_header_with_builtin(&mut header, ModuleId::RESULT);
|
||||
}
|
||||
|
||||
if ![ModuleId::NUM, ModuleId::BOOL, ModuleId::RESULT].contains(&header.module_id) {
|
||||
extend_header_with_builtin(&mut header, ModuleId::NUM);
|
||||
}
|
||||
|
||||
if ![ModuleId::BOOL].contains(&header.module_id) {
|
||||
extend_header_with_builtin(&mut header, ModuleId::BOOL);
|
||||
}
|
||||
|
||||
if !header.module_id.is_builtin() {
|
||||
extend_header_with_builtin(&mut header, ModuleId::BOX);
|
||||
extend_header_with_builtin(&mut header, ModuleId::NUM);
|
||||
extend_header_with_builtin(&mut header, ModuleId::BOOL);
|
||||
extend_header_with_builtin(&mut header, ModuleId::STR);
|
||||
extend_header_with_builtin(&mut header, ModuleId::LIST);
|
||||
extend_header_with_builtin(&mut header, ModuleId::RESULT);
|
||||
extend_header_with_builtin(&mut header, ModuleId::DICT);
|
||||
extend_header_with_builtin(&mut header, ModuleId::SET);
|
||||
extend_header_with_builtin(&mut header, ModuleId::LIST);
|
||||
extend_header_with_builtin(&mut header, ModuleId::BOX);
|
||||
extend_header_with_builtin(&mut header, ModuleId::ENCODE);
|
||||
extend_header_with_builtin(&mut header, ModuleId::DECODE);
|
||||
extend_header_with_builtin(&mut header, ModuleId::HASH);
|
||||
|
|
|
|||
|
|
@ -30,6 +30,7 @@ pub enum LowLevel {
|
|||
StrAppendScalar,
|
||||
StrGetScalarUnsafe,
|
||||
StrGetCapacity,
|
||||
StrWithCapacity,
|
||||
ListLen,
|
||||
ListWithCapacity,
|
||||
ListReserve,
|
||||
|
|
@ -249,6 +250,7 @@ map_symbol_to_lowlevel! {
|
|||
StrGetScalarUnsafe <= STR_GET_SCALAR_UNSAFE,
|
||||
StrToNum <= STR_TO_NUM,
|
||||
StrGetCapacity <= STR_CAPACITY,
|
||||
StrWithCapacity <= STR_WITH_CAPACITY,
|
||||
ListLen <= LIST_LEN,
|
||||
ListGetCapacity <= LIST_CAPACITY,
|
||||
ListWithCapacity <= LIST_WITH_CAPACITY,
|
||||
|
|
|
|||
|
|
@ -1296,6 +1296,7 @@ define_builtins! {
|
|||
50 STR_REPLACE_EACH: "replaceEach"
|
||||
51 STR_REPLACE_FIRST: "replaceFirst"
|
||||
52 STR_REPLACE_LAST: "replaceLast"
|
||||
53 STR_WITH_CAPACITY: "withCapacity"
|
||||
}
|
||||
6 LIST: "List" => {
|
||||
0 LIST_LIST: "List" exposed_apply_type=true // the List.List type alias
|
||||
|
|
@ -1373,6 +1374,8 @@ define_builtins! {
|
|||
72 LIST_SUBLIST_LOWLEVEL: "sublistLowlevel"
|
||||
73 LIST_CAPACITY: "capacity"
|
||||
74 LIST_MAP_TRY: "mapTry"
|
||||
75 LIST_WALK_TRY: "walkTry"
|
||||
76 LIST_WALK_BACKWARDS_UNTIL: "walkBackwardsUntil"
|
||||
}
|
||||
7 RESULT: "Result" => {
|
||||
0 RESULT_RESULT: "Result" exposed_type=true // the Result.Result type alias
|
||||
|
|
|
|||
|
|
@ -881,7 +881,7 @@ pub fn lowlevel_borrow_signature(arena: &Bump, op: LowLevel) -> &[bool] {
|
|||
Unreachable => arena.alloc_slice_copy(&[irrelevant]),
|
||||
ListLen | StrIsEmpty | StrToScalars | StrCountGraphemes | StrCountUtf8Bytes
|
||||
| StrGetCapacity | ListGetCapacity => arena.alloc_slice_copy(&[borrowed]),
|
||||
ListWithCapacity => arena.alloc_slice_copy(&[irrelevant]),
|
||||
ListWithCapacity | StrWithCapacity => arena.alloc_slice_copy(&[irrelevant]),
|
||||
ListReplaceUnsafe => arena.alloc_slice_copy(&[owned, irrelevant, irrelevant]),
|
||||
StrGetUnsafe | ListGetUnsafe => arena.alloc_slice_copy(&[borrowed, irrelevant]),
|
||||
ListConcat => arena.alloc_slice_copy(&[owned, owned]),
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Add a link
Reference in a new issue