support improper lists (#217)

* support improper lists

* make pairs serializable

* tests

* rule out improper lists in special forms

* fix warnings

* fix parsing

* more tests

cogs/r5rs.scm

@@ -288,7 +288,7 @@
 
 (check-equal? "empty list is not a boolean" #f (boolean? '()))
 
-; (check-equal #t (pair? '(a . b)))
+(check-equal? "pair?" #t (pair? '(a . b)))
 
 (check-equal? "lists are considered pairs" #t (pair? '(a b c)))
 
@@ -298,25 +298,25 @@
 
 (check-equal? "cons string onto list of symbols" '("a" b c) (cons "a" '(b c)))
 
-; (check-equal '(a . 3) (cons 'a 3))
+(check-equal? "cons" '(a . 3) (cons 'a 3))
 
-; (check-equal '((a b) . c) (cons '(a b) 'c))
+(check-equal? "cons of composites" '((a b) . c) (cons '(a b) 'c))
 
 (check-equal? "take the car of a list of symbols" 'a (car '(a b c)))
 
 (check-equal? "take the car, where the car is a list" '(a) (car '((a) b c d)))
 
-; (check-equal 1 (car '(1 . 2)))
+(check-equal? "car of non-list pair" 1 (car '(1 . 2)))
 
 (check-equal? "take the cdr of a list" '(b c d) (cdr '((a) b c d)))
 
-; (check-equal 2 (cdr '(1 . 2)))
+(check-equal? "take the cdr of a pair" 2 (cdr '(1 . 2)))
 
 (check-equal? "Check list predicate" #t (list? '(a b c)))
 
 (check-equal? "Empty list is a list" #t (list? '()))
 
-; (check-equal #f (list? '(a . b)))
+(check-equal? "Improper list" #f (list? '(a . b)))
 
 ; (check-equal #f
 ;       (let ([x (list 'a)])

crates/steel-core/src/compiler/compiler.rs

@@ -4,7 +4,7 @@ use crate::{
         map::SymbolMap,
         passes::{
             analysis::SemanticAnalysis, begin::flatten_begins_and_expand_defines,
-            reader::MultipleArityFunctions, shadow::RenameShadowedVariables, VisitorMutRefUnit,
+            shadow::RenameShadowedVariables, VisitorMutRefUnit,
         },
     },
     core::{instructions::u24, labels::Expr},
@@ -759,8 +759,6 @@ impl Compiler {
             .rename_shadowed_variables(&mut expanded_statements);
 
         // let mut expanded_statements =
-        MultipleArityFunctions::expand_multiple_arity_functions(&mut expanded_statements);
-
         log::info!(target: "expansion-phase", "Aggressive constant evaluation with memoization");
 
         // Begin lowering anonymous function calls to lets
@@ -941,7 +939,6 @@ impl Compiler {
 
         // TODO - make sure I want to keep this
         // let mut expanded_statements =
-        MultipleArityFunctions::expand_multiple_arity_functions(&mut expanded_statements);
 
         log::info!(target: "expansion-phase", "Aggressive constant evaluation with memoization");
 

crates/steel-core/src/compiler/passes/mangle.rs

@@ -178,12 +178,16 @@ impl VisitorMutRefUnit for NameMangler {
 
 #[cfg(test)]
 mod name_mangling_tests {
+    use steel_parser::visitors::Eraser;
+
     use super::*;
 
     use crate::parser::parser::Parser;
 
     #[test]
     fn basic_mangling() {
+        let mut eraser = Eraser;
+
         let expr = r#"
            (define (foo x y z) (let ((a 10) (b 20)) (bar (+ x y z a b))))
            (define (bar applesauce) (+ applesauce 10))
@@ -193,19 +197,25 @@ mod name_mangling_tests {
 
         mangle_vars_with_prefix("--test--".to_string(), &mut parsed);
 
-        let expected = Parser::parse(
+        eraser.visit_many(&mut parsed);
+
+        let mut expected = Parser::parse(
             r#"
             (define (--test--foo x y z) (let ((a 10) (b 20)) (--test--bar (+ x y z a b))))
             (define (--test--bar applesauce) (+ applesauce 10))
         "#,
         )
         .unwrap();
 
+        eraser.visit_many(&mut expected);
+
         assert_eq!(parsed, expected);
     }
 
     #[test]
     fn shadowed_global_still_mangled() {
+        let mut eraser = Eraser;
+
         let expr = r#"
         (define (foo x y z) (let ((foo 10) (b 20)) (foo (+ bar y z a b))))
         (define (bar applesauce) (+ applesauce 10))
@@ -215,14 +225,18 @@ mod name_mangling_tests {
 
         mangle_vars_with_prefix("--test--".to_string(), &mut parsed);
 
-        let expected = Parser::parse(
+        eraser.visit_many(&mut parsed);
+
+        let mut expected = Parser::parse(
             r#"
             (define (--test--foo x y z) (let ((--test--foo 10) (b 20)) (--test--foo (+ --test--bar y z a b))))
             (define (--test--bar applesauce) (+ applesauce 10))
      "#,
         )
         .unwrap();
 
+        eraser.visit_many(&mut expected);
+
         assert_eq!(parsed, expected);
     }
 

crates/steel-core/src/compiler/passes/mod.rs

@@ -2,7 +2,6 @@ pub mod analysis;
 pub mod begin;
 pub mod manager;
 pub mod mangle;
-pub mod reader;
 pub mod shadow;
 
 use std::ops::ControlFlow;

crates/steel-core/src/core/instructions.rs

@@ -1,6 +1,5 @@
 use crate::core::opcode::OpCode;
 use serde::{Deserialize, Serialize};
-use std::convert::TryInto;
 
 use super::labels::Expr;
 

crates/steel-core/src/parser/expand_visitor.rs

@@ -3,8 +3,6 @@ use quickscope::ScopeSet;
 use steel_parser::ast::{parse_lambda, Begin};
 use steel_parser::parser::SourceId;
 
-use crate::compiler::passes::reader::MultipleArityFunctions;
-use crate::compiler::passes::VisitorMutRefUnit;
 use crate::parser::ast::ExprKind;
 use crate::parser::parser::SyntaxObject;
 use crate::parser::span_visitor::get_span;
@@ -526,8 +524,6 @@ fn expand_keyword_arguments(lambda_function: &mut super::ast::LambdaFunction) ->
     // If there are rest arguments though, we'll need to split the rest argument list into two - the first half will then get
     // applied to the hashmap list, while the rest of the arguments will get applied to the correct place.
 
-    MultipleArityFunctions::new().visit_lambda_function(lambda_function);
-
     // If this already has a rest arguments, we need to slice out the
     // remaining function values from the keywords, and then bind those to whatever variable in the original
     // list before we create the hash. Making the hash itself is also not exactly my favorite pattern - we need

crates/steel-core/src/parser/parser.rs

@@ -221,6 +221,7 @@ impl TryFrom<SyntaxObject> for SteelVal {
             UnquoteSpliceSyntax => {
                 Err(SteelErr::new(ErrorKind::UnexpectedToken, "#,@".to_string()).with_span(span))
             }
+            Dot => Err(SteelErr::new(ErrorKind::UnexpectedToken, ".".to_string()).with_span(span)),
         }
     }
 }

crates/steel-core/src/parser/tryfrom_visitor.rs

@@ -125,10 +125,29 @@ impl ConsumingVisitor for TryFromExprKindForSteelVal {
     }
 
     fn visit_list(&mut self, l: super::ast::List) -> Self::Output {
-        let items: std::result::Result<List<_>, SteelErr> =
+        if !l.improper {
+            let items: std::result::Result<List<_>, SteelErr> =
+                l.args.into_iter().map(|x| self.visit(x)).collect();
+
+            return Ok(items?.into());
+        }
+
+        debug_assert!(l.args.len() >= 2);
+
+        if l.args.len() < 2 {
+            stop!(Generic => "internal compiler error - unexpected malformed improper list");
+        };
+
+        let items: std::result::Result<Vec<_>, SteelErr> =
             l.args.into_iter().map(|x| self.visit(x)).collect();
 
-        Ok(items?.into())
+        let pair = items?
+            .into_iter()
+            .rev()
+            .reduce(|cdr, car| crate::values::lists::Pair::cons(car, cdr).into())
+            .unwrap();
+
+        Ok(pair)
     }
 
     fn visit_syntax_rules(&mut self, s: Box<super::ast::SyntaxRules>) -> Self::Output {