From e51b89d717a1f1aaba7e59c79c9fb4b8e7031bab Mon Sep 17 00:00:00 2001 From: Fintan Halpenny Date: Sat, 27 Jul 2019 15:09:31 +0100 Subject: Add case for RightBasedRecordMerge in the typechecking phase. The implementation checks the types and kinds of the LHS and RHS. In the happy path it unions the HashMap prefering keys on the RHS over the LHS, and the result is the type of the resulting HashMap. The error cases are: - If the kinds of the records differ it results in a RecordMismatch error. - If either the LHS or RHS are not records it results in a MustCombineRecord error. --- dhall/src/phase/typecheck.rs | 51 +++++++++++++++++++++++++++++++++++++++----- 1 file changed, 46 insertions(+), 5 deletions(-) (limited to 'dhall/src/phase') diff --git a/dhall/src/phase/typecheck.rs b/dhall/src/phase/typecheck.rs index 419b2e2..2315edb 100644 --- a/dhall/src/phase/typecheck.rs +++ b/dhall/src/phase/typecheck.rs @@ -598,6 +598,47 @@ fn type_last_layer( } Ok(RetTypeOnly(text_type)) } + BinOp(RightBiasedRecordMerge, l, r) => { + let l_type = l.get_type()?; + let l_kind = l_type.get_type()?; + let r_type = r.get_type()?; + let r_kind = r_type.get_type()?; + + // Check the equality of kinds. + // This is to disallow expression such as: + // "{ x = Text } // { y = 1 }" + ensure_equal!( + l_kind, + r_kind, + mkerr(RecordMismatch(l.clone(), r.clone())), + ); + + // Extract the LHS record type + let mut kts_x = match l_type.to_value() { + Value::RecordType(kts) => kts, + _ => return Err(mkerr(MustCombineRecord(l.clone()))), + }; + + // Extract the RHS record type + let kts_y = match r_type.to_value() { + Value::RecordType(kts) => kts, + _ => return Err(mkerr(MustCombineRecord(r.clone()))), + }; + + // Union the two records, prefering + // the values found in the RHS. + for (label, value) in kts_y { + kts_x.insert(label, value); + } + + // Construct the final record type from the union + Ok(RetTypeOnly(tck_record_type( + ctx, + kts_x.iter() + .map(|(x, v)| Ok((x.clone(), v.to_type()))), + )? + .into_type())) + } BinOp(o @ ListAppend, l, r) => { match l.get_type()?.to_value() { Value::AppliedBuiltin(List, _) => {} @@ -1135,11 +1176,11 @@ mod spec_tests { // ti_success!(ti_success_unit_RecursiveRecordTypeMergeTwo, "unit/RecursiveRecordTypeMergeTwo"); // ti_success!(ti_success_unit_RecursiveRecordTypeMergeTwoKinds, "unit/RecursiveRecordTypeMergeTwoKinds"); // ti_success!(ti_success_unit_RecursiveRecordTypeMergeTwoTypes, "unit/RecursiveRecordTypeMergeTwoTypes"); - // ti_success!(ti_success_unit_RightBiasedRecordMergeRhsEmpty, "unit/RightBiasedRecordMergeRhsEmpty"); - // ti_success!(ti_success_unit_RightBiasedRecordMergeTwo, "unit/RightBiasedRecordMergeTwo"); - // ti_success!(ti_success_unit_RightBiasedRecordMergeTwoDifferent, "unit/RightBiasedRecordMergeTwoDifferent"); - // ti_success!(ti_success_unit_RightBiasedRecordMergeTwoKinds, "unit/RightBiasedRecordMergeTwoKinds"); - // ti_success!(ti_success_unit_RightBiasedRecordMergeTwoTypes, "unit/RightBiasedRecordMergeTwoTypes"); + ti_success!(ti_success_unit_RightBiasedRecordMergeRhsEmpty, "unit/RightBiasedRecordMergeRhsEmpty"); + ti_success!(ti_success_unit_RightBiasedRecordMergeTwo, "unit/RightBiasedRecordMergeTwo"); + ti_success!(ti_success_unit_RightBiasedRecordMergeTwoDifferent, "unit/RightBiasedRecordMergeTwoDifferent"); + ti_success!(ti_success_unit_RightBiasedRecordMergeTwoKinds, "unit/RightBiasedRecordMergeTwoKinds"); + ti_success!(ti_success_unit_RightBiasedRecordMergeTwoTypes, "unit/RightBiasedRecordMergeTwoTypes"); ti_success!(ti_success_unit_SomeTrue, "unit/SomeTrue"); ti_success!(ti_success_unit_Text, "unit/Text"); ti_success!(ti_success_unit_TextLiteral, "unit/TextLiteral"); -- cgit v1.2.3 From f806ad6bf0fad5a720c9b87310d86838612f3b7a Mon Sep 17 00:00:00 2001 From: FintanH Date: Wed, 31 Jul 2019 12:15:12 +0100 Subject: Reuse the merge_maps function to implement the right-biased union --- dhall/src/phase/normalize.rs | 2 +- dhall/src/phase/typecheck.rs | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) (limited to 'dhall/src/phase') diff --git a/dhall/src/phase/normalize.rs b/dhall/src/phase/normalize.rs index be2ba51..da19dc1 100644 --- a/dhall/src/phase/normalize.rs +++ b/dhall/src/phase/normalize.rs @@ -372,7 +372,7 @@ enum Ret<'a> { Expr(ExprF), } -fn merge_maps( +pub(crate) fn merge_maps( map1: &HashMap, map2: &HashMap, mut f: impl FnMut(&V, &V) -> V, diff --git a/dhall/src/phase/typecheck.rs b/dhall/src/phase/typecheck.rs index 2315edb..9107e36 100644 --- a/dhall/src/phase/typecheck.rs +++ b/dhall/src/phase/typecheck.rs @@ -599,6 +599,8 @@ fn type_last_layer( Ok(RetTypeOnly(text_type)) } BinOp(RightBiasedRecordMerge, l, r) => { + use crate::phase::normalize::merge_maps; + let l_type = l.get_type()?; let l_kind = l_type.get_type()?; let r_type = r.get_type()?; @@ -614,7 +616,7 @@ fn type_last_layer( ); // Extract the LHS record type - let mut kts_x = match l_type.to_value() { + let kts_x = match l_type.to_value() { Value::RecordType(kts) => kts, _ => return Err(mkerr(MustCombineRecord(l.clone()))), }; @@ -627,15 +629,13 @@ fn type_last_layer( // Union the two records, prefering // the values found in the RHS. - for (label, value) in kts_y { - kts_x.insert(label, value); - } + let kts = merge_maps(&kts_x, &kts_y, |_, r_t| r_t.clone()); // Construct the final record type from the union Ok(RetTypeOnly(tck_record_type( ctx, - kts_x.iter() - .map(|(x, v)| Ok((x.clone(), v.to_type()))), + kts.iter() + .map(|(x, v)| Ok((x.clone(), v.to_type()))), )? .into_type())) } -- cgit v1.2.3 From dceabb85e407b8e0e52105a725f3bb782fa474de Mon Sep 17 00:00:00 2001 From: FintanH Date: Wed, 31 Jul 2019 14:06:11 +0100 Subject: Add unreachable call for RightBasedRecordMerge case --- dhall/src/phase/typecheck.rs | 1 + 1 file changed, 1 insertion(+) (limited to 'dhall/src/phase') diff --git a/dhall/src/phase/typecheck.rs b/dhall/src/phase/typecheck.rs index 9107e36..ecd0a69 100644 --- a/dhall/src/phase/typecheck.rs +++ b/dhall/src/phase/typecheck.rs @@ -663,6 +663,7 @@ fn type_last_layer( NaturalTimes => Natural, TextAppend => Text, ListAppend => unreachable!(), + RightBiasedRecordMerge => unreachable!(), _ => return Err(mkerr(Unimplemented)), })?; -- cgit v1.2.3