Display counterexamples as Aiken values instead of raw UPLC.

Cargo.lock

@@ -88,6 +88,7 @@ dependencies = [
  "num-bigint",
  "ordinal",
  "owo-colors",
+ "pallas",
  "petgraph",
  "pretty_assertions",
  "strum",

crates/aiken-lang/Cargo.toml

@@ -21,6 +21,7 @@ itertools = "0.10.5"
 miette = "5.9.0"
 ordinal = "0.3.2"
 owo-colors = { version = "3.5.0", features = ["supports-colors"] }
+pallas.workspace = true
 strum = "0.24.1"
 thiserror = "1.0.39"
 vec1 = "1.10.1"

crates/aiken-lang/src/ast.rs

@@ -242,6 +242,18 @@ pub struct TypeAlias<T> {
     pub tipo: T,
 }
 
+#[derive(Clone, Debug, Eq, PartialEq, Hash)]
+pub struct DataTypeKey {
+    pub module_name: String,
+    pub defined_type: String,
+}
+
+#[derive(Clone, Debug, Eq, PartialEq, Hash, Ord, PartialOrd)]
+pub struct FunctionAccessKey {
+    pub module_name: String,
+    pub function_name: String,
+}
+
 pub type TypedDataType = DataType<Rc<Type>>;
 
 impl TypedDataType {

crates/aiken-lang/src/builtins.rs

@@ -1,7 +1,9 @@
 use crate::{
-    ast::{Arg, ArgName, CallArg, Function, ModuleKind, Span, TypedDataType, TypedFunction, UnOp},
+    ast::{
+        Arg, ArgName, CallArg, DataTypeKey, Function, FunctionAccessKey, ModuleKind, Span,
+        TypedDataType, TypedFunction, UnOp,
+    },
     expr::TypedExpr,
-    gen_uplc::builder::{DataTypeKey, FunctionAccessKey},
     tipo::{
         fields::FieldMap, Type, TypeConstructor, TypeInfo, TypeVar, ValueConstructor,
         ValueConstructorVariant,

crates/aiken-lang/src/expr.rs

@@ -1,7 +1,10 @@
-use std::rc::Rc;
+use std::{collections::HashMap, rc::Rc};
 
 use vec1::Vec1;
 
+use pallas::ledger::primitives::alonzo::{Constr, PlutusData};
+use uplc::machine::value::from_pallas_bigint;
+
 use crate::{
     ast::{
         self, Annotation, Arg, AssignmentKind, BinOp, ByteArrayFormatPreference, CallArg, Curve,
@@ -11,7 +14,7 @@ use crate::{
     },
     builtins::void,
     parser::token::Base,
-    tipo::{ModuleValueConstructor, PatternConstructor, Type, ValueConstructor},
+    tipo::{ModuleValueConstructor, PatternConstructor, Type, TypeInfo, TypeVar, ValueConstructor},
 };
 
 #[derive(Debug, Clone, PartialEq)]
@@ -573,6 +576,150 @@ pub const DEFAULT_TODO_STR: &str = "aiken::todo";
 pub const DEFAULT_ERROR_STR: &str = "aiken::error";
 
 impl UntypedExpr {
+    // Reify some opaque 'PlutusData' into an 'UntypedExpr', using a Type annotation. We also need
+    // an extra map to lookup record & enum constructor's names as they're completely erased when
+    // in their PlutusData form, and the Type annotation only contains type name.
+    //
+    // The function performs some sanity check to ensure that the type does indeed somewhat
+    // correspond to the data being given.
+    pub fn reify(
+        data_types: &HashMap<String, TypeInfo>,
+        data: PlutusData,
+        tipo: &Type,
+    ) -> Result<Self, String> {
+        if let Type::Var { tipo } = tipo {
+            if let TypeVar::Link { tipo } = &*tipo.borrow() {
+                return UntypedExpr::reify(data_types, data, tipo);
+            }
+        }
+
+        match data {
+            PlutusData::BigInt(ref i) => Ok(UntypedExpr::UInt {
+                location: Span::empty(),
+                base: Base::Decimal {
+                    numeric_underscore: false,
+                },
+                value: from_pallas_bigint(i).to_string(),
+            }),
+            PlutusData::BoundedBytes(bytes) => Ok(UntypedExpr::ByteArray {
+                location: Span::empty(),
+                bytes: bytes.into(),
+                preferred_format: ByteArrayFormatPreference::HexadecimalString,
+            }),
+            PlutusData::Array(args) => {
+                let inner;
+                match tipo {
+                    Type::App {
+                        module, name, args, ..
+                    } if module.is_empty() && name.as_str() == "List" => {
+                        if let [arg] = &args[..] {
+                            inner = arg.clone()
+                        } else {
+                            return Err("invalid List type annotation: the list has multiple type-parameters.".to_string());
+                        };
+                    }
+                    _ => {
+                        return Err(format!(
+                            "invalid type annotation. expected List but got: {tipo:?}"
+                        ))
+                    }
+                }
+
+                Ok(UntypedExpr::List {
+                    location: Span::empty(),
+                    elements: args
+                        .into_iter()
+                        .map(|arg| UntypedExpr::reify(data_types, arg, &inner))
+                        .collect::<Result<Vec<_>, _>>()?,
+                    tail: None,
+                })
+            }
+
+            PlutusData::Constr(Constr {
+                tag,
+                any_constructor,
+                fields,
+            }) => {
+                let ix = if tag == 102 {
+                    any_constructor.unwrap() as usize
+                } else if tag < 128 {
+                    tag as usize - 121
+                } else {
+                    tag as usize - 1280 + 7
+                };
+
+                if let Type::App { module, name, .. } = tipo {
+                    let module = if module.is_empty() { "aiken" } else { module };
+                    if let Some(type_info) = data_types.get(module) {
+                        if let Some(constructors) = type_info.types_constructors.get(name) {
+                            let constructor = &constructors[ix];
+                            return if fields.is_empty() {
+                                Ok(UntypedExpr::Var {
+                                    location: Span::empty(),
+                                    name: constructor.to_string(),
+                                })
+                            } else {
+                                // NOTE: When the type is _private_, we cannot see the
+                                // value constructor and so we default to showing a
+                                // placeholder.
+                                let arguments = match type_info.values.get(constructor) {
+                                    None => Ok(fields
+                                        .iter()
+                                        .map(|_| CallArg {
+                                            label: None,
+                                            location: Span::empty(),
+                                            value: UntypedExpr::Var {
+                                                name: "<hidden>".to_string(),
+                                                location: Span::empty(),
+                                            },
+                                        })
+                                        .collect()),
+                                    Some(value) => {
+                                        let types =
+                                            if let Type::Fn { args, .. } = value.tipo.as_ref() {
+                                                &args[..]
+                                            } else {
+                                                &[]
+                                            };
+
+                                        fields
+                                            .into_iter()
+                                            .zip(types)
+                                            .map(|(field, tipo)| {
+                                                UntypedExpr::reify(data_types, field, tipo).map(
+                                                    |value| CallArg {
+                                                        label: None,
+                                                        location: Span::empty(),
+                                                        value,
+                                                    },
+                                                )
+                                            })
+                                            .collect::<Result<Vec<_>, _>>()
+                                    }
+                                }?;
+
+                                Ok(UntypedExpr::Call {
+                                    location: Span::empty(),
+                                    arguments,
+                                    fun: Box::new(UntypedExpr::Var {
+                                        name: constructor.to_string(),
+                                        location: Span::empty(),
+                                    }),
+                                })
+                            };
+                        }
+                    }
+                }
+
+                Err(format!(
+                    "invalid type annotation {tipo:?} for constructor: {tag:?} with {fields:?}"
+                ))
+            }
+
+            PlutusData::Map(..) => todo!("reify Map"),
+        }
+    }
+
     pub fn todo(reason: Option<Self>, location: Span) -> Self {
         UntypedExpr::Trace {
             location,

crates/aiken-lang/src/gen_uplc.rs

@@ -19,8 +19,9 @@ use uplc::{
 
 use crate::{
     ast::{
-        AssignmentKind, BinOp, Bls12_381Point, Curve, Pattern, Span, TraceLevel, TypedArg,
+        AssignmentKind, BinOp, Bls12_381Point, Curve, DataTypeKey, FunctionAccessKey, Pattern,
-        TypedClause, TypedDataType, TypedFunction, TypedPattern, TypedValidator, UnOp,
+        Span, TraceLevel, TypedArg, TypedClause, TypedDataType, TypedFunction, TypedPattern,
+        TypedValidator, UnOp,
     },
     builtins::{bool, data, int, list, string, void},
     expr::TypedExpr,
@@ -48,7 +49,7 @@ use self::{
         air_holds_msg, cast_validator_args, constants_ir, convert_type_to_data, extract_constant,
         lookup_data_type_by_tipo, modify_cyclic_calls, modify_self_calls, rearrange_list_clauses,
         AssignmentProperties, ClauseProperties, CodeGenSpecialFuncs, CycleFunctionNames,
-        DataTypeKey, FunctionAccessKey, HoistableFunction, Variant,
+        HoistableFunction, Variant,
     },
     tree::{AirMsg, AirTree, TreePath},
 };

crates/aiken-lang/src/gen_uplc/builder.rs

@@ -15,8 +15,8 @@ use uplc::{
 
 use crate::{
     ast::{
-        AssignmentKind, DataType, Pattern, Span, TraceLevel, TypedArg, TypedClause,
+        AssignmentKind, DataType, DataTypeKey, FunctionAccessKey, Pattern, Span, TraceLevel,
-        TypedClauseGuard, TypedDataType, TypedPattern,
+        TypedArg, TypedClause, TypedClauseGuard, TypedDataType, TypedPattern,
     },
     builtins::{bool, data, function, int, list, string, void},
     expr::TypedExpr,
@@ -68,18 +68,6 @@ pub enum HoistableFunction {
     CyclicLink(FunctionAccessKey),
 }
 
-#[derive(Clone, Debug, Eq, PartialEq, Hash)]
-pub struct DataTypeKey {
-    pub module_name: String,
-    pub defined_type: String,
-}
-
-#[derive(Clone, Debug, Eq, PartialEq, Hash, Ord, PartialOrd)]
-pub struct FunctionAccessKey {
-    pub module_name: String,
-    pub function_name: String,
-}
-
 #[derive(Clone, Debug)]
 pub struct AssignmentProperties {
     pub value_type: Rc<Type>,

crates/aiken-lang/src/parser/definition/snapshots/def_invalid_property_test.snap

@@ -13,8 +13,8 @@ Test(
                     is_validator_param: false,
                 },
                 location: 9..16,
-                via: DefinitionIdentifier {
+                via: Var {
-                    module: None,
+                    location: 15..16,
                     name: "f",
                 },
                 tipo: (),
@@ -27,8 +27,8 @@ Test(
                     is_validator_param: false,
                 },
                 location: 18..25,
-                via: DefinitionIdentifier {
+                via: Var {
-                    module: None,
+                    location: 24..25,
                     name: "g",
                 },
                 tipo: (),
@@ -42,7 +42,14 @@ Test(
         location: 0..26,
         name: "foo",
         public: false,
-        return_annotation: None,
+        return_annotation: Some(
+            Constructor {
+                location: 0..39,
+                module: None,
+                name: "Bool",
+                arguments: [],
+            },
+        ),
         return_type: (),
         end_position: 38,
         can_error: false,

crates/aiken-lang/src/parser/definition/snapshots/def_property_test.snap

@@ -13,11 +13,13 @@ Test(
                     is_validator_param: false,
                 },
                 location: 9..27,
-                via: DefinitionIdentifier {
+                via: FieldAccess {
-                    module: Some(
+                    location: 15..27,
-                        "fuzz",
+                    label: "any_int",
-                    ),
+                    container: Var {
-                    name: "any_int",
+                        location: 15..19,
+                        name: "fuzz",
+                    },
                 },
                 tipo: (),
             },
@@ -30,7 +32,14 @@ Test(
         location: 0..28,
         name: "foo",
         public: false,
-        return_annotation: None,
+        return_annotation: Some(
+            Constructor {
+                location: 0..41,
+                module: None,
+                name: "Bool",
+                arguments: [],
+            },
+        ),
         return_type: (),
         end_position: 40,
         can_error: false,

crates/aiken-lang/src/parser/definition/snapshots/def_test.snap

@@ -13,7 +13,14 @@ Test(
         location: 0..10,
         name: "foo",
         public: false,
-        return_annotation: None,
+        return_annotation: Some(
+            Constructor {
+                location: 0..23,
+                module: None,
+                name: "Bool",
+                arguments: [],
+            },
+        ),
         return_type: (),
         end_position: 22,
         can_error: false,

crates/aiken-lang/src/parser/definition/snapshots/def_test_fail.snap

@@ -37,7 +37,14 @@ Test(
         location: 0..26,
         name: "invalid_inputs",
         public: false,
-        return_annotation: None,
+        return_annotation: Some(
+            Constructor {
+                location: 0..61,
+                module: None,
+                name: "Bool",
+                arguments: [],
+            },
+        ),
         return_type: (),
         end_position: 60,
         can_error: true,

crates/aiken-lang/src/parser/expr/record.rs

@@ -187,6 +187,11 @@ pub fn parser(
 mod tests {
     use crate::assert_expr;
 
+    #[test]
+    fn record_enum() {
+        assert_expr!(r#"Winter"#);
+    }
+
     #[test]
     fn record_create_labeled() {
         assert_expr!(r#"User { name: "Aiken", age, thing: 2 }"#);

crates/aiken-lang/src/parser/expr/snapshots/record_enum.snap

@@ -0,0 +1,8 @@
+---
+source: crates/aiken-lang/src/parser/expr/record.rs
+description: "Code:\n\nWinter"
+---
+Var {
+    location: 0..6,
+    name: "Winter",
+}

crates/aiken-lang/src/tipo/infer.rs

@@ -1,4 +1,4 @@
-use std::{collections::HashMap, ops::Deref, rc::Rc};
+use std::{borrow::Borrow, collections::HashMap, ops::Deref, rc::Rc};
 
 use crate::{
     ast::{
@@ -332,78 +332,6 @@ fn infer_definition(
         }
 
         Definition::Test(f) => {
-            fn annotate_fuzzer(tipo: &Type, location: &Span) -> Result<Annotation, Error> {
-                match tipo {
-                    // TODO: Ensure args & first returned element is a Prelude's PRNG.
-                    Type::Fn { ret, .. } => {
-                        let ann = tipo_to_annotation(ret, location)?;
-                        match ann {
-                            Annotation::Constructor {
-                                module,
-                                name,
-                                arguments,
-                                ..
-                            } if module.as_ref().unwrap_or(&String::new()).is_empty()
-                                && name == "Option" =>
-                            {
-                                match &arguments[..] {
-                                    [Annotation::Tuple { elems, .. }] if elems.len() == 2 => {
-                                        Ok(elems.get(1).expect("Tuple has two elements").to_owned())
-                                    }
-                                    _ => {
-                                        todo!("expected a single generic argument unifying as 2-tuple")
-                                    }
-                                }
-                            }
-                            _ => todo!("expected an Option<a>"),
-                        }
-                    }
-                    Type::Var { .. } | Type::App { .. } | Type::Tuple { .. } => {
-                        todo!("Fuzzer type isn't a function?");
-                    }
-                }
-            }
-
-            fn tipo_to_annotation(tipo: &Type, location: &Span) -> Result<Annotation, Error> {
-                match tipo {
-                    Type::App {
-                        name, module, args, ..
-                    } => {
-                        let arguments = args
-                            .iter()
-                            .map(|arg| tipo_to_annotation(arg, location))
-                            .collect::<Result<Vec<Annotation>, _>>()?;
-                        Ok(Annotation::Constructor {
-                            name: name.to_owned(),
-                            module: Some(module.to_owned()),
-                            arguments,
-                            location: *location,
-                        })
-                    }
-                    Type::Tuple { elems } => {
-                        let elems = elems
-                            .iter()
-                            .map(|arg| tipo_to_annotation(arg, location))
-                            .collect::<Result<Vec<Annotation>, _>>()?;
-                        Ok(Annotation::Tuple {
-                            elems,
-                            location: *location,
-                        })
-                    }
-                    Type::Var { tipo } => match tipo.borrow().deref() {
-                        TypeVar::Link { tipo } => tipo_to_annotation(tipo, location),
-                        _ => todo!(
-                            "Fuzzer contains functions and/or non-concrete data-types? {tipo:#?}"
-                        ),
-                    },
-                    Type::Fn { .. } => {
-                        todo!(
-                            "Fuzzer contains functions and/or non-concrete data-types? {tipo:#?}"
-                        );
-                    }
-                }
-            }
-
             let (typed_via, annotation) = match f.arguments.first() {
                 Some(arg) => {
                     if f.arguments.len() > 1 {
@@ -416,12 +344,9 @@ fn infer_definition(
                     let typed_via =
                         ExprTyper::new(environment, lines, tracing).infer(arg.via.clone())?;
 
-                    let tipo = typed_via.tipo();
+                    let (annotation, inner_type) = infer_fuzzer(&typed_via.tipo(), &arg.location)?;
 
-                    Ok((
+                    Ok((Some((typed_via, inner_type)), Some(annotation)))
-                        Some(typed_via),
-                        Some(annotate_fuzzer(&tipo, &arg.location)?),
-                    ))
                 }
                 None => Ok((None, None)),
             }?;
@@ -466,17 +391,15 @@ fn infer_definition(
                 name: typed_f.name,
                 public: typed_f.public,
                 arguments: match typed_via {
-                    Some(via) => {
+                    Some((via, tipo)) => {
                         let Arg {
-                            arg_name,
+                            arg_name, location, ..
-                            location,
-                            tipo,
-                            ..
                         } = typed_f
                             .arguments
                             .first()
                             .expect("has exactly one argument")
                             .to_owned();
+
                         vec![ArgVia {
                             arg_name,
                             location,
@@ -805,3 +728,67 @@ fn infer_function(
         end_position,
     })
 }
+
+fn infer_fuzzer(tipo: &Type, location: &Span) -> Result<(Annotation, Rc<Type>), Error> {
+    match tipo {
+        // TODO: Ensure args & first returned element is a Prelude's PRNG.
+        Type::Fn { ret, .. } => match &ret.borrow() {
+            Type::App {
+                module, name, args, ..
+            } if module.is_empty() && name == "Option" && args.len() == 1 => {
+                match &args.first().map(|x| x.borrow()) {
+                    Some(Type::Tuple { elems }) if elems.len() == 2 => {
+                        let wrapped = elems.get(1).expect("Tuple has two elements");
+                        Ok((annotation_from_type(wrapped, location)?, wrapped.clone()))
+                    }
+                    _ => {
+                        todo!("expected a single generic argument unifying as 2-tuple")
+                    }
+                }
+            }
+            _ => todo!("expected an Option<a>"),
+        },
+
+        Type::Var { .. } | Type::App { .. } | Type::Tuple { .. } => {
+            todo!("Fuzzer type isn't a function?");
+        }
+    }
+}
+
+fn annotation_from_type(tipo: &Type, location: &Span) -> Result<Annotation, Error> {
+    match tipo {
+        Type::App {
+            name, module, args, ..
+        } => {
+            let arguments = args
+                .iter()
+                .map(|arg| annotation_from_type(arg, location))
+                .collect::<Result<Vec<Annotation>, _>>()?;
+            Ok(Annotation::Constructor {
+                name: name.to_owned(),
+                module: Some(module.to_owned()),
+                arguments,
+                location: *location,
+            })
+        }
+
+        Type::Tuple { elems } => {
+            let elems = elems
+                .iter()
+                .map(|arg| annotation_from_type(arg, location))
+                .collect::<Result<Vec<Annotation>, _>>()?;
+            Ok(Annotation::Tuple {
+                elems,
+                location: *location,
+            })
+        }
+
+        Type::Var { tipo } => match &*tipo.deref().borrow() {
+            TypeVar::Link { tipo } => annotation_from_type(tipo, location),
+            _ => todo!("Fuzzer contains functions and/or non-concrete data-types? {tipo:#?}"),
+        },
+        Type::Fn { .. } => {
+            todo!("Fuzzer contains functions and/or non-concrete data-types? {tipo:#?}");
+        }
+    }
+}

crates/aiken-project/src/lib.rs

@@ -29,11 +29,11 @@ use crate::{
 };
 use aiken_lang::{
     ast::{
-        Definition, Function, ModuleKind, Span, Tracing, TypedDataType, TypedFunction, Validator,
+        DataTypeKey, Definition, Function, FunctionAccessKey, ModuleKind, Span, Tracing,
+        TypedDataType, TypedFunction, Validator,
     },
     builtins,
-    expr::TypedExpr,
+    expr::{TypedExpr, UntypedExpr},
-    gen_uplc::builder::{DataTypeKey, FunctionAccessKey},
     tipo::{Type, TypeInfo},
     IdGenerator,
 };
@@ -321,9 +321,9 @@ where
                     self.event_listener.handle_event(Event::RunningTests);
                 }
 
-                let results = self.run_tests(tests);
+                let tests = self.run_tests(tests);
 
-                let errors: Vec<Error> = results
+                let errors: Vec<Error> = tests
                     .iter()
                     .filter_map(|e| {
                         if e.is_success() {
@@ -335,7 +335,7 @@ where
                     .collect();
 
                 self.event_listener
-                    .handle_event(Event::FinishedTests { tests: results });
+                    .handle_event(Event::FinishedTests { tests });
 
                 if !errors.is_empty() {
                     Err(errors)
@@ -886,7 +886,7 @@ where
         Ok(programs)
     }
 
-    fn run_tests(&self, tests: Vec<Test>) -> Vec<TestResult> {
+    fn run_tests(&self, tests: Vec<Test>) -> Vec<TestResult<UntypedExpr>> {
         use rayon::prelude::*;
 
         tests
@@ -897,6 +897,9 @@ where
                 // provided.
                 Test::PropertyTest(property_test) => property_test.run(42),
             })
+            .collect::<Vec<TestResult<PlutusData>>>()
+            .into_iter()
+            .map(|test| test.reify(&self.module_types))
             .collect()
     }
 

crates/aiken-project/src/module.rs

@@ -1,13 +1,11 @@
 use crate::error::Error;
 use aiken_lang::{
     ast::{
-        DataType, Definition, Function, Located, ModuleKind, Tracing, TypedDataType, TypedFunction,
+        DataType, DataTypeKey, Definition, Function, FunctionAccessKey, Located, ModuleKind,
-        TypedModule, TypedValidator, UntypedModule, Validator,
+        Tracing, TypedDataType, TypedFunction, TypedModule, TypedValidator, UntypedModule,
-    },
+        Validator,
-    gen_uplc::{
-        builder::{DataTypeKey, FunctionAccessKey},
-        CodeGenerator,
     },
+    gen_uplc::CodeGenerator,
     line_numbers::LineNumbers,
     parser::extra::{comments_before, Comment, ModuleExtra},
     tipo::TypeInfo,

crates/aiken-project/src/script.rs

@@ -1,10 +1,17 @@
 use crate::{pretty, ExBudget};
-use aiken_lang::gen_uplc::builder::convert_data_to_type;
+use aiken_lang::{
-use aiken_lang::{ast::BinOp, tipo::Type};
+    ast::BinOp,
-use pallas::codec::utils::Int;
+    expr::UntypedExpr,
-use pallas::ledger::primitives::alonzo::{BigInt, Constr, PlutusData};
+    gen_uplc::builder::convert_data_to_type,
+    tipo::{Type, TypeInfo},
+};
+use pallas::{
+    codec::utils::Int,
+    ledger::primitives::alonzo::{BigInt, Constr, PlutusData},
+};
 use std::{
     borrow::Borrow,
+    collections::HashMap,
     fmt::{self, Display},
     path::PathBuf,
     rc::Rc,
@@ -14,26 +21,25 @@ use uplc::{
     machine::eval_result::EvalResult,
 };
 
-// ----------------------------------------------------------------------------
+/// ----------------------------------------------------------------------------
-//
+///
-// Test
+/// Test
-//
+///
-// Aiken supports two kinds of tests: unit and property. A unit test is a simply
+/// Aiken supports two kinds of tests: unit and property. A unit test is a simply
-// UPLC program which returns must be a lambda that returns a boolean.
+/// UPLC program which returns must be a lambda that returns a boolean.
-//
+///
-// A property on the other-hand is a template for generating tests, which is also
+/// A property on the other-hand is a template for generating tests, which is also
-// a lambda but that takes an extra argument. The argument is generated from a
+/// a lambda but that takes an extra argument. The argument is generated from a
-// fuzzer which is meant to yield random values in a pseudo-random (albeit seeded)
+/// fuzzer which is meant to yield random values in a pseudo-random (albeit seeded)
-// sequence. On failures, the value that caused a failure is simplified using an
+/// sequence. On failures, the value that caused a failure is simplified using an
-// approach similar to what's described in MiniThesis<https://github.com/DRMacIver/minithesis>,
+/// approach similar to what's described in MiniThesis<https://github.com/DRMacIver/minithesis>,
-// which is a simplified version of Hypothesis, a property-based testing framework
+/// which is a simplified version of Hypothesis, a property-based testing framework
-// with integrated shrinking.
+/// with integrated shrinking.
-//
+///
-// Our approach could perhaps be called "microthesis", as it implements a subset of
+/// Our approach could perhaps be called "microthesis", as it implements a subset of
-// minithesis. More specifically, we do not currently support pre-conditions, nor
+/// minithesis. More specifically, we do not currently support pre-conditions, nor
-// targets.
+/// targets.
-// ----------------------------------------------------------------------------
+/// ----------------------------------------------------------------------------
-
 #[derive(Debug, Clone)]
 pub enum Test {
     UnitTest(UnitTest),
@@ -99,7 +105,7 @@ pub struct UnitTest {
 unsafe impl Send for UnitTest {}
 
 impl UnitTest {
-    pub fn run(self) -> TestResult {
+    pub fn run<T>(self) -> TestResult<T> {
         let mut eval_result = self.program.clone().eval(ExBudget::max());
         TestResult::UnitTestResult(UnitTestResult {
             test: self.to_owned(),
@@ -134,7 +140,7 @@ impl PropertyTest {
 
     /// Run a property test from a given seed. The property is run at most MAX_TEST_RUN times. It
     /// may stops earlier on failure; in which case a 'counterexample' is returned.
-    pub fn run(self, seed: u32) -> TestResult {
+    pub fn run(self, seed: u32) -> TestResult<PlutusData> {
         let n = PropertyTest::MAX_TEST_RUN;
 
         let (counterexample, iterations) = match self.run_n_times(n, seed, None) {
@@ -153,8 +159,8 @@ impl PropertyTest {
         &self,
         remaining: usize,
         seed: u32,
-        counterexample: Option<(usize, Term<NamedDeBruijn>)>,
+        counterexample: Option<(usize, PlutusData)>,
-    ) -> Option<(usize, Term<NamedDeBruijn>)> {
+    ) -> Option<(usize, PlutusData)> {
         // We short-circuit failures in case we have any. The counterexample is already simplified
         // at this point.
         if remaining > 0 && counterexample.is_none() {
@@ -169,12 +175,12 @@ impl PropertyTest {
         }
     }
 
-    fn run_once(&self, seed: u32) -> (u32, Option<Term<NamedDeBruijn>>) {
+    fn run_once(&self, seed: u32) -> (u32, Option<PlutusData>) {
         let (next_prng, value) = Prng::from_seed(seed)
-            .sample(&self.fuzzer.0, &self.fuzzer.1)
+            .sample(&self.fuzzer.0)
             .expect("running seeded Prng cannot fail.");
 
-        let result = self.program.apply_term(&value).eval(ExBudget::max());
+        let result = self.eval(&value);
 
         if let Prng::Seeded {
             seed: next_seed, ..
@@ -182,12 +188,9 @@ impl PropertyTest {
         {
             if result.failed(self.can_error) {
                 let mut counterexample = Counterexample {
-                    result,
                     value,
                     choices: next_prng.choices(),
-                    can_error: self.can_error,
+                    property: self,
-                    program: &self.program,
-                    fuzzer: (&self.fuzzer.0, &self.fuzzer.1),
                 };
 
                 if !counterexample.choices.is_empty() {
@@ -202,6 +205,13 @@ impl PropertyTest {
             unreachable!("Prng constructed from a seed necessarily yield a seed.");
         }
     }
+
+    pub fn eval(&self, value: &PlutusData) -> EvalResult {
+        let term = convert_data_to_type(Term::data(value.clone()), &self.fuzzer.1)
+            .try_into()
+            .expect("safe conversion from Name -> NamedDeBruijn");
+        self.program.apply_term(&term).eval(ExBudget::max())
+    }
 }
 
 // ----------------------------------------------------------------------------
@@ -230,9 +240,9 @@ impl Prng {
     const REPLAYED: u64 = 1;
 
     /// Constructor tag for Option's 'Some'
-    const OK: u64 = 0;
+    const SOME: u64 = 0;
     /// Constructor tag for Option's 'None'
-    const ERR: u64 = 1;
+    const NONE: u64 = 1;
 
     pub fn uplc(&self) -> PlutusData {
         match self {
@@ -281,18 +291,14 @@ impl Prng {
     }
 
     /// Generate a pseudo-random value from a fuzzer using the given PRNG.
-    pub fn sample(
+    pub fn sample(&self, fuzzer: &Program<NamedDeBruijn>) -> Option<(Prng, PlutusData)> {
-        &self,
-        fuzzer: &Program<NamedDeBruijn>,
-        return_type: &Type,
-    ) -> Option<(Prng, Term<NamedDeBruijn>)> {
         let result = fuzzer
             .apply_data(self.uplc())
             .eval(ExBudget::max())
             .result()
             .expect("Fuzzer crashed?");
 
-        Prng::from_result(result, return_type)
+        Prng::from_result(result)
     }
 
     /// Obtain a Prng back from a fuzzer execution. As a reminder, fuzzers have the following
@@ -305,10 +311,7 @@ impl Prng {
     /// made during shrinking aren't breaking underlying invariants (if only, because we run out of
     /// values to replay). In such case, the replayed sequence is simply invalid and the fuzzer
     /// aborted altogether with 'None'.
-    pub fn from_result(
+    pub fn from_result(result: Term<NamedDeBruijn>) -> Option<(Self, PlutusData)> {
-        result: Term<NamedDeBruijn>,
-        type_info: &Type,
-    ) -> Option<(Self, Term<NamedDeBruijn>)> {
         /// Interpret the given 'PlutusData' as one of two Prng constructors.
         fn as_prng(cst: &PlutusData) -> Prng {
             if let PlutusData::Constr(Constr { tag, fields, .. }) = cst {
@@ -345,15 +348,10 @@ impl Prng {
 
         if let Term::Constant(rc) = &result {
             if let Constant::Data(PlutusData::Constr(Constr { tag, fields, .. })) = &rc.borrow() {
-                if *tag == 121 + Prng::OK {
+                if *tag == 121 + Prng::SOME {
                     if let [PlutusData::Array(elems)] = &fields[..] {
                         if let [new_seed, value] = &elems[..] {
-                            return Some((
+                            return Some((as_prng(new_seed), value.clone()));
-                                as_prng(new_seed),
-                                convert_data_to_type(Term::data(value.clone()), type_info)
-                                    .try_into()
-                                    .expect("safe conversion from Name -> NamedDeBruijn"),
-                            ));
                         }
                     }
                 }
@@ -362,7 +360,7 @@ impl Prng {
                 // choices. If we run out of choices, or a choice end up being
                 // invalid as per the expectation, the fuzzer can't go further and
                 // fail.
-                if *tag == 121 + Prng::ERR {
+                if *tag == 121 + Prng::NONE {
                     return None;
                 }
             }
@@ -385,12 +383,9 @@ impl Prng {
 
 #[derive(Debug)]
 pub struct Counterexample<'a> {
-    pub value: Term<NamedDeBruijn>,
+    pub value: PlutusData,
     pub choices: Vec<u32>,
-    pub result: EvalResult,
+    pub property: &'a PropertyTest,
-    pub can_error: bool,
-    pub program: &'a Program<NamedDeBruijn>,
-    pub fuzzer: (&'a Program<NamedDeBruijn>, &'a Type),
 }
 
 impl<'a> Counterexample<'a> {
@@ -404,17 +399,17 @@ impl<'a> Counterexample<'a> {
         // test cases many times. Given that tests are fully deterministic, we can
         // memoize the already seen choices to avoid re-running the generators and
         // the test (which can be quite expensive).
-        match Prng::from_choices(choices).sample(self.fuzzer.0, self.fuzzer.1) {
+        match Prng::from_choices(choices).sample(&self.property.fuzzer.0) {
             // Shrinked choices led to an impossible generation.
             None => false,
 
             // Shrinked choices let to a new valid generated value, now, is it better?
             Some((_, value)) => {
-                let result = self.program.apply_term(&value).eval(ExBudget::max());
+                let result = self.property.eval(&value);
 
                 // If the test no longer fails, it isn't better as we're only
                 // interested in counterexamples.
-                if !result.failed(self.can_error) {
+                if !result.failed(self.property.can_error) {
                     return false;
                 }
 
@@ -546,14 +541,25 @@ impl<'a> Counterexample<'a> {
 // ----------------------------------------------------------------------------
 
 #[derive(Debug)]
-pub enum TestResult {
+pub enum TestResult<T> {
     UnitTestResult(UnitTestResult),
-    PropertyTestResult(PropertyTestResult),
+    PropertyTestResult(PropertyTestResult<T>),
 }
 
-unsafe impl Send for TestResult {}
+unsafe impl<T> Send for TestResult<T> {}
 
-impl TestResult {
+impl TestResult<PlutusData> {
+    pub fn reify(self, data_types: &HashMap<String, TypeInfo>) -> TestResult<UntypedExpr> {
+        match self {
+            TestResult::UnitTestResult(test) => TestResult::UnitTestResult(test),
+            TestResult::PropertyTestResult(test) => {
+                TestResult::PropertyTestResult(test.reify(data_types))
+            }
+        }
+    }
+}
+
+impl<T> TestResult<T> {
     pub fn is_success(&self) -> bool {
         match self {
             TestResult::UnitTestResult(UnitTestResult { success, .. }) => *success,
@@ -633,13 +639,29 @@ pub struct UnitTestResult {
 unsafe impl Send for UnitTestResult {}
 
 #[derive(Debug)]
-pub struct PropertyTestResult {
+pub struct PropertyTestResult<T> {
     pub test: PropertyTest,
-    pub counterexample: Option<Term<NamedDeBruijn>>,
+    pub counterexample: Option<T>,
     pub iterations: usize,
 }
 
-unsafe impl Send for PropertyTestResult {}
+unsafe impl<T> Send for PropertyTestResult<T> {}
+
+impl PropertyTestResult<PlutusData> {
+    pub fn reify(self, data_types: &HashMap<String, TypeInfo>) -> PropertyTestResult<UntypedExpr> {
+        PropertyTestResult {
+            counterexample: match self.counterexample {
+                None => None,
+                Some(counterexample) => Some(
+                    UntypedExpr::reify(data_types, counterexample, &self.test.fuzzer.1)
+                        .expect("Failed to reify counterexample?"),
+                ),
+            },
+            iterations: self.iterations,
+            test: self.test,
+        }
+    }
+}
 
 #[derive(Debug, Clone)]
 pub struct Assertion {

crates/aiken-project/src/telemetry.rs

@@ -1,5 +1,6 @@
 use crate::pretty;
 use crate::script::{PropertyTestResult, TestResult, UnitTestResult};
+use aiken_lang::{expr::UntypedExpr, format::Formatter};
 use owo_colors::{OwoColorize, Stream::Stderr};
 use std::{collections::BTreeMap, fmt::Display, path::PathBuf};
 use uplc::machine::cost_model::ExBudget;
@@ -34,7 +35,7 @@ pub enum Event {
     },
     RunningTests,
     FinishedTests {
-        tests: Vec<TestResult>,
+        tests: Vec<TestResult<UntypedExpr>>,
     },
     WaitingForBuildDirLock,
     ResolvingPackages {
@@ -249,7 +250,12 @@ impl EventListener for Terminal {
     }
 }
 
-fn fmt_test(result: &TestResult, max_mem: usize, max_cpu: usize, styled: bool) -> String {
+fn fmt_test(
+    result: &TestResult<UntypedExpr>,
+    max_mem: usize,
+    max_cpu: usize,
+    styled: bool,
+) -> String {
     // Status
     let mut test = if result.is_success() {
         pretty::style_if(styled, "PASS".to_string(), |s| {
@@ -316,7 +322,9 @@ fn fmt_test(result: &TestResult, max_mem: usize, max_cpu: usize, styled: bool) -
                     .if_supports_color(Stderr, |s| s.red())
                     .if_supports_color(Stderr, |s| s.bold())
                     .to_string()),
-                &counterexample.to_pretty(),
+                &Formatter::new()
+                    .expr(counterexample, false)
+                    .to_pretty_string(70),
                 |s| s.red().to_string()
             )
         )
@@ -351,7 +359,7 @@ fn fmt_test(result: &TestResult, max_mem: usize, max_cpu: usize, styled: bool) -
     test
 }
 
-fn fmt_test_summary(tests: &[&TestResult], styled: bool) -> String {
+fn fmt_test_summary<T>(tests: &[&TestResult<T>], styled: bool) -> String {
     let (n_passed, n_failed) = tests.iter().fold((0, 0), |(n_passed, n_failed), result| {
         if result.is_success() {
             (n_passed + 1, n_failed)
@@ -375,16 +383,16 @@ fn fmt_test_summary(tests: &[&TestResult], styled: bool) -> String {
     )
 }
 
-fn group_by_module(results: &Vec<TestResult>) -> BTreeMap<String, Vec<&TestResult>> {
+fn group_by_module<T>(results: &Vec<TestResult<T>>) -> BTreeMap<String, Vec<&TestResult<T>>> {
     let mut modules = BTreeMap::new();
     for r in results {
-        let xs: &mut Vec<&TestResult> = modules.entry(r.module().to_string()).or_default();
+        let xs: &mut Vec<&TestResult<_>> = modules.entry(r.module().to_string()).or_default();
         xs.push(r);
     }
     modules
 }
 
-fn find_max_execution_units(xs: &[TestResult]) -> (usize, usize) {
+fn find_max_execution_units<T>(xs: &[TestResult<T>]) -> (usize, usize) {
     let (max_mem, max_cpu) = xs
         .iter()
         .fold((0, 0), |(max_mem, max_cpu), test| match test {

crates/aiken-project/src/tests/mod.rs

@@ -2,8 +2,10 @@ use std::collections::HashMap;
 use std::path::PathBuf;
 
 use aiken_lang::{
-    ast::{ModuleKind, TraceLevel, Tracing, TypedDataType, TypedFunction},
+    ast::{
-    gen_uplc::builder::{DataTypeKey, FunctionAccessKey},
+        DataTypeKey, FunctionAccessKey, ModuleKind, TraceLevel, Tracing, TypedDataType,
+        TypedFunction,
+    },
     parser,
     tipo::TypeInfo,
     IdGenerator,

crates/uplc/src/machine/value.rs

@@ -1,13 +1,12 @@
 use std::{collections::VecDeque, mem::size_of, ops::Deref, rc::Rc};
 
-use num_bigint::BigInt;
-use num_traits::{Signed, ToPrimitive, Zero};
-use pallas::ledger::primitives::babbage::{self, PlutusData};
-
 use crate::{
     ast::{Constant, NamedDeBruijn, Term, Type},
     builtins::DefaultFunction,
 };
+use num_bigint::BigInt;
+use num_traits::{Signed, ToPrimitive, Zero};
+use pallas::ledger::primitives::babbage::{self, PlutusData};
 
 use super::{runtime::BuiltinRuntime, Error};
 

examples/acceptance_tests/095/lib/foo.ak

@@ -2,11 +2,16 @@ use aiken/builtin
 
 const max_int: Int = 255
 
-type PRNG {
+pub type PRNG {
   Seeded { seed: Int, choices: List<Int> }
   Replayed { choices: List<Int> }
 }
 
+type Fuzzer<a> =
+  fn(PRNG) -> Option<(PRNG, a)>
+
+// Primitives
+
 fn any_int(prng: PRNG) -> Option<(PRNG, Int)> {
   when prng is {
     Seeded { seed, choices } -> {
@@ -40,10 +45,94 @@ fn any_int(prng: PRNG) -> Option<(PRNG, Int)> {
   }
 }
 
-test prop_foo_1(n via any_int) {
+pub fn constant(a: a) -> Fuzzer<a> {
-  n >= 0 && n <= 255
+  fn(s0) { Some((s0, a)) }
 }
 
-test prop_foo_2(n via any_int) fail {
+pub fn and_then(fuzz_a: Fuzzer<a>, f: fn(a) -> Fuzzer<b>) -> Fuzzer<b> {
-  n < 100
+  fn(s0) {
+    when fuzz_a(s0) is {
+      Some((s1, a)) -> f(a)(s1)
+      None -> None
+    }
+  }
+}
+
+pub fn map(fuzz_a: Fuzzer<a>, f: fn(a) -> b) -> Fuzzer<b> {
+  fn(s0) {
+    when fuzz_a(s0) is {
+      Some((s1, a)) -> Some((s1, f(a)))
+      None -> None
+    }
+  }
+}
+
+pub fn map2(fuzz_a: Fuzzer<a>, fuzz_b: Fuzzer<b>, f: fn(a, b) -> c) -> Fuzzer<c> {
+  fn(s0) {
+    when fuzz_a(s0) is {
+      Some((s1, a)) ->
+        when fuzz_b(s1) is {
+          Some((s2, b)) -> Some((s2, f(a, b)))
+          None -> None
+        }
+      None -> None
+    }
+  }
+}
+
+// Builders
+
+fn any_bool() -> Fuzzer<Bool> {
+  any_int |> map(fn(n) { n <= 127 })
+}
+
+fn any_list(fuzz_a: Fuzzer<a>) -> Fuzzer<List<a>> {
+  any_bool()
+    |> and_then(
+         fn(continue) {
+           if continue {
+             map2(fuzz_a, any_list(fuzz_a), fn(head, tail) { [head, ..tail] })
+           } else {
+             constant([])
+           }
+         },
+       )
+}
+
+fn any_season() -> Fuzzer<Season> {
+  any_int
+    |> map(
+         fn(i) {
+           let n = i % 3
+           if n == 0 {
+             Winter { cold: True }
+           } else if n == 1 {
+             Spring(i)
+           } else if n == 2 {
+             Summer
+           } else {
+             Fall
+           }
+         },
+       )
+}
+
+// Properties
+
+pub type Season {
+  Winter { cold: Bool }
+  Spring(Int)
+  Summer
+  Fall
+}
+
+test prop_list(xs via any_list(any_season())) {
+  xs != [Winter(True)] || xs != [Winter(False)]
+}
+
+fn length(xs: List<a>) -> Int {
+  when xs is {
+    [] -> 0
+    [_, ..tail] -> 1 + length(tail)
+  }
 }