* Realisation of File(...) expressions.

1 files changed, 47 insertions, 229 deletions

diff --git a/src/eval.cc b/src/eval.cc
index 831464c18365..4f59bcc21c4e 100644
--- a/src/eval.cc
+++ b/src/eval.cc
@@ -30,6 +30,7 @@ bool pathExists(string path)
 }
 
 
+#if 0
 /* Compute a derived value by running a program. */
 static Hash computeDerived(Hash sourceHash, string targetName,
     string platform, Hash prog, Environment env)
@@ -175,6 +176,7 @@ static Hash computeDerived(Hash sourceHash, string targetName,
 
     return targetHash;
 }
+#endif
 
 
 /* Throw an exception if the given platform string is not supported by
@@ -182,52 +184,30 @@ static Hash computeDerived(Hash sourceHash, string targetName,
 static void checkPlatform(string platform)
 {
     if (platform != thisSystem)
-        throw Error("a `" + platform +
-            "' is required, but I am a `" + thisSystem + "'");
+        throw Error(format("a `%1%' is required, but I am a `%2%'")
+            % platform % thisSystem);
 }
 
 
-string printExpr(Expr e)
+string printTerm(ATerm t)
 {
-    char * s = ATwriteToString(e);
+    char * s = ATwriteToString(t);
     return s;
 }
 
 
 /* Throw an exception with an error message containing the given
    aterm. */
-static Error badTerm(const string & msg, Expr e)
-{
-    return Error(msg + ", in `" + printExpr(e) + "'");
-}
-
-
-Hash hashExpr(Expr e)
+static Error badTerm(const format & f, ATerm t)
 {
-    return hashString(printExpr(e));
+    return Error(format("%1%, in `%2%'") % f.str() % printTerm(t));
 }
 
 
-/* Evaluate an expression; the result must be a string. */
-static string evalString(Expr e)
-{
-    e = whNormalise(e);
-    char * s;
-    if (ATmatch(e, "Str(<str>)", &s)) return s;
-    else throw badTerm("string value expected", e);
-}
-
-
-#if 0
-/* Evaluate an expression; the result must be a value reference. */
-static Hash evalHash(Expr e)
+Hash hashTerm(ATerm t)
 {
-    e = evalValue(e);
-    char * s;
-    if (ATmatch(e, "Hash(<str>)", &s)) return parseHash(s);
-    else throw badTerm("value reference expected", e);
+    return hashString(printTerm(t));
 }
-#endif
 
 
 #if 0
@@ -262,225 +242,63 @@ void evalArgs(ATermList args, ATermList & argsNF, Environment & env)
 #endif
 
 
-Expr substExpr(string x, Expr rep, Expr e)
-{
-    char * s;
-    Expr e2;
-
-    if (ATmatch(e, "Var(<str>)", &s))
-        if (x == s)
-            return rep;
-        else
-            return e;
-
-    if (ATmatch(e, "Lam(<str>, <term>)", &s, &e2))
-        if (x == s)
-            return e;
-    /* !!! unfair substitutions */
-
-    /* Generically substitute in subterms. */
-
-    if (ATgetType(e) == AT_APPL) {
-        AFun fun = ATgetAFun(e);
-        int arity = ATgetArity(fun);
-        ATermList args = ATempty;
-
-        for (int i = arity - 1; i >= 0; i--)
-            args = ATinsert(args, substExpr(x, rep, ATgetArgument(e, i)));
-        
-        return (ATerm) ATmakeApplList(fun, args);
-    }
-
-    if (ATgetType(e) == AT_LIST) {
-        ATermList in = (ATermList) e;
-        ATermList out = ATempty;
-
-        while (!ATisEmpty(in)) {
-            out = ATinsert(out, substExpr(x, rep, ATgetFirst(in)));
-            in = ATgetNext(in);
-        }
-
-        return (ATerm) ATreverse(out);
-    }
-
-    throw badTerm("do not know how to substitute", e);
-}
-
-
-#if 0
-Expr evalValue(Expr e)
-{
-    char * s;
-    Expr eBuildPlatform, eProg, e2, e3, e4;
-    ATermList args;
-
-    /* Value references. */
-    if (ATmatch(e, "Hash(<str>)", &s)) {
-        parseHash(s); /* i.e., throw exception if not valid */
-        return e;
-    }
-
-    /* External expression. */
-    if (ATmatch(e, "Deref(<term>)", &e2)) {
-        string fn = queryValuePath(evalHash(e2));
-        ATerm e3 = ATreadFromNamedFile(fn.c_str());
-        if (!e3) throw Error("reading aterm from " + fn);
-        return evalValue(e3);
-    }
-
-    /* Execution primitive. */
-
-    if (ATmatch(e, "Exec(<term>, <term>, [<list>])",
-                 &eBuildPlatform, &eProg, &args))
-    {
-        string buildPlatform = evalString(eBuildPlatform);
-
-        checkPlatform(buildPlatform);
-
-        Hash prog = evalHash(eProg);
-
-        Environment env;
-        ATermList argsNF;
-        evalArgs(args, argsNF, env);
-
-        Hash sourceHash = hashExpr(
-            ATmake("Exec(Str(<str>), Hash(<str>), <term>)",
-                buildPlatform.c_str(), ((string) prog).c_str(), argsNF));
-
-        /* Do we know a normal form for sourceHash? */
-        Hash targetHash;
-        string targetHashS;
-        if (queryDB(nixDB, dbNFs, sourceHash, targetHashS)) {
-            /* Yes. */
-            targetHash = parseHash(targetHashS);
-            debug("already built: " + (string) sourceHash 
-                + " -> " + (string) targetHash);
-        } else {
-            /* No, so we compute one. */
-            targetHash = computeDerived(sourceHash, 
-                (string) sourceHash + "-nf", buildPlatform, prog, env);
-        }
-
-        return ATmake("Hash(<str>)", ((string) targetHash).c_str());
-    }
-
-    /* Barf. */
-    throw badTerm("invalid expression", e);
-}
-#endif
-
-
-Expr whNormalise(Expr e)
-{
-    char * s;
-    Expr e2, e3, e4, e5;
-
-    /* Normal forms. */
-    if (ATmatch(e, "Str(<str>)", &s) ||
-        ATmatch(e, "Bool(True)") || 
-        ATmatch(e, "Bool(False)") ||
-        ATmatch(e, "Lam(<str>, <term>)", &s, &e2) ||
-        ATmatch(e, "File(<str>, <term>, <term>)", &s, &e2, &e3) ||
-        ATmatch(e, "Derive(<term>, <term>, <term>, <term>)", &e2, &e3, &e4, &e5))
-        return e;
-
-    /* Application. */
-    if (ATmatch(e, "App(<term>, <term>)", &e2, &e3)) {
-        e2 = whNormalise(e2);
-        if (!ATmatch(e2, "Lam(<str>, <term>)", &s, &e4))
-            throw badTerm("expecting lambda", e2);
-        return whNormalise(substExpr(s, e3, e4));
-    }
-
-    throw badTerm("invalid expression", e);
-}
-
-
-Expr dNormalise(Expr e)
+struct RStatus
 {
-    e = whNormalise(e);
-    /* !!! todo */
-    return e;
-}
+    /* !!! the comparator of this hash should match the semantics of
+       the file system */
+//     map<string, Hash> paths;
+};
 
 
-Expr fNormalise(Expr e)
+static void realise(RStatus & status, FState fs)
 {
-    e = dNormalise(e);
-
     char * s;
-    Expr e2, e3;
+    Content content;
+    ATermList refs;
+    
+    if (ATmatch(fs, "File(<str>, <term>, [<list>])", &s, &content, &refs)) {
+        string path(s);
 
-    if (ATmatch(e, "File(<str>, <term>, [<list>])", &s, &e2, &e3)) {
+        if (path[0] != '/') throw Error("absolute path expected: " + path);
 
-        ATermList refs = (ATermList) e3, refs2 = ATempty;
+        /* Realise referenced paths. */
         while (!ATisEmpty(refs)) {
-            ATerm ref = ATgetFirst(refs);
-            refs2 = ATinsert(refs2, fNormalise(ref));
+            realise(status, ATgetFirst(refs));
             refs = ATgetNext(refs);
         }
-        refs2 = ATreverse(refs2);
-
-        return ATmake("File(<str>, <term>, <term>)", s, e2, refs2);
-
-    }
-
-    else return e;
-}
-
-
-void writeContent(string path, Content content)
-{
-    char * s;
 
-    if (ATmatch(content, "Regular(<str>)", &s)) {
+        if (!ATmatch(content, "Hash(<str>)", &s))
+            throw badTerm("hash expected", content);
+        Hash hash = parseHash(s);
 
-        int fd; /* !!! close on exception */
-        fd = open(path.c_str(), O_CREAT | O_EXCL | O_WRONLY, 0666);
-        if (fd == -1)
-            throw SysError("creating file " + path);
+        /* Perhaps the path already exists and has the right hash? */
+        if (pathExists(path)) {
+            if (hash == hashPath(path)) {
+                debug(format("path %1% already has hash %2%")
+                    % path % (string) hash);
+                return;
+            }
 
-        int len = strlen(s);
-        if (write(fd, s, len) != len)
-            throw SysError("writing file " + path);
+            throw Error(format("path %1% exists, but does not have hash %2%")
+                % path % (string) hash);
+        }
 
-        close(fd);
+        /* Do we know a path with that hash?  If so, copy it. */
+        string path2 = queryFromStore(hash);
+        copyFile(path2, path);
     }
-    
-    else throw badTerm("ill-formed content", content);
-}
-
-
-struct RStatus
-{
-    /* !!! the comparator of this hash should match the semantics of
-       the file system */
-    map<string, Hash> paths;
-};
 
-
-static void realise2(RStatus & status, Expr e)
-{
-    char * s;
-    Content content;
-    ATermList refs;
-    
-    if (!ATmatch(e, "File(<str>, <term>, [<list>])", &s, &content, &refs))
-        throw badTerm("not f-normalised", e);
-
-    string path(s);
-
-    while (!ATisEmpty(refs)) {
-        realise2(status, ATgetFirst(refs));
-        refs = ATgetNext(refs);
+    else if (ATmatch(fs, "Derive()")) {
+        
+        
     }
-    
-    writeContent(path, content);
+
+    else throw badTerm("bad file system state expression", fs);
 }
 
 
-void realise(Expr e)
+void realiseFState(FState fs)
 {
     RStatus status;
-    realise2(status, e);
+    realise(status, fs);
 }