* Some utility functions for working with ATerms.

14 files changed, 363 insertions, 175 deletions

diff --git a/src/fix-ng/eval.cc b/src/fix-ng/eval.cc
index 2b45b47984e8..55cb5fbcff27 100644
--- a/src/fix-ng/eval.cc
+++ b/src/fix-ng/eval.cc
@@ -16,6 +16,7 @@ EvalState::EvalState()
 /* Substitute an argument set into the body of a function. */
 static Expr substArgs(Expr body, ATermList formals, Expr arg)
 {
+    ATMatcher m;
     ATermMap subs;
     Expr undefined = ATmake("Undefined");
 
@@ -23,9 +24,9 @@ static Expr substArgs(Expr body, ATermList formals, Expr arg)
     while (!ATisEmpty(formals)) {
         ATerm t = ATgetFirst(formals);
         Expr name, def;
-        if (ATmatch(t, "NoDefFormal(<term>)", &name))
+        if (atMatch(m, t) >> "NoDefFormal" >> name)
             subs.set(name, undefined);
-        else if (ATmatch(t, "DefFormal(<term>, <term>)", &name, &def))
+        else if (atMatch(m, t) >> "DefFormal" >> name >> def)
             subs.set(name, def);
         else abort(); /* can't happen */
         formals = ATgetNext(formals);
@@ -67,15 +68,17 @@ static Expr substArgs(Expr body, ATermList formals, Expr arg)
    (e.x) (e.y), y = e.x}'. */
 ATerm expandRec(ATerm e, ATermList bnds)
 {
+    ATMatcher m;
+
     /* Create the substitution list. */
     ATermMap subs;
     ATermList bs = bnds;
     while (!ATisEmpty(bs)) {
-        char * s;
+        string s;
         Expr e2;
-        if (!ATmatch(ATgetFirst(bs), "Bind(<str>, <term>)", &s, &e2))
+        if (!(atMatch(m, ATgetFirst(bs)) >> "Bind" >> s >> e2))
             abort(); /* can't happen */
-        subs.set(s, ATmake("Select(<term>, <str>)", e, s));
+        subs.set(s, ATmake("Select(<term>, <str>)", e, s.c_str()));
         bs = ATgetNext(bs);
     }
 
@@ -83,9 +86,9 @@ ATerm expandRec(ATerm e, ATermList bnds)
     ATermMap as;
     bs = bnds;
     while (!ATisEmpty(bs)) {
-        char * s;
+        string s;
         Expr e2;
-        if (!ATmatch(ATgetFirst(bs), "Bind(<str>, <term>)", &s, &e2))
+        if (!(atMatch(m, ATgetFirst(bs)) >> "Bind" >> s >> e2))
             abort(); /* can't happen */
         as.set(s, substitute(subs, e2));
         bs = ATgetNext(bs);
@@ -98,8 +101,9 @@ ATerm expandRec(ATerm e, ATermList bnds)
 string evalString(EvalState & state, Expr e)
 {
     e = evalExpr(state, e);
-    char * s;
-    if (!ATmatch(e, "Str(<str>)", &s))
+    ATMatcher m;
+    string s;
+    if (!(atMatch(m, e) >> "Str" >> s))
         throw badTerm("string expected", e);
     return s;
 }
@@ -108,8 +112,9 @@ string evalString(EvalState & state, Expr e)
 Path evalPath(EvalState & state, Expr e)
 {
     e = evalExpr(state, e);
-    char * s;
-    if (!ATmatch(e, "Path(<str>)", &s))
+    ATMatcher m;
+    string s;
+    if (!(atMatch(m, e) >> "Path" >> s))
         throw badTerm("path expected", e);
     return s;
 }
@@ -118,78 +123,79 @@ Path evalPath(EvalState & state, Expr e)
 bool evalBool(EvalState & state, Expr e)
 {
     e = evalExpr(state, e);
-    if (ATmatch(e, "Bool(True)")) return true;
-    else if (ATmatch(e, "Bool(False)")) return false;
+    ATMatcher m;
+    if (atMatch(m, e) >> "Bool" >> "True") return true;
+    else if (atMatch(m, e) >> "Bool" >> "False") return false;
     else throw badTerm("expecting a boolean", e);
 }
 
 
 Expr evalExpr2(EvalState & state, Expr e)
 {
+    ATMatcher m;
     Expr e1, e2, e3, e4;
-    char * s1;
+    string s1;
 
     /* Normal forms. */
-    if (ATmatch(e, "Str(<str>)", &s1) ||
-        ATmatch(e, "Path(<str>)", &s1) ||
-        ATmatch(e, "Uri(<str>)", &s1) ||
-        ATmatch(e, "Bool(<term>)", &e1) ||
-        ATmatch(e, "Function([<list>], <term>)", &e1, &e2) ||
-        ATmatch(e, "Attrs([<list>])", &e1) ||
-        ATmatch(e, "List([<list>])", &e1))
+    if (atMatch(m, e) >> "Str" ||
+        atMatch(m, e) >> "Path" ||
+        atMatch(m, e) >> "Uri" ||
+        atMatch(m, e) >> "Bool" ||
+        atMatch(m, e) >> "Function" ||
+        atMatch(m, e) >> "Attrs" ||
+        atMatch(m, e) >> "List")
         return e;
 
     /* Any encountered variables must be undeclared or primops. */
-    if (ATmatch(e, "Var(<str>)", &s1)) {
-        if ((string) s1 == "null") return primNull(state);
+    if (atMatch(m, e) >> "Var" >> s1) {
+        if (s1 == "null") return primNull(state);
         return e;
     }
 
     /* Function application. */
-    if (ATmatch(e, "Call(<term>, <term>)", &e1, &e2)) {
+    if (atMatch(m, e) >> "Call" >> e1 >> e2) {
+
+        ATermList formals;
         
         /* Evaluate the left-hand side. */
         e1 = evalExpr(state, e1);
 
         /* Is it a primop or a function? */
-        if (ATmatch(e1, "Var(<str>)", &s1)) {
-            string primop(s1);
-            if (primop == "import") return primImport(state, e2);
-            if (primop == "derivation") return primDerivation(state, e2);
-            if (primop == "toString") return primToString(state, e2);
-            if (primop == "baseNameOf") return primBaseNameOf(state, e2);
-            if (primop == "isNull") return primIsNull(state, e2);
+        if (atMatch(m, e1) >> "Var" >> s1) {
+            if (s1 == "import") return primImport(state, e2);
+            if (s1 == "derivation") return primDerivation(state, e2);
+            if (s1 == "toString") return primToString(state, e2);
+            if (s1 == "baseNameOf") return primBaseNameOf(state, e2);
+            if (s1 == "isNull") return primIsNull(state, e2);
             else throw badTerm("undefined variable/primop", e1);
         }
 
-        else if (ATmatch(e1, "Function([<list>], <term>)", &e3, &e4)) {
+        else if (atMatch(m, e1) >> "Function" >> formals >> e4)
             return evalExpr(state, 
-                substArgs(e4, (ATermList) e3, evalExpr(state, e2)));
-        }
+                substArgs(e4, formals, evalExpr(state, e2)));
         
         else throw badTerm("expecting a function or primop", e1);
     }
 
     /* Attribute selection. */
-    if (ATmatch(e, "Select(<term>, <str>)", &e1, &s1)) {
-        string name(s1);
-        Expr a = queryAttr(evalExpr(state, e1), name);
-        if (!a) throw badTerm(format("missing attribute `%1%'") % name, e);
+    if (atMatch(m, e) >> "Select" >> e1 >> s1) {
+        Expr a = queryAttr(evalExpr(state, e1), s1);
+        if (!a) throw badTerm(format("missing attribute `%1%'") % s1, e);
         return evalExpr(state, a);
     }
 
     /* Mutually recursive sets. */
     ATermList bnds;
-    if (ATmatch(e, "Rec([<list>])", &bnds))
-        return expandRec(e, (ATermList) bnds);
+    if (atMatch(m, e) >> "Rec" >> bnds)
+        return expandRec(e, bnds);
 
     /* Let expressions `let {..., body = ...}' are just desugared
        into `(rec {..., body = ...}).body'. */
-    if (ATmatch(e, "LetRec(<term>)", &e1))
-        return evalExpr(state, ATmake("Select(Rec(<term>), \"body\")", e1));
+    if (atMatch(m, e) >> "LetRec" >> bnds)
+        return evalExpr(state, ATmake("Select(Rec(<term>), \"body\")", bnds));
 
     /* Conditionals. */
-    if (ATmatch(e, "If(<term>, <term>, <term>)", &e1, &e2, &e3)) {
+    if (atMatch(m, e) >> "If" >> e1 >> e2 >> e3) {
         if (evalBool(state, e1))
             return evalExpr(state, e2);
         else
@@ -197,33 +203,33 @@ Expr evalExpr2(EvalState & state, Expr e)
     }
 
     /* Assertions. */
-    if (ATmatch(e, "Assert(<term>, <term>)", &e1, &e2)) {
+    if (atMatch(m, e) >> "Assert" >> e1 >> e2) {
         if (!evalBool(state, e1)) throw badTerm("guard failed", e);
         return evalExpr(state, e2);
     }
 
     /* Generic equality. */
-    if (ATmatch(e, "OpEq(<term>, <term>)", &e1, &e2))
+    if (atMatch(m, e) >> "OpEq" >> e1 >> e2)
         return makeBool(evalExpr(state, e1) == evalExpr(state, e2));
 
     /* Generic inequality. */
-    if (ATmatch(e, "OpNEq(<term>, <term>)", &e1, &e2))
+    if (atMatch(m, e) >> "OpNEq" >> e1 >> e2)
         return makeBool(evalExpr(state, e1) != evalExpr(state, e2));
 
     /* Negation. */
-    if (ATmatch(e, "OpNot(<term>)", &e1))
+    if (atMatch(m, e) >> "OpNot" >> e1)
         return makeBool(!evalBool(state, e1));
 
     /* Implication. */
-    if (ATmatch(e, "OpImpl(<term>, <term>)", &e1, &e2))
+    if (atMatch(m, e) >> "OpImpl" >> e1 >> e2)
         return makeBool(!evalBool(state, e1) || evalBool(state, e2));
 
     /* Conjunction (logical AND). */
-    if (ATmatch(e, "OpAnd(<term>, <term>)", &e1, &e2))
+    if (atMatch(m, e) >> "OpAnd" >> e1 >> e2)
         return makeBool(evalBool(state, e1) && evalBool(state, e2));
 
     /* Disjunction (logical OR). */
-    if (ATmatch(e, "OpOr(<term>, <term>)", &e1, &e2))
+    if (atMatch(m, e) >> "OpOr" >> e1 >> e2)
         return makeBool(evalBool(state, e1) || evalBool(state, e2));
 
     /* Barf. */
@@ -234,7 +240,7 @@ Expr evalExpr2(EvalState & state, Expr e)
 Expr evalExpr(EvalState & state, Expr e)
 {
     startNest(nest, lvlVomit,
-        format("evaluating expression: %1%") % printTerm(e));
+        format("evaluating expression: %1%") % e);
 
     state.nrEvaluated++;
 
diff --git a/src/fix-ng/fix-expr.cc b/src/fix-ng/fix-expr.cc
index 1ce4a55e475a..a3d24ba0e6ab 100644
--- a/src/fix-ng/fix-expr.cc
+++ b/src/fix-ng/fix-expr.cc
@@ -118,14 +118,15 @@ ATerm bottomupRewrite(TermFun & f, ATerm e)
 
 void queryAllAttrs(Expr e, ATermMap & attrs)
 {
+    ATMatcher m;
     ATermList bnds;
-    if (!ATmatch(e, "Attrs([<list>])", &bnds))
+    if (!(atMatch(m, e) >> "Attrs" >> bnds))
         throw badTerm("expected attribute set", e);
 
     while (!ATisEmpty(bnds)) {
-        char * s;
+        string s;
         Expr e;
-        if (!ATmatch(ATgetFirst(bnds), "Bind(<str>, <term>)", &s, &e))
+        if (!(atMatch(m, ATgetFirst(bnds)) >> "Bind" >> s >> e))
             abort(); /* can't happen */
         attrs.set(s, e);
         bnds = ATgetNext(bnds);
@@ -156,9 +157,10 @@ Expr makeAttrs(const ATermMap & attrs)
 
 Expr substitute(const ATermMap & subs, Expr e)
 {
-    char * s;
+    ATMatcher m;
+    string s;
 
-    if (ATmatch(e, "Var(<str>)", &s)) {
+    if (atMatch(m, e) >> "Var" >> s) {
         Expr sub = subs.get(s);
         return sub ? sub : e;
     }
@@ -167,13 +169,13 @@ Expr substitute(const ATermMap & subs, Expr e)
        function. */
     ATermList formals;
     ATerm body;
-    if (ATmatch(e, "Function([<list>], <term>)", &formals, &body)) {
+    if (atMatch(m, e) >> "Function" >> formals >> body) {
         ATermMap subs2(subs);
         ATermList fs = formals;
         while (!ATisEmpty(fs)) {
             Expr def;
-            if (!ATmatch(ATgetFirst(fs), "NoDefFormal(<str>)", &s) &&
-                !ATmatch(ATgetFirst(fs), "DefFormal(<str>, <term>)", &s))
+            if (!(atMatch(m, ATgetFirst(fs)) >> "NoDefFormal" >> s) &&
+                !(atMatch(m, ATgetFirst(fs)) >> "DefFormal" >> s >> def))
                 abort();
             subs2.remove(s);
             fs = ATgetNext(fs);
@@ -184,12 +186,12 @@ Expr substitute(const ATermMap & subs, Expr e)
 
     /* Idem for a mutually recursive attribute set. */
     ATermList bindings;
-    if (ATmatch(e, "Rec([<list>])", &bindings)) {
+    if (atMatch(m, e) >> "Rec" >> bindings) {
         ATermMap subs2(subs);
         ATermList bnds = bindings;
         while (!ATisEmpty(bnds)) {
             Expr e;
-            if (!ATmatch(ATgetFirst(bnds), "Bind(<str>, <term>)", &s, &e))
+            if (!(atMatch(m, ATgetFirst(bnds)) >> "Bind" >> s >> e))
                 abort(); /* can't happen */
             subs2.remove(s);
             bnds = ATgetNext(bnds);
diff --git a/src/fix-ng/fix.cc b/src/fix-ng/fix.cc
index dc2790a60ad9..49f19669a08b 100644
--- a/src/fix-ng/fix.cc
+++ b/src/fix-ng/fix.cc
@@ -27,37 +27,6 @@ static Path searchPath(const Paths & searchDirs, const Path & relPath)
 #endif
 
 
-#if 0
-static Expr evalExpr2(EvalState & state, Expr e)
-{
-    /* Ad-hoc function for string matching. */
-    if (ATmatch(e, "HasSubstr(<term>, <term>)", &e1, &e2)) {
-        e1 = evalExpr(state, e1);
-        e2 = evalExpr(state, e2);
-        
-        char * s1, * s2;
-        if (!ATmatch(e1, "<str>", &s1))
-            throw badTerm("expecting a string", e1);
-        if (!ATmatch(e2, "<str>", &s2))
-            throw badTerm("expecting a string", e2);
-        
-        return
-            string(s1).find(string(s2)) != string::npos ?
-            ATmake("True") : ATmake("False");
-    }
-
-    /* BaseName primitive function. */
-    if (ATmatch(e, "BaseName(<term>)", &e1)) {
-        e1 = evalExpr(state, e1);
-        if (!ATmatch(e1, "<str>", &s1)) 
-            throw badTerm("string expected", e1);
-        return ATmake("<str>", baseNameOf(s1).c_str());
-    }
-
-}
-#endif
-
-
 static Expr evalStdin(EvalState & state)
 {
     startNest(nest, lvlTalkative, format("evaluating standard input"));
@@ -70,9 +39,10 @@ static Expr evalStdin(EvalState & state)
 
 static void printNixExpr(EvalState & state, Expr e)
 {
+    ATMatcher m;
     ATermList es;
 
-    if (ATmatch(e, "Attrs([<list>])", &es)) {
+    if (atMatch(m, e) >> "Attrs" >> es) {
         Expr a = queryAttr(e, "type");
         if (a && evalString(state, a) == "derivation") {
             a = queryAttr(e, "drvPath");
@@ -83,7 +53,7 @@ static void printNixExpr(EvalState & state, Expr e)
         }
     }
 
-    if (ATmatch(e, "[<list>]", &es)) {
+    if (ATgetType(e) == AT_LIST) {
         while (!ATisEmpty(es)) {
             printNixExpr(state, evalExpr(state, ATgetFirst(es)));
             es = ATgetNext(es);
diff --git a/src/fix-ng/parser.cc b/src/fix-ng/parser.cc
index 93afe0627ad8..710ea6a86de0 100644
--- a/src/fix-ng/parser.cc
+++ b/src/fix-ng/parser.cc
@@ -28,40 +28,40 @@ struct Cleanup : TermFun
 
     virtual ATerm operator () (ATerm e)
     {
-        char * s;
+        ATMatcher m;
+        string s;
 
-        if (ATmatch(e, "Str(<str>)", &s)) {
-            string s2(s);
+        if (atMatch(m, e) >> "Str" >> s) {
             return ATmake("Str(<str>)",
-                string(s2, 1, s2.size() - 2).c_str());
+                string(s, 1, s.size() - 2).c_str());
         }
 
-        if (ATmatch(e, "Path(<str>)", &s)) {
-            string path(s);
-            if (path[0] != '/')
-                path = basePath + "/" + path;
-            return ATmake("Path(<str>)", canonPath(path).c_str());
+        if (atMatch(m, e) >> "Path" >> s) {
+            if (s[0] != '/')
+                s = basePath + "/" + s;
+            return ATmake("Path(<str>)", canonPath(s).c_str());
         }
 
-        if (ATmatch(e, "Int(<str>)", &s)) {
+        if (atMatch(m, e) >> "Int" >> s) {
             istringstream s2(s);
             int n;
             s2 >> n;
             return ATmake("Int(<int>)", n);
         }
 
-        if (ATmatch(e, "Bool(\"true\")", &s))
+        if (atMatch(m, e) >> "Bool" >> "true")
             return ATmake("Bool(True)");
         
-        if (ATmatch(e, "Bool(\"false\")", &s))
+        if (atMatch(m, e) >> "Bool" >> "false")
             return ATmake("Bool(False)");
 
-        if (ATmatch(e, "ExprNil"))
+        if (atMatch(m, e) >> "ExprNil")
             return (ATerm) ATempty;
 
-        ATerm e1, e2;
-        if (ATmatch(e, "ExprCons(<term>, [<list>])", &e1, &e2))
-            return (ATerm) ATinsert((ATermList) e2, e1);
+        ATerm e1;
+        ATermList e2;
+        if (atMatch(m, e) >> "ExprCons" >> e1 >> e2)
+            return (ATerm) ATinsert(e2, e1);
 
         return e;
     }
@@ -133,7 +133,7 @@ Expr parseExprFromFile(Path path)
         throw SysError(format("parse failed in `%1%'") % path);
     if (SGisParseError(result))
         throw Error(format("parse error in `%1%': %2%")
-            % path % printTerm(result));
+            % path % result);
 
     /* Implode it. */
     PT_ParseTree tree = PT_makeParseTreeFromTerm(result);
@@ -156,7 +156,7 @@ Expr parseExprFromFile(Path path)
         throw Error(format("cannot implode parse tree"));
 
     debug(format("imploded parse tree of `%1%': %2%")
-        % path % printTerm(imploded));
+        % path % imploded);
 
     /* Finally, clean it up. */
     Cleanup cleanup;
diff --git a/src/fix-ng/primops.cc b/src/fix-ng/primops.cc
index 07281e89beaf..a68352579753 100644
--- a/src/fix-ng/primops.cc
+++ b/src/fix-ng/primops.cc
@@ -5,8 +5,9 @@
 
 Expr primImport(EvalState & state, Expr arg)
 {
-    char * path;
-    if (!ATmatch(arg, "Path(<str>)", &path))
+    ATMatcher m;
+    string path;
+    if (!(atMatch(m, arg) >> "Path" >> path))
         throw badTerm("path expected", arg);
     return evalFile(state, path);
 }
@@ -79,15 +80,16 @@ static string processBinding(EvalState & state, Expr e, NixExpr & ne)
 {
     e = evalExpr(state, e);
 
-    char * s;
+    ATMatcher m;
+    string s;
     ATermList es;
 
-    if (ATmatch(e, "Str(<str>)", &s)) return s;
-    if (ATmatch(e, "Uri(<str>)", &s)) return s;
-    if (ATmatch(e, "Bool(True)")) return "1";
-    if (ATmatch(e, "Bool(False)")) return "";
+    if (atMatch(m, e) >> "Str" >> s) return s;
+    if (atMatch(m, e) >> "Uri" >> s) return s;
+    if (atMatch(m, e) >> "Bool" >> "True") return "1";
+    if (atMatch(m, e) >> "Bool" >> "False") return "";
 
-    if (ATmatch(e, "Attrs([<list>])", &es)) {
+    if (atMatch(m, e) >> "Attrs" >> es) {
         Expr a = queryAttr(e, "type");
         if (a && evalString(state, a) == "derivation") {
             a = queryAttr(e, "drvPath");
@@ -98,12 +100,12 @@ static string processBinding(EvalState & state, Expr e, NixExpr & ne)
         }
     }
 
-    if (ATmatch(e, "Path(<str>)", &s)) {
+    if (atMatch(m, e) >> "Path" >> s) {
         Path drvPath = copyAtom(state, s);
         return addInput(state, drvPath, ne);
     }
     
-    if (ATmatch(e, "List([<list>])", &es)) {
+    if (atMatch(m, e) >> "List" >> es) {
 	string s;
 	bool first = true;
         while (!ATisEmpty(es)) {
@@ -115,7 +117,7 @@ static string processBinding(EvalState & state, Expr e, NixExpr & ne)
 	return s;
     }
 
-    if (ATmatch(e, "Null")) return "";
+    if (atMatch(m, e) >> "Null") return "";
     
     throw badTerm("invalid derivation binding", e);
 }
@@ -148,14 +150,17 @@ Expr primDerivation(EvalState & state, Expr args)
         /* The `args' attribute is special: it supplies the
            command-line arguments to the builder. */
         if (key == "args") {
+            throw Error("args not implemented");
+#if 0
             ATermList args;
-            if (!ATmatch(value, "[<list>]", &args))
+            if (!(ATmatch(value, "[<list>]", &args))
                 throw badTerm("list expected", value);
             while (!ATisEmpty(args)) {
                 Expr arg = evalExpr(state, ATgetFirst(args));
                 ne.derivation.args.push_back(processBinding(state, arg, ne));
                 args = ATgetNext(args);
             }
+#endif
         }
 
         /* All other attributes are passed to the builder through the
@@ -220,11 +225,12 @@ Expr primBaseNameOf(EvalState & state, Expr arg)
 Expr primToString(EvalState & state, Expr arg)
 {
     arg = evalExpr(state, arg);
-    char * s;
-    if (ATmatch(arg, "Str(<str>)", &s) ||
-        ATmatch(arg, "Path(<str>)", &s) ||
-        ATmatch(arg, "Uri(<str>)", &s))
-        return ATmake("Str(<str>)", s);
+    ATMatcher m;
+    string s;
+    if (atMatch(m, arg) >> "Str" >> s ||
+        atMatch(m, arg) >> "Path" >> s ||
+        atMatch(m, arg) >> "Uri" >> s)
+        return ATmake("Str(<str>)", s.c_str());
     else throw badTerm("cannot coerce to string", arg);
 }
 
@@ -238,5 +244,6 @@ Expr primNull(EvalState & state)
 Expr primIsNull(EvalState & state, Expr arg)
 {
     arg = evalExpr(state, arg);
-    return makeBool(ATmatch(arg, "Null"));
+    ATMatcher m;
+    return makeBool(atMatch(m, arg) >> "Null");
 }
diff --git a/src/fix/fix.cc b/src/fix/fix.cc
index d75e26b00930..8b8441050df6 100644
--- a/src/fix/fix.cc
+++ b/src/fix/fix.cc
@@ -384,7 +384,7 @@ static Expr evalExpr2(EvalState & state, Expr e)
 static Expr evalExpr(EvalState & state, Expr e)
 {
     startNest(nest, lvlVomit,
-        format("evaluating expression: %1%") % printTerm(e));
+        format("evaluating expression: %1%") % e);
 
     /* Consult the memo table to quickly get the normal form of
        previously evaluated expressions. */
diff --git a/src/libnix/Makefile.am b/src/libnix/Makefile.am
index b890ba8c0548..7671b1613d19 100644
--- a/src/libnix/Makefile.am
+++ b/src/libnix/Makefile.am
@@ -2,8 +2,15 @@ noinst_LIBRARIES = libnix.a
 
 libnix_a_SOURCES = util.cc hash.cc archive.cc md5.c \
  store.cc expr.cc normalise.cc exec.cc \
- globals.cc db.cc references.cc pathlocks.cc
+ globals.cc db.cc references.cc pathlocks.cc aterm.cc
 
 AM_CXXFLAGS = -DSYSTEM=\"@host@\" -Wall -I.. -I../../externals/inst/include
 
 EXTRA_DIST = *.hh *.h test-builder-*.sh
+
+check_PROGRAMS = test-aterm
+
+test_aterm_SOURCES = test-aterm.cc
+test_aterm_LDADD = libnix.a $(LDADD) ../boost/format/libformat.a \
+ -L../../externals/inst/lib -ldb_cxx -lATerm
+
diff --git a/src/libnix/aterm.cc b/src/libnix/aterm.cc
new file mode 100644
index 000000000000..de7c359521a7
--- /dev/null
+++ b/src/libnix/aterm.cc
@@ -0,0 +1,93 @@
+#include "aterm.hh"
+
+
+string atPrint(ATerm t)
+{
+    if (!t) throw Error("attempt to print null aterm");
+    char * s = ATwriteToString(t);
+    if (!s) throw Error("cannot print term");
+    return s;
+}
+
+
+ostream & operator << (ostream & stream, ATerm e)
+{
+    return stream << atPrint(e);
+}
+
+
+ATMatcher & atMatch(ATMatcher & pos, ATerm t)
+{
+    pos.t = t;
+    pos.pos = ATMatcher::funPos;
+    return pos;
+}
+
+
+static inline bool failed(const ATMatcher & pos)
+{
+    return pos.pos == ATMatcher::failPos;
+}
+
+
+static inline ATMatcher & fail(ATMatcher & pos)
+{
+    pos.pos = ATMatcher::failPos;
+    return pos;
+}
+
+
+ATMatcher & operator >> (ATMatcher & pos, ATerm & out)
+{
+    out = 0;
+    if (failed(pos)) return pos;
+    if (pos.pos == ATMatcher::funPos || 
+        ATgetType(pos.t) != AT_APPL ||
+        pos.pos >= (int) ATgetArity(ATgetAFun(pos.t)))
+        return fail(pos);
+    out = ATgetArgument(pos.t, pos.pos);
+    pos.pos++;
+    return pos;
+}
+
+
+ATMatcher & operator >> (ATMatcher & pos, string & out)
+{
+    out = "";
+    if (pos.pos == ATMatcher::funPos) {
+        if (ATgetType(pos.t) != AT_APPL) return fail(pos);
+        out = ATgetName(ATgetAFun(pos.t));
+        pos.pos = 0;
+    } else {
+        ATerm t;
+        pos = pos >> t;
+        if (failed(pos)) return pos;
+        if (ATgetType(t) != AT_APPL ||
+            ATgetArity(ATgetAFun(t)) != 0)
+            return fail(pos);
+        out = ATgetName(ATgetAFun(t));
+    }
+    return pos;
+}
+
+
+ATMatcher & operator >> (ATMatcher & pos, const string & s)
+{
+    string s2;
+    pos = pos >> s2;
+    if (failed(pos)) return pos;
+    if (s != s2) return fail(pos);
+    return pos;
+}
+
+
+ATMatcher & operator >> (ATMatcher & pos, ATermList & out)
+{
+    out = 0;
+    ATerm t;
+    pos = pos >> t;
+    if (failed(pos)) return pos;
+    if (ATgetType(t) != AT_LIST) return fail(pos);
+    out = (ATermList) t;
+    return pos;
+}
diff --git a/src/libnix/aterm.hh b/src/libnix/aterm.hh
new file mode 100644
index 000000000000..1e4ee80eeab5
--- /dev/null
+++ b/src/libnix/aterm.hh
@@ -0,0 +1,55 @@
+#ifndef __ATERM_H
+#define __ATERM_H
+
+extern "C" {
+#include <aterm2.h>
+}
+
+#include "util.hh"
+
+
+/* Print an ATerm. */
+string atPrint(ATerm t);
+
+/* Write an ATerm to an output stream. */
+ostream & operator << (ostream & stream, ATerm e);
+
+/* Type-safe matching. */
+
+struct ATMatcher 
+{
+    ATerm t;
+    int pos;
+    const static int failPos = -2;
+    const static int funPos = -1;
+
+    ATMatcher() : t(0), pos(failPos)
+    {
+    }
+
+    operator bool() const
+    {
+        return pos != failPos;
+    }
+};
+
+/* Initiate matching of a term. */
+ATMatcher & atMatch(ATMatcher & pos, ATerm t);
+
+/* Get the next argument of an application. */
+ATMatcher & operator >> (ATMatcher & pos, ATerm & out);
+
+/* Get the name of the function symbol of an applicatin, or the next
+   argument of an application as a string. */
+ATMatcher & operator >> (ATMatcher & pos, string & out);
+
+/* Like the previous, but check that the string is equal to the given
+   string. */
+ATMatcher & operator >> (ATMatcher & pos, const string & s);
+
+/* Get the next argument of an application, and verify that it is a
+   list. */
+ATMatcher & operator >> (ATMatcher & pos, ATermList & out);
+
+
+#endif /* !__ATERM_H */
diff --git a/src/libnix/expr.cc b/src/libnix/expr.cc
index 9bbe80ab4c88..67fa69f72fab 100644
--- a/src/libnix/expr.cc
+++ b/src/libnix/expr.cc
@@ -3,14 +3,6 @@
 #include "store.hh"
 
 
-string printTerm(ATerm t)
-{
-    char * s = ATwriteToString(t);
-    if (!s) throw Error("cannot print term");
-    return s;
-}
-
-
 Error badTerm(const format & f, ATerm t)
 {
     char * s = ATwriteToString(t);
@@ -26,7 +18,7 @@ Error badTerm(const format & f, ATerm t)
 
 Hash hashTerm(ATerm t)
 {
-    return hashString(printTerm(t));
+    return hashString(atPrint(t));
 }
 
 
@@ -50,10 +42,11 @@ Path writeTerm(ATerm t, const string & suffix)
 
 static void parsePaths(ATermList paths, PathSet & out)
 {
+    ATMatcher m;
     while (!ATisEmpty(paths)) {
-        char * s;
+        string s;
         ATerm t = ATgetFirst(paths);
-        if (!ATmatch(t, "<str>", &s))
+        if (!(atMatch(m, t) >> s))
             throw badTerm("not a path", t);
         out.insert(s);
         paths = ATgetNext(paths);
@@ -91,21 +84,22 @@ static void checkClosure(const Closure & closure)
 static bool parseClosure(ATerm t, Closure & closure)
 {
     ATermList roots, elems;
-    
-    if (!ATmatch(t, "Closure([<list>], [<list>])", &roots, &elems))
+    ATMatcher m;
+
+    if (!(atMatch(m, t) >> "Closure" >> roots >> elems))
         return false;
 
     parsePaths(roots, closure.roots);
 
     while (!ATisEmpty(elems)) {
-        char * s1;
+        string path;
         ATermList refs;
         ATerm t = ATgetFirst(elems);
-        if (!ATmatch(t, "(<str>, [<list>])", &s1, &refs))
+        if (!(atMatch(m, t) >> "" >> path >> refs))
             throw badTerm("not a closure element", t);
         ClosureElem elem;
         parsePaths(refs, elem.refs);
-        closure.elems[s1] = elem;
+        closure.elems[path] = elem;
         elems = ATgetNext(elems);
     }
 
@@ -116,19 +110,13 @@ static bool parseClosure(ATerm t, Closure & closure)
 
 static bool parseDerivation(ATerm t, Derivation & derivation)
 {
+    ATMatcher m;
     ATermList outs, ins, args, bnds;
-    char * builder;
-    char * platform;
-
-    if (!ATmatch(t, "Derive([<list>], [<list>], <str>, <str>, [<list>], [<list>])",
-            &outs, &ins, &platform, &builder, &args, &bnds))
-    {
-        /* !!! compatibility -> remove eventually */
-        if (!ATmatch(t, "Derive([<list>], [<list>], <str>, <str>, [<list>])",
-                &outs, &ins, &builder, &platform, &bnds))
-            return false;
-        args = ATempty;
-    }
+    string builder, platform;
+
+    if (!(atMatch(m, t) >> "Derive" >> outs >> ins >> platform
+            >> builder >> args >> bnds))
+        return false;
 
     parsePaths(outs, derivation.outputs);
     parsePaths(ins, derivation.inputs);
@@ -137,18 +125,18 @@ static bool parseDerivation(ATerm t, Derivation & derivation)
     derivation.platform = platform;
     
     while (!ATisEmpty(args)) {
-        char * s;
+        string s;
         ATerm arg = ATgetFirst(args);
-        if (!ATmatch(arg, "<str>", &s))
+        if (!(atMatch(m, arg) >> s))
             throw badTerm("string expected", arg);
         derivation.args.push_back(s);
         args = ATgetNext(args);
     }
 
     while (!ATisEmpty(bnds)) {
-        char * s1, * s2;
+        string s1, s2;
         ATerm bnd = ATgetFirst(bnds);
-        if (!ATmatch(bnd, "(<str>, <str>)", &s1, &s2))
+        if (!(atMatch(m, bnd) >> "" >> s1 >> s2))
             throw badTerm("tuple of strings expected", bnd);
         derivation.env[s1] = s2;
         bnds = ATgetNext(bnds);
diff --git a/src/libnix/expr.hh b/src/libnix/expr.hh
index 7d0420935f9d..f5abf9af0d3a 100644
--- a/src/libnix/expr.hh
+++ b/src/libnix/expr.hh
@@ -1,10 +1,7 @@
 #ifndef __FSTATE_H
 #define __FSTATE_H
 
-extern "C" {
-#include <aterm2.h>
-}
-
+#include "aterm.hh"
 #include "store.hh"
 
 
@@ -43,9 +40,6 @@ struct NixExpr
 };
 
 
-/* Return a canonical textual representation of an expression. */
-string printTerm(ATerm t);
-
 /* Throw an exception with an error message containing the given
    aterm. */
 Error badTerm(const format & f, ATerm t);
diff --git a/src/libnix/normalise.cc b/src/libnix/normalise.cc
index 49f86cc6fe18..cb2bf4f5b183 100644
--- a/src/libnix/normalise.cc
+++ b/src/libnix/normalise.cc
@@ -239,7 +239,7 @@ Path normaliseNixExpr(const Path & _nePath, PathSet pending)
     /* Write the normal form.  This does not have to occur in the
        transaction below because writing terms is idem-potent. */
     ATerm nfTerm = unparseNixExpr(nf);
-    printMsg(lvlVomit, format("normal form: %1%") % printTerm(nfTerm));
+    printMsg(lvlVomit, format("normal form: %1%") % atPrint(nfTerm));
     Path nfPath = writeTerm(nfTerm, "-s");
 
     /* Register each outpat path, and register the normal form.  This
diff --git a/src/libnix/references.hh b/src/libnix/references.hh
index d009453d6a00..ada23a883302 100644
--- a/src/libnix/references.hh
+++ b/src/libnix/references.hh
@@ -1,5 +1,5 @@
-#ifndef __VALUES_H
-#define __VALUES_H
+#ifndef __REFERENCES_H
+#define __REFERENCES_H
 
 #include "util.hh"
 
@@ -7,4 +7,4 @@
 Strings filterReferences(const Path & path, const Strings & refs);
 
 
-#endif /* !__VALUES_H */
+#endif /* !__REFERENCES_H */
diff --git a/src/libnix/test-aterm.cc b/src/libnix/test-aterm.cc
new file mode 100644
index 000000000000..325639ca4f30
--- /dev/null
+++ b/src/libnix/test-aterm.cc
@@ -0,0 +1,66 @@
+#include "aterm.hh"
+#include <iostream>
+
+
+void runTests()
+{
+    verbosity = lvlDebug;
+
+    ATMatcher pos;
+
+    ATerm t = ATmake("Call(Foo, Bar, \"xyz\")");
+    
+    debug(format("term: %1%") % t);
+
+    string fun, arg3;
+    ATerm lhs, rhs;
+
+    if (!(atMatch(pos, t) >> "Call" >> lhs >> rhs >> arg3))
+        throw Error("should succeed");
+    if (arg3 != "xyz") throw Error("bad 1");
+
+    if (!(atMatch(pos, t) >> fun >> lhs >> rhs >> arg3))
+        throw Error("should succeed");
+    if (fun != "Call") throw Error("bad 2");
+    if (arg3 != "xyz") throw Error("bad 3");
+
+    if (!(atMatch(pos, t) >> fun >> lhs >> rhs >> "xyz"))
+        throw Error("should succeed");
+
+    if (atMatch(pos, t) >> fun >> lhs >> rhs >> "abc")
+        throw Error("should fail");
+
+    if (atMatch(pos, t) >> "Call" >> lhs >> rhs >> "abc")
+        throw Error("should fail");
+
+    t = ATmake("X([A, B, C], \"abc\")");
+
+    ATerm t1, t2, t3;
+    if (atMatch(pos, t) >> "X" >> t1 >> t2 >> t3)
+        throw Error("should fail");
+    if (!(atMatch(pos, t) >> "X" >> t1 >> t2))
+        throw Error("should succeed");
+    ATermList ts;
+    if (!(atMatch(pos, t) >> "X" >> ts >> t2))
+        throw Error("should succeed");
+    if (ATgetLength(ts) != 3)
+        throw Error("bad");
+    if (atMatch(pos, t) >> "X" >> t1 >> ts)
+        throw Error("should fail");
+}
+
+
+int main(int argc, char * * argv)
+{
+    ATerm bottomOfStack;
+    ATinit(argc, argv, &bottomOfStack);
+
+    try {
+        runTests();
+    } catch (Error & e) {
+        printMsg(lvlError, format("error: %1%") % e.msg());
+        return 1;
+    }
+
+    return 0;
+}