roc-lang/roc
1
1
Fork 0
mirror of https://github.com/roc-lang/roc.git synced 2024-09-20 15:27:45 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #3711 from roc-lang/record-decoding

Browse Source 
Record decoding and their derivers
This commit is contained in:
Richard Feldman 2022-08-15 22:06:34 -04:00 committed by GitHub
commit 0ba5b3cfc6
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
27 changed files with 1542 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
crates/compiler/builtins/roc/Decode.roc
View File

@ -22,6 +22,7 @@ interface Decode
bool,
string,
list,
record,
custom,
decodeWith,
fromBytesPartial,
@ -57,6 +58,7 @@ DecoderFormatting has
bool : Decoder Bool fmt | fmt has DecoderFormatting
string : Decoder Str fmt | fmt has DecoderFormatting
list : Decoder elem fmt -> Decoder (List elem) fmt | fmt has DecoderFormatting
record : state, (state, Str -> [Keep (Decoder state fmt), Skip]), (state -> Result val DecodeError) -> Decoder val fmt | fmt has DecoderFormatting
custom : (List U8, fmt -> DecodeResult val) -> Decoder val fmt | fmt has DecoderFormatting
custom = \decode -> @Decoder decode

77
crates/compiler/builtins/roc/Json.roc
View File

@ -16,6 +16,7 @@ interface Json
Decode,
Decode.{
DecoderFormatting,
DecodeResult,
},
]
@ -57,6 +58,7 @@ Json := {} has [
bool: decodeBool,
string: decodeString,
list: decodeList,
record: decodeRecord,
},
]
@ -316,7 +318,8 @@ decodeBool = Decode.custom \bytes, @Json {} ->
else
{ result: Err TooShort, rest: bytes }
decodeString = Decode.custom \bytes, @Json {} ->
jsonString : List U8 -> DecodeResult Str
jsonString = \bytes ->
{ before, others: afterStartingQuote } = List.split bytes 1
if
@ -335,6 +338,9 @@ decodeString = Decode.custom \bytes, @Json {} ->
else
{ result: Err TooShort, rest: bytes }
decodeString = Decode.custom \bytes, @Json {} ->
jsonString bytes
decodeList = \decodeElem -> Decode.custom \bytes, @Json {} ->
decodeElems = \chunk, accum ->
when Decode.decodeWith chunk decodeElem (@Json {}) is
@ -372,3 +378,72 @@ decodeList = \decodeElem -> Decode.custom \bytes, @Json {} ->
{ result: Err TooShort, rest }
else
{ result: Err TooShort, rest: bytes }
parseExactChar : List U8, U8 -> DecodeResult {}
parseExactChar = \bytes, char ->
when List.get bytes 0 is
Ok c ->
if
c == char
then
{ result: Ok {}, rest: (List.split bytes 1).others }
else
{ result: Err TooShort, rest: bytes }
Err _ -> { result: Err TooShort, rest: bytes }
openBrace : List U8 -> DecodeResult {}
openBrace = \bytes -> parseExactChar bytes (asciiByte '{')
closingBrace : List U8 -> DecodeResult {}
closingBrace = \bytes -> parseExactChar bytes (asciiByte '}')
recordKey : List U8 -> DecodeResult Str
recordKey = \bytes -> jsonString bytes
anything : List U8 -> DecodeResult {}
anything = \bytes -> { result: Err TooShort, rest: bytes }
colon : List U8 -> DecodeResult {}
colon = \bytes -> parseExactChar bytes (asciiByte ':')
comma : List U8 -> DecodeResult {}
comma = \bytes -> parseExactChar bytes (asciiByte ',')
tryDecode : DecodeResult a, ({ val : a, rest : List U8 } -> DecodeResult b) -> DecodeResult b
tryDecode = \{ result, rest }, mapper ->
when result is
Ok val -> mapper { val, rest }
Err e -> { result: Err e, rest }
decodeRecord = \initialState, stepField, finalizer -> Decode.custom \bytes, @Json {} ->
# NB: the stepper function must be passed explicitly until #2894 is resolved.
decodeFields = \stepper, state, kvBytes ->
{ val: key, rest } <- recordKey kvBytes |> tryDecode
{ rest: afterColonBytes } <- colon rest |> tryDecode
{ val: newState, rest: beforeCommaOrBreak } <- tryDecode
(
when stepper state key is
Skip ->
{ rest: beforeCommaOrBreak } <- afterColonBytes |> anything |> tryDecode
{ result: Ok state, rest: beforeCommaOrBreak }
Keep decoder ->
Decode.decodeWith afterColonBytes decoder (@Json {})
)
{ result: commaResult, rest: nextBytes } = comma beforeCommaOrBreak
when commaResult is
Ok {} -> decodeFields stepField newState nextBytes
Err _ -> { result: Ok newState, rest: nextBytes }
{ rest: afterBraceBytes } <- bytes |> openBrace |> tryDecode
{ val: endStateResult, rest: beforeClosingBraceBytes } <- decodeFields stepField initialState afterBraceBytes |> tryDecode
{ rest: afterRecordBytes } <- beforeClosingBraceBytes |> closingBrace |> tryDecode
when finalizer endStateResult is
Ok val -> { result: Ok val, rest: afterRecordBytes }
Err e -> { result: Err e, rest: afterRecordBytes }

2
crates/compiler/can/src/builtins.rs
View File

@ -444,7 +444,7 @@ fn no_region<T>(value: T) -> Loc<T> {
#[inline(always)]
fn tag(name: &'static str, args: Vec<Expr>, var_store: &mut VarStore) -> Expr {
Expr::Tag {
variant_var: var_store.fresh(),
tag_union_var: var_store.fresh(),
ext_var: var_store.fresh(),
name: TagName(name.into()),
arguments: args

20
crates/compiler/can/src/copy.rs
View File

@ -535,12 +535,12 @@ fn deep_copy_expr_help<C: CopyEnv>(env: &mut C, copied: &mut Vec<Variable>, expr
},
Tag {
variant_var,
tag_union_var: variant_var,
ext_var,
name,
arguments,
} => Tag {
variant_var: sub!(*variant_var),
tag_union_var: sub!(*variant_var),
ext_var: sub!(*ext_var),
name: name.clone(),
arguments: arguments
@ -1154,13 +1154,13 @@ mod test {
let var2 = new_var(&mut subs, FlexVar(Some(b)));
let expr = Expr::Tag {
variant_var: var1,
tag_union_var: var1,
ext_var: Variable::EMPTY_TAG_UNION,
name: TagName("F".into()),
arguments: vec![(
var2,
Loc::at_zero(Expr::Tag {
variant_var: var2,
tag_union_var: var2,
ext_var: Variable::EMPTY_TAG_UNION,
name: TagName("G".into()),
arguments: vec![],
@ -1175,7 +1175,7 @@ mod test {
match expr {
Expr::Tag {
variant_var,
tag_union_var: variant_var,
ext_var,
name,
mut arguments,
@ -1209,7 +1209,7 @@ mod test {
match arg.value {
Expr::Tag {
variant_var,
tag_union_var: variant_var,
ext_var,
name,
arguments,
@ -1240,13 +1240,13 @@ mod test {
let var2 = new_var(&mut source, FlexVar(Some(b)));
let expr = Expr::Tag {
variant_var: var1,
tag_union_var: var1,
ext_var: Variable::EMPTY_TAG_UNION,
name: TagName("F".into()),
arguments: vec![(
var2,
Loc::at_zero(Expr::Tag {
variant_var: var2,
tag_union_var: var2,
ext_var: Variable::EMPTY_TAG_UNION,
name: TagName("G".into()),
arguments: vec![],
@ -1261,7 +1261,7 @@ mod test {
match expr {
Expr::Tag {
variant_var,
tag_union_var: variant_var,
ext_var,
name,
mut arguments,
@ -1290,7 +1290,7 @@ mod test {
match arg.value {
Expr::Tag {
variant_var,
tag_union_var: variant_var,
ext_var,
name,
arguments,

10
crates/compiler/can/src/expr.rs
View File

@ -184,7 +184,7 @@ pub enum Expr {
// Sum Types
Tag {
variant_var: Variable,
tag_union_var: Variable,
ext_var: Variable,
name: TagName,
arguments: Vec<(Variable, Loc<Expr>)>,
@ -772,12 +772,12 @@ pub fn canonicalize_expr<'a>(
return (fn_expr, output);
}
Tag {
variant_var,
tag_union_var: variant_var,
ext_var,
name,
..
} => Tag {
variant_var,
tag_union_var: variant_var,
ext_var,
name,
arguments: args,
@ -788,7 +788,7 @@ pub fn canonicalize_expr<'a>(
name,
..
} => Tag {
variant_var,
tag_union_var: variant_var,
ext_var,
name,
arguments: args,
@ -1863,7 +1863,7 @@ pub fn inline_calls(var_store: &mut VarStore, scope: &mut Scope, expr: Expr) ->
}
Tag {
variant_var,
tag_union_var: variant_var,
ext_var,
name,
arguments,

2
crates/compiler/can/src/traverse.rs
View File

@ -244,7 +244,7 @@ pub fn walk_expr<V: Visitor>(visitor: &mut V, expr: &Expr, var: Variable) {
walk_record_fields(visitor, updates.iter());
}
Expr::Tag {
variant_var: _,
tag_union_var: _,
ext_var: _,
name: _,
arguments,

2
crates/compiler/constrain/src/expr.rs
View File

@ -993,7 +993,7 @@ pub fn constrain_expr(
body_con
}
Tag {
variant_var,
tag_union_var: variant_var,
ext_var,
name,
arguments,

4
crates/compiler/derive/Cargo.toml
View File

@ -19,3 +19,7 @@ bumpalo = { version = "3.8.0", features = ["collections"] }
[features]
default = []
debug-derived-symbols = ["roc_module/debug-symbols"]
# Enables open extension variables for constructed records and tag unions.
# This is not necessary for code generation, but may be necessary if you are
# constraining and solving generated derived bodies.
open-extension-vars = []

1033
crates/compiler/derive/src/decoding.rs
View File

File diff suppressed because it is too large Load Diff

23
crates/compiler/derive/src/util.rs
View File

@ -152,4 +152,27 @@ impl Env<'_> {
}
}
}
/// Creates an extension variable for a tag union or record.
///
/// Derivers should always construct tag union and record types such that they are closed.
/// If the `open-extension-vars` feature is turned on, flex extension vars will be
/// returned; otherwise, the appropriate closed extension variable for the type will be
/// returned.
#[inline(always)]
pub fn new_ext_var(&mut self, kind: ExtensionKind) -> Variable {
if cfg!(feature = "open-extension-vars") {
self.subs.fresh_unnamed_flex_var()
} else {
match kind {
ExtensionKind::Record => Variable::EMPTY_RECORD,
ExtensionKind::TagUnion => Variable::EMPTY_TAG_UNION,
}
}
}
}
pub(crate) enum ExtensionKind {
Record,
TagUnion,
}

33
crates/compiler/derive_key/src/decoding.rs
View File

@ -1,7 +1,7 @@
use roc_module::symbol::Symbol;
use roc_module::{ident::Lowercase, symbol::Symbol};
use roc_types::subs::{Content, FlatType, Subs, Variable};
use crate::DeriveError;
use crate::{util::debug_name_record, DeriveError};
#[derive(Hash)]
pub enum FlatDecodable {
@ -12,12 +12,16 @@ pub enum FlatDecodable {
#[derive(Hash, PartialEq, Eq, Debug, Clone)]
pub enum FlatDecodableKey {
List(/* takes one variable */),
// Unfortunate that we must allocate here, c'est la vie
Record(Vec<Lowercase>),
}
impl FlatDecodableKey {
pub(crate) fn debug_name(&self) -> String {
match self {
FlatDecodableKey::List() => "list".to_string(),
FlatDecodableKey::Record(fields) => debug_name_record(fields),
}
}
}
@ -33,8 +37,25 @@ impl FlatDecodable {
Symbol::STR_STR => Ok(Immediate(Symbol::DECODE_STRING)),
_ => Err(Underivable),
},
FlatType::Record(_fields, _ext) => {
Err(Underivable) // yet
FlatType::Record(fields, ext) => {
let fields_iter = match fields.unsorted_iterator(subs, ext) {
Ok(it) => it,
Err(_) => return Err(Underivable),
};
let mut field_names = Vec::with_capacity(fields.len());
for (field_name, record_field) in fields_iter {
if record_field.is_optional() {
// Can't derive a concrete decoder for optional fields, since those are
// compile-time-polymorphic
return Err(Underivable);
}
field_names.push(field_name.clone());
}
field_names.sort();
Ok(Key(FlatDecodableKey::Record(field_names)))
}
FlatType::TagUnion(_tags, _ext) | FlatType::RecursiveTagUnion(_, _tags, _ext) => {
Err(Underivable) // yet
@ -42,9 +63,7 @@ impl FlatDecodable {
FlatType::FunctionOrTagUnion(_name_index, _, _) => {
Err(Underivable) // yet
}
FlatType::EmptyRecord => {
Err(Underivable) // yet
}
FlatType::EmptyRecord => Ok(Key(FlatDecodableKey::Record(vec![]))),
FlatType::EmptyTagUnion => {
Err(Underivable) // yet
}

37
crates/compiler/derive_key/src/encoding.rs
View File

@ -4,7 +4,10 @@ use roc_module::{
};
use roc_types::subs::{Content, FlatType, GetSubsSlice, Subs, Variable};
use crate::DeriveError;
use crate::{
util::{check_empty_ext_var, debug_name_record},
DeriveError,
};
#[derive(Hash)]
pub enum FlatEncodable {
@ -28,17 +31,7 @@ impl FlatEncodableKey {
FlatEncodableKey::List() => "list".to_string(),
FlatEncodableKey::Set() => "set".to_string(),
FlatEncodableKey::Dict() => "dict".to_string(),
FlatEncodableKey::Record(fields) => {
let mut str = String::from('{');
fields.iter().enumerate().for_each(|(i, f)| {
if i > 0 {
str.push(',');
}
str.push_str(f.as_str());
});
str.push('}');
str
}
FlatEncodableKey::Record(fields) => debug_name_record(fields),
FlatEncodableKey::TagUnion(tags) => {
let mut str = String::from('[');
tags.iter().enumerate().for_each(|(i, (tag, arity))| {
@ -56,22 +49,6 @@ impl FlatEncodableKey {
}
}
fn check_ext_var(
subs: &Subs,
ext_var: Variable,
is_empty_ext: impl Fn(&Content) -> bool,
) -> Result<(), DeriveError> {
let ext_content = subs.get_content_without_compacting(ext_var);
if is_empty_ext(ext_content) {
Ok(())
} else {
match ext_content {
Content::FlexVar(_) => Err(DeriveError::UnboundVar),
_ => Err(DeriveError::Underivable),
}
}
}
impl FlatEncodable {
pub(crate) fn from_var(subs: &Subs, var: Variable) -> Result<FlatEncodable, DeriveError> {
use DeriveError::*;
@ -86,7 +63,7 @@ impl FlatEncodable {
_ => Err(Underivable),
},
FlatType::Record(fields, ext) => {
check_ext_var(subs, ext, |ext| {
check_empty_ext_var(subs, ext, |ext| {
matches!(ext, Content::Structure(FlatType::EmptyRecord))
})?;
@ -106,7 +83,7 @@ impl FlatEncodable {
// [ A t1, B t1 t2 ] as R
// look the same on the surface, because `R` is only somewhere inside of the
// `t`-prefixed payload types.
check_ext_var(subs, ext, |ext| {
check_empty_ext_var(subs, ext, |ext| {
matches!(ext, Content::Structure(FlatType::EmptyTagUnion))
})?;

1
crates/compiler/derive_key/src/lib.rs
View File

@ -15,6 +15,7 @@
pub mod decoding;
pub mod encoding;
mod util;
use decoding::{FlatDecodable, FlatDecodableKey};
use encoding::{FlatEncodable, FlatEncodableKey};

32
crates/compiler/derive_key/src/util.rs Normal file
View File

@ -0,0 +1,32 @@
use roc_module::ident::Lowercase;
use roc_types::subs::{Content, Subs, Variable};
use crate::DeriveError;
pub(crate) fn check_empty_ext_var(
subs: &Subs,
ext_var: Variable,
is_empty_ext: impl Fn(&Content) -> bool,
) -> Result<(), DeriveError> {
let ext_content = subs.get_content_without_compacting(ext_var);
if is_empty_ext(ext_content) {
Ok(())
} else {
match ext_content {
Content::FlexVar(_) => Err(DeriveError::UnboundVar),
_ => Err(DeriveError::Underivable),
}
}
}
pub(crate) fn debug_name_record(fields: &[Lowercase]) -> String {
let mut str = String::from('{');
fields.iter().enumerate().for_each(|(i, f)| {
if i > 0 {
str.push(',');
}
str.push_str(f.as_str());
});
str.push('}');
str
}

24
crates/compiler/ident/src/lib.rs
View File

@ -203,6 +203,30 @@ impl From<&str> for IdentStr {
}
}
impl From<IdentStr> for String {
fn from(ident_str: IdentStr) -> Self {
if ident_str.is_small_str() {
// Copy it to a heap allocation
ident_str.as_str().to_string()
} else {
// Reuse the existing heap allocation
let string = unsafe {
String::from_raw_parts(
ident_str.as_ptr() as *mut u8,
ident_str.len(),
ident_str.len(),
)
};
// Make sure not to drop the IdentStr, since now there's
// a String referencing its heap-allocated contents.
std::mem::forget(ident_str);
string
}
}
}
impl From<String> for IdentStr {
fn from(string: String) -> Self {
if string.len() <= Self::SMALL_STR_BYTES {

20
crates/compiler/module/src/ident.rs
View File

@ -65,6 +65,12 @@ impl TagName {
}
}
impl From<&str> for TagName {
fn from(string: &str) -> Self {
Self(string.into())
}
}
impl ModuleName {
// NOTE: After adding one of these, go to `impl ModuleId` and
// add a corresponding ModuleId to there!
@ -187,6 +193,20 @@ impl Lowercase {
}
}
impl From<Lowercase> for String {
fn from(lowercase: Lowercase) -> Self {
lowercase.0.into()
}
}
impl From<Lowercase> for Box<str> {
fn from(lowercase: Lowercase) -> Self {
let string: String = lowercase.0.into();
string.into()
}
}
impl<'a> From<&'a str> for Lowercase {
fn from(string: &'a str) -> Self {
Self(string.into())

9
crates/compiler/module/src/symbol.rs
View File

@ -1417,10 +1417,11 @@ define_builtins! {
19 DECODE_BOOL: "bool"
20 DECODE_STRING: "string"
21 DECODE_LIST: "list"
22 DECODE_CUSTOM: "custom"
23 DECODE_DECODE_WITH: "decodeWith"
24 DECODE_FROM_BYTES_PARTIAL: "fromBytesPartial"
25 DECODE_FROM_BYTES: "fromBytes"
22 DECODE_RECORD: "record"
23 DECODE_CUSTOM: "custom"
24 DECODE_DECODE_WITH: "decodeWith"
25 DECODE_FROM_BYTES_PARTIAL: "fromBytesPartial"
26 DECODE_FROM_BYTES: "fromBytes"
}
13 JSON: "Json" => {
0 JSON_JSON: "Json"

4
crates/compiler/mono/src/ir.rs
View File

@ -3857,7 +3857,7 @@ pub fn with_hole<'a>(
)
}
Tag {
variant_var,
tag_union_var: variant_var,
name: tag_name,
arguments: args,
..
@ -5679,7 +5679,7 @@ fn tag_union_to_function<'a>(
}
let loc_body = Loc::at_zero(roc_can::expr::Expr::Tag {
variant_var: return_variable,
tag_union_var: return_variable,
name: tag_name,
arguments: loc_expr_args,
ext_var,

10
crates/compiler/solve/src/ability.rs
View File

@ -584,7 +584,15 @@ trait DerivableVisitor {
let descend = Self::visit_record(var)?;
if descend.0 {
push_var_slice!(fields.variables());
stack.push(ext);
if !matches!(
subs.get_content_without_compacting(ext),
Content::FlexVar(_) | Content::RigidVar(_)
) {
// TODO: currently, just we suppose the presence of a flex var may
// include more or less things which we can derive. But, we should
// instead recurse here, and add a `t ~ u | u has Decode` constraint as needed.
stack.push(ext);
}
}
}
TagUnion(tags, ext) => {

2
crates/compiler/test_derive/Cargo.toml
View File

@ -16,7 +16,7 @@ roc_builtins = { path = "../builtins" }
roc_load_internal = { path = "../load_internal" }
roc_can = { path = "../can" }
roc_derive_key = { path = "../derive_key" }
roc_derive = { path = "../derive", features = ["debug-derived-symbols"] }
roc_derive = { path = "../derive", features = ["debug-derived-symbols", "open-extension-vars"] }
roc_target = { path = "../roc_target" }
roc_types = { path = "../types" }
roc_reporting = { path = "../../reporting" }

101
crates/compiler/test_derive/src/decoding.rs
View File

@ -5,14 +5,48 @@
#![allow(non_snake_case)]
use crate::{
util::{check_immediate, derive_test},
test_key_eq, test_key_neq,
util::{check_immediate, check_underivable, derive_test},
v,
};
use insta::assert_snapshot;
use roc_module::symbol::Symbol;
use roc_types::subs::Variable;
use roc_derive_key::DeriveBuiltin::Decoder;
use roc_derive_key::{DeriveBuiltin::Decoder, DeriveError};
test_key_eq! {
Decoder,
same_record:
v!({ a: v!(U8), }), v!({ a: v!(U8), })
same_record_fields_diff_types:
v!({ a: v!(U8), }), v!({ a: v!(STR), })
same_record_fields_any_order:
v!({ a: v!(U8), b: v!(U8), c: v!(U8), }),
v!({ c: v!(U8), a: v!(U8), b: v!(U8), })
explicit_empty_record_and_implicit_empty_record:
v!(EMPTY_RECORD), v!({})
list_list_diff_types:
v!(Symbol::LIST_LIST v!(STR)), v!(Symbol::LIST_LIST v!(U8))
str_str:
v!(Symbol::STR_STR), v!(Symbol::STR_STR)
}
test_key_neq! {
Decoder,
different_record_fields:
v!({ a: v!(U8), }), v!({ b: v!(U8), })
record_empty_vs_nonempty:
v!(EMPTY_RECORD), v!({ a: v!(U8), })
}
#[test]
fn optional_record_field_derive_error() {
check_underivable(Decoder, v!({ ?a: v!(U8), }), DeriveError::Underivable);
}
#[test]
fn immediates() {
@ -49,3 +83,66 @@ fn list() {
)
})
}
#[test]
fn record_2_fields() {
derive_test(Decoder, v!({first: v!(STR), second: v!(STR),}), |golden| {
assert_snapshot!(golden, @r###"
# derived for { first : Str, second : Str }
# Decoder { first : val, second : val1 } fmt | fmt has DecoderFormatting, val has Decoding, val1 has Decoding
# List U8, fmt -[[custom(22)]]-> { rest : List U8, result : [Err [TooShort], Ok { first : val, second : val1 }] } | fmt has DecoderFormatting, val has Decoding, val1 has Decoding
# Specialization lambda sets:
# @<1>: [[custom(22)]]
#Derived.decoder_{first,second} =
Decode.custom
\#Derived.bytes3, #Derived.fmt3 ->
Decode.decodeWith
#Derived.bytes3
(Decode.record
{ second: Err NoField, first: Err NoField }
\#Derived.stateRecord2, #Derived.field ->
when #Derived.field is
"first" ->
Keep (Decode.custom
\#Derived.bytes, #Derived.fmt ->
when Decode.decodeWith
#Derived.bytes
Decode.decoder
#Derived.fmt is
#Derived.rec ->
{
result: when #Derived.rec.result is
Ok #Derived.val ->
Ok { stateRecord2 & first: Ok #Derived.val }
Err #Derived.err -> Err #Derived.err,
rest: #Derived.rec.rest
})
"second" ->
Keep (Decode.custom
\#Derived.bytes2, #Derived.fmt2 ->
when Decode.decodeWith
#Derived.bytes2
Decode.decoder
#Derived.fmt2 is
#Derived.rec2 ->
{
result: when #Derived.rec2.result is
Ok #Derived.val2 ->
Ok { stateRecord2 & second: Ok #Derived.val2 }
Err #Derived.err2 -> Err #Derived.err2,
rest: #Derived.rec2.rest
})
_ -> Skip
\#Derived.stateRecord ->
when #Derived.stateRecord.first is
Ok #Derived.first ->
when #Derived.stateRecord.second is
Ok #Derived.second ->
Ok { second: #Derived.second, first: #Derived.first }
_ -> Err TooShort
_ -> Err TooShort)
#Derived.fmt3
"###
)
})
}

15
crates/compiler/test_derive/src/encoding.rs
View File

@ -7,7 +7,7 @@
use insta::assert_snapshot;
use crate::{
test_hash_eq, test_hash_neq,
test_key_eq, test_key_neq,
util::{check_immediate, derive_test},
v,
};
@ -17,7 +17,7 @@ use roc_types::subs::Variable;
// {{{ hash tests
test_hash_eq! {
test_key_eq! {
ToEncoder,
same_record:
@ -70,7 +70,7 @@ test_hash_eq! {
v!(@Symbol::BOOL_BOOL => v!([ True, False ])), v!(Symbol::UNDERSCORE => v!([False, True]))
}
test_hash_neq! {
test_key_neq! {
ToEncoder,
different_record_fields:
@ -174,10 +174,7 @@ fn one_field_record() {
\#Derived.bytes, #Derived.fmt ->
Encode.appendWith
#Derived.bytes
(Encode.record
[
{ value: Encode.toEncoder #Derived.rcd.a, key: "a", },
])
(Encode.record [{ value: Encode.toEncoder #Derived.rcd.a, key: "a" }])
#Derived.fmt
"###
)
@ -202,8 +199,8 @@ fn two_field_record() {
#Derived.bytes
(Encode.record
[
{ value: Encode.toEncoder #Derived.rcd.a, key: "a", },
{ value: Encode.toEncoder #Derived.rcd.b, key: "b", },
{ value: Encode.toEncoder #Derived.rcd.a, key: "a" },
{ value: Encode.toEncoder #Derived.rcd.b, key: "b" },
])
#Derived.fmt
"###

84
crates/compiler/test_derive/src/pretty_print.rs
View File

@ -19,7 +19,10 @@ pub fn pretty_print_def(c: &Ctx, d: &Def) -> String {
macro_rules! maybe_paren {
($paren_if_above:expr, $my_prec:expr, $doc:expr) => {
if $my_prec > $paren_if_above {
maybe_paren!($paren_if_above, $my_prec, || true, $doc)
};
($paren_if_above:expr, $my_prec:expr, $extra_cond:expr, $doc:expr) => {
if $my_prec > $paren_if_above && $extra_cond() {
$doc.parens().group()
} else {
$doc
@ -47,7 +50,7 @@ fn def<'a>(c: &Ctx, f: &'a Arena<'a>, d: &'a Def) -> DocBuilder<'a, Arena<'a>> {
#[derive(PartialEq, PartialOrd)]
enum EPrec {
Free,
CallArg,
AppArg,
}
fn expr<'a>(c: &Ctx, p: EPrec, f: &'a Arena<'a>, e: &'a Expr) -> DocBuilder<'a, Arena<'a>> {
@ -137,11 +140,11 @@ fn expr<'a>(c: &Ctx, p: EPrec, f: &'a Arena<'a>, e: &'a Expr) -> DocBuilder<'a,
maybe_paren!(
Free,
p,
expr(c, CallArg, f, &fun.value)
expr(c, AppArg, f, &fun.value)
.append(
f.concat(args.iter().map(|le| f.line().append(expr(
c,
CallArg,
AppArg,
f,
&le.1.value
))))
@ -175,15 +178,18 @@ fn expr<'a>(c: &Ctx, p: EPrec, f: &'a Arena<'a>, e: &'a Expr) -> DocBuilder<'a,
Record { fields, .. } => f
.reflow("{")
.append(
f.concat(fields.iter().map(|(name, field)| {
let field = f
.text(name.as_str())
.append(f.reflow(": "))
.append(expr(c, Free, f, &field.loc_expr.value))
.nest(2)
.group();
f.line().append(field).append(",")
}))
f.intersperse(
fields.iter().map(|(name, field)| {
let field = f
.text(name.as_str())
.append(f.reflow(": "))
.append(expr(c, Free, f, &field.loc_expr.value))
.nest(2)
.group();
f.line().append(field)
}),
f.reflow(","),
)
.nest(2)
.group(),
)
@ -193,15 +199,61 @@ fn expr<'a>(c: &Ctx, p: EPrec, f: &'a Arena<'a>, e: &'a Expr) -> DocBuilder<'a,
EmptyRecord => f.text("{}"),
Access {
loc_expr, field, ..
} => expr(c, CallArg, f, &loc_expr.value)
} => expr(c, AppArg, f, &loc_expr.value)
.append(f.text(format!(".{}", field.as_str())))
.group(),
OpaqueWrapFunction(OpaqueWrapFunctionData { opaque_name, .. }) => {
f.text(format!("@{}", opaque_name.as_str(c.interns)))
}
Accessor(_) => todo!(),
Update { .. } => todo!(),
Tag { .. } => todo!(),
Update {
symbol, updates, ..
} => f
.reflow("{")
.append(f.line())
.append(f.text(symbol.as_str(c.interns).to_string()))
.append(f.reflow(" &"))
.append(
f.intersperse(
updates.iter().map(|(name, field)| {
let field = f
.text(name.as_str())
.append(f.reflow(": "))
.append(expr(c, Free, f, &field.loc_expr.value))
.nest(2)
.group();
f.line().append(field)
}),
f.reflow(","),
)
.nest(2)
.group(),
)
.append(f.line())
.append(f.text("}"))
.group(),
Tag {
name, arguments, ..
} => maybe_paren!(
Free,
p,
|| !arguments.is_empty(),
f.text(name.0.as_str())
.append(if arguments.is_empty() {
f.nil()
} else {
f.space()
})
.append(
f.intersperse(
arguments
.iter()
.map(|(_, le)| expr(c, AppArg, f, &le.value)),
f.space(),
)
)
.group()
),
ZeroArgumentTag { .. } => todo!(),
OpaqueRef { .. } => todo!(),
Expect { .. } => todo!(),

28
crates/compiler/test_derive/src/util.rs
View File

@ -18,7 +18,7 @@ use roc_collections::VecSet;
use roc_constrain::expr::constrain_decls;
use roc_debug_flags::dbg_do;
use roc_derive::DerivedModule;
use roc_derive_key::{DeriveBuiltin, DeriveKey, Derived};
use roc_derive_key::{DeriveBuiltin, DeriveError, DeriveKey, Derived};
use roc_load_internal::file::{add_imports, default_aliases, LoadedModule, Threading};
use roc_module::symbol::{IdentIds, Interns, ModuleId, Symbol};
use roc_region::all::LineInfo;
@ -53,7 +53,7 @@ fn module_source_and_path(builtin: DeriveBuiltin) -> (ModuleId, &'static str, Pa
}
}
/// DSL for creating [`Content`][crate::subs::Content].
/// DSL for creating [`Content`][roc_types::subs::Content].
#[macro_export]
macro_rules! v {
({ $($field:ident: $make_v:expr,)* $(?$opt_field:ident : $make_opt_v:expr,)* }) => {{
@ -65,7 +65,7 @@ macro_rules! v {
$(let $opt_field = $make_opt_v(subs);)*
let fields = vec![
$( (stringify!($field).into(), RecordField::Required($field)) ,)*
$( (stringify!($opt_field).into(), RecordField::Required($opt_field)) ,)*
$( (stringify!($opt_field).into(), RecordField::Optional($opt_field)) ,)*
];
let fields = RecordFields::insert_into_subs(subs, fields);
roc_derive::synth_var(subs, Content::Structure(FlatType::Record(fields, Variable::EMPTY_RECORD)))
@ -178,7 +178,7 @@ where
}
#[macro_export]
macro_rules! test_hash_eq {
macro_rules! test_key_eq {
($builtin:expr, $($name:ident: $synth1:expr, $synth2:expr)*) => {$(
#[test]
fn $name() {
@ -188,7 +188,7 @@ macro_rules! test_hash_eq {
}
#[macro_export]
macro_rules! test_hash_neq {
macro_rules! test_key_neq {
($builtin:expr, $($name:ident: $synth1:expr, $synth2:expr)*) => {$(
#[test]
fn $name() {
@ -197,6 +197,18 @@ macro_rules! test_hash_neq {
)*};
}
pub(crate) fn check_underivable<Sy>(builtin: DeriveBuiltin, synth: Sy, err: DeriveError)
where
Sy: FnOnce(&mut Subs) -> Variable,
{
let mut subs = Subs::new();
let var = synth(&mut subs);
let key = Derived::builtin(builtin, &subs, var);
assert_eq!(key, Err(err));
}
pub(crate) fn check_immediate<S>(builtin: DeriveBuiltin, synth: S, immediate: Symbol)
where
S: FnOnce(&mut Subs) -> Variable,
@ -324,7 +336,7 @@ fn check_derived_typechecks_and_golden(
// run the solver, print and fail if we have errors
dbg_do!(
roc_debug_flags::ROC_PRINT_UNIFICATIONS_DERIVED,
std::env::set_var(roc_debug_flags::ROC_PRINT_UNIFICATIONS_DERIVED, "1")
std::env::set_var(roc_debug_flags::ROC_PRINT_UNIFICATIONS, "1")
);
let (mut solved_subs, _, problems, _) = roc_solve::module::run_solve(
test_module,
@ -338,6 +350,10 @@ fn check_derived_typechecks_and_golden(
&exposed_for_module.exposed_by_module,
Default::default(),
);
dbg_do!(
roc_debug_flags::ROC_PRINT_UNIFICATIONS_DERIVED,
std::env::set_var(roc_debug_flags::ROC_PRINT_UNIFICATIONS, "0")
);
let subs = solved_subs.inner_mut();
if !problems.is_empty() {

58
crates/compiler/test_gen/src/gen_abilities.rs
View File

@ -952,3 +952,61 @@ fn encode_then_decode_list_of_lists_of_strings() {
RocStr
)
}
#[test]
#[cfg(any(feature = "gen-llvm", feature = "gen-wasm"))]
fn decode_record_two_fields() {
assert_evals_to!(
indoc!(
r#"
app "test" imports [Encode, Decode, Json] provides [main] to "./platform"
main =
when Str.toUtf8 "{\"first\":\"ab\",\"second\":\"cd\"}" |> Decode.fromBytes Json.fromUtf8 is
Ok {first: "ab", second: "cd"} -> "abcd"
_ -> "something went wrong"
"#
),
RocStr::from("abcd"),
RocStr
)
}
#[test]
#[cfg(any(feature = "gen-llvm", feature = "gen-wasm"))]
fn decode_record_two_fields_string_and_int() {
assert_evals_to!(
indoc!(
r#"
app "test" imports [Encode, Decode, Json] provides [main] to "./platform"
main =
when Str.toUtf8 "{\"first\":\"ab\",\"second\":10}" |> Decode.fromBytes Json.fromUtf8 is
Ok {first: "ab", second: 10u8} -> "ab10"
_ -> "something went wrong"
"#
),
RocStr::from("ab10"),
RocStr
)
}
#[test]
#[cfg(any(feature = "gen-llvm", feature = "gen-wasm"))]
#[ignore = "json parsing impl must be fixed first"]
fn decode_empty_record() {
assert_evals_to!(
indoc!(
r#"
app "test" imports [Encode, Decode, Json] provides [main] to "./platform"
main =
when Str.toUtf8 "{}" |> Decode.fromBytes Json.fromUtf8 is
Ok {} -> "empty"
_ -> "something went wrong"
"#
),
RocStr::from("empty"),
RocStr
)
}

24
crates/compiler/types/src/subs.rs
View File

@ -2261,13 +2261,13 @@ pub struct LambdaSet {
///
/// ```text
/// XEffect : A -> B
///
///
/// after : ({} -> XEffect) -> XEffect
/// after =
/// \cont ->
/// f = \A -[`f (typeof cont)]-> when cont {} is A -> B
/// f
///
///
/// nestForever : {} -> XEffect
/// nestForever = \{} -[`nestForever]-> after nestForever
/// ^^^^^^^^^^^ {} -[`nestForever]-> A -[`f ({} -[`nestForever]-> A -[`f ...]-> B)]-> B
@ -2485,6 +2485,26 @@ pub trait Label: Sized + Clone {
pub type UnionTags = UnionLabels<TagName>;
pub type UnionLambdas = UnionLabels<Symbol>;
impl UnionTags {
pub fn for_result(subs: &mut Subs, ok_payload: Variable, err_payload: Variable) -> Self {
let ok_tuple = {
let variables_slice =
VariableSubsSlice::insert_into_subs(subs, std::iter::once(ok_payload));
("Ok".into(), variables_slice)
};
let err_tuple = {
let variables_slice =
VariableSubsSlice::insert_into_subs(subs, std::iter::once(err_payload));
("Err".into(), variables_slice)
};
UnionTags::insert_slices_into_subs(subs, [err_tuple, ok_tuple])
}
}
impl Label for TagName {
fn index_subs(subs: &Subs, idx: SubsIndex<Self>) -> &Self {
&subs[idx]

4
crates/compiler/types/src/types.rs
View File

@ -102,6 +102,10 @@ impl<T> RecordField<T> {
RigidOptional(t) => RigidOptional(f(t)),
}
}
pub fn is_optional(&self) -> bool {
matches!(self, RecordField::Optional(..))
}
}
impl RecordField<Type> {