Retain names for (named) procedures (#29)

Make sure that if we have named procedure definition, we remember the label of the procedure correctly.
This is used in the writer to write the name of the procedure instead of just lambda.

Additionally this fixes a bug in the test helper to match data structurally.
Working on this revealed that the expander didn't handle variable arguments in procedure definitions correctly,
which is also fixed here.

src/compiler/backend/code_generator.rs

@@ -406,11 +406,11 @@ impl<'a> CodeGenerator<'a> {
             DefinitionExpression::DefineSimple(id, expr, _loc) => {
                 self.emit_instructions(expr, &Context::NonTail)?;
                 let id_sym = self.sym(&id.string());
-                let const_addr = self.current_chunk().add_constant(id_sym);
+                let const_address = self.current_chunk().add_constant(id_sym);
 
                 if let Target::TopLevel = self.target {
                     self.emit_instruction(
-                        Instruction::Define(const_addr),
+                        Instruction::Define(const_address),
                         &definition.source_location(),
                     )
                 } else {

src/compiler/frontend/expander.rs

@@ -145,7 +145,6 @@ impl Expander {
 #[cfg(test)]
 pub mod tests {
     use crate::compiler::frontend::reader::tests::*;
-    use std::fmt::Debug;
 
     use super::*;
 
@@ -167,9 +166,12 @@ pub mod tests {
         let mut exp = Expander::new();
         let actual_datum = parse_datum(lhs);
         let expected_datum = parse_datum(rhs);
-        let expanded = exp.expand(&actual_datum)?;
+        let expanded_datum = exp.expand(&actual_datum)?;
 
-        assert_struct_eq(&expanded, &expected_datum, pedantic);
+        //println!("expected: {}", expected_datum);
+        //println!("expanded: {}", expanded_datum);
+
+        assert_struct_eq(&expanded_datum, &expected_datum, pedantic);
         Ok(())
     }
 
@@ -190,7 +192,7 @@ pub mod tests {
         match (lhs, rhs) {
             (Datum::List(inner_lhs, _), Datum::List(inner_rhs, _)) => {
                 assert_vec_eq(&inner_lhs, &inner_rhs, |l, r| {
-                    assert_struct_eq(l, r, pedantic)
+                    assert_struct_eq(l, r, pedantic);
                 })
             }
             (
@@ -210,31 +212,19 @@ pub mod tests {
             (Datum::Symbol(inner_lhs, _), Datum::Symbol(inner_rhs, _)) if !pedantic => {
                 assert_eq!(inner_lhs.as_str(), inner_rhs.as_str())
             }
-            (datum_lhs, datum_rhs) if !pedantic => {
-                assert_eq_ignore_location(datum_lhs, datum_rhs);
-            }
-            (datum_lhs, datum_rhs) => {
-                assert_eq!(datum_lhs, datum_rhs)
-            }
-        }
-    }
-
-    fn assert_eq_ignore_location(lhs: &Datum, rhs: &Datum) {
-        match (lhs, rhs) {
             (Datum::Bool(l, _), Datum::Bool(r, _)) => assert_eq!(l, r),
             (Datum::Symbol(l, _), Datum::Symbol(r, _)) => assert_eq!(l, r),
             (Datum::String(l, _), Datum::String(r, _)) => assert_eq!(l, r),
             (Datum::Char(l, _), Datum::Char(r, _)) => assert_eq!(l, r),
             (Datum::Number(l, _), Datum::Number(r, _)) => assert_eq!(l, r),
             (Datum::ByteVector(l, _), Datum::ByteVector(r, _)) => assert_eq!(l, r),
-            (l, r) => assert_struct_eq(l, r, false),
+            _ => assert!(false, "Expected datum to be of the same kind"),
         }
     }
 
-    fn assert_vec_eq<T, F>(lhs: &Vec<T>, rhs: &Vec<T>, assertion: F)
+    fn assert_vec_eq<F>(lhs: &Vec<Datum>, rhs: &Vec<Datum>, assertion: F)
     where
-        F: Copy + FnOnce(&T, &T),
-        T: Debug,
+        F: Copy + FnOnce(&Datum, &Datum),
     {
         if lhs.len() == 0 {
             assert_eq!(0, rhs.len(), "expected length of both vectors to be 0")

src/compiler/frontend/expander/define.rs

@@ -34,6 +34,43 @@ impl Expander {
                     )),
                 }
             }
+
+            [definition, exprs @ ..] if definition.is_improper_list() => {
+                match definition.improper_list_slice() {
+                    Some((head, tail)) => match &head[..] {
+                        //(foo . rest)
+                        [identifier] => {
+                            let lambda = self.build_lambda(
+                                tail,
+                                exprs,
+                                datum.source_location().clone()
+                            );
+                            Ok(Datum::list(vec![operator.clone(), identifier.clone(), lambda], datum.source_location().clone()))
+                        }
+                        //(foo x y . rest)
+                        [identifier , required_args @ ..]  => {
+                            let lambda = self.build_lambda(
+                                &Datum::improper_list(
+                                    required_args.to_vec(),
+                                    tail.clone(),
+                                    datum.source_location().clone(),
+                                ),
+                                exprs,
+                                datum.source_location().clone(),
+                            );
+
+                            Ok(Datum::list(vec![operator.clone(), identifier.clone(), lambda], datum.source_location().clone()))
+                        }
+                        _ => Err(Error::expansion_error(
+                            "Invalid procedure definition. Expected name and arguments in def-formals" ,
+                            &datum
+                        ))
+                    }
+                    _ => Err(Error::bug(
+                        "Expected improper list in expansion of <define>",
+                    )),
+                }
+            }
             //(define <id> <expr>)
             [identifier, expr] => Ok(Datum::list(
                 vec![operator.clone(), identifier.clone(), expr.clone()],
@@ -58,6 +95,12 @@ mod tests {
         Ok(())
     }
 
+    #[test]
+    fn test_expand_define_procedure_nullary() -> Result<()> {
+        assert_expands_equal("(define (foo) x)", "(define foo (lambda () x))", false)?;
+        Ok(())
+    }
+
     #[test]
     fn test_expand_define_procedure() -> Result<()> {
         assert_expands_equal(
@@ -67,4 +110,26 @@ mod tests {
         )?;
         Ok(())
     }
+
+    #[test]
+    fn test_expand_define_procedure_varargs() -> Result<()> {
+        assert_expands_equal(
+            "(define (foo x y . args) x)",
+            "(define foo (lambda (x y . args) x))",
+            false,
+        )?;
+
+        Ok(())
+    }
+
+    #[test]
+    fn test_expand_define_procedure_single_rest_arg() -> Result<()> {
+        assert_expands_equal(
+            "(define (foo . args) x)",
+            "(define foo (lambda args x))",
+            false,
+        )?;
+
+        Ok(())
+    }
 }

src/compiler/frontend/parser/define.rs

@@ -63,9 +63,16 @@ impl CoreParser {
                     self.environment
                         .extend(parsed_identifier.symbol().clone(), Denotation::Id);
 
+                    let parsed_expression = match self.parse(&expr)? {
+                        Expression::Lambda(lambda) => {
+                            Expression::Lambda(lambda.with_label(parsed_identifier.string()))
+                        }
+                        other => other,
+                    };
+
                     Ok(DefinitionExpression::DefineSimple(
                         parsed_identifier,
-                        Box::new(self.parse(&expr)?),
+                        Box::new(parsed_expression),
                         datum.source_location().clone(),
                     ))
                 }

src/compiler/frontend/parser/lambda.rs

@@ -32,6 +32,13 @@ impl LambdaExpression {
             label,
         }
     }
+
+    pub fn with_label<S: Into<String>>(self, label: S) -> Self {
+        LambdaExpression {
+            label: Some(label.into()),
+            ..self
+        }
+    }
 }
 
 impl HasSourceLocation for LambdaExpression {

src/compiler/frontend/reader/datum.rs

@@ -160,6 +160,20 @@ impl Datum {
         }
     }
 
+    pub fn is_improper_list(&self) -> bool {
+        match self {
+            Self::ImproperList(_, _, _) => true,
+            _ => false,
+        }
+    }
+
+    pub fn improper_list_slice(&self) -> Option<(&[Datum], &Datum)> {
+        match self {
+            Self::ImproperList(head, tail, _) => Some((&head[..], &tail)),
+            _ => None,
+        }
+    }
+
     /// If the current datum is a proper list, return the slice of that list's elements
     ///
     /// This function is mostly used in the parser, which uses slice patterns extensively.

src/vm/scheme/writer.rs

@@ -163,13 +163,13 @@ impl Writer {
     fn write_procedure(&self, proc: &procedure::Procedure) -> String {
         match proc {
             procedure::Procedure::Native(proc) => format!(
-                "#<procedure {} ({})>",
+                "#<procedure ({} {})>",
                 proc.name().clone().unwrap_or(String::from("")),
                 self.write_formals(&proc.arity)
             ),
             procedure::Procedure::Foreign(proc) => {
                 format!(
-                    "#<procedure {} ({})>",
+                    "#<procedure ({} {})>",
                     proc.name,
                     self.write_formals(&proc.arity)
                 )
@@ -187,7 +187,7 @@ impl Writer {
                 let fixed_args: Vec<String> = (0..*count).map(|i| format!("x{}", i)).collect();
                 format!("{} . rest", fixed_args.join(" "))
             }
-            procedure::Arity::Many => " . args".to_string(),
+            procedure::Arity::Many => ". args".to_string(),
         }
     }