add #simplext, a super-simple syntax extension system

src/comp/front/ext.rs

@@ -1,25 +1,29 @@
-
+import std::vec;
 import std::option;
 import std::map::hashmap;
 import driver::session::session;
 import front::parser::parser;
 import util::common::span;
 import util::common::new_str_hash;
 
-type syntax_expander =
-    fn(&ext_ctxt, span, &vec[@ast::expr], option::t[str]) -> @ast::expr ;
-
-
-// Temporary: to introduce a tag in order to make a recursive type work
-tag syntax_extension { x(syntax_expander); }
+type syntax_expander = 
+    fn(&ext_ctxt, span, &vec[@ast::expr], option::t[str]) -> @ast::expr;
+type macro_definer = fn(&ext_ctxt, span, &vec[@ast::expr],
+                        option::t[str]) -> tup(str, syntax_extension);
 
+tag syntax_extension {
+    normal(syntax_expander);
+    macro_defining(macro_definer);
+}
 
 // A temporary hard-coded map of methods for expanding syntax extension
 // AST nodes into full ASTs
 fn syntax_expander_table() -> hashmap[str, syntax_extension] {
     auto syntax_expanders = new_str_hash[syntax_extension]();
-    syntax_expanders.insert("fmt", x(extfmt::expand_syntax_ext));
-    syntax_expanders.insert("env", x(extenv::expand_syntax_ext));
+    syntax_expanders.insert("fmt", normal(extfmt::expand_syntax_ext));
+    syntax_expanders.insert("env", normal(extenv::expand_syntax_ext));
+    syntax_expanders.insert("macro",    
+                            macro_defining(extsimplext::add_new_extension));
     ret syntax_expanders;
 }
 
@@ -51,6 +55,37 @@ fn mk_ctxt(parser parser) -> ext_ctxt {
             span_unimpl=ext_span_unimpl,
             next_id=ext_next_id);
 }
+
+fn expr_to_str(&ext_ctxt cx, @ast::expr expr, str error) -> str {
+    alt (expr.node) {
+        case (ast::expr_lit(?l)) {
+            alt (l.node) {
+                case (ast::lit_str(?s, _)) { ret s; }
+                case (_) { cx.span_fatal(l.span, error); }
+            }
+        }
+        case (_) { cx.span_fatal(expr.span, error); }
+    }
+}
+
+fn expr_to_ident(&ext_ctxt cx, @ast::expr expr, str error) -> ast::ident {
+    alt(expr.node) {
+        case (ast::expr_path(?p)) {
+            if (vec::len(p.node.types) > 0u 
+                || vec::len(p.node.idents) != 1u) {
+                cx.span_fatal(expr.span, error);
+            } else {
+                ret p.node.idents.(0);
+            }
+        }
+        case (_) {
+            cx.span_fatal(expr.span, error);
+        }
+    }
+}
+
+
+
 //
 // Local Variables:
 // mode: rust

src/comp/front/extenv.rs

@@ -21,27 +21,13 @@ fn expand_syntax_ext(&ext_ctxt cx, common::span sp, &vec[@ast::expr] args,
     // FIXME: if this was more thorough it would manufacture an
     // option::t[str] rather than just an maybe-empty string.
 
-    auto var = expr_to_str(cx, args.(0));
+    auto var = expr_to_str(cx, args.(0), "#env requires a string");
     alt (generic_os::getenv(var)) {
         case (option::none) { ret make_new_str(cx, sp, ""); }
         case (option::some(?s)) { ret make_new_str(cx, sp, s); }
     }
 }
 
-
-// FIXME: duplicate code copied from extfmt:
-fn expr_to_str(&ext_ctxt cx, @ast::expr expr) -> str {
-    alt (expr.node) {
-        case (ast::expr_lit(?l)) {
-            alt (l.node) {
-                case (ast::lit_str(?s, _)) { ret s; }
-                case (_) { cx.span_fatal(l.span, "malformed #env call"); }
-            }
-        }
-        case (_) { cx.span_fatal(expr.span, "malformed #env call"); }
-    }
-}
-
 fn make_new_lit(&ext_ctxt cx, common::span sp, ast::lit_ lit) -> @ast::expr {
     auto sp_lit = @rec(node=lit, span=sp);
     ret @rec(id=cx.next_id(), node=ast::expr_lit(sp_lit), span=sp);

src/comp/front/extfmt.rs

@@ -20,7 +20,8 @@ fn expand_syntax_ext(&ext_ctxt cx, common::span sp, &vec[@ast::expr] args,
     if (vec::len[@ast::expr](args) == 0u) {
         cx.span_fatal(sp, "#fmt requires a format string");
     }
-    auto fmt = expr_to_str(cx, args.(0));
+    auto fmt = expr_to_str(cx, args.(0), "first argument to #fmt must be a "
+                           + "string literal.");
     auto fmtspan = args.(0).span;
     log "Format string:";
     log fmt;
@@ -32,20 +33,6 @@ fn expand_syntax_ext(&ext_ctxt cx, common::span sp, &vec[@ast::expr] args,
     ret pieces_to_expr(cx, sp, pieces, args);
 }
 
-fn expr_to_str(&ext_ctxt cx, @ast::expr expr) -> str {
-    auto err_msg = "first argument to #fmt must be a string literal";
-    alt (expr.node) {
-        case (ast::expr_lit(?l)) {
-            alt (l.node) {
-                case (ast::lit_str(?s, _)) { ret s; }
-                case (_) { cx.span_fatal(l.span, err_msg); }
-            }
-        }
-        case (_) { cx.span_fatal(expr.span, err_msg); }
-    }
-}
-
-
 // FIXME: A lot of these functions for producing expressions can probably
 // be factored out in common with other code that builds expressions.
 // FIXME: Cleanup the naming of these functions

src/comp/front/extsimplext.rs

@@ -0,0 +1,144 @@
+use std;
+
+import util::common::span;
+import std::vec;
+import std::option;
+import vec::map;
+import vec::len;
+import option::some;
+import option::none;
+
+import ext::syntax_extension;
+import ext::ext_ctxt;
+import ext::normal;
+import ext::expr_to_str;
+import ext::expr_to_ident;
+
+import fold::*;
+import ast::ident;
+import ast::path_;
+import ast::expr_path;
+
+export add_new_extension;
+
+
+//temporary, until 'position' shows up in the snapshot
+fn position[T](&T x, &vec[T] v) -> option::t[uint] {
+    let uint i = 0u;
+    while (i < len(v)) {
+        if (x == v.(i)) { ret some[uint](i); }
+        i += 1u;
+    }
+    ret none[uint];
+}
+
+// substitute, in a position that's required to be an ident
+fn subst_ident(&ext_ctxt cx, &vec[@ast::expr] args, 
+               @vec[ident] param_names, &ident i, ast_fold fld) -> ident {
+    alt (position(i, *param_names)) {
+        case (some[uint](?idx)) {
+            ret expr_to_ident(cx, args.(idx), 
+                              "This argument is expanded as an "
+                              + "identifier; it must be one.");
+        }
+        case (none[uint]) {
+            ret i;
+        }
+    }
+}
+
+fn subst_path(&ext_ctxt cx, &vec[@ast::expr] args, 
+              @vec[ident] param_names, &path_ p, ast_fold fld) -> path_ {
+    // Don't substitute into qualified names.
+    if (len(p.types) > 0u || len(p.idents) != 1u) { ret p; }
+    alt (position(p.idents.(0), *param_names)) {
+        case (some[uint](?idx)) {
+            alt (args.(idx).node) {
+                case (expr_path(?new_path)) {
+                    ret new_path.node;
+                }
+                case (_) {
+                    cx.span_fatal(args.(idx).span,
+                                "This argument is expanded as a path; "
+                                + "it must be one.");
+                }
+            }
+        }
+        case (none[uint]) { ret p; }
+    }
+}
+
+
+fn subst_expr(&ext_ctxt cx, &vec[@ast::expr] args, @vec[ident] param_names, 
+              &ast::expr_ e, ast_fold fld, 
+              fn(&ast::expr_, ast_fold) -> ast::expr_ orig) -> ast::expr_ {
+    ret alt(e) {
+        case (expr_path(?p)){
+            // Don't substitute into qualified names.
+            if (len(p.node.types) > 0u || len(p.node.idents) != 1u) { e }
+            alt (position(p.node.idents.(0), *param_names)) {
+                case (some[uint](?idx)) {
+                    args.(idx).node
+                }
+                case (none[uint]) { e }
+            }
+        }
+        case (_) { orig(e,fld) }
+    }
+}
+
+
+fn add_new_extension(&ext_ctxt cx, span sp, &vec[@ast::expr] args,
+                     option::t[str] body) -> tup(str, syntax_extension) {
+    if (len(args) < 2u) {
+        cx.span_fatal(sp, "malformed extension description");
+    }
+
+    fn generic_extension(&ext_ctxt cx, span sp, &vec[@ast::expr] args,
+                         option::t[str] body, @vec[ident] param_names,
+                         @ast::expr dest_form) -> @ast::expr {
+        if (len(args) != len(*param_names)) {
+            cx.span_fatal(sp, #fmt("extension expects %u arguments, got %u",
+                                 len(*param_names), len(args)));
+        }
+
+        auto afp = default_ast_fold();
+        auto f_pre = 
+            rec(fold_ident = bind subst_ident(cx, args, param_names, _, _),
+                fold_path = bind subst_path(cx, args, param_names, _, _),
+                fold_expr = bind subst_expr(cx, args, param_names, _, _,
+                                            afp.fold_expr)
+                with *afp);
+        auto f = make_fold(f_pre);
+        auto result = f.fold_expr(dest_form);
+        dummy_out(f); //temporary: kill circular reference
+        ret result;
+
+    }
+
+    let vec[ident] param_names = vec::empty[ident]();
+    let uint idx = 1u;
+    while(1u+idx < len(args)) {
+        param_names +=
+            [expr_to_ident(cx, args.(idx),
+                           "this parameter name must be an identifier.")];
+        idx += 1u;
+    }
+
+    ret tup(expr_to_str(cx, args.(0), "first arg must be a literal string."),
+            normal(bind generic_extension(_,_,_,_,@param_names,
+                                          args.(len(args)-1u))));
+}
+
+
+
+//
+// Local Variables:
+// mode: rust
+// fill-column: 78;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C $RBUILD 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:
+//