Some bug fixes with requiring modules, syntax objects (#128)

* optimistic cdr is null check

* add r5rs test suite to test runner

* add string replace function

cogs/r5rs.scm

@@ -37,6 +37,10 @@
 
 (set-test-mode!)
 
+(provide __module__)
+
+(define __module__ 'r5rs-test-suite)
+
 (check-equal? "Parsing hex" #x0f 15)
 (check-equal? "Parsing octal" #o0777 511)
 (check-equal? "Parsing binary" #b0110 6)
@@ -390,7 +394,6 @@
 (check-equal? "Basic functionality of make-string" "aaa" (make-string 3 #\a))
 (check-equal? "make-string with no character" "\0\0\0" (make-string 3))
 (check-equal? "make-string with zero length" "" (make-string 0))
-(check-equal? "make-string with multiple additional characters" "error" (make-string 3 #\a #\b))
 
 (check-equal? "string-equality with constructor, equal" #t (string=? "a" (string #\a)))
 (check-equal? "string-equality with constructor, not equal" #f (string=? "a" (string #\b)))
@@ -422,8 +425,12 @@
 (check-equal? "case-insensitive string >=, true" #t (string-ci>=? "aa" "A"))
 (check-equal? "case-insensitive string >=, same string" #t (string-ci>=? "a" "A"))
 
-(check-equal? "make-string creates single character string 'a' correctly" #t (string=? "a" (make-string 1 #\a)))
-(check-equal? "make-string with character 'b' does not create string 'a'" #f (string=? "a" (make-string 1 #\b)))
+(check-equal? "make-string creates single character string 'a' correctly"
+              #t
+              (string=? "a" (make-string 1 #\a)))
+(check-equal? "make-string with character 'b' does not create string 'a'"
+              #f
+              (string=? "a" (make-string 1 #\b)))
 
 (check-equal? "string-append with empty string" "abc" (string-append "abc" ""))
 

crates/steel-core/Cargo.toml

@@ -26,7 +26,7 @@ serde = { version = "1.0.193", features = ["derive", "rc"] }
 serde_derive = "1.0.193"
 bincode = "1.3.3"
 pretty = "0.12.1"
-im-lists = "0.6.0"
+im-lists = "0.7.0"
 quickscope = "0.2.0"
 lasso = { version = "0.7.2", features = ["multi-threaded", "serialize"] }
 once_cell = "1.18.0"

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

@@ -649,6 +649,8 @@ impl Compiler {
 
                 for module in &self.lifted_macro_environments {
                     if let Some(macro_env) = self.modules().get(module).map(|x| &x.macro_map) {
+                        let source_id = sources.get_source_id(module).unwrap();
+
                         x = crate::parser::expand_visitor::expand(x, macro_env)?
                     }
                 }
@@ -837,6 +839,12 @@ impl Compiler {
 
                 for module in &self.lifted_macro_environments {
                     if let Some(macro_env) = self.modules().get(module).map(|x| &x.macro_map) {
+                        let source_id = sources.get_source_id(module).unwrap();
+
+                        // x = crate::parser::expand_visitor::expand_with_source_id(
+                        //     x, macro_env, source_id,
+                        // )?
+
                         x = crate::parser::expand_visitor::expand(x, macro_env)?
                     }
                 }

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

@@ -11,7 +11,7 @@ use crate::{
         ast::{AstTools, Atom, Begin, Define, ExprKind, List, Quote},
         expand_visitor::{
             expand_kernel, expand_kernel_in_env, expand_kernel_in_env_with_allowed,
-            expand_kernel_in_env_with_change,
+            expand_kernel_in_env_with_change, expand_with_source_id,
         },
         interner::InternedString,
         kernel::Kernel,
@@ -53,6 +53,7 @@ use crate::parser::ast::IteratorExtensions;
 use super::{
     compiler::KernelDefMacroSpec,
     passes::{
+        analysis::is_a_builtin_definition,
         begin::FlattenBegin,
         mangle::{collect_globals, NameMangler, NameUnMangler},
     },
@@ -630,7 +631,13 @@ impl ModuleManager {
                     // }
 
                     if expander.changed || changed {
-                        let fully_expanded = expand(first_round_expanded, &module.macro_map)?;
+                        let source_id = sources.get_source_id(&module.name).unwrap();
+
+                        let fully_expanded = expand(
+                            first_round_expanded,
+                            &module.macro_map,
+                            // source_id,
+                        )?;
 
                         let module_name = module.name.to_str().unwrap().to_string();
 
@@ -1323,13 +1330,42 @@ impl CompiledModule {
             SyntaxObject::default(TokenType::Quote),
         )));
 
-        // println!("------ {}", module_define.to_pretty(60));
+        let mut offset = None;
+
+        // Find offset of first non builtin require definition:
+        for (idx, expr) in exprs.iter().enumerate() {
+            if let ExprKind::Define(d) = expr {
+                if !is_a_builtin_definition(d) {
+                    // println!("Found offset at: {:?}", offset);
+
+                    offset = Some(idx);
+                    break;
+                }
+            }
+        }
 
         exprs.push(module_define);
 
+        if let Some(offset) = offset {
+            for (idx, expr) in provide_definitions.into_iter().enumerate() {
+                exprs.insert(offset + idx, expr);
+            }
+        } else {
+            provide_definitions.append(&mut exprs);
+        }
+
+        // println!("------ {}", module_define.to_pretty(60));
+
+        // exprs.pretty_print();
+
+        // exprs.push(module_define);
+
         // Construct the overall definition
         // TODO: Perhaps mangle these as well, especially if they have contracts associated with them
-        provide_definitions.append(&mut exprs);
+
+        // if offset.is_none() {
+        //     provide_definitions.append(&mut exprs);
+        // }
 
         // Try this out?
         // let mut analysis = Analysis::from_exprs(&provide_definitions);
@@ -1340,10 +1376,8 @@ impl CompiledModule {
         // .replace_non_shadowed_globals_with_builtins()
         // .remove_unused_globals_with_prefix("mangler");
 
-        // println!("------ {}", provide_definitions.to_pretty(60));
-
         Ok(ExprKind::Begin(Begin::new(
-            provide_definitions,
+            exprs,
             SyntaxObject::default(TokenType::Begin),
         )))
     }
@@ -1810,6 +1844,8 @@ impl<'a> ModuleBuilder<'a> {
                     let mut first_round_expanded = expander.expand(x)?;
                     let mut changed = false;
 
+                    // dbg!(expander.changed);
+
                     // (first_round_expanded, changed) = expand_kernel_in_env_with_allowed(
                     //     first_round_expanded,
                     //     self.kernel.as_mut(),
@@ -1837,7 +1873,7 @@ impl<'a> ModuleBuilder<'a> {
                     // }
 
                     if expander.changed || changed {
-                        // expand(first_round_expanded, &module.macro_map)
+                        // let source_id = self.sources.get_source_id(&module.name).unwrap();
 
                         let fully_expanded = expand(first_round_expanded, &module.macro_map)?;
 
@@ -2421,7 +2457,11 @@ impl<'a> ModuleBuilder<'a> {
     }
 
     fn parse_builtin(mut self, input: &str) -> Result<Self> {
-        let parsed = Parser::new_from_source(input, self.name.clone(), None)
+        let id = self
+            .sources
+            .add_source(input.to_string(), Some(self.name.clone()));
+
+        let parsed = Parser::new_from_source(input, self.name.clone(), Some(id))
             .without_lowering()
             .map(|x| x.and_then(lower_macro_and_require_definitions))
             .collect::<std::result::Result<Vec<_>, ParseError>>()?;

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

@@ -424,12 +424,12 @@ pub fn inline_num_operations(instructions: &mut [Instruction]) {
         {
             let replaced = match *ident {
                 x if x == *PRIM_PLUS && *payload_size == 2 => Some(OpCode::BINOPADD),
-                x if x == *PRIM_PLUS => Some(OpCode::ADD),
-                x if x == *PRIM_MINUS => Some(OpCode::SUB),
-                x if x == *PRIM_DIV => Some(OpCode::DIV),
-                x if x == *PRIM_STAR => Some(OpCode::MUL),
-                x if x == *PRIM_EQUAL => Some(OpCode::EQUAL),
-                x if x == *PRIM_LTE => Some(OpCode::LTE),
+                x if x == *PRIM_PLUS && *payload_size > 0 => Some(OpCode::ADD),
+                x if x == *PRIM_MINUS && *payload_size > 0 => Some(OpCode::SUB),
+                x if x == *PRIM_DIV && *payload_size > 0 => Some(OpCode::DIV),
+                x if x == *PRIM_STAR && *payload_size > 0 => Some(OpCode::MUL),
+                x if x == *PRIM_EQUAL && *payload_size > 0 => Some(OpCode::EQUAL),
+                x if x == *PRIM_LTE && *payload_size > 0 => Some(OpCode::LTE),
                 _ => None,
             };
 

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

@@ -2,6 +2,7 @@
 
 use quickscope::ScopeSet;
 use steel_parser::ast::{parse_lambda, LAMBDA, LAMBDA_SYMBOL};
+use steel_parser::parser::SourceId;
 
 use crate::compiler::passes::reader::MultipleArityFunctions;
 use crate::compiler::passes::Folder;
@@ -53,6 +54,21 @@ pub fn expand(expr: ExprKind, map: &HashMap<InternedString, SteelMacro>) -> Resu
         map,
         changed: false,
         in_scope_values: ScopeSet::new(),
+        source_id: None,
+    }
+    .visit(expr)
+}
+
+pub fn expand_with_source_id(
+    expr: ExprKind,
+    map: &HashMap<InternedString, SteelMacro>,
+    source_id: SourceId,
+) -> Result<ExprKind> {
+    Expander {
+        map,
+        changed: false,
+        in_scope_values: ScopeSet::new(),
+        source_id: Some(source_id),
     }
     .visit(expr)
 }
@@ -62,6 +78,7 @@ pub struct Expander<'a> {
     pub(crate) changed: bool,
     // We're going to actually check if the macro is in scope
     in_scope_values: ScopeSet<InternedString>,
+    source_id: Option<SourceId>,
 }
 
 impl<'a> Expander<'a> {
@@ -70,6 +87,7 @@ impl<'a> Expander<'a> {
             map,
             changed: false,
             in_scope_values: ScopeSet::new(),
+            source_id: None,
         }
     }
 
@@ -187,9 +205,17 @@ impl<'a> ConsumingVisitor for Expander<'a> {
                     // If this macro has been overwritten by any local value, respect
                     // the local binding and do not expand the macro
                     if !self.in_scope_values.contains(s) {
-                        let expanded = m.expand(l.clone(), *sp)?;
-                        self.changed = true;
-                        return self.visit(expanded);
+                        if self.source_id.is_none()
+                            || self.source_id.is_some() && self.source_id == sp.source_id()
+                        {
+                            let expanded = m.expand(l.clone(), *sp)?;
+                            self.changed = true;
+                            return self.visit(expanded);
+                        }
+
+                        // let expanded = m.expand(l.clone(), *sp)?;
+                        // self.changed = true;
+                        // return self.visit(expanded);
                     }
                 }
             }

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

@@ -1,4 +1,4 @@
-use crate::compiler::program::{BEGIN, DEFINE};
+use crate::compiler::program::{BEGIN, DEFINE, IF};
 use crate::parser::ast::{Atom, ExprKind, List, Macro, PatternPair};
 use crate::parser::parser::SyntaxObject;
 use crate::parser::rename_idents::RenameIdentifiersVisitor;
@@ -359,6 +359,7 @@ pub enum MacroPattern {
     BooleanLiteral(bool),
     QuotedExpr(Box<Quote>),
     Quote(InternedString),
+    Keyword(InternedString),
 }
 
 // pub enum QuotedLiteral {
@@ -382,6 +383,7 @@ impl std::fmt::Debug for MacroPattern {
             MacroPattern::QuotedExpr(s) => f.debug_tuple("QuotedExpr").field(s).finish(),
             MacroPattern::Quote(i) => f.debug_tuple("Quote").field(&i.resolve()).finish(),
             MacroPattern::ManyNested(n) => f.debug_tuple("ManyNested").field(n).finish(),
+            MacroPattern::Keyword(k) => f.debug_tuple("Keyword").field(k).finish(),
         }
     }
 }
@@ -459,6 +461,9 @@ impl MacroPattern {
                     TokenType::Define => {
                         pattern_vec.push(MacroPattern::Syntax(*DEFINE));
                     }
+                    TokenType::If => {
+                        pattern_vec.push(MacroPattern::Syntax(*IF));
+                    }
                     TokenType::BooleanLiteral(b) => {
                         pattern_vec.push(MacroPattern::BooleanLiteral(b));
                     }
@@ -474,6 +479,9 @@ impl MacroPattern {
                     TokenType::StringLiteral(s) => {
                         pattern_vec.push(MacroPattern::StringLiteral(s));
                     }
+                    TokenType::Keyword(k) => {
+                        pattern_vec.push(MacroPattern::Keyword(k));
+                    }
                     // TODO: Crunch the quoted values here, and pull them in so that this
                     // holds a body of possible quoted values
                     TokenType::Quote => {
@@ -602,6 +610,12 @@ pub fn match_vec_pattern(args: &[MacroPattern], list: &[ExprKind]) -> bool {
                                 ..
                             },
                     }) if *v == *BEGIN => continue,
+                    ExprKind::Atom(Atom {
+                        syn:
+                            SyntaxObject {
+                                ty: TokenType::If, ..
+                            },
+                    }) if *v == *IF => continue,
                     ExprKind::Atom(Atom {
                         syn:
                             SyntaxObject {
@@ -611,6 +625,16 @@ pub fn match_vec_pattern(args: &[MacroPattern], list: &[ExprKind]) -> bool {
                     }) => continue,
                     _ => return false,
                 },
+                MacroPattern::Keyword(k) => match val {
+                    ExprKind::Atom(Atom {
+                        syn:
+                            SyntaxObject {
+                                ty: TokenType::Keyword(s),
+                                ..
+                            },
+                    }) if s == k => continue,
+                    _ => return false,
+                },
                 MacroPattern::BooleanLiteral(b) => match val {
                     ExprKind::Atom(Atom {
                         syn:

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

@@ -521,7 +521,7 @@ impl Kernel {
         let span = get_span(&expr);
 
         let syntax_objects =
-            super::tryfrom_visitor::SyntaxObjectFromExprKind::try_from_expr_kind(expr.clone())?;
+            super::tryfrom_visitor::SyntaxObjectFromExprKind::try_from_expr_kind(expr)?;
 
         let function = if environment == "default" {
             // TODO: This actually needs to go through the proper resolution process,
@@ -546,18 +546,7 @@ impl Kernel {
             .call_function_with_args(function, vec![syntax_objects])
             .map_err(|x| x.set_span(span))?;
 
-        // dbg!(&result);
-
         // This shouldn't be lowering all the way. It should just be back to list right?
         TryFromSteelValVisitorForExprKind::root(&result)
-
-        // let span = result.as_ref().map(get_span);
-
-        // dbg!(&span);
-
-        // result
-
-        // TODO: We don't want this forever, but for now its okay
-        // .and_then(|x| RewriteSpan::new(span).visit(x))
     }
 }