diff --git a/4/GNUmakefile b/4/GNUmakefile
new file mode 100644
index 0000000..eed98a1
--- /dev/null
+++ b/4/GNUmakefile
@@ -0,0 +1,2 @@
+# -*- makefile-gmake -*-
+include ../gnu.mk
diff --git a/4/main.scm b/4/main.scm
new file mode 100644
index 0000000..3779750
--- /dev/null
+++ b/4/main.scm
@@ -0,0 +1,116 @@
+(import (scheme base)
+        (scheme cxr)
+        (scheme file)
+        (scheme process-context)
+        (scheme write))
+
+(define (pad item lst)
+  (cons item (reverse (cons item (reverse lst)))))
+
+(define (make-list len fill)
+  (let loop ((len len)
+             (acc '()))
+    (if (zero? len)
+        acc
+        (loop (- len 1) (cons fill acc)))))
+
+(define (get-cell lol row col)
+  (list-ref (list-ref lol row) col))
+
+(define (get-reachables table wid hgh)
+  (let loop ((row 1)
+             (col 1)
+             (sum 0))
+    (if (> row hgh)
+        sum
+        (if (> col wid)
+            (loop (+ row 1) 0 sum)
+            (begin
+              (let ((cell (get-cell table row col)))
+                (if (zero? cell)
+                    (loop row (+ col 1) sum)
+                    (let ((nbors (+ (get-cell table (- row 1) (- col 1))
+                                    (get-cell table (- row 1) col)
+                                    (get-cell table (- row 1) (+ col 1))
+                                    (get-cell table row (- col 1))
+                                    (get-cell table row (+ col 1))
+                                    (get-cell table (+ row 1) (- col 1))
+                                    (get-cell table (+ row 1) col)
+                                    (get-cell table (+ row 1) (+ col 1)))))
+                      (if (< nbors 4)
+                          (begin
+                            (loop row (+ col 1) (+ sum 1)))
+                          (loop row (+ col 1) sum))))))))))
+
+(define (get-reachables/mark-for-deletion table wid hgh)
+  (let loop ((row 1)
+             (col 1)
+             (sum 0)
+             (newtbl '())
+             (newcurrow '()))
+    (if (> row hgh)
+        (values sum (pad (make-list (+ wid 2) 0) (reverse (map (lambda (row) (pad 0 row)) newtbl))))
+        (if (> col wid)
+            (loop (+ row 1) 1 sum (cons (reverse newcurrow) newtbl) '())
+            (begin
+              (let ((cell (get-cell table row col)))
+                (if (zero? cell)
+                    (loop row (+ col 1) sum newtbl (cons cell newcurrow))
+                    (let ((nbors (+ (get-cell table (- row 1) (- col 1))
+                                    (get-cell table (- row 1) col)
+                                    (get-cell table (- row 1) (+ col 1))
+                                    (get-cell table row (- col 1))
+                                    (get-cell table row (+ col 1))
+                                    (get-cell table (+ row 1) (- col 1))
+                                    (get-cell table (+ row 1) col)
+                                    (get-cell table (+ row 1) (+ col 1)))))
+                      (if (< nbors 4)
+                          (loop row (+ col 1) (+ sum 1) newtbl (cons 0 newcurrow))
+                          (loop row (+ col 1) sum newtbl (cons 1 newcurrow)))))))))))
+
+(define (part1 file)
+  (with-input-from-file file
+    (lambda ()
+      (let* ((char->one-or-zero (lambda (char) (if (char=? char #\@) 1 0)))
+             (lines (let loop ((lines '()))
+                      (let ((line (read-line)))
+                        (if (eof-object? line)
+                            (reverse lines)
+                            (loop (cons line lines))))))
+             (padded-lines (map (lambda (line)
+                                  (pad 0 (map char->one-or-zero (string->list line))))
+                                lines))
+             (len (length (car padded-lines)))
+             (wid (- len 2))
+             (hgh (length padded-lines))
+             (table (pad (make-list len 0) padded-lines)))
+        (display (number->string (get-reachables table wid hgh)))
+        (newline)))))
+
+(define (part2 file)
+  (with-input-from-file file
+    (lambda ()
+      (let* ((char->one-or-zero (lambda (char) (if (char=? char #\@) 1 0)))
+             (lines (let loop ((lines '()))
+                      (let ((line (read-line)))
+                        (if (eof-object? line)
+                            (reverse lines)
+                            (loop (cons line lines))))))
+             (padded-lines (map (lambda (line)
+                                  (pad 0 (map char->one-or-zero (string->list line))))
+                                lines))
+             (len (length (car padded-lines)))
+             (wid (- len 2))
+             (hgh (length padded-lines))
+             (table (pad (make-list len 0) padded-lines)))
+        (let loop ((tbl table)
+                   (sum 0))
+          (let-values (((removed newtbl) (get-reachables/mark-for-deletion tbl wid hgh)))
+            (if (zero? removed)
+                (begin
+                  (display sum)
+                  (newline))
+                (loop newtbl (+ removed sum)))))))))
+
+(for-each part1 (cdr (command-line)))
+(for-each part2 (cdr (command-line)))
diff --git a/4/makefile b/4/makefile
new file mode 100644
index 0000000..058141b
--- /dev/null
+++ b/4/makefile
@@ -0,0 +1,2 @@
+# -*- makefile-bsdmake -*-
+.include "../common.mk"