language-servers/roc
1
0
Fork 0
mirror of https://github.com/roc-lang/roc.git synced 2025-08-04 20:28:02 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 7

Merge remote-tracking branch 'upstream' into annotate-type-signatures

Browse source
This commit is contained in:
snobee 2025-01-15 21:15:32 -08:00
commit 406cc6c5e9
No known key found for this signature in database
GPG key ID: ABF756C92D69FDF1
1204 changed files with 34365 additions and 39684 deletions
Download patch file Download diff file Expand all files Collapse all files

26
crates/cli/src/format.rs
View file

@ -199,7 +199,7 @@ pub enum FormatProblem {
pub fn format_src(arena: &Bump, src: &str, flags: MigrationFlags) -> Result<String, FormatProblem> {
let ast = arena.alloc(parse_all(arena, src).unwrap_or_else(|e| {
user_error!("Unexpected parse failure when parsing this formatting:\n\n{:?}\n\nParse error was:\n\n{:?}\n\n", src, e)
user_error!("Unexpected parse failure when parsing this formatting:\n\n{src}\n\nParse error was:\n\n{:#?}\n\n", e)
}));
let mut buf = Buf::new_in(arena, flags);
fmt_all(&mut buf, ast);
@ -438,14 +438,14 @@ import pf.Stdin
main =
Stdout.line! "What's your name?"
name = Stdin.line!
Stdout.line! "Hi $(name)!""#;
Stdout.line! "Hi ${name}!""#;
const UNFORMATTED_ROC: &str = r#"app [main] { pf: platform "platform/main.roc" }
main =
Stdout.line! "What's your name?"
name = Stdin.line!
Stdout.line! "Hi $(name)!"
Stdout.line! "Hi ${name}!"
"#;
fn setup_test_file(dir: &Path, file_name: &str, contents: &str) -> PathBuf {
@ -465,7 +465,10 @@ main =
fn test_single_file_needs_reformatting() {
let dir = tempdir().unwrap();
let file_path = setup_test_file(dir.path(), "test1.roc", UNFORMATTED_ROC);
let flags = MigrationFlags::new(false);
let flags = MigrationFlags {
snakify: false,
parens_and_commas: false,
};
let result = format_files(vec![file_path.clone()], FormatMode::CheckOnly, flags);
assert!(result.is_err());
@ -485,7 +488,10 @@ main =
let dir = tempdir().unwrap();
let file1 = setup_test_file(dir.path(), "test1.roc", UNFORMATTED_ROC);
let file2 = setup_test_file(dir.path(), "test2.roc", UNFORMATTED_ROC);
let flags = MigrationFlags::new(false);
let flags = MigrationFlags {
snakify: false,
parens_and_commas: false,
};
let result = format_files(vec![file1, file2], FormatMode::CheckOnly, flags);
assert!(result.is_err());
@ -499,7 +505,10 @@ main =
fn test_no_files_need_reformatting() {
let dir = tempdir().unwrap();
let file_path = setup_test_file(dir.path(), "formatted.roc", FORMATTED_ROC);
let flags = MigrationFlags::new(false);
let flags = MigrationFlags {
snakify: false,
parens_and_commas: false,
};
let result = format_files(vec![file_path], FormatMode::CheckOnly, flags);
assert!(result.is_ok());
@ -513,7 +522,10 @@ main =
let file_formatted = setup_test_file(dir.path(), "formatted.roc", FORMATTED_ROC);
let file1_unformated = setup_test_file(dir.path(), "test1.roc", UNFORMATTED_ROC);
let file2_unformated = setup_test_file(dir.path(), "test2.roc", UNFORMATTED_ROC);
let flags = MigrationFlags::new(false);
let flags = MigrationFlags {
snakify: false,
parens_and_commas: false,
};
let result = format_files(
vec![file_formatted, file1_unformated, file2_unformated],

48
crates/cli/src/lib.rs
View file

@ -92,6 +92,7 @@ pub const FLAG_PP_HOST: &str = "host";
pub const FLAG_PP_PLATFORM: &str = "platform";
pub const FLAG_PP_DYLIB: &str = "lib";
pub const FLAG_MIGRATE: &str = "migrate";
pub const FLAG_DOCS_ROOT: &str = "root-dir";
pub const VERSION: &str = env!("ROC_VERSION");
const DEFAULT_GENERATED_DOCS_DIR: &str = "generated-docs";
@ -187,6 +188,12 @@ pub fn build_app() -> Command {
.num_args(0..)
.allow_hyphen_values(true);
let flag_docs_root_dir = Arg::new(FLAG_DOCS_ROOT)
.long(FLAG_DOCS_ROOT)
.help("Set a root directory path to be used as a prefix for URL links in the generated documentation files.")
.value_parser(value_parser!(Option<String>))
.required(false);
let build_target_values_parser =
PossibleValuesParser::new(Target::iter().map(Into::<&'static str>::into));
@ -244,6 +251,13 @@ pub fn build_app() -> Command {
.action(ArgAction::SetTrue)
.required(false),
)
.arg(
Arg::new(FLAG_VERBOSE)
.long(FLAG_VERBOSE)
.help("Print detailed information while building")
.action(ArgAction::SetTrue)
.required(false)
)
.arg(
Arg::new(ROC_FILE)
.help("The .roc file to build")
@ -411,6 +425,7 @@ pub fn build_app() -> Command {
.required(false)
.default_value(DEFAULT_ROC_FILENAME),
)
.arg(flag_docs_root_dir)
)
.subcommand(Command::new(CMD_GLUE)
.about("Generate glue code between a platform's Roc API and its host language")
@ -434,6 +449,7 @@ pub fn build_app() -> Command {
.required(false)
.default_value(DEFAULT_ROC_FILENAME)
)
.arg(flag_linker.clone())
)
.subcommand(Command::new(CMD_PREPROCESS_HOST)
.about("Runs the surgical linker preprocessor to generate `.rh` and `.rm` files.")
@ -779,6 +795,30 @@ fn nearest_match<'a>(reference: &str, options: &'a [String]) -> Option<(&'a Stri
.min_by(|(_, a), (_, b)| a.cmp(b))
}
pub fn default_linking_strategy(
matches: &ArgMatches,
link_type: LinkType,
target: Target,
) -> LinkingStrategy {
let linker_support_level = roc_linker::support_level(link_type, target);
match matches.get_one::<String>(FLAG_LINKER).map(AsRef::as_ref) {
Some("legacy") => LinkingStrategy::Legacy,
Some("surgical") => match linker_support_level {
roc_linker::SupportLevel::Full => LinkingStrategy::Surgical,
roc_linker::SupportLevel::Wip => {
println!("Warning! Using an unfinished surgical linker for target {target}");
LinkingStrategy::Surgical
}
roc_linker::SupportLevel::None => LinkingStrategy::Legacy,
},
_ => match linker_support_level {
roc_linker::SupportLevel::Full => LinkingStrategy::Surgical,
_ => LinkingStrategy::Legacy,
},
}
}
#[allow(clippy::too_many_arguments)]
pub fn build(
matches: &ArgMatches,
subcommands: &[String],
@ -787,6 +827,7 @@ pub fn build(
out_path: Option<&Path>,
roc_cache_dir: RocCacheDir<'_>,
link_type: LinkType,
verbose: bool,
) -> io::Result<i32> {
use BuildConfig::*;
@ -929,12 +970,8 @@ pub fn build(
let linking_strategy = if wasm_dev_backend {
LinkingStrategy::Additive
} else if !roc_linker::supported(link_type, target)
|| matches.get_one::<String>(FLAG_LINKER).map(|s| s.as_str()) == Some("legacy")
{
LinkingStrategy::Legacy
} else {
LinkingStrategy::Surgical
default_linking_strategy(matches, link_type, target)
};
// All hosts should be prebuilt, this flag keeps the rebuilding behvaiour
@ -982,6 +1019,7 @@ pub fn build(
roc_cache_dir,
load_config,
out_path,
verbose,
);
match res_binary_path {

59
crates/cli/src/main.rs
View file

@ -3,12 +3,13 @@ use bumpalo::Bump;
use roc_build::link::LinkType;
use roc_build::program::{check_file, CodeGenBackend};
use roc_cli::{
annotate_file, build_app, format_files, format_src, test, BuildConfig, FormatMode, CMD_BUILD,
CMD_CHECK, CMD_DEV, CMD_DOCS, CMD_FORMAT, CMD_FORMAT_ANNOTATE, CMD_GLUE, CMD_PREPROCESS_HOST,
CMD_REPL, CMD_RUN, CMD_TEST, CMD_VERSION, DIRECTORY_OR_FILES, FLAG_CHECK, FLAG_DEV, FLAG_LIB,
FLAG_MAIN, FLAG_MIGRATE, FLAG_NO_COLOR, FLAG_NO_HEADER, FLAG_NO_LINK, FLAG_OUTPUT,
FLAG_PP_DYLIB, FLAG_PP_HOST, FLAG_PP_PLATFORM, FLAG_STDIN, FLAG_STDOUT, FLAG_TARGET, FLAG_TIME,
GLUE_DIR, GLUE_SPEC, ROC_FILE, VERSION,
annotate_file, build_app, default_linking_strategy, format_files, format_src, test,
BuildConfig, FormatMode, CMD_BUILD, CMD_CHECK, CMD_DEV, CMD_DOCS, CMD_FORMAT,
CMD_FORMAT_ANNOTATE, CMD_GLUE, CMD_PREPROCESS_HOST, CMD_REPL, CMD_RUN, CMD_TEST, CMD_VERSION,
DIRECTORY_OR_FILES, FLAG_CHECK, FLAG_DEV, FLAG_DOCS_ROOT, FLAG_LIB, FLAG_MAIN, FLAG_MIGRATE,
FLAG_NO_COLOR, FLAG_NO_HEADER, FLAG_NO_LINK, FLAG_OUTPUT, FLAG_PP_DYLIB, FLAG_PP_HOST,
FLAG_PP_PLATFORM, FLAG_STDIN, FLAG_STDOUT, FLAG_TARGET, FLAG_TIME, FLAG_VERBOSE, GLUE_DIR,
GLUE_SPEC, ROC_FILE, VERSION,
};
use roc_docs::generate_docs_html;
use roc_error_macros::{internal_error, user_error};
@ -54,6 +55,7 @@ fn main() -> io::Result<()> {
None,
RocCacheDir::Persistent(cache::roc_cache_packages_dir().as_path()),
LinkType::Executable,
false,
)
} else {
Ok(1)
@ -69,6 +71,7 @@ fn main() -> io::Result<()> {
None,
RocCacheDir::Persistent(cache::roc_cache_packages_dir().as_path()),
LinkType::Executable,
false,
)
} else {
eprintln!("What .roc file do you want to run? Specify it at the end of the `roc run` command.");
@ -95,6 +98,7 @@ fn main() -> io::Result<()> {
None,
RocCacheDir::Persistent(cache::roc_cache_packages_dir().as_path()),
LinkType::Executable,
false,
)
} else {
eprintln!("What .roc file do you want to build? Specify it at the end of the `roc run` command.");
@ -113,8 +117,19 @@ fn main() -> io::Result<()> {
false => CodeGenBackend::Llvm(LlvmBackendMode::BinaryGlue),
};
let link_type = LinkType::Dylib;
let target = Triple::host().into();
let linking_strategy = default_linking_strategy(matches, link_type, target);
if !output_path.exists() || output_path.is_dir() {
roc_glue::generate(input_path, output_path, spec_path, backend)
roc_glue::generate(
input_path,
output_path,
spec_path,
backend,
link_type,
linking_strategy,
)
} else {
eprintln!("`roc glue` must be given a directory to output into, because the glue might generate multiple files.");
@ -153,7 +168,7 @@ fn main() -> io::Result<()> {
.and_then(|s| Target::from_str(s).ok())
.unwrap_or_default();
let verbose_and_time = matches.get_one::<bool>(roc_cli::FLAG_VERBOSE).unwrap();
let verbose_and_time = matches.get_one::<bool>(FLAG_VERBOSE).unwrap();
let preprocessed_path = platform_path.with_file_name(target.prebuilt_surgical_host());
let metadata_path = platform_path.with_file_name(target.metadata_file_name());
@ -184,6 +199,7 @@ fn main() -> io::Result<()> {
let out_path = matches
.get_one::<OsString>(FLAG_OUTPUT)
.map(OsString::as_ref);
let verbose = matches.get_flag(FLAG_VERBOSE);
Ok(build(
matches,
@ -193,6 +209,7 @@ fn main() -> io::Result<()> {
out_path,
RocCacheDir::Persistent(cache::roc_cache_packages_dir().as_path()),
link_type,
verbose,
)?)
}
Some((CMD_CHECK, matches)) => {
@ -282,6 +299,7 @@ fn main() -> io::Result<()> {
) {
Ok((problems, total_time)) => {
problems.print_error_warning_count(total_time);
println!(".\n");
Ok(problems.exit_code())
}
@ -307,7 +325,25 @@ fn main() -> io::Result<()> {
let root_path = matches.get_one::<PathBuf>(ROC_FILE).unwrap();
let out_dir = matches.get_one::<OsString>(FLAG_OUTPUT).unwrap();
generate_docs_html(root_path.to_owned(), out_dir.as_ref());
let maybe_root_dir: Option<String> = {
if let Ok(root_dir) = std::env::var("ROC_DOCS_URL_ROOT") {
// if the env var is set, it should override the flag for now
// TODO -- confirm we no longer need this and remove
// once docs are migrated to individual repositories and not roc website
Some(root_dir)
} else {
matches
.get_one::<Option<String>>(FLAG_DOCS_ROOT)
.unwrap_or(&None)
.clone()
}
};
generate_docs_html(
root_path.to_owned(),
out_dir.as_ref(),
maybe_root_dir.clone(),
);
Ok(0)
}
@ -346,7 +382,10 @@ fn main() -> io::Result<()> {
false => FormatMode::WriteToFile,
}
};
let flags = MigrationFlags::new(migrate);
let flags = MigrationFlags {
snakify: migrate,
parens_and_commas: migrate,
};
if from_stdin && matches!(format_mode, FormatMode::WriteToFile) {
eprintln!("When using the --stdin flag, either the --check or the --stdout flag must also be specified. (Otherwise, it's unclear what filename to write to!)");

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

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

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

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

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

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

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

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

136
crates/cli/tests/benchmarks/Bytes/Decode.roc
View file

@ -7,105 +7,111 @@ 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
decode = \bytes, @ByteDecoder(decoder) ->
when decoder({ bytes, cursor: 0 }) is
Good(_, value) ->
Ok(value)
Bad e ->
Err e
Bad(e) ->
Err(e)
succeed : a -> ByteDecoder a
succeed = \value -> @ByteDecoder \state -> Good state value
succeed = \value -> @ByteDecoder(\state -> Good(state, value))
map : ByteDecoder a, (a -> b) -> ByteDecoder b
map = \@ByteDecoder decoder, transform ->
@ByteDecoder
map = \@ByteDecoder(decoder), transform ->
@ByteDecoder(
\state ->
when decoder state is
Good state1 value ->
Good state1 (transform value)
when decoder(state) is
Good(state1, value) ->
Good(state1, transform(value))
Bad e ->
Bad e
Bad(e) ->
Bad(e),
)
map2 : ByteDecoder a, ByteDecoder b, (a, b -> c) -> ByteDecoder c
map2 = \@ByteDecoder decoder1, @ByteDecoder decoder2, transform ->
@ByteDecoder
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)
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)
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
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)
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
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
after = \@ByteDecoder(decoder), transform ->
@ByteDecoder(
\state ->
when decoder state is
Good state1 value ->
(@ByteDecoder decoder1) = transform value
when decoder(state) is
Good(state1, value) ->
@ByteDecoder(decoder1) = transform(value)
decoder1 state1
decoder1(state1)
Bad e ->
Bad e
Bad(e) ->
Bad(e),
)
u8 : ByteDecoder U8
u8 = @ByteDecoder
u8 = @ByteDecoder(
\state ->
when List.get state.bytes state.cursor is
Ok b ->
Good { state & cursor: state.cursor + 1 } b
when List.get(state.bytes, state.cursor) is
Ok(b) ->
Good({ state & cursor: state.cursor + 1 }, b)
Err _ ->
Bad OutOfBytes
Err(_) ->
Bad(OutOfBytes),
)
Step state b : [Loop state, Done b]
loop : (state -> ByteDecoder (Step state a)), state -> ByteDecoder a
loop = \stepper, initial ->
@ByteDecoder
@ByteDecoder(
\state ->
loopHelp stepper initial state
loop_help(stepper, initial, state),
)
loopHelp = \stepper, accum, state ->
(@ByteDecoder stepper1) = stepper accum
loop_help = \stepper, accum, state ->
@ByteDecoder(stepper1) = stepper(accum)
when stepper1 state is
Good newState (Done value) ->
Good newState value
when stepper1(state) is
Good(new_state, Done(value)) ->
Good(new_state, value)
Good newState (Loop newAccum) ->
loopHelp stepper newAccum newState
Good(new_state, Loop(new_accum)) ->
loop_help(stepper, new_accum, new_state)
Bad e ->
Bad e
Bad(e) ->
Bad(e)

110
crates/cli/tests/benchmarks/Bytes/Encode.roc
View file

@ -5,130 +5,132 @@ Endianness : [BE, LE]
ByteEncoder : [Signed8 I8, Unsigned8 U8, Signed16 Endianness I16, Unsigned16 Endianness U16, Sequence U64 (List ByteEncoder), Bytes (List U8)]
u8 : U8 -> ByteEncoder
u8 = \value -> Unsigned8 value
u8 = \value -> Unsigned8(value)
empty : ByteEncoder
empty =
foo : List ByteEncoder
foo = []
Sequence 0 foo
Sequence(0, foo)
u16 : Endianness, U16 -> ByteEncoder
u16 = \endianness, value -> Unsigned16 endianness value
u16 = \endianness, value -> Unsigned16(endianness, value)
bytes : List U8 -> ByteEncoder
bytes = \bs -> Bytes bs
bytes = \bs -> Bytes(bs)
sequence : List ByteEncoder -> ByteEncoder
sequence = \encoders ->
Sequence (getWidths encoders 0) encoders
Sequence(get_widths(encoders, 0), encoders)
getWidth : ByteEncoder -> U64
getWidth = \encoder ->
get_width : ByteEncoder -> U64
get_width = \encoder ->
when encoder is
Signed8 _ -> 1
Unsigned8 _ -> 1
Signed16 _ _ -> 2
Unsigned16 _ _ -> 2
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
Sequence(w, _) -> w
Bytes(bs) -> List.len(bs)
getWidths : List ByteEncoder, U64 -> U64
getWidths = \encoders, initial ->
List.walk encoders initial \accum, encoder -> accum + getWidth encoder
get_widths : List ByteEncoder, U64 -> U64
get_widths = \encoders, initial ->
List.walk(encoders, initial, \accum, encoder -> accum + get_width(encoder))
encode : ByteEncoder -> List U8
encode = \encoder ->
output = List.repeat 0 (getWidth encoder)
output = List.repeat(0, get_width(encoder))
encodeHelp encoder 0 output
encode_help(encoder, 0, output)
|> .output
encodeHelp : ByteEncoder, U64, List U8 -> { output : List U8, offset : U64 }
encodeHelp = \encoder, offset, output ->
encode_help : ByteEncoder, U64, List U8 -> { output : List U8, offset : U64 }
encode_help = \encoder, offset, output ->
when encoder is
Unsigned8 value ->
Unsigned8(value) ->
{
output: List.set output offset value,
output: List.set(output, offset, value),
offset: offset + 1,
}
Signed8 value ->
Signed8(value) ->
cast : U8
cast = Num.intCast value
cast = Num.int_cast(value)
{
output: List.set output offset cast,
output: List.set(output, offset, cast),
offset: offset + 1,
}
Unsigned16 endianness value ->
Unsigned16(endianness, value) ->
a : U8
a = Num.intCast (Num.shiftRightBy value 8)
a = Num.int_cast(Num.shift_right_by(value, 8))
b : U8
b = Num.intCast value
b = Num.int_cast(value)
newOutput =
new_output =
when endianness is
BE ->
output
|> List.set (offset + 0) a
|> List.set (offset + 1) b
|> List.set((offset + 0), a)
|> List.set((offset + 1), b)
LE ->
output
|> List.set (offset + 0) b
|> List.set (offset + 1) a
|> List.set((offset + 0), b)
|> List.set((offset + 1), a)
{
output: newOutput,
output: new_output,
offset: offset + 2,
}
Signed16 endianness value ->
Signed16(endianness, value) ->
a : U8
a = Num.intCast (Num.shiftRightBy value 8)
a = Num.int_cast(Num.shift_right_by(value, 8))
b : U8
b = Num.intCast value
b = Num.int_cast(value)
newOutput =
new_output =
when endianness is
BE ->
output
|> List.set (offset + 0) a
|> List.set (offset + 1) b
|> List.set((offset + 0), a)
|> List.set((offset + 1), b)
LE ->
output
|> List.set (offset + 0) b
|> List.set (offset + 1) a
|> List.set((offset + 0), b)
|> List.set((offset + 1), a)
{
output: newOutput,
output: new_output,
offset: offset + 1,
}
Bytes bs ->
List.walk
bs
{ output, offset }
Bytes(bs) ->
List.walk(
bs,
{ output, offset },
\accum, byte -> {
offset: accum.offset + 1,
output: List.set accum.output offset byte,
}
output: List.set(accum.output, offset, byte),
},
)
Sequence _ encoders ->
List.walk
encoders
{ output, offset }
Sequence(_, encoders) ->
List.walk(
encoders,
{ output, offset },
\accum, single ->
encodeHelp single accum.offset accum.output
encode_help(single, accum.offset, accum.output),
)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

File diff suppressed because one or more lines are too long

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

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

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

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

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

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

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

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

114
crates/cli/tests/cli_tests.rs
View file

@ -50,12 +50,12 @@ mod cli_tests {
const TEST_LEGACY_LINKER: bool = false;
#[test]
#[ignore = "Works when run manually, but not in CI"]
#[ignore = "Needs investigation, see also github.com/roc-lang/roc/pull/7231"]
fn platform_switching_rust() {
// pre-build the platform
std::process::Command::new("bash")
.arg(file_from_root(
"examples/platform-switching/rust-platform",
"crates/cli/tests/platform-switching/rust-platform",
"build.sh",
))
.status()
@ -63,7 +63,7 @@ mod cli_tests {
let cli_build = ExecCli::new(
roc_cli::CMD_DEV,
file_from_root("examples/platform-switching", "rocLovesRust.roc"),
file_from_root("crates/cli/tests/platform-switching", "rocLovesRust.roc"),
);
let expected_output = "Roc <3 Rust!\n";
@ -80,7 +80,7 @@ mod cli_tests {
let cli_build = ExecCli::new(
CMD_BUILD,
file_from_root("examples/platform-switching", "rocLovesZig.roc"),
file_from_root("crates/cli/tests/platform-switching", "rocLovesZig.roc"),
)
.arg(BUILD_HOST_FLAG)
.arg(SUPPRESS_BUILD_HOST_WARNING_FLAG);
@ -104,7 +104,10 @@ mod cli_tests {
// so let's just check it for now
let cli_check = ExecCli::new(
CMD_CHECK,
file_from_root("examples/platform-switching", "rocLovesWebAssembly.roc"),
file_from_root(
"crates/cli/tests/platform-switching",
"rocLovesWebAssembly.roc",
),
);
let cli_check_out = cli_check.run();
@ -160,34 +163,6 @@ mod cli_tests {
);
}
// TODO: write a new test once mono bugs are resolved in investigation
// Encountering this TODO years later, I presume the new test should test the execution, not just roc check.
#[test]
#[cfg(not(debug_assertions))] // https://github.com/roc-lang/roc/issues/4806 - later observation: this issue is closed but the tests still hangs in debug mode
fn check_virtual_dom_server() {
let cli_check = ExecCli::new(
CMD_CHECK,
file_from_root("examples/virtual-dom-wip", "example-server.roc"),
);
let cli_check_out = cli_check.run();
cli_check_out.assert_clean_success();
}
// TODO: write a new test once mono bugs are resolved in investigation
// Encountering this TODO years later, I presume the new test should test the execution, not just roc check.
#[test]
#[cfg(not(debug_assertions))] // https://github.com/roc-lang/roc/issues/4806 - later observation: this issue is closed but the tests still hangs in debug mode
fn check_virtual_dom_client() {
let cli_check = ExecCli::new(
CMD_CHECK,
file_from_root("examples/virtual-dom-wip", "example-client.roc"),
);
let cli_check_out = cli_check.run();
cli_check_out.assert_clean_success();
}
#[test]
#[cfg_attr(windows, ignore)]
// tea = The Elm Architecture
@ -212,31 +187,35 @@ mod cli_tests {
);
}
// TODO check this out, there's more that's going wrong than a segfault
//#[test]
/*#[cfg_attr(
any(target_os = "windows", target_os = "linux", target_os = "macos"),
ignore = "Segfault, likely broken because of alias analysis: https://github.com/roc-lang/roc/issues/6544"
)]*/
/*
#[test]
// #[cfg_attr(windows, ignore)]
#[ignore]
fn false_interpreter() {
let cli_build = ExecCli::new(
CMD_BUILD,
file_from_root("crates/cli/tests/test-projects/false-interpreter", "main.roc")
)
.arg(BUILD_HOST_FLAG)
.arg(SUPPRESS_BUILD_HOST_WARNING_FLAG);
CMD_BUILD,
file_from_root(
"crates/cli/tests/test-projects/false-interpreter",
"main.roc",
),
)
.arg(BUILD_HOST_FLAG)
.arg(SUPPRESS_BUILD_HOST_WARNING_FLAG);
let sqrt_false_path_buf = file_from_root("crates/cli/tests/test-projects/false-interpreter/examples", "sqrt.false");
let sqrt_false_path_buf = file_from_root(
"crates/cli/tests/test-projects/false-interpreter/examples",
"sqrt.false",
);
let app_args = ["--",
sqrt_false_path_buf
.as_path()
.to_str()
.unwrap()];
let app_args = [sqrt_false_path_buf.as_path().to_str().unwrap()];
cli_build.full_check_build_and_run("1414", TEST_LEGACY_LINKER, ALLOW_VALGRIND, None, Some(&app_args));
}*/
cli_build.full_check_build_and_run(
"1414",
TEST_LEGACY_LINKER,
ALLOW_VALGRIND,
None,
Some(&app_args),
);
}
#[test]
#[cfg_attr(windows, ignore)]
@ -874,7 +853,7 @@ mod cli_tests {
),
);
let expected_output = "(@Community {friends: [{2}, {2}, {0, 1}], people: [(@Person {age: 27, favoriteColor: Blue, firstName: \"John\", hasBeard: Bool.true, lastName: \"Smith\"}), (@Person {age: 47, favoriteColor: Green, firstName: \"Debby\", hasBeard: Bool.false, lastName: \"Johnson\"}), (@Person {age: 33, favoriteColor: (RGB (255, 255, 0)), firstName: \"Jane\", hasBeard: Bool.false, lastName: \"Doe\"})]})\n";
let expected_output = "(@Community {friends: [{2}, {2}, {0, 1}], people: [(@Person {age: 27, favorite_color: Blue, first_name: \"John\", has_beard: Bool.true, last_name: \"Smith\"}), (@Person {age: 47, favorite_color: Green, first_name: \"Debby\", has_beard: Bool.false, last_name: \"Johnson\"}), (@Person {age: 33, favorite_color: (RGB (255, 255, 0)), first_name: \"Jane\", has_beard: Bool.false, last_name: \"Doe\"})]})\n";
cli_build.full_check_build_and_run(
expected_output,
@ -891,7 +870,7 @@ mod cli_tests {
build_platform_host();
let cli_build = ExecCli::new(
roc_cli::CMD_DEV,
roc_cli::CMD_BUILD,
file_from_root("crates/cli/tests/test-projects/effectful", "form.roc"),
);
@ -911,14 +890,14 @@ mod cli_tests {
fn effectful_hello() {
build_platform_host();
let cli_build = ExecCli::new(
let cli_dev = ExecCli::new(
roc_cli::CMD_DEV,
file_from_root("crates/cli/tests/test-projects/effectful/", "hello.roc"),
);
let expected_out = "I'm an effect 👻\n";
cli_build.run().assert_clean_stdout(expected_out);
cli_dev.run().assert_clean_stdout(expected_out);
}
#[test]
@ -926,14 +905,14 @@ mod cli_tests {
fn effectful_loops() {
build_platform_host();
let cli_build = ExecCli::new(
let cli_dev = ExecCli::new(
roc_cli::CMD_DEV,
file_from_root("crates/cli/tests/test-projects/effectful/", "loops.roc"),
);
let expected_out = "Lu\nMarce\nJoaquin\nChloé\nMati\nPedro\n";
cli_build.run().assert_clean_stdout(expected_out);
cli_dev.run().assert_clean_stdout(expected_out);
}
#[test]
@ -941,7 +920,7 @@ mod cli_tests {
fn effectful_untyped_passed_fx() {
build_platform_host();
let cli_build = ExecCli::new(
let cli_dev = ExecCli::new(
roc_cli::CMD_DEV,
file_from_root(
"crates/cli/tests/test-projects/effectful/",
@ -951,7 +930,7 @@ mod cli_tests {
let expected_out = "Before hello\nHello, World!\nAfter hello\n";
cli_build.run().assert_clean_stdout(expected_out);
cli_dev.run().assert_clean_stdout(expected_out);
}
#[test]
@ -959,7 +938,7 @@ mod cli_tests {
fn effectful_ignore_result() {
build_platform_host();
let cli_build = ExecCli::new(
let cli_dev = ExecCli::new(
roc_cli::CMD_DEV,
file_from_root(
"crates/cli/tests/test-projects/effectful/",
@ -969,7 +948,7 @@ mod cli_tests {
let expected_out = "I asked for input and I ignored it. Deal with it! 😎\n";
cli_build.run().assert_clean_stdout(expected_out);
cli_dev.run().assert_clean_stdout(expected_out);
}
#[test]
@ -978,14 +957,14 @@ mod cli_tests {
build_platform_host();
let cli_build = ExecCli::new(
roc_cli::CMD_DEV,
roc_cli::CMD_BUILD,
file_from_root(
"crates/cli/tests/test-projects/effectful",
"suffixed_record_field.roc",
),
);
let expected_output = "notEffectful: hardcoded\neffectful: from stdin\n";
let expected_output = "not_effectful: hardcoded\neffectful: from stdin\n";
cli_build.check_build_and_run(
expected_output,
@ -1001,7 +980,7 @@ mod cli_tests {
build_platform_host();
let cli_build = ExecCli::new(
roc_cli::CMD_DEV,
roc_cli::CMD_BUILD,
file_from_root("crates/cli/tests/test-projects/effectful", "on_err.roc"),
);
@ -1016,7 +995,7 @@ mod cli_tests {
build_platform_host();
let cli_build = ExecCli::new(
roc_cli::CMD_DEV,
roc_cli::CMD_BUILD,
file_from_root(
"crates/cli/tests/test-projects/effectful",
"for_each_try.roc",
@ -1302,6 +1281,7 @@ mod cli_tests {
}
#[test]
#[ignore = "flaky currently due to 7022"]
fn known_type_error() {
let cli_check = ExecCli::new(
CMD_CHECK,

14
crates/cli/tests/platform-switching/README.md Normal file
View file

@ -0,0 +1,14 @@
# Platform switching
To run, `cd` into this directory and run this in your terminal:
```bash
roc --build-host --suppress-build-host-warning rocLovesC.roc
```
## About these examples
They use a very simple [platform](https://www.roc-lang.org/platforms) which does nothing more than printing the string you give it.
If you want to start building your own platforms, these are some very simple example platforms to use as starting points.

120
crates/cli/tests/platform-switching/c-platform/host.c Normal file
View file

@ -0,0 +1,120 @@
#include <errno.h>
#include <signal.h>
#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/stat.h>
#include <unistd.h>
#ifdef _WIN32
#else
#include <sys/shm.h> // shm_open
#include <sys/mman.h> // for mmap
#include <signal.h> // for kill
#endif
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(1);
}
void roc_dbg(char* loc, char* msg, char* src) {
fprintf(stderr, "[%s] %s = %s\n", loc, src, msg);
}
void* roc_memset(void* str, int c, size_t n) { return memset(str, c, n); }
int roc_shm_open(char* name, int oflag, int mode) {
#ifdef _WIN32
return 0;
#else
return shm_open(name, oflag, mode);
#endif
}
void* roc_mmap(void* addr, int length, int prot, int flags, int fd, int offset) {
#ifdef _WIN32
return addr;
#else
return mmap(addr, length, prot, flags, fd, offset);
#endif
}
int roc_getppid() {
#ifdef _WIN32
return 0;
#else
return getppid();
#endif
}
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__main_for_host_1_exposed_generic(struct RocStr *string);
int main() {
struct RocStr str;
roc__main_for_host_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;
}
}

9
crates/cli/tests/platform-switching/c-platform/main.roc Normal file
View file

@ -0,0 +1,9 @@
platform "echo-in-c"
requires {} { main : Str }
exposes []
packages {}
imports []
provides [main_for_host]
main_for_host : Str
main_for_host = main

9
crates/cli/tests/platform-switching/rocLovesC.roc Normal file
View file

@ -0,0 +1,9 @@
app [main] { pf: platform "c-platform/main.roc" }
# may require:
# ubuntu: sudo apt install build-essential clang
# fedora: sudo dnf install clang
# run with `roc --build-host --suppress-build-host-warning rocLovesC.roc`
main = "Roc <3 C!\n"

3
crates/cli/tests/platform-switching/rocLovesRust.roc Normal file
View file

@ -0,0 +1,3 @@
app [main] { pf: platform "rust-platform/main.roc" }
main = "Roc <3 Rust!\n"

3
crates/cli/tests/platform-switching/rocLovesWebAssembly.roc Normal file
View file

@ -0,0 +1,3 @@
app [main] { pf: platform "web-assembly-platform/main.roc" }
main = "Roc <3 Web Assembly!\n"

10
crates/cli/tests/platform-switching/rocLovesZig.roc Normal file
View file

@ -0,0 +1,10 @@
app [main] { pf: platform "zig-platform/main.roc" }
# To run:
# cd examples/platform-switching/zig-platform
# mkdir glue
# cp crates/compiler/builtins/bitcode/src/* ./glue
# cd -
# roc --build-host --suppress-build-host-warning rocLovesZig.roc
main = "Roc <3 Zig!\n"

16
crates/cli/tests/platform-switching/rust-platform/Cargo.toml Normal file
View file

@ -0,0 +1,16 @@
[package]
name = "rust-platform"
authors = ["The Roc Contributors"]
edition = "2021"
license = "UPL-1.0"
version = "0.0.1"
build = "build.rs"
[lib]
name = "rustplatform"
path = "src/lib.rs"
crate-type = ["staticlib"]
[dependencies]
libc = "0.2"
roc_std = { path = "../../../crates/roc_std" }

33
crates/cli/tests/platform-switching/rust-platform/build.rs Normal file
View file

@ -0,0 +1,33 @@
// We need set these linker flags to prevent `cargo build` for the workspace from failing with the following error:
//
// ```
// = note: Undefined symbols for architecture arm64:
// "_roc__main_for_host_1_exposed_generic", referenced from:
// _main in rustplatform-df9e357e0cc989a6.rustplatform.863be87f3956573-cgu.0.rcgu.o
// ld: symbol(s) not found for architecture arm64
// clang-16: error: linker command failed with exit code 1 (use -v to see invocation)
// ```
//
// This is ok, because this static library will be linked later by roc and the symbols will be resolved.
//
fn main() {
// Get the target triple
let target = std::env::var("TARGET").unwrap();
// Set the entry point to main
println!("cargo:rustc-link-arg=-e");
println!("cargo:rustc-link-arg=main");
// Add platform-specific flags for undefined symbols
if target.contains("apple") {
println!("cargo:rustc-link-arg=-undefined");
println!("cargo:rustc-link-arg=dynamic_lookup");
} else if target.contains("linux") {
println!("cargo:rustc-link-arg=--allow-undefined");
} else if target.contains("windows") {
println!("cargo:rustc-link-arg=/FORCE:UNRESOLVED"); // Windows MSVC
}
// Force rebuild if this build script changes
println!("cargo:rerun-if-changed=build.rs");
}

11
crates/cli/tests/platform-switching/rust-platform/build.sh Executable file
View file

@ -0,0 +1,11 @@
#!/usr/bin/env bash
# https://vaneyckt.io/posts/safer_bash_scripts_with_set_euxo_pipefail/
set -euxo pipefail
# set the working directory to the directory of the script
cd "$(dirname "$0")"
cargo build -p rust-platform
cp ../../../target/debug/librustplatform.a ./libhost.a

9
crates/cli/tests/platform-switching/rust-platform/main.roc Normal file
View file

@ -0,0 +1,9 @@
platform "echo-in-rust"
requires {} { main : Str }
exposes []
packages {}
imports []
provides [main_for_host]
main_for_host : Str
main_for_host = main

9
crates/cli/tests/platform-switching/rust-platform/rust-toolchain.toml Normal file
View file

@ -0,0 +1,9 @@
[toolchain]
channel = "1.77.2"
profile = "default"
components = [
# for usages of rust-analyzer or similar tools inside `nix develop`
"rust-src"
]

131
crates/cli/tests/platform-switching/rust-platform/src/lib.rs Normal file
View file

@ -0,0 +1,131 @@
#![allow(non_snake_case)]
#![no_main]
use core::ffi::c_void;
use roc_std::RocStr;
use std::io::Write;
extern "C" {
#[link_name = "roc__main_for_host_1_exposed_generic"]
fn roc_main(_: &mut RocStr);
}
/// # Safety
///
/// TODO
#[no_mangle]
pub unsafe extern "C" fn roc_alloc(size: usize, _alignment: u32) -> *mut c_void {
libc::malloc(size)
}
/// # Safety
///
/// TODO
#[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 {
libc::realloc(c_ptr, new_size)
}
/// # Safety
///
/// TODO
#[no_mangle]
pub unsafe extern "C" fn roc_dealloc(c_ptr: *mut c_void, _alignment: u32) {
libc::free(c_ptr);
}
/// # Safety
///
/// TODO
#[no_mangle]
pub unsafe extern "C" fn roc_panic(msg: *mut RocStr, tag_id: u32) {
match tag_id {
0 => {
eprintln!("Roc standard library hit a panic: {}", &*msg);
}
1 => {
eprintln!("Application hit a panic: {}", &*msg);
}
_ => unreachable!(),
}
std::process::exit(1);
}
/// # Safety
///
/// TODO
#[no_mangle]
pub unsafe extern "C" fn roc_dbg(loc: *mut RocStr, msg: *mut RocStr, src: *mut RocStr) {
eprintln!("[{}] {} = {}", &*loc, &*src, &*msg);
}
/// # Safety
///
/// TODO
#[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)
}
/// # Safety
///
/// TODO
#[cfg(unix)]
#[no_mangle]
pub unsafe extern "C" fn roc_getppid() -> libc::pid_t {
libc::getppid()
}
/// # Safety
///
/// TODO
#[cfg(unix)]
#[no_mangle]
pub unsafe extern "C" fn roc_mmap(
addr: *mut libc::c_void,
len: libc::size_t,
prot: libc::c_int,
flags: libc::c_int,
fd: libc::c_int,
offset: libc::off_t,
) -> *mut libc::c_void {
libc::mmap(addr, len, prot, flags, fd, offset)
}
/// # Safety
///
/// TODO
#[cfg(unix)]
#[no_mangle]
pub unsafe extern "C" fn roc_shm_open(
name: *const libc::c_char,
oflag: libc::c_int,
mode: libc::mode_t,
) -> libc::c_int {
libc::shm_open(name, oflag, mode as libc::c_uint)
}
/// # Safety
///
/// TODO
#[no_mangle]
pub extern "C" fn main(_argc: isize, _argv: *const *const u8) -> isize {
let mut roc_str = RocStr::default();
unsafe { roc_main(&mut roc_str) };
if let Err(e) = std::io::stdout().write_all(roc_str.as_bytes()) {
panic!("Writing to stdout failed! {:?}", e);
}
// roc_str will not print without flushing if it does not contain a newline and you're using --linker=legacy
if let Err(e) = std::io::stdout().flush() {
panic!("Failed to flush stdout: {:?}", e);
}
0
}

67
crates/cli/tests/platform-switching/web-assembly-platform/README.md Normal file
View file

@ -0,0 +1,67 @@
# Hello, World!
To run this website, we first compile the app that uses the Wasm platform:
- If you use the nightly roc release:
```bash
./roc build --target=wasm32 examples/platform-switching/rocLovesWebAssembly.roc
```
- If you start from the compiler source code:
```bash
# Build roc compiler if you have not done so already
cargo build
target/debug/roc build --target=wasm32 examples/platform-switching/rocLovesWebAssembly.roc
```
We then move the file:
```bash
# Go to the directory where index.html is
cd examples/platform-switching/web-assembly-platform/
# Move the .wasm file so that it's beside index.html
mv ../rocLovesWebAssembly.wasm .
```
In the directory where index.html is, run any web server on localhost.
For example if you have Python3 on your system, you can use `http.server`:
```bash
python3 -m http.server 8080
```
Or if you have npm, you can use `http-server`
```bash
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.

65
crates/cli/tests/platform-switching/web-assembly-platform/host.js Normal file
View file

@ -0,0 +1,65 @@
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!";
},
roc_dbg: (_loc, _msg) => {
// TODO write a proper impl.
throw "Roc dbg not supported!";
},
},
};
const fetchPromise = fetch(wasm_filename);
let wasm;
if (WebAssembly.instantiateStreaming) {
// streaming API has better performance if available
// It can start compiling Wasm before it has fetched all of the bytes, so we don't `await` the request!
wasm = await WebAssembly.instantiateStreaming(fetchPromise, importObj);
} else {
const response = await fetchPromise;
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,
};
}

25
crates/cli/tests/platform-switching/web-assembly-platform/host.test.js Normal file
View file

@ -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");
});

53
crates/cli/tests/platform-switching/web-assembly-platform/host.zig Normal file
View file

@ -0,0 +1,53 @@
const str = @import("glue").str;
const builtin = @import("builtin");
const RocStr = str.RocStr;
comptime {
if (builtin.target.cpu.arch != .wasm32) {
@compileError("This platform is for WebAssembly only. You need to pass `--target wasm32` to the Roc compiler.");
}
}
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(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(@as([*]align(Align) u8, @alignCast(@ptrCast(c_ptr))), new_size);
}
export fn roc_dealloc(c_ptr: *anyopaque, alignment: u32) callconv(.C) void {
_ = alignment;
free(@as([*]align(Align) u8, @alignCast(@ptrCast(c_ptr))));
}
// NOTE roc_panic and roc_dbg is provided in the JS file, so it can throw an exception
extern fn roc__main_for_host_1_exposed(*RocStr) void;
extern fn js_display_roc_string(str_bytes: ?[*]u8, str_len: usize) void;
pub export fn main() u8 {
// actually call roc to populate the callresult
var callresult = RocStr.empty();
roc__main_for_host_1_exposed(&callresult);
// display the result using JavaScript
js_display_roc_string(callresult.asU8ptrMut(), callresult.len());
callresult.decref();
return 0;
}

12
crates/cli/tests/platform-switching/web-assembly-platform/index.html Normal file
View file

@ -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>

9
crates/cli/tests/platform-switching/web-assembly-platform/main.roc Normal file
View file

@ -0,0 +1,9 @@
platform "echo-in-web-assembly"
requires {} { main : Str }
exposes []
packages {}
imports []
provides [main_for_host]
main_for_host : Str
main_for_host = main

122
crates/cli/tests/platform-switching/zig-platform/host.zig Normal file
View file

@ -0,0 +1,122 @@
const std = @import("std");
const builtin = @import("builtin");
const str = @import("glue/str.zig");
const RocStr = str.RocStr;
const testing = std.testing;
const expectEqual = testing.expectEqual;
const expect = testing.expect;
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) {
const 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(@as([*]align(Align) u8, @alignCast(@ptrCast(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(@as([*]align(Align) u8, @alignCast(@ptrCast(c_ptr))));
}
export fn roc_panic(msg: *RocStr, tag_id: u32) callconv(.C) void {
const stderr = std.io.getStdErr().writer();
switch (tag_id) {
0 => {
stderr.print("Roc standard library crashed with message\n\n {s}\n\nShutting down\n", .{msg.asSlice()}) catch unreachable;
},
1 => {
stderr.print("Application crashed with message\n\n {s}\n\nShutting down\n", .{msg.asSlice()}) catch unreachable;
},
else => unreachable,
}
std.process.exit(1);
}
export fn roc_dbg(loc: *RocStr, msg: *RocStr, src: *RocStr) callconv(.C) void {
const stderr = std.io.getStdErr().writer();
stderr.print("[{s}] {s} = {s}\n", .{ loc.asSlice(), src.asSlice(), msg.asSlice() }) catch unreachable;
}
export fn roc_memset(dst: [*]u8, value: i32, size: usize) callconv(.C) void {
return memset(dst, value, size);
}
extern fn kill(pid: c_int, sig: c_int) c_int;
extern fn shm_open(name: *const i8, oflag: c_int, mode: c_uint) c_int;
extern fn mmap(addr: ?*anyopaque, length: c_uint, prot: c_int, flags: c_int, fd: c_int, offset: c_uint) *anyopaque;
extern fn getppid() c_int;
fn roc_getppid() callconv(.C) c_int {
return getppid();
}
fn roc_getppid_windows_stub() callconv(.C) c_int {
return 0;
}
fn roc_shm_open(name: *const i8, oflag: c_int, mode: c_uint) callconv(.C) c_int {
return shm_open(name, oflag, mode);
}
fn roc_mmap(addr: ?*anyopaque, length: c_uint, prot: c_int, flags: c_int, fd: c_int, offset: c_uint) callconv(.C) *anyopaque {
return mmap(addr, length, prot, flags, fd, offset);
}
comptime {
if (builtin.os.tag == .macos or builtin.os.tag == .linux) {
@export(roc_getppid, .{ .name = "roc_getppid", .linkage = .strong });
@export(roc_mmap, .{ .name = "roc_mmap", .linkage = .strong });
@export(roc_shm_open, .{ .name = "roc_shm_open", .linkage = .strong });
}
if (builtin.os.tag == .windows) {
@export(roc_getppid_windows_stub, .{ .name = "roc_getppid", .linkage = .strong });
}
}
const mem = std.mem;
const Allocator = mem.Allocator;
extern fn roc__main_for_host_1_exposed_generic(*RocStr) void;
const Unit = extern struct {};
pub export fn main() u8 {
const stdout = std.io.getStdOut().writer();
// actually call roc to populate the callresult
var callresult = RocStr.empty();
roc__main_for_host_1_exposed_generic(&callresult);
// stdout the result
stdout.print("{s}", .{callresult.asSlice()}) catch unreachable;
callresult.decref();
return 0;
}

9
crates/cli/tests/platform-switching/zig-platform/main.roc Normal file
View file

@ -0,0 +1,9 @@
platform "echo-in-zig"
requires {} { main : Str }
exposes []
packages {}
imports []
provides [main_for_host]
main_for_host : Str
main_for_host = main

4
crates/cli/tests/snapshots/cli_tests__cli_tests__exposed_not_defined.snap
View file

@ -1,6 +1,7 @@
---
source: crates/cli/tests/cli_tests.rs
expression: cli_check_out.normalize_stdout_and_stderr()
snapshot_kind: text
---
── MISSING DEFINITION in tests/test-projects/known_bad/ExposedNotDefined.roc ───
@ -12,4 +13,5 @@ from exposes.
────────────────────────────────────────────────────────────────────────────────
1 error and 0 warning found in <ignored for test> ms
1 error and 0 warnings found in <ignored for test> ms.

4
crates/cli/tests/snapshots/cli_tests__cli_tests__known_type_error.snap
View file

@ -1,6 +1,7 @@
---
source: crates/cli/tests/cli_tests.rs
expression: cli_check_out.normalize_stdout_and_stderr()
snapshot_kind: text
---
── TYPE MISMATCH in tests/test-projects/known_bad/TypeError.roc ────────────────
@ -25,4 +26,5 @@ this out.
────────────────────────────────────────────────────────────────────────────────
1 error and 0 warning found in <ignored for test> ms
1 error and 0 warnings found in <ignored for test> ms.

4
crates/cli/tests/snapshots/cli_tests__cli_tests__known_type_error_with_long_path.snap
View file

@ -1,6 +1,7 @@
---
source: crates/cli/tests/cli_tests.rs
expression: cli_check_out.normalize_stdout_and_stderr()
snapshot_kind: text
---
── UNUSED IMPORT in ...nown_bad/UnusedImportButWithALongFileNameForTesting.roc ─
@ -14,4 +15,5 @@ Since Symbol isn't used, you don't need to import it.
────────────────────────────────────────────────────────────────────────────────
0 error and 1 warning found in <ignored for test> ms
0 errors and 1 warning found in <ignored for test> ms.

3
crates/cli/tests/snapshots/cli_tests__cli_tests__test_platform_simple_zig__expects_test_failure.snap
View file

@ -1,6 +1,7 @@
---
source: crates/cli/tests/cli_tests.rs
expression: cli_test_out.normalize_stdout_and_stderr()
snapshot_kind: text
---
── EXPECT FAILED in tests/test-projects/expects/expects.roc ────────────────────
@ -31,7 +32,7 @@ a = 1
This expectation failed:
11│> expect
12│> a = makeA
12│> a = make_a
13│> b = 2i64
14│>
15│> a == b

16
crates/cli/tests/snapshots/cli_tests__cli_tests__test_platform_simple_zig__module_params_arity_mismatch.snap
View file

@ -6,10 +6,10 @@ snapshot_kind: text
── TOO MANY ARGS in tests/test-projects/module_params/arity_mismatch.roc ───────
The getUser function expects 1 argument, but it got 2 instead:
The get_user function expects 1 argument, but it got 2 instead:
12│ $(Api.getUser 1 2)
^^^^^^^^^^^
12│ ${Api.get_user(1, 2)}
^^^^^^^^^^^^
Are there any missing commas? Or missing parentheses?
@ -18,18 +18,18 @@ Are there any missing commas? Or missing parentheses?
This value is not a function, but it was given 1 argument:
13│ $(Api.baseUrl 1)
^^^^^^^^^^^
13│ ${Api.base_url(1)}
^^^^^^^^^^^^
Are there any missing commas? Or missing parentheses?
── TOO FEW ARGS in tests/test-projects/module_params/arity_mismatch.roc ────────
The getPostComment function expects 2 arguments, but it got only 1:
The get_post_comment function expects 2 arguments, but it got only 1:
16│ $(Api.getPostComment 1)
^^^^^^^^^^^^^^^^^^
16│ ${Api.get_post_comment(1)}
^^^^^^^^^^^^^^^^^^^^
Roc does not allow functions to be partially applied. Use a closure to
make partial application explicit.

21
crates/cli/tests/snapshots/cli_tests__cli_tests__test_platform_simple_zig__module_params_bad_ann.snap
View file

@ -6,34 +6,35 @@ snapshot_kind: text
── TYPE MISMATCH in tests/test-projects/module_params/BadAnn.roc ───────────────
Something is off with the body of the fnAnnotatedAsValue definition:
Something is off with the body of the
fn_annotated_as_value definition:
3│ fnAnnotatedAsValue : Str
4│> fnAnnotatedAsValue = \postId, commentId ->
5│> "/posts/$(postId)/comments/$(Num.toStr commentId)"
3│ fn_annotated_as_value : Str
4│> fn_annotated_as_value = \post_id, comment_id ->
5│> "/posts/${post_id}/comments/${Num.to_str(comment_id)}"
The body is an anonymous function of type:
Str, Num * -> Str
But the type annotation on fnAnnotatedAsValue says it should be:
But the type annotation on fn_annotated_as_value says it should be:
Str
── TYPE MISMATCH in tests/test-projects/module_params/BadAnn.roc ───────────────
Something is off with the body of the missingArg definition:
Something is off with the body of the missing_arg definition:
7│ missingArg : Str -> Str
8│> missingArg = \postId, _ ->
9│> "/posts/$(postId)/comments"
7│ missing_arg : Str -> Str
8│> missing_arg = \post_id, _ ->
9│> "/posts/${post_id}/comments"
The body is an anonymous function of type:
(Str, ? -> Str)
But the type annotation on missingArg says it should be:
But the type annotation on missing_arg says it should be:
(Str -> Str)

5
crates/cli/tests/snapshots/cli_tests__cli_tests__test_platform_simple_zig__module_params_unexpected_fn.snap
View file

@ -8,9 +8,8 @@ snapshot_kind: text
This argument to this string interpolation has an unexpected type:
10│ """
11│> $(Api.getPost)
12│ """
10│ "${Api.get_post}"
^^^^^^^^^^^^
The argument is an anonymous function of type:

3
crates/cli/tests/snapshots/cli_tests__cli_tests__unused_import.snap
View file

@ -1,6 +1,7 @@
---
source: crates/cli/tests/cli_tests.rs
expression: cli_check_out.normalize_stdout_and_stderr()
snapshot_kind: text
---
── UNUSED IMPORT in tests/test-projects/known_bad/UnusedImport.roc ─────────────
@ -14,4 +15,4 @@ Since Symbol isn't used, you don't need to import it.
────────────────────────────────────────────────────────────────────────────────
0 error and 1 warning found in <ignored for test> ms
0 errors and 1 warning found in <ignored for test> ms.

6
crates/cli/tests/test-projects/algorithms/fibonacci-platform/host.zig
View file

@ -11,8 +11,8 @@ 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;
// extern fn roc__main_for_host_1_exposed(i64, *i64) void;
extern fn roc__main_for_host_1_exposed(i64) i64;
const Align = 2 * @alignOf(usize);
extern fn malloc(size: usize) callconv(.C) ?*align(Align) anyopaque;
@ -110,7 +110,7 @@ comptime {
pub export fn main() u8 {
const stdout = std.io.getStdOut().writer();
const result = roc__mainForHost_1_exposed(10);
const result = roc__main_for_host_1_exposed(10);
stdout.print("{d}\n", .{result}) catch unreachable;

6
crates/cli/tests/test-projects/algorithms/fibonacci-platform/main.roc
View file

@ -3,7 +3,7 @@ platform "fibonacci"
exposes []
packages {}
imports []
provides [mainForHost]
provides [main_for_host]
mainForHost : I64 -> I64
mainForHost = \a -> main a
main_for_host : I64 -> I64
main_for_host = \a -> main(a)

4
crates/cli/tests/test-projects/algorithms/fibonacci.roc
View file

@ -1,10 +1,10 @@
app [main] { pf: platform "fibonacci-platform/main.roc" }
main = \n -> fib n 0 1
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)
fib((n - 1), b, (a + b))

6
crates/cli/tests/test-projects/algorithms/quicksort-platform/host.zig
View file

@ -9,7 +9,7 @@ const expect = testing.expect;
const mem = std.mem;
const Allocator = mem.Allocator;
extern fn roc__mainForHost_1_exposed(input: RocList) callconv(.C) RocList;
extern fn roc__main_for_host_1_exposed(input: RocList) callconv(.C) RocList;
const Align = 2 * @alignOf(usize);
extern fn malloc(size: usize) callconv(.C) ?*align(Align) anyopaque;
@ -117,7 +117,7 @@ pub export fn main() u8 {
var raw_numbers: [NUM_NUMS + 1]i64 = undefined;
// set refcount to one
raw_numbers[0] = -9223372036854775808;
raw_numbers[0] = 1;
var numbers = raw_numbers[1..];
@ -128,7 +128,7 @@ pub export fn main() u8 {
const roc_list = RocList{ .elements = numbers, .length = NUM_NUMS, .capacity = NUM_NUMS };
// actually call roc to populate the callresult
const callresult: RocList = roc__mainForHost_1_exposed(roc_list);
const callresult: RocList = roc__main_for_host_1_exposed(roc_list);
// stdout the result
const length = @min(20, callresult.length);

6
crates/cli/tests/test-projects/algorithms/quicksort-platform/main.roc
View file

@ -3,7 +3,7 @@ platform "quicksort"
exposes []
packages {}
imports []
provides [mainForHost]
provides [main_for_host]
mainForHost : List I64 -> List I64
mainForHost = \list -> quicksort list
main_for_host : List I64 -> List I64
main_for_host = \list -> quicksort(list)

60
crates/cli/tests/test-projects/algorithms/quicksort.roc
View file

@ -1,54 +1,54 @@
app [quicksort] { pf: platform "quicksort-platform/main.roc" }
quicksort = \originalList ->
n = List.len originalList
quicksort = \original_list ->
n = List.len(original_list)
quicksortHelp originalList 0 (n - 1)
quicksort_help(original_list, 0, (n - 1))
quicksortHelp : List (Num a), U64, U64 -> List (Num a)
quicksortHelp = \list, low, high ->
quicksort_help : List (Num a), U64, U64 -> List (Num a)
quicksort_help = \list, low, high ->
if low < high then
when partition low high list is
Pair partitionIndex partitioned ->
when partition(low, high, list) is
Pair(partition_index, partitioned) ->
partitioned
|> quicksortHelp low (partitionIndex - 1)
|> quicksortHelp (partitionIndex + 1) high
|> quicksort_help(low, (partition_index - 1))
|> quicksort_help((partition_index + 1), high)
else
list
partition : U64, U64, List (Num a) -> [Pair U64 (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)
partition = \low, high, initial_list ->
when List.get(initial_list, high) is
Ok(pivot) ->
when partition_help(low, low, initial_list, high, pivot) is
Pair(new_i, new_list) ->
Pair(new_i, swap(new_i, high, new_list))
Err _ ->
Pair low initialList
Err(_) ->
Pair(low, initial_list)
partitionHelp : U64, U64, List (Num c), U64, Num c -> [Pair U64 (List (Num c))]
partitionHelp = \i, j, list, high, pivot ->
partition_help : U64, U64, List (Num c), U64, Num c -> [Pair U64 (List (Num c))]
partition_help = \i, j, list, high, pivot ->
if j < high then
when List.get list j is
Ok value ->
when List.get(list, j) is
Ok(value) ->
if value <= pivot then
partitionHelp (i + 1) (j + 1) (swap i j list) high pivot
partition_help((i + 1), (j + 1), swap(i, j, list), high, pivot)
else
partitionHelp i (j + 1) list high pivot
partition_help(i, (j + 1), list, high, pivot)
Err _ ->
Pair i list
Err(_) ->
Pair(i, list)
else
Pair i list
Pair(i, list)
swap : U64, U64, List a -> List a
swap = \i, j, list ->
when Pair (List.get list i) (List.get list j) is
Pair (Ok atI) (Ok atJ) ->
when Pair(List.get(list, i), List.get(list, j)) is
Pair(Ok(at_i), Ok(at_j)) ->
list
|> List.set i atJ
|> List.set j atI
|> List.set(i, at_j)
|> List.set(j, at_i)
_ ->
# to prevent a decrement on list

88
crates/cli/tests/test-projects/effectful/Community.roc
View file

@ -1,10 +1,10 @@
module [
Community,
empty,
addPerson,
addFriend,
add_person,
add_friend,
Person,
walkFriendNames,
walk_friend_names,
]
## Datatype representing a community for demonstration purposes in inspect-gui.roc and inspect-logging.roc
@ -16,11 +16,11 @@ Community := {
implements [Inspect]
Person := {
firstName : Str,
lastName : Str,
first_name : Str,
last_name : Str,
age : U8,
hasBeard : Bool,
favoriteColor : Color,
has_beard : Bool,
favorite_color : Color,
}
implements [Inspect]
@ -31,52 +31,52 @@ Color : [
RGB (U8, U8, U8),
]
empty = @Community { people: [], friends: [] }
empty = @Community({ people: [], friends: [] })
addPerson = \@Community { people, friends }, person ->
@Community {
people: List.append people (@Person person),
friends: List.append friends (Set.empty {}),
}
add_person = \@Community({ people, friends }), person ->
@Community({
people: List.append(people, @Person(person)),
friends: List.append(friends, Set.empty({})),
})
addFriend = \@Community { people, friends }, from, to ->
when (List.get friends from, List.get friends to) is
(Ok fromSet, Ok toSet) ->
@Community {
add_friend = \@Community({ people, friends }), from, to ->
when (List.get(friends, from), List.get(friends, to)) is
(Ok(from_set), Ok(to_set)) ->
@Community({
people,
friends: friends
|> List.set from (Set.insert fromSet to)
|> List.set to (Set.insert toSet from),
}
|> List.set(from, Set.insert(from_set, to))
|> List.set(to, Set.insert(to_set, from)),
})
_ ->
@Community { people, friends }
@Community({ people, friends })
walkFriendNames : Community, state, (state, Str, Set Str -> state) -> state
walkFriendNames = \@Community { people, friends }, s0, nextFn ->
walk_friend_names : Community, state, (state, Str, Set Str -> state) -> state
walk_friend_names = \@Community({ people, friends }), s0, next_fn ->
(out, _) =
List.walk friends (s0, 0) \(s1, id), friendSet ->
(@Person person) =
when List.get people id is
Ok v -> v
Err _ -> crash "Unknown Person"
personName =
person.firstName
|> Str.concat " "
|> Str.concat person.lastName
List.walk(friends, (s0, 0), \(s1, id), friend_set ->
@Person(person) =
when List.get(people, id) is
Ok(v) -> v
Err(_) -> crash("Unknown Person")
person_name =
person.first_name
|> Str.concat(" ")
|> Str.concat(person.last_name)
friendNames =
Set.walk friendSet (Set.empty {}) \friendsSet, friendId ->
(@Person friend) =
when List.get people friendId is
Ok v -> v
Err _ -> crash "Unknown Person"
friendName =
friend.firstName
|> Str.concat " "
|> Str.concat friend.lastName
Set.insert friendsSet friendName
friend_names =
Set.walk(friend_set, Set.empty({}), \friends_set, friend_id ->
@Person(friend) =
when List.get(people, friend_id) is
Ok(v) -> v
Err(_) -> crash("Unknown Person")
friend_name =
friend.first_name
|> Str.concat(" ")
|> Str.concat(friend.last_name)
Set.insert(friends_set, friend_name))
(nextFn s1 personName friendNames, id + 1)
(next_fn(s1, person_name, friend_names), id + 1))
out

22
crates/cli/tests/test-projects/effectful/combine-tasks.roc
View file

@ -3,19 +3,19 @@ app [main] { pf: platform "https://github.com/roc-lang/basic-cli/releases/downlo
import pf.Stdout
main =
multipleIn =
multiple_in =
{ sequential <-
a: Task.ok 123,
b: Task.ok "abc",
c: Task.ok [123],
_d: Task.ok ["abc"],
_: Task.ok (Dict.single "a" "b"),
a: Task.ok(123),
b: Task.ok("abc"),
c: Task.ok([123]),
_d: Task.ok(["abc"]),
_: Task.ok(Dict.single("a", "b")),
}!
Stdout.line! "For multiple tasks: $(Inspect.toStr multipleIn)"
Stdout.line!("For multiple tasks: ${Inspect.to_str(multiple_in)}")
sequential : Task a err, Task b err, (a, b -> c) -> Task c err
sequential = \firstTask, secondTask, mapper ->
first = firstTask!
second = secondTask!
Task.ok (mapper first second)
sequential = \first_task, second_task, mapper ->
first = first_task!
second = second_task!
Task.ok(mapper(first, second))

30
crates/cli/tests/test-projects/effectful/echo.roc
View file

@ -3,33 +3,33 @@ app [main!] { pf: platform "../test-platform-effects-zig/main.roc" }
import pf.Effect
main! : {} => {}
main! = \{} -> tick! {}
main! = \{} -> tick!({})
tick! = \{} ->
line = Effect.getLine! {}
line = Effect.get_line!({})
if !(Str.isEmpty line) then
Effect.putLine! (echo line)
if !(Str.is_empty(line)) then
Effect.put_line!(echo(line))
else
Effect.putLine! "Received no input."
Effect.put_line!("Received no input.")
echo : Str -> Str
echo = \shout ->
silence = \length -> List.repeat ' ' length
silence = \length -> List.repeat(' ', length)
shout
|> Str.toUtf8
|> List.mapWithIndex \_, i ->
length = (List.len (Str.toUtf8 shout) - i)
phrase = (List.splitAt (Str.toUtf8 shout) length).before
|> Str.to_utf8
|> List.map_with_index(\_, i ->
length = (List.len(Str.to_utf8(shout)) - i)
phrase = (List.split_at(Str.to_utf8(shout), length)).before
List.concat (silence (if i == 0 then 2 * length else length)) phrase
List.concat(silence((if i == 0 then 2 * length else length)), phrase))
|> List.join
|> Str.fromUtf8
|> Result.withDefault ""
|> Str.from_utf8
|> Result.with_default("")
expect
message = "hello!"
echoedMessage = echo message
echoed_message = echo(message)
echoedMessage == " hello! hello hell hel he h"
echoed_message == " hello! hello hell hel he h"

19
crates/cli/tests/test-projects/effectful/for_each_try.roc
View file

@ -4,20 +4,19 @@ import pf.Effect
main! : {} => {}
main! = \{} ->
good = [0, 2, 4] |> List.forEachTry! validate!
expect good == Ok {}
good = [0, 2, 4] |> List.for_each_try!(validate!)
expect good == Ok({})
bad = [6, 8, 9, 10] |> List.forEachTry! validate!
expect bad == Err 9
bad = [6, 8, 9, 10] |> List.for_each_try!(validate!)
expect bad == Err(9)
{}
validate! : U32 => Result {} U32
validate! = \x ->
if Num.isEven x then
Effect.putLine! "✅ $(Num.toStr x)"
Ok {}
if Num.is_even(x) then
Effect.put_line!("✅ ${Num.to_str(x)}")
Ok({})
else
Effect.putLine! "$(Num.toStr x) is not even! ABORT!"
Err x
Effect.put_line!("${Num.to_str(x)} is not even! ABORT!")
Err(x)

26
crates/cli/tests/test-projects/effectful/form.roc
View file

@ -4,24 +4,24 @@ import pf.Effect
main! : {} => {}
main! = \{} ->
first = ask! "What's your first name?"
last = ask! "What's your last name?"
first = ask!("What's your first name?")
last = ask!("What's your last name?")
Effect.putLine! "\nHi, $(first) $(last)!\n"
Effect.put_line!("\nHi, ${first} ${last}!\n")
when Str.toU8 (ask! "How old are you?") is
Err InvalidNumStr ->
Effect.putLine! "Enter a valid number"
when Str.to_u8(ask!("How old are you?")) is
Err(InvalidNumStr) ->
Effect.put_line!("Enter a valid number")
Ok age if age >= 18 ->
Effect.putLine! "\nNice! You can vote!"
Ok(age) if age >= 18 ->
Effect.put_line!("\nNice! You can vote!")
Ok age ->
Effect.putLine! "\nYou'll be able to vote in $(Num.toStr (18 - age)) years"
Ok(age) ->
Effect.put_line!("\nYou'll be able to vote in ${Num.to_str(18 - age)} years")
Effect.putLine! "\nBye! 👋"
Effect.put_line!("\nBye! 👋")
ask! : Str => Str
ask! = \question ->
Effect.putLine! question
Effect.getLine! {}
Effect.put_line!(question)
Effect.get_line!({})

2
crates/cli/tests/test-projects/effectful/hello.roc
View file

@ -4,4 +4,4 @@ import pf.Effect
main! : {} => {}
main! = \{} ->
Effect.putLine! "I'm an effect 👻"
Effect.put_line!("I'm an effect 👻")

4
crates/cli/tests/test-projects/effectful/ignore_result.roc
View file

@ -4,5 +4,5 @@ import pf.Effect
main! : {} => {}
main! = \{} ->
_ = Effect.getLine! {}
Effect.putLine! "I asked for input and I ignored it. Deal with it! 😎"
_ = Effect.get_line!({})
Effect.put_line!("I asked for input and I ignored it. Deal with it! 😎")

44
crates/cli/tests/test-projects/effectful/inspect-logging.roc
View file

@ -8,28 +8,28 @@ import Community
main! = \{} ->
Community.empty
|> Community.addPerson {
firstName: "John",
lastName: "Smith",
|> Community.add_person({
first_name: "John",
last_name: "Smith",
age: 27,
hasBeard: Bool.true,
favoriteColor: Blue,
}
|> Community.addPerson {
firstName: "Debby",
lastName: "Johnson",
has_beard: Bool.true,
favorite_color: Blue,
})
|> Community.add_person({
first_name: "Debby",
last_name: "Johnson",
age: 47,
hasBeard: Bool.false,
favoriteColor: Green,
}
|> Community.addPerson {
firstName: "Jane",
lastName: "Doe",
has_beard: Bool.false,
favorite_color: Green,
})
|> Community.add_person({
first_name: "Jane",
last_name: "Doe",
age: 33,
hasBeard: Bool.false,
favoriteColor: RGB (255, 255, 0),
}
|> Community.addFriend 0 2
|> Community.addFriend 1 2
|> Inspect.toStr
|> Effect.putLine!
has_beard: Bool.false,
favorite_color: RGB((255, 255, 0)),
})
|> Community.add_friend(0, 2)
|> Community.add_friend(1, 2)
|> Inspect.to_str
|> Effect.put_line!

10
crates/cli/tests/test-projects/effectful/loops.roc
View file

@ -5,12 +5,12 @@ import pf.Effect
main! : {} => {}
main! = \{} ->
friends = ["Lu", "Marce", "Joaquin", "Chloé", "Mati", "Pedro"]
printAll! friends
print_all!(friends)
printAll! : List Str => {}
printAll! = \friends ->
print_all! : List Str => {}
print_all! = \friends ->
when friends is
[] -> {}
[first, .. as remaining] ->
Effect.putLine! first
printAll! remaining
Effect.put_line!(first)
print_all!(remaining)

16
crates/cli/tests/test-projects/effectful/on_err.roc
View file

@ -5,20 +5,20 @@ import pf.Effect
main! : {} => {}
main! = \{} ->
_ =
authenticate! {}
|> Result.onErr! \BadPass ->
Effect.putLine! "LOG: Failed login attempt"
Ok "Bad password"
authenticate!({})
|> Result.on_err!(\BadPass ->
Effect.put_line!("LOG: Failed login attempt")
Ok("Bad password"))
{}
authenticate! : {} => Result Str [BadPass]
authenticate! = \{} ->
Effect.putLine! "Enter your password:"
Effect.put_line!("Enter your password:")
password = Effect.getLine! {}
password = Effect.get_line!({})
if password == "password" then
Ok "You are in"
Ok("You are in")
else
Err BadPass
Err(BadPass)

12
crates/cli/tests/test-projects/effectful/print-line.roc
View file

@ -5,15 +5,15 @@ import pf.Effect
main! : {} => {}
main! = \{} ->
["Welcome!", "What's your name?"]
|> List.forEach! Effect.putLine!
|> List.for_each!(Effect.put_line!)
line = Effect.getLine! {}
line = Effect.get_line!({})
if line == "secret" then
Effect.putLine! "You found the secret"
Effect.putLine! "Congratulations!"
Effect.put_line!("You found the secret")
Effect.put_line!("Congratulations!")
else
{}
Effect.putLine! "You entered: $(line)"
Effect.putLine! "It is known"
Effect.put_line!("You entered: ${line}")
Effect.put_line!("It is known")

14
crates/cli/tests/test-projects/effectful/suffixed_record_field.roc
View file

@ -3,20 +3,20 @@ app [main!] { pf: platform "../test-platform-effects-zig/main.roc" }
import pf.Effect
Fx : {
getLine!: {} => Str,
get_line! : {} => Str,
}
main! : {} => {}
main! = \{} ->
notEffectful : Fx
notEffectful = {
getLine!: \{} -> "hardcoded"
not_effectful : Fx
not_effectful = {
get_line!: \{} -> "hardcoded",
}
effectful : Fx
effectful = {
getLine!: Effect.getLine!
get_line!: Effect.get_line!,
}
Effect.putLine! "notEffectful: $(notEffectful.getLine! {})"
Effect.putLine! "effectful: $(effectful.getLine! {})"
Effect.put_line!("not_effectful: ${not_effectful.get_line!({})}")
Effect.put_line!("effectful: ${effectful.get_line!({})}")

8
crates/cli/tests/test-projects/effectful/untyped_passed_fx.roc
View file

@ -4,9 +4,9 @@ import pf.Effect
main! : {} => {}
main! = \{} ->
logged! "hello" (\{} -> Effect.putLine! "Hello, World!")
logged!("hello", \{} -> Effect.put_line!("Hello, World!"))
logged! = \name, fx! ->
Effect.putLine! "Before $(name)"
fx! {}
Effect.putLine! "After $(name)"
Effect.put_line!("Before ${name}")
fx!({})
Effect.put_line!("After ${name}")

10
crates/cli/tests/test-projects/expects/expects.roc
View file

@ -1,6 +1,6 @@
app [main] { pf: platform "../test-platform-simple-zig/main.roc" }
makeA =
make_a =
a = 1
expect a == 2
@ -9,19 +9,19 @@ makeA =
a
expect
a = makeA
a = make_a
b = 2i64
a == b
polyDbg = \x ->
poly_dbg = \x ->
dbg x
x
main =
str = "this will for sure be a large string so when we split it it will use seamless slices which affect printing"
words = Str.splitOn str " "
words = Str.split_on(str, " ")
expect words == []
x = 42
@ -31,7 +31,7 @@ main =
dbg "this is line 24"
r = { x: polyDbg "abc", y: polyDbg 10u8, z: polyDbg (A (B C)) }
r = { x: poly_dbg("abc"), y: poly_dbg(10u8), z: poly_dbg(A(B(C))) }
when r is
_ -> "Program finished!\n"

10
crates/cli/tests/test-projects/expects_transitive/Direct.roc
View file

@ -1,12 +1,12 @@
module [
addAndStringify,
add_and_stringify,
]
import Transitive
addAndStringify = \num1, num2 ->
Num.toStr (Transitive.add num1 num2)
add_and_stringify = \num1, num2 ->
Num.to_str(Transitive.add(num1, num2))
expect addAndStringify 1 2 == "3"
expect add_and_stringify(1, 2) == "3"
expect addAndStringify 3 4 == "7"
expect add_and_stringify(3, 4) == "7"

2
crates/cli/tests/test-projects/expects_transitive/Transitive.roc
View file

@ -4,4 +4,4 @@ module [
add = \num1, num2 -> (num1 + num2)
expect add 1 2 == 3
expect add(1, 2) == 3

124
crates/cli/tests/test-projects/false-interpreter/Context.roc
View file

@ -1,4 +1,4 @@
module [Context, Data, with, getChar, Option, pushStack, popStack, toStr, inWhileScope]
module [Context, Data, with!, get_char!, Option, push_stack, pop_stack, to_str, in_while_scope]
import pf.File
import Variable exposing [Variable]
@ -9,100 +9,100 @@ Option a : [Some a, None]
Data : [Lambda (List U8), Number I32, Var Variable]
# While loops are special and have their own Scope specific state.
WhileState : { cond : List U8, body : List U8, state : [InCond, InBody] }
Scope : { data : Option File.Handle, index : U64, buf : List U8, whileInfo : Option WhileState }
Scope : { data : Option File.Handle, index : U64, buf : List U8, while_info : Option WhileState }
State : [Executing, InComment, InLambda U64 (List U8), InString (List U8), InNumber I32, InSpecialChar, LoadChar]
Context : { scopes : List Scope, stack : List Data, vars : List Data, state : State }
pushStack : Context, Data -> Context
pushStack = \ctx, data ->
{ ctx & stack: List.append ctx.stack data }
push_stack : Context, Data -> Context
push_stack = \ctx, data ->
{ ctx & stack: List.append(ctx.stack, data) }
# I think an open tag union should just work here.
# Instead at a call sites, I need to match on the error and then return the same error.
# Otherwise it hits unreachable code in ir.rs
popStack : Context -> Result [T Context Data] [EmptyStack]
popStack = \ctx ->
when List.last ctx.stack is
Ok val ->
poppedCtx = { ctx & stack: List.dropAt ctx.stack (List.len ctx.stack - 1) }
pop_stack : Context -> Result (Context, Data) [EmptyStack]
pop_stack = \ctx ->
when List.last(ctx.stack) is
Ok(val) ->
popped_ctx = { ctx & stack: List.drop_at(ctx.stack, (List.len(ctx.stack) - 1)) }
Ok (T poppedCtx val)
Ok((popped_ctx, val))
Err ListWasEmpty ->
Err EmptyStack
Err(ListWasEmpty) ->
Err(EmptyStack)
toStrData : Data -> Str
toStrData = \data ->
to_str_data : Data -> Str
to_str_data = \data ->
when data is
Lambda _ -> "[]"
Number n -> Num.toStr (Num.intCast n)
Var v -> Variable.toStr v
Lambda(_) -> "[]"
Number(n) -> Num.to_str(Num.int_cast(n))
Var(v) -> Variable.to_str(v)
toStrState : State -> Str
toStrState = \state ->
to_str_state : State -> Str
to_str_state = \state ->
when state is
Executing -> "Executing"
InComment -> "InComment"
InString _ -> "InString"
InNumber _ -> "InNumber"
InLambda _ _ -> "InLambda"
InString(_) -> "InString"
InNumber(_) -> "InNumber"
InLambda(_, _) -> "InLambda"
InSpecialChar -> "InSpecialChar"
LoadChar -> "LoadChar"
toStr : Context -> Str
toStr = \{ scopes, stack, state, vars } ->
depth = Num.toStr (List.len scopes)
stateStr = toStrState state
stackStr = Str.joinWith (List.map stack toStrData) " "
varsStr = Str.joinWith (List.map vars toStrData) " "
to_str : Context -> Str
to_str = \{ scopes, stack, state, vars } ->
depth = Num.to_str(List.len(scopes))
state_str = to_str_state(state)
stack_str = Str.join_with(List.map(stack, to_str_data), " ")
vars_str = Str.join_with(List.map(vars, to_str_data), " ")
"\n============\nDepth: $(depth)\nState: $(stateStr)\nStack: [$(stackStr)]\nVars: [$(varsStr)]\n============\n"
"\n============\nDepth: ${depth}\nState: ${state_str}\nStack: [${stack_str}]\nVars: [${vars_str}]\n============\n"
with : Str, (Context -> Task {} a) -> Task {} a
with = \path, callback ->
File.withOpen path \handle ->
with! : Str, (Context => a) => a
with! = \path, callback! ->
File.with_open!(path, \handle ->
# I cant define scope here and put it in the list in callback. It breaks alias anaysis.
# Instead I have to inline this.
# root_scope = { data: Some handle, index: 0, buf: [], whileInfo: None }
callback { scopes: [{ data: Some handle, index: 0, buf: [], whileInfo: None }], state: Executing, stack: [], vars: List.repeat (Number 0) Variable.totalCount }
callback!({ scopes: [{ data: Some(handle), index: 0, buf: [], while_info: None }], state: Executing, stack: [], vars: List.repeat(Number(0), Variable.total_count) }))
# I am pretty sure there is a syntax to destructure and keep a reference to the whole, but Im not sure what it is.
getChar : Context -> Task [T U8 Context] [EndOfData, NoScope]
getChar = \ctx ->
when List.last ctx.scopes is
Ok scope ->
(T val newScope) = getCharScope! scope
Task.ok (T val { ctx & scopes: List.set ctx.scopes (List.len ctx.scopes - 1) newScope })
get_char! : Context => Result (U8, Context) [EndOfData, NoScope]
get_char! = \ctx ->
when List.last(ctx.scopes) is
Ok(scope) ->
(val, new_scope) = get_char_scope!?(scope)
Ok((val, { ctx & scopes: List.set(ctx.scopes, (List.len(ctx.scopes) - 1), new_scope) }))
Err ListWasEmpty ->
Task.err NoScope
Err(ListWasEmpty) ->
Err(NoScope)
getCharScope : Scope -> Task [T U8 Scope] [EndOfData, NoScope]
getCharScope = \scope ->
when List.get scope.buf scope.index is
Ok val ->
Task.ok (T val { scope & index: scope.index + 1 })
get_char_scope! : Scope => Result (U8, Scope) [EndOfData, NoScope]
get_char_scope! = \scope ->
when List.get(scope.buf, scope.index) is
Ok(val) ->
Ok((val, { scope & index: scope.index + 1 }))
Err OutOfBounds ->
Err(OutOfBounds) ->
when scope.data is
Some h ->
bytes = File.chunk! h
when List.first bytes is
Ok val ->
Some(h) ->
bytes = File.chunk!(h)
when List.first(bytes) is
Ok(val) ->
# This starts at 1 because the first character is already being returned.
Task.ok (T val { scope & buf: bytes, index: 1 })
Ok((val, { scope & buf: bytes, index: 1 }))
Err ListWasEmpty ->
Task.err EndOfData
Err(ListWasEmpty) ->
Err(EndOfData)
None ->
Task.err EndOfData
Err(EndOfData)
inWhileScope : Context -> Bool
inWhileScope = \ctx ->
when List.last ctx.scopes is
Ok scope ->
scope.whileInfo != None
in_while_scope : Context -> Bool
in_while_scope = \ctx ->
when List.last(ctx.scopes) is
Ok(scope) ->
scope.while_info != None
Err ListWasEmpty ->
Err(ListWasEmpty) ->
Bool.false

29
crates/cli/tests/test-projects/false-interpreter/Variable.roc
View file

@ -1,34 +1,33 @@
module [Variable, fromUtf8, toIndex, totalCount, toStr]
module [Variable, from_utf8, to_index, total_count, to_str]
# Variables in False can only be single letters. Thus, the valid variables are "a" to "z".
# This opaque type deals with ensure we always have valid variables.
Variable := U8
totalCount : U64
totalCount =
total_count : U64
total_count =
0x7A # "z"
- 0x61 # "a"
+ 1
toStr : Variable -> Str
toStr = \@Variable char ->
when Str.fromUtf8 [char] is
Ok str -> str
to_str : Variable -> Str
to_str = \@Variable(char) ->
when Str.from_utf8([char]) is
Ok(str) -> str
_ -> "_"
fromUtf8 : U8 -> Result Variable [InvalidVariableUtf8]
fromUtf8 = \char ->
from_utf8 : U8 -> Result Variable [InvalidVariableUtf8]
from_utf8 = \char ->
if
char
>= 0x61 # "a"
&& char
<= 0x7A # "z"
then
Ok (@Variable char)
Ok(@Variable(char))
else
Err InvalidVariableUtf8
Err(InvalidVariableUtf8)
toIndex : Variable -> U64
toIndex = \@Variable char ->
Num.intCast (char - 0x61) # "a"
# List.first (Str.toUtf8 "a")
to_index : Variable -> U64
to_index = \@Variable(char) ->
Num.int_cast((char - 0x61)) # "a"

976
crates/cli/tests/test-projects/false-interpreter/main.roc
View file

File diff suppressed because it is too large Load diff

2
crates/cli/tests/test-projects/false-interpreter/platform/Cargo.toml
View file

@ -18,6 +18,6 @@ path = "src/main.rs"
[dependencies]
libc = "0.2"
roc_std = { path = "../../../../roc_std/" }
roc_std = { path = "../../../../../roc_std/" }
[workspace]

46
crates/cli/tests/test-projects/false-interpreter/platform/File.roc
View file

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

19
crates/cli/tests/test-projects/false-interpreter/platform/Host.roc Normal file
View file

@ -0,0 +1,19 @@
hosted Host
exposes [open_file!, close_file!, get_file_line!, get_file_bytes!, put_line!, put_raw!, get_line!, get_char!]
imports []
open_file! : Str => U64
close_file! : U64 => {}
get_file_line! : U64 => Str
get_file_bytes! : U64 => List U8
put_line! : Str => {}
put_raw! : Str => {}
get_line! : {} => Str
get_char! : {} => U8

21
crates/cli/tests/test-projects/false-interpreter/platform/PlatformTasks.roc
View file

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

21
crates/cli/tests/test-projects/false-interpreter/platform/Stdin.roc
View file

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

18
crates/cli/tests/test-projects/false-interpreter/platform/Stdout.roc
View file

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

2
crates/cli/tests/test-projects/false-interpreter/platform/host.c
View file

@ -1,5 +1,3 @@
#include <stdio.h>
extern int rust_main();
int main() {

8
crates/cli/tests/test-projects/false-interpreter/platform/main.roc
View file

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

104
crates/cli/tests/test-projects/false-interpreter/platform/src/lib.rs
View file

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

2
crates/cli/tests/test-projects/fixtures/format/formatted.roc
View file

@ -1,4 +1,4 @@
app [main] { pf: "platform/main.roc" }
main : Str
main = Dep1.value1 {}
main = Dep1.value1({})

2
crates/cli/tests/test-projects/fixtures/format/formatted_directory/Formatted.roc
View file

@ -1,4 +1,4 @@
app [main] { pf: "platform/main.roc" }
main : Str
main = Dep1.value1 {}
main = Dep1.value1({})

4
crates/cli/tests/test-projects/fixtures/format/not-formatted.roc
View file

@ -1,4 +1,4 @@
app [main] { pf: "platform/main.roc" }
app [main] { pf: "platform/main.roc" }
main : Str
main = Dep1.value1 {}
main = Dep1.value1({})

2
crates/cli/tests/test-projects/fixtures/multi-dep-thunk/Dep1.roc
View file

@ -3,4 +3,4 @@ module [value1]
import Dep2
value1 : {} -> Str
value1 = \_ -> Dep2.value2 {}
value1 = \_ -> Dep2.value2({})

2
crates/cli/tests/test-projects/fixtures/multi-dep-thunk/main.roc
View file

@ -3,4 +3,4 @@ app [main] { pf: platform "../../test-platform-simple-zig/main.roc" }
import Dep1
main : Str
main = Dep1.value1 {}
main = Dep1.value1({})

2
crates/cli/tests/test-projects/fixtures/packages/main.roc
View file

@ -7,4 +7,4 @@ app [main] {
import json.JsonParser
import csv.Csv
main = "Hello, World! $(JsonParser.example) $(Csv.example)"
main = "Hello, World! ${JsonParser.example} ${Csv.example}"

2
crates/cli/tests/test-projects/fixtures/transitive-deps/direct-one-and-two.roc
View file

@ -7,4 +7,4 @@ app [main] {
import one.One
import two.Two
main = "$(One.example) | $(Two.example)"
main = "${One.example} | ${Two.example}"

2
crates/cli/tests/test-projects/fixtures/transitive-deps/one/One.roc
View file

@ -2,4 +2,4 @@ module [example]
import two.Two
example = "[One imports Two: $(Two.example)]"
example = "[One imports Two: ${Two.example}]"

2
crates/cli/tests/test-projects/fixtures/transitive-deps/zero/Zero.roc
View file

@ -2,4 +2,4 @@ module [example]
import one.One
example = "[Zero imports One: $(One.example)]"
example = "[Zero imports One: ${One.example}]"

6
crates/cli/tests/test-projects/known_bad/UnusedImport.roc
View file

@ -1,7 +1,7 @@
module [plainText, emText]
module [plain_text, em_text]
import Symbol exposing [Ident]
plainText = \str -> PlainText str
plain_text = \str -> PlainText(str)
emText = \str -> EmText str
em_text = \str -> EmText(str)

Some files were not shown because too many files have changed in this diff Show more