diff --git a/env.scm b/env.scm
index 4cf8446..6d645f7 100644
--- a/env.scm
+++ b/env.scm
@@ -234,8 +234,7 @@
             (with-output-to-file "tree" (λ () (write (list dirhash))))))
         (lookup-environment name))))
 
-(define* (add-layer env layer #:optional (onto 'current))
-  ;; TODO currently ignores stree structure of tree file!!
+(define* (add-layer env layer #:optional (onto 'current) (tag onto))
   ;; TODO deduplicate with init-env
   (unless (file-exists? layer)
     (throw 'add-layer-directory-doesnt-exist!))
@@ -246,18 +245,57 @@
          (new-pin (decode-hash-link-encode pin dirhash))
          (stack (environment-tag-layers env onto))
          (loc (layer-file dirhash)))
+
+    (define (grow tree pinned layer)
+      ;; TODO abstract away
+      (let  ((atom? (compose not pair?)))
+        (match tree
+          (() (throw 'missformed-tree))
+          ((root) (if (equal? pinned root)
+                      (list root layer)
+                      (throw 'missformed-tree)))
+          ((root _ ...)
+           (cons root
+                 (let loop ((tree (cdr tree))
+                            (hash (environment-root env)))
+                   (match tree
+                     (() '())
+                     (((? atom? head))
+                      (let ((h (decode-hash-link-encode hash head)))
+                        (if (equal? pinned h)
+                            (list head layer)
+                            (list head))))
+                     (((? atom? head) tail ...)
+                      (let ((h (decode-hash-link-encode hash head)))
+                        (if (equal? pinned h)
+                            (list (list head (list layer) tail))
+                            (cons head (loop tail h)))))
+                     ((((? atom? head)
+                        (? pair? branch1)
+                        (? pair? branch2)
+                        (? pair? branch3) ...))
+                      (let* ((h (decode-hash-link-encode hash head)))
+                        (if (eq? pinned h)
+                            (list (cons head
+                                        (cons (list layer)
+                                              (cons* branch1 branch2 branch3))))
+                            (list (cons head (map (λ (br) (loop br h))
+                                                  (cons* branch1 branch2 branch3)))))))
+                     (else (throw 'missformed-tree)))))))))
+
     ;; TODO check if appendable
     (unless (file-exists? loc)
       (copy-recursively/overlay layer loc)
       ;; TODO: check for collisions
       (symlink-layer! dirhash))
     (with-directory-excursion (metadata-file name)
-      (when (symbolic-link? "./tags/current")
-        (delete-file "./tags/current"))
-      (with-output-to-file  "./tags/current"
-        (λ () (display new-pin)))
+      (let ((tags/tag (string-append "./tags/" (symbol->string tag))))
+        (when (and (file-exists? tags/tag) (symbolic-link? tags/tag))
+          (delete-file tags/tag))
+        (with-output-to-file tags/tag
+          (λ () (display new-pin))))
       (with-output-to-file "./tree"
-        (λ () (write (append stack (list dirhash))))))
+        (λ () (write (grow (environment-tree env) pin dirhash)))))
     (lookup-environment name)))
 
 (define* (roll-back! env #:optional (tag 'current))